Last obs before exposure flag and baseline flag

R/derive_blfl.R

@@ -142,6 +142,7 @@ dtc_timepart <- function(dtc, partial_as_na = TRUE, ignore_seconds = TRUE) {
 #'  - Join the baseline flag onto the input dataset based on oak id vars
 #'
 #' @param sdtm_in Input SDTM domain.
+#' @param dm_domain DM domain with the reference varaible `ref_var`
 #' @param tgt_var Name of variable to be derived (`--BLFL` or
 #'   `--LOBXFL` where `--` is domain).
 #' @param ref_var vector of a date/time from the
@@ -413,15 +414,15 @@ derive_blfl <- function(sdtm_in,
 
   # Split --DTC and ref_var into date and time parts
   # (partial or missing dates and times set to NA)
-  ds_mod$dom_dt <- dtc_datepart(ds_mod[[domain_prefixed_names["dtc"]]]) # nolint object_name_linter()
-  ds_mod$dom_tm <- dtc_timepart(ds_mod[[domain_prefixed_names["dtc"]]]) # nolint object_name_linter()
-  ds_mod$ref_dt <- dtc_datepart(ds_mod[[ref_var]]) # nolint object_name_linter()
-  ds_mod$ref_tm <- dtc_timepart(ds_mod[[ref_var]]) # nolint object_name_linter()
+  ds_mod$dom_dt <- dtc_datepart(ds_mod[[domain_prefixed_names["dtc"]]])
+  ds_mod$dom_tm <- dtc_timepart(ds_mod[[domain_prefixed_names["dtc"]]])
+  ds_mod$ref_dt <- dtc_datepart(ds_mod[[ref_var]])
+  ds_mod$ref_tm <- dtc_timepart(ds_mod[[ref_var]])
 
 
   # If VISIT not in data frame then assign it as "<unspecified>" for processing
   if (!"VISIT" %in% names(ds_mod)) {
-    ds_mod[["VISIT"]] <- "<unspecified>" # nolint object_name_linter()
+    ds_mod[["VISIT"]] <- "<unspecified>"
   }
 
   # If --TPT not in data frame then assign it as "<unspecified>" for processing
@@ -465,7 +466,7 @@ derive_blfl <- function(sdtm_in,
   ds_base <- rbind(ds_subset_lt, ds_subset_eq_1, ds_subset_eq_2)
 
   # Sort the rows in ascending order with respect to columns from con_col
-  ds_base <- dplyr::arrange_at(ds_base, c("USUBJID", con_col)) # nolint object_name_linter()
+  ds_base <- dplyr::arrange_at(ds_base, c("USUBJID", con_col))
 
   if (nrow(ds_base) == 0L) {
     message(paste0("There are no baseline records."))
@@ -480,7 +481,7 @@ derive_blfl <- function(sdtm_in,
     dplyr::slice_max(!!rlang::sym(domain_prefixed_names["dtc"]), na_rm = TRUE) |>
     dplyr::ungroup() |>
     dplyr::select(
-      dplyr::all_of(c(sdtm.oak:::oak_id_vars(), domain_prefixed_names[["testcd"]])),
+      dplyr::all_of(c(sdtm.oak::oak_id_vars(), domain_prefixed_names[["testcd"]])),
       dplyr::any_of(
         c(domain_prefixed_names[c(
           "cat",
@@ -501,7 +502,7 @@ derive_blfl <- function(sdtm_in,
   # Join baseline flag onto input dataset
   ds_out <- dplyr::left_join(sdtm_in, ds_blfl, by = c(
     domain_prefixed_names[["testcd"]],
-    sdtm.oak:::oak_id_vars()
+    sdtm.oak::oak_id_vars()
   ))
 
   # Assert that merged data frame has same number of rows as input data frame

R/globals.R

@@ -0,0 +1,2 @@
+utils::globalVariables(c("USUBJID", "VISIT", "dom_dt", "dom_tm", "ref_dt",
+                         "ref_tm"))

tests/testthat/test-derive_blfl.R

@@ -1,4 +1,3 @@
-dta <- function(env = parent.frame()) {
   dm <- tibble::tribble(
     ~USUBJID, ~RFSTDTC, ~RFXSTDTC,
     "test_study-375", "2020-09-28T10:10", "2020-09-28T10:10",
@@ -24,18 +23,10 @@ dta <- function(env = parent.frame()) {
       "VS", 3L, "VTLS1", 378L, "test_study-378", "2020-01-21T11:00", "PULSE", "105", NA, "SCREENING"
     )
 
-  withr::defer(
-    {
-      rm(d, envir = env)
-    },
-    envir = env
-  )
+  d <- list(sdtm_in = sdtm_in, dm = dm)
 
-  list(sdtm_in = sdtm_in, dm = dm)
-}
 
 test_that("derive_blfl example works", {
-  d <- dta()
 
   observed_output <- derive_blfl(
     sdtm_in = d$sdtm_in,
@@ -50,7 +41,6 @@ test_that("derive_blfl example works", {
 })
 
 test_that("derive_blfl sdmt_in validations work", {
-  d <- dta()
   sdmt_in_no_domain <-
     d$sdtm_in |>
     dplyr::select(-DOMAIN)
@@ -64,7 +54,7 @@ test_that("derive_blfl sdmt_in validations work", {
 
   sdmt_in_no_id_vars <-
     d$sdtm_in |>
-    dplyr::select(-sdtm.oak:::oak_id_vars())
+    dplyr::select(-sdtm.oak::oak_id_vars())
 
   expect_snapshot_error(derive_blfl(
     sdtm_in = sdmt_in_no_id_vars,
@@ -91,7 +81,6 @@ test_that("derive_blfl sdmt_in validations work", {
 })
 
 test_that("derive_blfl dm_domain validations work", {
-  d <- dta()
 
   dm_no_vars <-
     d$dm |>
@@ -106,7 +95,6 @@ test_that("derive_blfl dm_domain validations work", {
 })
 
 test_that("derive_blfl tgt_var and ref_var validations work", {
-  d <- dta()
 
   expect_snapshot_error(derive_blfl(
     sdtm_in = d$sdtm_in,
@@ -131,7 +119,6 @@ test_that("derive_blfl tgt_var and ref_var validations work", {
 })
 
 test_that("derive_blfl DOMAIN validation works", {
-  d <- dta()
 
   sdtm_in_bad_domain <-
     d$sdtm_in |>