tests/testthat/test-13-db-custom_cohort_creation.R

test_custom_derived_cohort <- function(con, cdm_schema, write_schema) {
  skip_if_not_installed("CirceR")
  cdm <- cdmFromCon(con, cdmSchema = cdm_schema, writeSchema = write_schema)
  cohort_set <- readCohortSet(system.file("cohorts3", package = "CDMConnector"))
  cdm <- generateCohortSet(cdm, cohort_set, name = "cohort")

  cdm$cohort2 <- cdm$cohort %>%
    dplyr::filter(!!datediff("cohort_start_date", "cohort_end_date") >= 14) %>%
    dplyr::mutate(cohort_definition_id = 10L + cohort_definition_id) %>%
    dplyr::union_all(
      cdm$cohort %>%
        dplyr::filter(!!datediff("cohort_start_date", "cohort_end_date") >= 21) %>%
        dplyr::mutate(cohort_definition_id = 100L + cohort_definition_id)
    ) %>%
    dplyr::union_all(
      cdm$cohort %>%
        dplyr::filter(!!datediff("cohort_start_date", "cohort_end_date") >= 28) %>%
        dplyr::mutate(cohort_definition_id = 1000L + cohort_definition_id)
    ) %>%
    compute(name = "cohort2", temporary = FALSE, overwrite = TRUE)

  expect_s3_class(cdm$cohort2, "GeneratedCohortSet")
}

for (dbtype in dbToTest) {
  test_that(glue::glue("{dbtype} - test_custom_derived_cohort"), {
    if (!(dbtype %in% ciTestDbs)) skip_on_ci()
    if (dbtype != "duckdb") skip_on_cran() else skip_if_not_installed("duckdb")

    con <- get_connection(dbtype)
    cdm_schema <- get_cdm_schema(dbtype)
    write_schema <- get_write_schema(dbtype)
    skip_if(any(write_schema == "") || any(cdm_schema == "") || is.null(con))
    test_custom_derived_cohort(con, cdm_schema = cdm_schema, write_schema = write_schema)
    disconnect(con)
  })
}

Try the CDMConnector package in your browser

Any scripts or data that you put into this service are public.

CDMConnector documentation built on April 4, 2025, 4:42 a.m.