diff --git a/R/conceptCohort.R b/R/conceptCohort.R index 228bc5e..feb0b2d 100644 --- a/R/conceptCohort.R +++ b/R/conceptCohort.R @@ -206,12 +206,15 @@ conceptCohort <- function(cdm, } if(overlap == "extend"){ - cli::cli_inform(c("i" = "Merging overlapping records.")) + cli::cli_inform(c("i" = "Adding overlapping records.")) cdm[[name]] <- cdm[[name]] |> extendOverlap(name = name) |> omopgenerics::recordCohortAttrition(reason = "Add overlapping records") - } + # adding days might mean we no longer satisfy cohort requirements + cli::cli_inform(c("i" = "Re-appplying cohort requirements.")) + cdm[[name]] <- fulfillCohortReqs(cdm = cdm, name = name) + } cdm[[name]] <- omopgenerics::newCohortTable(table = cdm[[name]]) diff --git a/tests/testthat/test-conceptCohort.R b/tests/testthat/test-conceptCohort.R index 2b59d5d..e12227a 100644 --- a/tests/testthat/test-conceptCohort.R +++ b/tests/testthat/test-conceptCohort.R @@ -909,7 +909,7 @@ test_that("overlap option", { "drug_exposure_end_date" = as.Date(c("2020-01-08", "2020-01-11", "2020-01-15")), "drug_type_concept_id" = 1L )) - expect_no_error(conceptCohort(cdm = cdm, + expect_no_error(cdm$cohort_6 <- conceptCohort(cdm = cdm, conceptSet = list(a = 1L), name = "cohort_6", exit = "event_end_date", @@ -917,6 +917,25 @@ test_that("overlap option", { + # Check if "extend" exceeds observation_period_end_date + cdm <- omopgenerics::insertTable( + cdm = cdm, name = "drug_exposure", table = dplyr::tibble( + "drug_exposure_id" = c(1L, 2L), + "person_id" = c(1L, 1L), + "drug_concept_id" = c(1L, 1L), + "drug_exposure_start_date" = as.Date(c("2020-01-15", "2020-01-20")), + "drug_exposure_end_date" = as.Date(c("2020-01-28", "2020-01-28")), + "drug_type_concept_id" = 1L + )) + + expect_no_error(cdm$cohort_7 <- conceptCohort(cdm = cdm, + conceptSet = list(a = 1L), + name = "cohort_7", + exit = "event_end_date", + overlap = "extend")) + + + PatientProfiles::mockDisconnect(cdm) })