Merge pull request #350 from OHDSI/patient_profiles

Use `name` in PatientProfiles add functions

R/collapseCohorts.R

@@ -43,7 +43,7 @@ collapseCohorts <- function(cohort,
  }
  if (gap == Inf) {
  newCohort <- newCohort |>
- PatientProfiles::addObservationPeriodId() |>
+ PatientProfiles::addObservationPeriodId(name = tmpNewCohort) |>
  joinAll(by = c(
  "cohort_definition_id",
  "subject_id",
@@ -52,7 +52,7 @@ collapseCohorts <- function(cohort,
  dplyr::select(!"observation_period_id")
  } else if (gap > 0) {
  newCohort <- newCohort |>
- PatientProfiles::addObservationPeriodId() |>
+ PatientProfiles::addObservationPeriodId(name = tmpNewCohort) |>
  joinOverlap(
  name = tmpNewCohort,
  gap = gap,

R/exitAtColumnDate.R

@@ -137,7 +137,8 @@ exitAtColumnDate <- function(cohort,
  cli::cli_abort("All cohort records must have at least one non-empty date in the `dateColumns`")
  }
 
- tmpName <- omopgenerics::uniqueTableName()
+ tmpPrefix <- omopgenerics::tmpPrefix()
+ tmpName <- omopgenerics::uniqueTableName(prefix = tmpPrefix)
 
  if (all(ids %in% cohortId)) {
  newCohort <- cohort |>
@@ -186,7 +187,7 @@ exitAtColumnDate <- function(cohort,
  dplyr::compute(name = tmpName, temporary = FALSE)
 
  # checks with informative errors
- validateNewCohort(newCohort, cdm, tmpName)
+ validateNewCohort(newCohort, cdm, tmpPrefix)
 
  if (any(!ids %in% cohortId)) {
  dateColumns <- dateColumns[!dateColumns %in% c("cohort_end_date", "cohort_start_date")]
@@ -210,7 +211,7 @@ exitAtColumnDate <- function(cohort,
  dplyr::compute(name = name, temporary = FALSE) |>
  omopgenerics::newCohortTable(.softValidation = TRUE)
 
- cdm <- omopgenerics::dropTable(cdm, name = dplyr::starts_with(tmpName))
+ cdm <- omopgenerics::dropTable(cdm, name = dplyr::starts_with(tmpPrefix))
 
  return(newCohort)
 }
@@ -230,8 +231,11 @@ validateNewCohort <- function(newCohort, cdm, tmpName) {
  }
  ## Out of observation
  checkObservation <- newCohort |>
- PatientProfiles::addFutureObservation(futureObservationName = "observation_end_0123456789",
- futureObservationType = "date") |>
+ PatientProfiles::addFutureObservation(
+ futureObservationName = "observation_end_0123456789",
+ futureObservationType = "date",
+ name = omopgenerics::uniqueTableName(prefix = tmpName)
+ ) |>
  dplyr::filter(.data$cohort_end_date > .data$observation_end_0123456789) |>
  dplyr::tally() |>
  dplyr::pull("n")

R/exitAtDate.R

@@ -36,7 +36,7 @@ exitAtObservationEnd <- function(cohort,
 
  # create new cohort
  newCohort <- cohort |>
- PatientProfiles::addFutureObservation(futureObservationType = "date") |>
+ PatientProfiles::addFutureObservation(futureObservationType = "date", name = name) |>
  # exit at observation end
  dplyr::mutate(
  "cohort_end_date" = dplyr::if_else(
@@ -93,7 +93,7 @@ exitAtDeath <- function(cohort,
 
  # create new cohort
  newCohort <- cohort |>
- PatientProfiles::addDeathDate() |>
+ PatientProfiles::addDeathDate(name = name) |>
  # exit
  dplyr::mutate(
  "cohort_end_date" = dplyr::if_else(

R/padCohortEnd.R

@@ -51,7 +51,8 @@ padCohortEnd <- function(cohort,
  cohort <- cohort |>
  PatientProfiles::addFutureObservationQuery(
  futureObservationType = "date",
- futureObservationName = futureObsCol)
+ futureObservationName = futureObsCol
+ )
  }
 
  if(length(cohortId) < length(ids)) {

R/requireCohortIntersect.R

@@ -81,6 +81,7 @@ requireCohortIntersect <- function(cohort,
  dplyr::filter(.data$cohort_definition_id == .env$targetCohortId) %>%
  dplyr::pull("cohort_name")
 
+ subsetName <- omopgenerics::uniqueTableName()
  subsetCohort <- cohort %>%
  dplyr::select(dplyr::all_of(.env$cols)) %>%
  PatientProfiles::addCohortIntersectCount(
@@ -91,7 +92,8 @@ requireCohortIntersect <- function(cohort,
  targetEndDate = targetEndDate,
  window = window,
  censorDate = censorDate,
- nameStyle = "intersect_cohort"
+ nameStyle = "intersect_cohort",
+ name = name
  )
 
  subsetCohort <- subsetCohort %>%
@@ -103,7 +105,8 @@ requireCohortIntersect <- function(cohort,
  ) |
  (!.data$cohort_definition_id %in% .env$cohortId)
  ) %>%
- dplyr::select(cols)
+ dplyr::select(cols) %>%
+ dplyr::compute(name = subsetName, temporary = FALSE)
 
  # attrition reason
  if (all(intersections == 0)) {
@@ -134,5 +137,7 @@ requireCohortIntersect <- function(cohort,
  omopgenerics::newCohortTable(.softValidation = TRUE) %>%
  omopgenerics::recordCohortAttrition(reason = reason, cohortId = cohortId)
 
+ omopgenerics::dropTable(cdm = cdm, name = subsetName)
+
  return(x)
 }

R/requireConceptIntersect.R

@@ -72,6 +72,7 @@ requireConceptIntersect <- function(cohort,
  if (length(conceptSet) == 0) {
  cli::cli_inform(c("i" = "Empty codelist provided, returning input cohort"))
  } else {
+ subsetName <- omopgenerics::uniqueTableName()
  subsetCohort <- cohort %>%
  dplyr::select(dplyr::all_of(.env$cols)) %>%
  PatientProfiles::addConceptIntersectCount(
@@ -81,7 +82,8 @@ requireConceptIntersect <- function(cohort,
  targetEndDate = targetEndDate,
  window = window,
  censorDate = censorDate,
- nameStyle = "intersect_concept"
+ nameStyle = "intersect_concept",
+ name = subsetName
  )
 
  subsetCohort <- subsetCohort %>%
@@ -93,7 +95,8 @@ requireConceptIntersect <- function(cohort,
  ) |
  (!.data$cohort_definition_id %in% .env$cohortId)
  ) %>%
- dplyr::select(cols)
+ dplyr::select(cols) %>%
+ dplyr::compute(name = subsetName, temporary = FALSE)
 
  # attrition reason
  if (all(intersections == 0)) {
@@ -123,6 +126,8 @@ requireConceptIntersect <- function(cohort,
  dplyr::compute(name = name, temporary = FALSE) %>%
  omopgenerics::newCohortTable(.softValidation = TRUE) %>%
  omopgenerics::recordCohortAttrition(reason = reason, cohortId = cohortId)
+
+ omopgenerics::dropTable(cdm = cdm, name = subsetName)
  }
 
  return(cohort)

R/requireDeathFlag.R

@@ -58,20 +58,23 @@ requireDeathFlag <- function(cohort,
  window_start <- window[[1]][1]
  window_end <- window[[1]][2]
 
+ subsetName <- omopgenerics::uniqueTableName()
  subsetCohort <- cohort %>%
  dplyr::select(dplyr::all_of(.env$cols)) %>%
  PatientProfiles::addDeathFlag(
  indexDate = indexDate,
  censorDate = censorDate,
  window = window,
- deathFlagName = "death"
+ deathFlagName = "death",
+ name = subsetName
  )
 
  if (isFALSE(negate)) {
  subsetCohort <- subsetCohort %>%
  dplyr::filter(.data$death == 1 |
  (!.data$cohort_definition_id %in% cohortId)) %>%
- dplyr::select(!"death")
+ dplyr::select(!"death") %>%
+ dplyr::compute(name = subsetName, temporary = FALSE)
  # attrition reason
  reason <- glue::glue("Death between {window_start} & ",
  "{window_end} days relative to {indexDate}")
@@ -80,7 +83,8 @@ requireDeathFlag <- function(cohort,
  subsetCohort <- subsetCohort %>%
  dplyr::filter(.data$death != 1 |
  (!.data$cohort_definition_id %in% cohortId)) %>%
- dplyr::select(!"death")
+ dplyr::select(!"death") %>%
+ dplyr::compute(name = subsetName, temporary = FALSE)
  # attrition reason
  reason <- glue::glue("Alive between {window_start} & ",
  "{window_end} days relative to {indexDate}")
@@ -96,5 +100,7 @@ requireDeathFlag <- function(cohort,
  omopgenerics::newCohortTable(.softValidation = TRUE) %>%
  omopgenerics::recordCohortAttrition(reason = reason, cohortId = cohortId)
 
+ omopgenerics::dropTable(cdm = cdm, name = subsetName)
+
  return(x)
 }

R/requireDemographics.R

@@ -290,9 +290,9 @@ demographicsFilter <- function(cohort,
  age = reqAge,
  sex = reqSex,
  priorObservation = reqPriorObservation,
- futureObservation = reqFutureObservation
- ) |>
- dplyr::compute(name = workingName, temporary = FALSE)
+ futureObservation = reqFutureObservation,
+  name = workingName
+ )
 
  # all output cohorts in one table to filter all at the same time:
  workingTable <- workingTable |>

R/requireTableIntersect.R

@@ -67,6 +67,7 @@ requireTableIntersect <- function(cohort,
  cli::cli_abort("Currently just one table supported.")
  }
 
+ subsetName <- omopgenerics::uniqueTableName()
  subsetCohort <- cohort %>%
  dplyr::select(dplyr::all_of(.env$cols)) %>%
  PatientProfiles::addTableIntersectCount(
@@ -76,7 +77,8 @@ requireTableIntersect <- function(cohort,
  targetEndDate = targetEndDate,
  window = window,
  censorDate = censorDate,
- nameStyle = "intersect_table"
+ nameStyle = "intersect_table",
+ name = subsetName
  )
 
  subsetCohort <- subsetCohort %>%
@@ -88,7 +90,8 @@ requireTableIntersect <- function(cohort,
  ) |
  (!.data$cohort_definition_id %in% .env$cohortId)
  ) %>%
- dplyr::select(cols)
+ dplyr::select(cols) %>%
+ dplyr::compute(name = subsetName, temporary = FALSE)
 
  # attrition reason
  if (all(intersections == 0)) {
@@ -119,5 +122,7 @@ requireTableIntersect <- function(cohort,
  omopgenerics::newCohortTable(.softValidation = TRUE) %>%
  omopgenerics::recordCohortAttrition(reason = reason, cohortId = cohortId)
 
+ omopgenerics::dropTable(cdm = cdm, name = subsetName)
+
  return(x)
 }