Added DM parameter and merge when SITEID variable exists

R/check_lb_lbstresn_missing.R

@@ -1,10 +1,12 @@
 #' @title Check missing standard lab values (LBSTRESN/LBSTRESC)
 #'
 #' @description This check looks for missing standardized finding (LBSTRESN/LBSTRESC)
-#'              when original finding (LBORRES) is not missing
+#'              when original finding (LBORRES) is not missing. Merges with DM dataset
+#'              when DM$SITEID is present
 #'
 #' @param LB Lab SDTM dataset with variables USUBJID, LBTESTCD, LBDTC, LBORRES,
 #' LBORRESU, LBSTRESN, LBSTRESC, VISIT (optional), LBSPID (optional)
+#' @param DM Demographics SDTM with variables USUBJID, SITEID. Set to NULL.
 #' @param preproc An optional company specific preprocessing script
 #' @param ... Other arguments passed to methods
 #'
@@ -33,11 +35,26 @@
 #'  LBSTRESN  = c(5,6,NA),
 #'  stringsAsFactors=FALSE
 #'  )
+#'  
+#'  DM <- data.frame(
+#'  USUBJID = c("Patient 1","Patient 2","Patient 3"),
+#'  SITEID = c("123","124","125"),
+#'  stringsAsFactors=FALSE
+#'  )
+#'
+#'  DM2 <- data.frame(
+#'  USUBJID = c("Patient 1","Patient 2","Patient 3"),
+#'  stringsAsFactors=FALSE
+#'  )
 #'
 #' check_lb_lbstresn_missing(LB)
 #'
 #' LB$LBSTRESC[3] = ""
 #' check_lb_lbstresn_missing(LB)
+#' 
+#' check_lb_lbstresn_missing(LB, DM)
+#' 
+#' check_lb_lbstresn_missing(LB, DM2)
 #'
 #' LB$LBSTRESC[1] = ""
 #' check_lb_lbstresn_missing(LB)
@@ -55,33 +72,44 @@
 #' check_lb_lbstresn_missing(LB)
 #'
 
