Commit 240198ed authored by Jason Rigby's avatar Jason Rigby
Browse files

add new measures for query ranges

parent 5603903f
...@@ -237,6 +237,7 @@ GetDataBySubjectID <- function(con, tables_and_fields = list(), include_visit_ti ...@@ -237,6 +237,7 @@ GetDataBySubjectID <- function(con, tables_and_fields = list(), include_visit_ti
#' Queries the database for the union of tblPathologyAU and xt_PathologyAU #' Queries the database for the union of tblPathologyAU and xt_PathologyAU
#' #'
#' @param con a database connection using the DBI package or \code{ASPREEDb()} #' @param con a database connection using the DBI package or \code{ASPREEDb()}
#' @param measures subset of measures to return
#' @return the combined data #' @return the combined data
#' @import dplyr #' @import dplyr
#' @export #' @export
...@@ -348,6 +349,7 @@ CombinedPathologyAU <- function(con, measures = NULL) { ...@@ -348,6 +349,7 @@ CombinedPathologyAU <- function(con, measures = NULL) {
#' Queries the database for the union of tblPathologyUS and xt_PathologyUS #' Queries the database for the union of tblPathologyUS and xt_PathologyUS
#' #'
#' @param con a database connection using the DBI package or \code{ASPREEDb()} #' @param con a database connection using the DBI package or \code{ASPREEDb()}
#' @param measures subset of measures to return
#' @return the combined data #' @return the combined data
#' @import dplyr #' @import dplyr
#' @export #' @export
...@@ -451,11 +453,12 @@ CombinedPathologyUS <- function(con, measures = NULL) { ...@@ -451,11 +453,12 @@ CombinedPathologyUS <- function(con, measures = NULL) {
return(data) return(data)
} }
#' Get a combined view of the pre-XT and XT physicsl measures #' Get a combined view of the pre-XT and XT physical measures
#' #'
#' Queries the database for the union of tblAnnualVisits and xt_PhysExam for physical measures #' Queries the database for the union of tblAnnualVisits and xt_PhysExam for physical measures
#' #'
#' @param con a database connection using the DBI package or \code{ASPREEDb()} #' @param con a database connection using the DBI package or \code{ASPREEDb()}
#' @param measures subset of measures to return
#' @return the combined data #' @return the combined data
#' @import dplyr #' @import dplyr
#' @export #' @export
...@@ -528,3 +531,163 @@ select submitted ...@@ -528,3 +531,163 @@ select submitted
} }
return(data) return(data)
} }
#' Get a combined view of the pre-XT and XT physical performance measures
#'
#' Queries the database for the union of tblAnnualVisits and xt_PhysPerform for physical measures
#'
#' @param con a database connection using the DBI package or \code{ASPREEDb()}
#' @param measures subset of measures to return
#' @return the combined data
#' @import dplyr
#' @export
CombinedPhysicalPerformanceMeasures <- function(con, measures = NULL) {
data <- con %>% tbl(sql(
"SELECT submitted
,SubjectID
,visitTime
,unit
,RightGrip1No
,RightGrip1
,RightGrip2No
,RightGrip2
,RightGrip3No
,RightGrip3
,LeftGrip1No
,LeftGrip1
,LeftGrip2No
,LeftGrip2
,LeftGrip3No
,LeftGrip3
,Gait1No
,Gait1
,Gait2No
,Gait2
,WalkAid
,WalkAidOth
,CreatedBy
,CreatedDt
,ModifiedBy
,ModifiedDt
FROM xt_PhysPerform
union
select submitted
,SubjectID
,visitTime
,unit
,NULL AS RightGrip1No
,RightGrip1
,RightGrip2No
,RightGrip2
,RightGrip3No
,RightGrip3
,NULL AS LeftGrip1No
,LeftGrip1
,LeftGrip2No
,LeftGrip2
,LeftGrip3No
,LeftGrip3
,Gait1No
,Gait1
,Gait2No
,Gait2
,WalkAid
,WalkAidOth
,CreatedBy
,CreatedDt
,ModifiedBy
,ModifiedDt
from tblAnnualVisits")) %>% collect() %>% rowwise() %>% mutate(
RightGrip_Mean = mean(c(RightGrip1, RightGrip2, RightGrip3), na.rm = TRUE),
LeftGrip_Mean = mean(c(LeftGrip1, LeftGrip2, LeftGrip3), na.rm = TRUE),
Gait_Mean = mean(c(Gait1, Gait2), na.rm = TRUE),
)
data <- con %>% GetDataBySubjectID(tables_and_fields = list("PhysPerform" = data)) %>% tidyr::drop_na("visitTime")
if (!is.null(measures)) {
data <- data %>% select(c("SubjectID", "visitTime", "visitName", "visitDate", "AV", "year", measures))
}
return(data)
}
#' Get a combined view of the pre-XT and XT "other cogs" measures
#'
#' Queries the database for the union of tblAnnualVisits and xt_OtherCogs for physical measures
#'
#' @param con a database connection using the DBI package or \code{ASPREEDb()}
#' @param measures subset of measures to return
#' @return the combined data
#' @import dplyr
#' @export
CombinedOtherCogsMeasures <- function(con, measures = NULL) {
data <- con %>% tbl(sql(
"SELECT submitted
,SubjectID
,visitTime
,SLFT
,SDMT
,CT1Secs
,CT1Errs
,CT1NM
,CT1Prpts
,CT1NotComplete
,CT2Secs
,CT2ColErrs
,CT2NoErrs
,CT2NM
,CT2Prpts
,CT2NotComplete
,HVLT1
,HVLT2
,HVLT2No
,HVLT3
,HVLT3No
,HVLT4
,HVLT4No
,HVLTRec1
,HVLTRec1No
,HVLTRec2
,HVLTRec2No
,CreatedBy
,CreatedDt
,ModifiedBy
,ModifiedDt
FROM xt_OtherCogs
union
select submitted
,SubjectID
,visitTime
,SLFT
,SDMT
,NULL AS CT1Secs
,NULL AS CT1Errs
,NULL AS CT1NM
,NULL AS CT1Prpts
,NULL AS CT1NotComplete
,NULL AS CT2Secs
,NULL AS CT2ColErrs
,NULL AS CT2NoErrs
,NULL AS CT2NM
,NULL AS CT2Prpts
,NULL AS CT2NotComplete
,HVLT1
,HVLT2
,HVLT2No
,HVLT3
,HVLT3No
,HVLT4
,HVLT4No
,HVLTRec1
,HVLTRec1No
,HVLTRec2
,HVLTRec2No
,CreatedBy
,CreatedDt
,ModifiedBy
,ModifiedDt
from tblAnnualVisits")) %>% collect()
data <- con %>% GetDataBySubjectID(tables_and_fields = list("OtherCogs" = data)) %>% tidyr::drop_na("visitTime")
if (!is.null(measures)) {
data <- data %>% select(c("SubjectID", "visitTime", "visitName", "visitDate", "AV", "year", measures))
}
return(data)
}
...@@ -204,7 +204,7 @@ CalculateXTQueryRanges <- function(con, cutoff_sd = 3) { ...@@ -204,7 +204,7 @@ CalculateXTQueryRanges <- function(con, cutoff_sd = 3) {
Hb = case_when( Hb = case_when(
!is.na(Hb_Pathology) ~ Hb_Pathology, !is.na(Hb_Pathology) ~ Hb_Pathology,
TRUE ~ Hb TRUE ~ Hb
), ),
Cr = Cr * 88.4, Cr = Cr * 88.4,
ACR = ACR * 0.113, ACR = ACR * 0.113,
Glc = Glc * 0.0555, Glc = Glc * 0.0555,
...@@ -221,11 +221,21 @@ CalculateXTQueryRanges <- function(con, cutoff_sd = 3) { ...@@ -221,11 +221,21 @@ CalculateXTQueryRanges <- function(con, cutoff_sd = 3) {
"DBP_Mean", "DBP_Mean",
"HR_Mean", "HR_Mean",
"Wt" "Wt"
)))$cutoffs, )))$cutoffs,
CalculateQueryRanges(con, 7, 9, cutoff_sd = cutoff_sd, make_plots = FALSE, CalculateQueryRanges(con, 7, 9, cutoff_sd = cutoff_sd, make_plots = FALSE,
tables_and_fields = CombinedPhysicalMeasures(con, c( tables_and_fields = CombinedPhysicalMeasures(con, c(
"AC" "AC"
)))$cutoffs )))$cutoffs,
CalculateQueryRanges(con, 7, 8, cutoff_sd = cutoff_sd, make_plots = FALSE,
tables_and_fields = CombinedPhysicalPerformanceMeasures(con, c(
"LeftGrip_Mean",
"RightGrip_Mean",
"Gait_Mean"
)))$cutoffs,
CalculateQueryRanges(con, 7, 9, cutoff_sd = cutoff_sd, make_plots = FALSE,
tables_and_fields = CombinedOtherCogsMeasures(con, c(
"SLFT", "SDMT"
)))$cutoffs
) )
} }
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment