0115 ct alert message (#121)

* Apply review comments

* style file

* lint issue

* Add function to check ISO8601 format

* Closes #101 and #113

* Closes #115

This update introduces an informative message about unmappable CT terms. All functions calling `ct_map()` benefit from this feature: `hardcode_ct()` and `assign_ct()`.

* Add unit test

* Address Ramm's review comments

`inform_on_ct_mappability()` is now lenient on empty string and `NA` terms.

* Fix typo

---------

Co-authored-by: Shiyu Chen <shiyu.chen@atorusresearch.com>

Author: ramiromagno

R/ct.R

@@ -184,6 +184,59 @@ ct_mappings <- function(ct_spec, from = ct_spec_vars("from"), to = ct_spec_vars(
   ct_mappings
 }
 
+#' Identify CT mappable terms
+#'
+#' @description
+#'
+#' [is_ct_mappable()] returns a logical vector indicating whether each element
+#' of `x` is found in the `from` values used for controlled terminology recoding.
+#'
+#' Empty strings (blanks) and `NA` values are treated specially and are
+#' considered mappable terms, even though they might not be.
+#'
+#' This function is useful for checking in advance which terms in a vector can be
+#' recoded given a specified controlled terminology mapping.
+#'
+#' @param x A character vector of terms to be evaluated for recoding.
+#' @param from A character vector of controlled terminology terms that `x` will
+#'   be compared against.
+#'
+#' @return A logical vector of the same length as `x`, where `TRUE` indicates the
+#'   corresponding term in `x` is found in `from`, and `FALSE` otherwise.
+#'
+#' @keywords internal
+is_ct_mappable <- function(x, from) {
+  !is.na(index_for_recode(x = x, from = from)) | is.na(x) | x %in% ""
+}
+
+#' Inform on the mappability of terms to controlled terminology
+#'
+#' [inform_on_ct_mappability()] checks whether all values in `x` can be mapped
+#' using the controlled terminology terms in `from`. It raises an informative
+#' message if any values in `x` are not mappable.
+#'
+#' @param x A character vector of terms to be checked.
+#' @param from A character vector of valid controlled terminology terms.
+#'
+#' @returns Invisibly returns `TRUE` if all terms are mappable; otherwise,
+#'   prints an informative message and returns `FALSE` invisibly.
+#'
+#' @keywords internal
+inform_on_ct_mappability <- function(x, from) {
+  is_mappable <- is_ct_mappable(x, from)
+  if (all(is_mappable)) {
+    return(invisible(TRUE))
+  }
+
+  unmappable <- unique(x[!is_mappable])
+
+  cli::cli_alert_info("These terms could not be mapped per the controlled terminology: {.val {unmappable}}.",
+    wrap = FALSE
+  )
+
+  invisible(FALSE)
+}
+
 #' Recode according to controlled terminology
 #'
 #' [ct_map()] recodes a vector following a controlled terminology.
@@ -246,6 +299,7 @@ ct_map <-
     ct_spec <- dplyr::filter(ct_spec, .data[[ct_spec_vars("ct_clst")]] %in% ct_clst)
 
     mappings <- ct_mappings(ct_spec, from = from, to = to)
+    inform_on_ct_mappability(x, from = mappings$from)
     recode(
       x,
       from = mappings$from,

inst/WORDLIST

@@ -72,3 +72,14 @@ RELREC
 SDTMIG
 SV
 GSK
+mappable
+mappability
+IDVAR
+QLABEL
+QNAM
+QORIG
+RFENDTC
+RFXENDTC
+suppquals
+tformat
+dformat

man/inform_on_ct_mappability.Rd

@@ -79,3 +79,87 @@ test_that("hardcode_ct works as expected", {
 
   expect_identical(result, expected_result)
 })
+
+test_that("hardcode_ct informs about unmappable terms", {
+  md1 <-
+    tibble::tribble(
+      ~oak_id, ~raw_source, ~patient_number, ~MDRAW,
+      1L,      "MD1",       101L,            "BABY ASPIRIN",
+      2L,      "MD1",       102L,            "CORTISPORIN",
+      3L,      "MD1",       103L,            NA_character_,
+      4L,      "MD1",       104L,            "DIPHENHYDRAMINE HCL"
+    )
+
+  cm_inter <-
+    tibble::tribble(
+      ~oak_id, ~raw_source, ~patient_number, ~CMTRT,                ~CMINDC,
+      1L,      "MD1",       101L,            "BABY ASPIRIN",        NA,
+      2L,      "MD1",       102L,            "CORTISPORIN",         "NAUSEA",
+      3L,      "MD1",       103L,            "ASPIRIN",             "ANEMIA",
+      4L,      "MD1",       104L,            "DIPHENHYDRAMINE HCL", "NAUSEA",
+      5L,      "MD1",       105L,            "PARACETAMOL",         "PYREXIA"
+    )
+
+  (ct_spec <- read_ct_spec_example("ct-01-cm"))
+
+  exp_msg <- "These terms could not be mapped per the controlled terminology: \"GENERAL CONCOMITANT MEDICATIONS\"."
+  expect_message(
+    hardcode_ct(
+      tgt_dat = cm_inter,
+      tgt_var = "CMCAT",
+      raw_dat = md1,
+      raw_var = "MDRAW",
+      tgt_val = "GENERAL CONCOMITANT MEDICATIONS",
+      ct_spec = ct_spec,
+      ct_clst = "C66729"
+    ),
+    exp_msg
+  )
+})
+
+test_that("hardcode_ct does not consider blanks or NAs to be CT unmappable", {
+  md1 <-
+    tibble::tribble(
+      ~oak_id, ~raw_source, ~patient_number, ~MDRAW,
+      1L,      "MD1",       101L,            "BABY ASPIRIN",
+      2L,      "MD1",       102L,            "CORTISPORIN",
+      3L,      "MD1",       103L,            NA_character_,
+      4L,      "MD1",       104L,            "DIPHENHYDRAMINE HCL"
+    )
+
+  cm_inter <-
+    tibble::tribble(
+      ~oak_id, ~raw_source, ~patient_number, ~CMTRT,                ~CMINDC,
+      1L,      "MD1",       101L,            "BABY ASPIRIN",        NA,
+      2L,      "MD1",       102L,            "CORTISPORIN",         "NAUSEA",
+      3L,      "MD1",       103L,            "ASPIRIN",             "ANEMIA",
+      4L,      "MD1",       104L,            "DIPHENHYDRAMINE HCL", "NAUSEA",
+      5L,      "MD1",       105L,            "PARACETAMOL",         "PYREXIA"
+    )
+
+  (ct_spec <- read_ct_spec_example("ct-01-cm"))
+
+  expect_silent(
+    hardcode_ct(
+      tgt_dat = cm_inter,
+      tgt_var = "CMCAT",
+      raw_dat = md1,
+      raw_var = "MDRAW",
+      tgt_val = "",
+      ct_spec = ct_spec,
+      ct_clst = "C66729"
+    )
+  )
+
+  expect_silent(
+    hardcode_ct(
+      tgt_dat = cm_inter,
+      tgt_var = "CMCAT",
+      raw_dat = md1,
+      raw_var = "MDRAW",
+      tgt_val = NA_character_,
+      ct_spec = ct_spec,
+      ct_clst = "C66729"
+    )
+  )
+})