-check_lb_lbstresn_missing <- function(LB,preproc=identity,...){
-
+check_lb_lbstresn_missing <- function(LB, DM = NULL,preproc=identity,...){
+  
   if(LB %lacks_any% c("USUBJID", "LBTESTCD", "LBDTC", "LBORRES", "LBORRESU", "LBSTRESN", "LBSTRESC")){
-
+    
     fail(lacks_msg(LB, c("USUBJID", "LBTESTCD", "LBDTC", "LBORRES", "LBORRESU", "LBSTRESN", "LBSTRESC")))
-
+    
   }else{
-
+
+    # If DM is present, merge by USUBJID
+    if(!is.null(DM) & "SITEID" %in% names(DM)){
+
+      DM <- DM %>%
+        select(any_of(c("USUBJID", "SITEID")))
+
+      LB <- left_join(LB, DM, by="USUBJID")
+    }
+
     #Apply company specific preprocessing function
     LB = preproc(LB,...)
-
+    
     # Subset LB to fewer variables
     LB <- LB %>%
-      select(any_of(c("USUBJID", "LBTESTCD", "LBDTC", "LBORRES", "LBORRESU", "LBSTRESN", "LBSTRESC","RAVE","VISIT")))
-
+      select(any_of(c("USUBJID", "LBTESTCD", "LBDTC", "LBORRES", "LBORRESU", 
+                      "LBSTRESN", "LBSTRESC", "RAVE", "VISIT", "SITEID" )))
+
     # Subset to LBORRES populated but LBSTRESN not
     mydf <- subset(LB, !is_sas_na(LB$LBORRES) & is_sas_na(LB$LBSTRESN) & is_sas_na(LB$LBSTRESC))
-
+    
     if (nrow(mydf)==0){
       pass()
     }
     else if (nrow(mydf)>0) {
-        fail(paste0(length(unique(mydf$USUBJID)),
-                    " unique patient(s) with ",
-                    nrow(mydf),
-                    " lab record(s) with result reported without standard value. "),
-             mydf)
+      fail(paste0(length(unique(mydf$USUBJID)),
+                  " unique patient(s) with ",
+                  nrow(mydf),
+                  " lab record(s) with result reported without standard value. "),
+           mydf)
     }
   }
 }
+

R/check_lb_lbstresu.R

@@ -3,11 +3,12 @@
 #' @description This check identifies records where original lab values (LBORRES)
 #' exist but standard lab units (LBSTRESU) are not populated, excluding
 #' qualitative results (LBMETHOD) and excluding records when LBTESTCD in
-#' ("PH" "SPGRAV")
+#' ("PH" "SPGRAV"). Merges with DM dataset when DM$SITEID is present
 #'
 #' @param LB Lab SDTM dataset with variables USUBJID, LBSTRESC, LBSTRESN,
 #'   LBORRES, LBSTRESU, LBTESTCD, LBDTC, LBMETHOD (optional),
 #'   LBSPID (optional), and VISIT (optional)
+#' @param DM Demographics SDTM with variables USUBJID, SITEID. Set to NULL.
 #' @param preproc An optional company specific preprocessing script
 #' @param ... Other arguments passed to methods
 #'
@@ -34,10 +35,29 @@
 #' stringsAsFactors=FALSE
 #' )
 #'
+#'  DM <- data.frame(
+#'  USUBJID = 1:10,
+#'  SITEID = 111:120,
+#'  stringsAsFactors=FALSE
+#'  )
+#'  
+#'  DM2 <- data.frame(
+#'  USUBJID = 1:10,
+#'  stringsAsFactors=FALSE
+#'  )
+#'
+#'
 #' check_lb_lbstresu(LB)
 #'
 #' LB$LBSTRESU[1]=""
 #' check_lb_lbstresu(LB)
+#' 
+#' check_lb_lbstresu(LB, DM2)
+#' 
+#' check_lb_lbstresu(LB, DM)
+#' 
+#' LB$LBSTRESU[1]=""
+#' check_lb_lbstresu(LB)
 #'
 #' LB$LBSTRESU[2]="NA"
 #' check_lb_lbstresu(LB)
@@ -46,7 +66,7 @@
 #' check_lb_lbstresu(LB)
 #'
 #' LB$LBSPID= "FORMNAME-R:2/L:2XXXX"
-#' check_lb_lbstresu(LB,preproc=roche_derive_rave_row)
+#' check_lb_lbstresu(LB, DM, preproc=roche_derive_rave_row)
 #'
 #' LB$VISIT= "SCREENING"
 #' check_lb_lbstresu(LB)
@@ -55,7 +75,7 @@
 #' check_lb_lbstresu(LB)
 #'
 
-check_lb_lbstresu <- function(LB,preproc=identity,...){
+check_lb_lbstresu <- function(LB, DM = NULL, preproc=identity,...){
 
     ###Check that required variables exist and return a message if they don't.
     if(LB %lacks_any% c("USUBJID", "LBSTRESC", "LBSTRESN", "LBSTRESU", "LBORRES",
@@ -64,6 +84,15 @@ check_lb_lbstresu <- function(LB,preproc=identity,...){
                              "LBTESTCD", "LBDTC")))
     } else{
 
+        # If DM is present, merge by USUBJID
+        if(!is.null(DM) & "SITEID" %in% names(DM)){
+
+            DM <- DM %>%
+                select(any_of(c("USUBJID", "SITEID")))
+
+            LB <- left_join(LB, DM, by="USUBJID")
+        }
+
         #Apply company specific preprocessing function
         LB = preproc(LB,...)
 
@@ -82,7 +111,8 @@ check_lb_lbstresu <- function(LB,preproc=identity,...){
 
         # Subset LB to fewer variables
         df <- LB %>%
-            select(any_of(c('USUBJID','LBTESTCD','LBORRES','LBSTRESU','LBSTRESC','LBDTC','RAVE','VISIT')))
+            select(any_of(c('USUBJID','LBTESTCD','LBORRES','LBSTRESU','LBSTRESC','LBDTC',
+                            'RAVE','VISIT', 'SITEID')))
 
         ### Exclude particular labs known to be unitless
         df <- df %>%
@@ -106,4 +136,5 @@ check_lb_lbstresu <- function(LB,preproc=identity,...){
 
     }
 
-}
+}
+