[review](feat) Dataset/parameterization update checks.

Author: ml-ebs-ext

R/check_call_auto.R

@@ -4,7 +4,7 @@
 
 # dv.listings::mod_listings
 check_mod_listings_auto <- function(afmm, datasets, module_id, dataset_names, default_vars, pagination,
-    intended_use_label, subjid_var, review, receiver_id, warn, err) {
+    intended_use_label, subjid_var, receiver_id, review, warn, err) {
     OK <- logical(0)
     used_dataset_names <- new.env(parent = emptyenv())
     OK[["module_id"]] <- CM$check_module_id("module_id", module_id, warn, err)
@@ -23,10 +23,10 @@ check_mod_listings_auto <- function(afmm, datasets, module_id, dataset_names, de
     "NOTE: subjid_var (character) tagged as \"manual_check\""
     "      The expectation is that it either does not require automated checks or that"
     "      the caller of this function has written manual checks near the call site."
-    "NOTE: review (group) tagged as \"manual_check\""
+    "NOTE: receiver_id (character) tagged as \"manual_check\""
     "      The expectation is that it either does not require automated checks or that"
     "      the caller of this function has written manual checks near the call site."
-    "NOTE: receiver_id (character) tagged as \"manual_check\""
+    "NOTE: review (group) tagged as \"manual_check\""
     "      The expectation is that it either does not require automated checks or that"
     "      the caller of this function has written manual checks near the call site."
     return(OK)

R/mock_listings.R

@@ -129,3 +129,123 @@ mock_listings_mm <- function() {
     enableBookmarking = "url"
   )
 }
+
+mock_cqm <- function() {
+  ae <- safetyData::sdtm_ae
+  dm <- safetyData::sdtm_dm
+  
+  # Filter out subjects that didn't pass initial screening
+  screen_fail_mask <- dm[["ACTARMCD"]] == "Scrnfail"
+  dm <- dm[!screen_fail_mask, ]
+  
+  # Subset AE columns and extend the domain with a couple of date columns from the demographic data frame
+  ae_cols <- c("STUDYID", "USUBJID", "AETERM", "AEHLGT", "AEHLT", "AELLT", "AEDECOD", "AESOC",
+               "AESTDTC", "AEENDTC", "AEOUT", "AEACN", "AEREL", "AESEV", "AESEQ")
+  ae <- merge(dm[c("USUBJID", "RFXSTDTC", "RFSTDTC")], ae[ae_cols], by = "USUBJID")
+  
+  # Add labels
+  var_labels <- c(
+    STUDYID = "Study Identifier",
+    USUBJID = "Unique Subject Identifier",
+    AETERM = "Reported Term for the Adverse Event",
+    AEHLGT = "High Level Group Term",
+    AEHLT = "High Level Term",
+    AELLT = "Lowest Level Term",
+    AEDECOD = "Dictionary-Derived Term",
+    AESEQ = "Sequence Number",
+    AESOC = "Primary System Organ Class",
+    AESTDTC = "Start Date/Time of Adverse Event",
+    AEENDTC = "End Date/Time of Adverse Event",
+    AEOUT = "Outcome of Adverse Event",
+    AEACN = "Action Taken with Study Treatment",
+    AEREL = "Causality",
+    AESEV = "Severity/Intensity",
+    RFXSTDTC = "Date/Time of First Study Treatment",
+    RFSTDTC = "Subject Reference Start Date/Time",
+    DOMAIN = "Domain Abbreviation",
+    SUBJID = "Subject Identifier for the Study",
+    RFENDTC = "Subject Reference End Date/Time",
+    RFXENDTC = "Date/Time of Last Study Treatment",
+    RFICDTC = "Date/Time of Informed Consent",
+    RFPENDTC = "Date/Time of End of Participation",
+    DTHDTC = "Date/Time of Death",
+    DTHFL = "Subject Death Flag",
+    SITEID = "Study Site Identifier",
+    AGE = "Age",
+    AGEU = "Age Units",
+    SEX = "Sex",
+    RACE = "Race",
+    ETHNIC = "Ethnicity",
+    ARMCD = "Planned Arm Code",
+    ARM = "Description of Planned Arm",
+    ACTARMCD = "Actual Arm Code",
+    ACTARM = "Description of Actual Arm",
+    COUNTRY = "Country",
+    DMDTC = "Date/Time of Collection",
+    DMDY = "Study Day of Collection"
+  )
+ 
+  dm <- set_labels(dm, var_labels[names(dm)]) 
+  ae <- set_labels(ae, var_labels[names(ae)])
+  
+  data_list <- list(ae = ae, dm = dm)
+  
+  attr(data_list[["ae"]], "label") <- "Adverse Events"  # NOTE(miguel): Otherwise uses label from the `dm` dataset
+  
+  # Step 4 - Module specification
+  listing <- mod_listings(
+    module_id = "listing",
+    dataset_names = c("ae", "dm"),
+    default_vars = list(
+      ae = c(
+        "USUBJID",
+        "AESEV",
+        "RFXSTDTC",
+        "RFSTDTC",
+        "AETERM",
+        "AEHLGT", "AEHLT", "AELLT", "AEDECOD", "AESOC",
+        "AESTDTC", "AEENDTC",
+        "AEOUT",
+        "AEACN",
+        "AEREL"
+      ),
+      dm = c("COUNTRY", "RFXSTDTC")
+    ),
+    # Jumping to the Patient Profile module is possible, provided that it is included as well:
+    receiver_id = "papo",
+    review = list(
+      datasets = list(ae = list(id_vars = c("USUBJID", "AESEQ"), untracked_vars = c())),
+      choices = c("Pending", "Reviewed with no issues", "Action required", "Resolved"),
+      roles = c("TSTAT", "SP", "Safety", "CTL"),
+      store_path = tempdir()
+    )
+  )
+  
+  mod_receiver <- function(module_id, sender_id) {
+    list(
+      ui = function(id) shiny::verbatimTextOutput(shiny::NS(id)("out")),
+      server = function(afmm) {
+        shiny::moduleServer(
+          module_id,
+          function(input, output, session) {
+            output[["out"]] <- shiny::reactive({
+              sprintf('Message from module "%s": %s', sender_id, afmm[["module_output"]]()[[sender_id]][["subj_id"]]())
+            })
+          }
+        )
+      },
+      module_id = module_id
+    )
+  }
+  
+  # Step 5 - Run app
+  dv.manager::run_app(
+    data = list("CQM_AE_list" = data_list),
+    module_list = list(
+      "Listing" = listing,
+      "Signal receiver" = mod_receiver(module_id = "papo", sender_id = "listing")
+    ),
+    filter_data = "dm",
+    filter_key = "USUBJID"
+  )
+}

R/mod_listings.R

@@ -760,14 +760,14 @@ mod_listings_API_docs <- list(
   pagination = list(""),
   intended_use_label = list(""),
   subjid_var = list(""), 
+  receiver_id = list(""),
   review = list(
     "Review-related fields",
     datasets = list(""),
     choices = list(""),
     roles = list(""),
     store_path = list("")
-  ), 
-  receiver_id = list("")
+  )
 )
 
 mod_listings_API_spec <- TC$group(
@@ -777,14 +777,13 @@ mod_listings_API_spec <- TC$group(
   pagination = TC$logical() |> TC$flag("manual_check", "optional"),             # manually tested by check_mod_listings
   intended_use_label = TC$character() |> TC$flag("manual_check", "optional"),   # manually tested by check_mod_listings
   subjid_var = TC$character() |> TC$flag("manual_check"),                       # manually tested by check_mod_listings
+  receiver_id = TC$character() |> TC$flag("manual_check"),                      # manually tested by check_mod_listings
   review = TC$group(
-    # TODO: functionality is a WIP, so not defining for now
     datasets = TC$group(),
     choices = TC$character() |> TC$flag("one_or_more"),
     roles = TC$character() |> TC$flag("one_or_more"),
     store_path = TC$character() |> TC$flag("optional")
-  ) |> TC$flag("manual_check", "optional"),
-  receiver_id = TC$character() |> TC$flag("manual_check")                       # manually tested by check_mod_listings
+  ) |> TC$flag("manual_check", "optional")
 ) |> TC$attach_docs(mod_listings_API_docs)
 
 dataset_info_listings <- function(dataset_names, ...) {
@@ -800,7 +799,7 @@ check_mod_listings <- function(afmm, datasets, module_id, dataset_names,
   ok <- check_mod_listings_auto(
     afmm, datasets,
     module_id, dataset_names, default_vars, pagination, intended_use_label,
-    subjid_var, receiver_id, warn, err
+    subjid_var, receiver_id, review, warn, err
   )
 
   # default_vars 
@@ -845,10 +844,6 @@ check_mod_listings <- function(afmm, datasets, module_id, dataset_names,
     msg = "`subjid_var` should be either character(1) or NULL."
   )
 
-  # review
-  # TODO:
-  
-  # receiver_id
   CM$assert(
     container = err,
     cond = checkmate::test_string(receiver_id, null.ok = TRUE),
@@ -860,6 +855,82 @@ check_mod_listings <- function(afmm, datasets, module_id, dataset_names,
                   receiver_id, paste(names(afmm$module_names), collapse = ", ")
     )
   )
+
+  # review
+  local({
+    if (is.null(review)) return(NULL)
+    ok <- CM$assert(
+      container = err,
+      cond = (checkmate::test_list(review, names = "unique") &&
+                checkmate::test_subset(c("datasets", "choices", "roles"), names(review))),
+      msg = "`review` should be a list with at least three elements: `datasets`, `choices` and `roles`"
+    ) &&
+      CM$assert(
+        container = err,
+        cond = (checkmate::test_list(review[["datasets"]], names = "unique") &&
+                  checkmate::test_subset(names(review[["datasets"]]), dataset_names)),
+        msg = sprintf(
+          "`review$datasets` should be a list and its elements should be named after the following dataset names: %s",
+          paste(dataset_names, collapse = ", ")
+        )
+      ) &&
+      CM$assert(
+        container = err,
+        cond = checkmate::test_character(review[["choices"]], min.len = 1, min.chars = 1, unique = TRUE),
+        msg = "`review$choices` should be a non-empty character vector of unique, non-empty strings"
+      ) &&
+      CM$assert(
+        container = err,
+        cond = checkmate::test_character(review[["roles"]], min.len = 1, min.chars = 1, unique = TRUE),
+        msg = "`review$roles` should be a non-empty character vector of unique, non-empty strings"
+      )
+    
+    if (!ok) return(NULL)
+    for (domain in names(review[["datasets"]])){
+      info <- review[["datasets"]][[domain]]
+      
+      for (ds_name in names(afmm[["data"]])){
+        datasets <- afmm[["data"]][[ds_name]]
+        dataset <- datasets[[domain]]
+        
+        CM$assert(
+          container = err,
+          cond = (checkmate::test_list(review, names = "unique") &&
+                    checkmate::test_subset(c("id_vars", "untracked_vars"), names(info))),
+          msg = sprintf("`review$datasets$%s` should be a list with two elements named `id_vars` and `untracked_vars`",
+                        domain)
+        ) &&
+          CM$assert(
+            container = err,
+            cond = (checkmate::test_character(info[["id_vars"]], min.len = 1, min.chars = 1, unique = TRUE) &&
+                      checkmate::test_subset(info[["id_vars"]], names(dataset))),
+            msg = sprintf(
+              paste(
+                "`review$datasets$%s$id_vars` should be a character vector listing a subset of the columns",
+                "available in dataset `%s`"
+              ), domain, domain
+            )
+          ) &&
+          CM$assert(
+            container = err,
+            cond = nrow(dataset[info[["id_vars"]]]) == nrow(unique(dataset[info[["id_vars"]]])),
+            msg = sprintf("`review$datasets$%s$id_vars` should identify uniquely every row of the dataset `%s`", 
+                          domain, domain)
+          ) &&
+          CM$assert(
+            container = err,
+            cond = (checkmate::test_character(info[["untracked_vars"]], min.chars = 1, unique = TRUE, null.ok = TRUE) &&
+                      checkmate::test_subset(info[["untracked_vars"]], names(dataset))),
+            msg = sprintf(
+              paste(
+                "`review$datasets$%s$untracked_vars` should be a character vector listing a subset of the columns",
+                "available in dataset `%s`"
+              ), domain, domain
+            )
+          )
+      }
+    }
+  })
 
   res <- list(warnings = warn[["messages"]], errors = err[["messages"]])
   return(res)