Closes #1984 Allowing missing trt end date in derive_var_ontrtfl()

NEWS.md

@@ -5,6 +5,7 @@
 ## Updates of Existing Functions
 - The functions `derive_param_bmi()` and `derive_param_bsa()` are updated to have the option of producing more values at visits when only weight is collected (#1228).
 - The functions `derive_var_age_years()` and `compute_age_years()` are updated to return an `NA` age in the case that the age unit is missing. (#2001) The argument `unit` for `derive_vars_aage()` is also changed to `age_unit` for consistency between these age-related functions. (#2025)
+- The `derive_var_ontrtfl()` function has been updated to allow for the column passed in `ref_end_date` to contain `NA` values. Previously, if the end date was `NA`, the row would never be flagged. Now, an `NA` value is interpreted as the treatment being ongoing, for example. (#1984)
 
 - The function `derive_var_extreme_flag()` has a new function argument, `flag_all` that additionally flags all records if the first or last record is not unique. (#1979)
 

R/derive_var_ontrtfl.R

@@ -236,9 +236,15 @@ derive_var_ontrtfl <- function(dataset,
   } else {
     # Scenario 2: Treatment end date is passed, window added above
     if (ignore_time_for_ref_end_date) {
-      end_cond <- expr(date(!!start_date) <= date(!!ref_end_date) + days(!!ref_end_window))
+      end_cond <- expr(
+        (date(!!start_date) <= date(!!ref_end_date) + days(!!ref_end_window)) |
+          is.na(!!ref_end_date)
+      )
     } else {
-      end_cond <- expr(!!start_date <= !!ref_end_date + days(!!ref_end_window))
+      end_cond <- expr(
+        (!!start_date <= !!ref_end_date + days(!!ref_end_window)) |
+          is.na(!!ref_end_date)
+      )
     }
     dataset <- mutate(
       dataset,

tests/testthat/_snaps/derive_var_ontrtfl.md

@@ -0,0 +1,22 @@
+# derive_var_ontrtfl Test 15: if trt end date is missing, the obs may still be flagged
+
+    Code
+      derive_var_ontrtfl(adcm, start_date = ASTDT, end_date = AENDT, ref_start_date = TRTSDT,
+        ref_end_date = TRTEDT, span_period = "Y")
+    Output
+        USUBJID      ASTDT     TRTSDT TRTEDT      AENDT ONTRTFL
+      1     P01 2018-03-15 2019-01-01     NA 2022-12-01       Y
+      2     P02 2020-04-30 2019-01-01     NA 2022-03-15       Y
+      3     P03 2020-04-30 2019-01-01     NA       <NA>       Y
+
+---
+
+    Code
+      derive_var_ontrtfl(adcm, start_date = ASTDT, end_date = AENDT, ref_start_date = TRTSDT,
+        ref_end_date = TRTEDT)
+    Output
+        USUBJID      ASTDT     TRTSDT TRTEDT      AENDT ONTRTFL
+      1     P01 2018-03-15 2019-01-01     NA 2022-12-01    <NA>
+      2     P02 2020-04-30 2019-01-01     NA 2022-03-15       Y
+      3     P03 2020-04-30 2019-01-01     NA       <NA>       Y
+

tests/testthat/test-derive_var_ontrtfl.R

@@ -402,3 +402,38 @@ test_that("derive_var_ontrtfl Test 14: start_date < ref_start_date and end_date
     keys = c("STUDYID", "USUBJID", "ASTDT")
   )
 })
+
+
+## Test 15: if trt end date is missing, the obs may still be flagged ----
+test_that("derive_var_ontrtfl Test 15: if trt end date is missing, the obs may still be flagged", { # nolint
+  adcm <- tibble::tribble(
+    ~USUBJID, ~ASTDT, ~TRTSDT, ~TRTEDT, ~AENDT,
+    "P01", ymd("2018-03-15"), ymd("2019-01-01"), NA, ymd("2022-12-01"),
+    "P02", ymd("2020-04-30"), ymd("2019-01-01"), NA, ymd("2022-03-15"),
+    "P03", ymd("2020-04-30"), ymd("2019-01-01"), NA, NA,
+  ) %>%
+    as.data.frame()
+
+  # all flags should be "Y" because span_period flag is "Y"
+  expect_snapshot(
+    derive_var_ontrtfl(
+      adcm,
+      start_date = ASTDT,
+      end_date = AENDT,
+      ref_start_date = TRTSDT,
+      ref_end_date = TRTEDT,
+      span_period = "Y"
+    )
+  )
+
+  # first obs started before treatment, and it should NOT be flagged
+  expect_snapshot(
+    derive_var_ontrtfl(
+      adcm,
+      start_date = ASTDT,
+      end_date = AENDT,
+      ref_start_date = TRTSDT,
+      ref_end_date = TRTEDT
+    )
+  )
+})