add new measures for query ranges

R/data_access.R

@@ -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
 #'
 #' @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
@@ -348,6 +349,7 @@ CombinedPathologyAU <- function(con, measures = NULL) {
 #' Queries the database for the union of tblPathologyUS and xt_PathologyUS
 #'
 #' @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
@@ -451,11 +453,12 @@ CombinedPathologyUS <- function(con, measures = NULL) {
   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
 #'
 #' @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
@@ -528,3 +531,163 @@ select submitted
   }
   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)
+}

R/data_quality.R

@@ -204,7 +204,7 @@ CalculateXTQueryRanges <- function(con, cutoff_sd = 3) {
       Hb = case_when(
         !is.na(Hb_Pathology) ~ Hb_Pathology,
         TRUE ~ Hb
-        ),
+      ),
       Cr = Cr * 88.4,
       ACR = ACR * 0.113,
       Glc = Glc * 0.0555,
@@ -221,11 +221,21 @@ CalculateXTQueryRanges <- function(con, cutoff_sd = 3) {
                            "DBP_Mean",
                            "HR_Mean",
                            "Wt"
-                          )))$cutoffs,
+                         )))$cutoffs,
     CalculateQueryRanges(con, 7, 9, cutoff_sd = cutoff_sd, make_plots = FALSE,
                          tables_and_fields = CombinedPhysicalMeasures(con, c(
                            "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
   )
 }