update attrition

OHDSI · Oct 22, 2024 · b816648 · b816648
1 parent c7ef72e
commit b816648
Show file tree

Hide file tree

Showing 2 changed files with 15 additions and 14 deletions.
diff --git a/R/measurementCohort.R b/R/measurementCohort.R
@@ -141,20 +141,14 @@ measurementCohort <- function(cdm,
       cohortCodelist |> dplyr::select("concept_id", "cohort_definition_id"),
       by = "concept_id"
     ) |>
-    dplyr::compute(name = name, temporary = FALSE) |>
-    omopgenerics::newCohortTable(
-      cohortSetRef = cohortSet,
-      cohortCodelistRef = cohortCodelist |> dplyr::collect(),
-      .softValidation = TRUE
-    )
+    dplyr::compute(name = name, temporary = FALSE)
 
   if (!is.null(valueAsConcept) || !is.null(valueAsNumber)) {
     cli::cli_inform(c("i" = "Applying measurement requirements."))
     filterExpr <- getFilterExpression(valueAsConcept, valueAsNumber)
     cohort <- cohort |>
       dplyr::filter(!!!filterExpr) |>
-      dplyr::compute(name = name, temporary = FALSE) |>
-      omopgenerics::recordCohortAttrition(reason = "Fulfilling measurement value requirements")
+      dplyr::compute(name = name, temporary = FALSE)
 
     if (cohort |> dplyr::tally() |> dplyr::pull("n") == 0) {
       cli::cli_warn(
@@ -163,6 +157,13 @@ measurementCohort <- function(cdm,
     }
   }
 
+  cohort <- cohort |>
+    omopgenerics::newCohortTable(
+      cohortSetRef = cohortSet,
+      cohortCodelistRef = cohortCodelist |> dplyr::collect(),
+      .softValidation = TRUE
+    )
+
   if (cohort |> dplyr::tally() |> dplyr::pull("n") == 0) {
     cli::cli_inform(c("i" = "No table could be subsetted, returning empty cohort."))
     cdm <- omopgenerics::emptyCohortTable(cdm = cdm, name = name)

diff --git a/tests/testthat/test-measurementCohort.R b/tests/testthat/test-measurementCohort.R
@@ -77,16 +77,16 @@ test_that("mearurementCohorts works", {
     cdm$cohort |> attrition() |> dplyr::as_tibble(),
     dplyr::tibble(
       "cohort_definition_id" = 1L,
-      "number_records" = c(5L, rep(2L, 4)),
-      "number_subjects" = c(3L, rep(2L, 4)),
-      "reason_id" = 1:5L,
+      "number_records" = c(rep(2L, 4)),
+      "number_subjects" = c(rep(2L, 4)),
+      "reason_id" = 1:4L,
       "reason" = c(
-        "Initial qualifying events", "Fulfilling measurement value requirements",
+        "Initial qualifying events",
         "Not missing record date", "Record in observation",
         "Distinct measurement records"
       ),
-      "excluded_records" = c(0L, 3L, 0L, 0L, 0L),
-      "excluded_subjects" = c(0L, 1L, 0L, 0L, 0L),
+      "excluded_records" = c(0L, 0L, 0L, 0L),
+      "excluded_subjects" = c(0L, 0L, 0L, 0L),
     )
   )
   expect_true(settings(cdm$cohort)$cohort_name == "normal_blood_pressure")