## Patient-level classification of the post-cutoff IL2R cohort.
## il2 : IL2R rows with EMPI, draw_date, status
## ici : ICI rows with EMPI, ici_date, blinded
## Returns one row per patient with >=1 valid IL2R draw on/after `cutoff`.
derive_cohort <- function(il2, ici,
cutoff = CUTOFF_DATE,
valid_status = VALID_STATUS,
include_blinded = FALSE,
same_day_is_prior = FALSE) {
post <- il2[status %in% valid_status & draw_date >= cutoff]
pts <- post[, .(n_post_draws = .N,
n_post_dates = uniqueN(draw_date),
first_post_draw = min(draw_date),
last_post_draw = max(draw_date)), by = EMPI]
ici_use <- if (include_blinded) ici else ici[blinded == FALSE]
ici_use <- ici_use[!is.na(ici_date)]
start <- ici_use[, .(ici_start = min(ici_date)), by = EMPI]
## regimen = every ICI given on the start date (e.g. "ipilimumab + nivolumab")
reg <- ici_use[start, on = .(EMPI, ici_date = ici_start), nomatch = 0L][
, .(ici_first_regimen = paste(sort(unique(ici_generic(MEDICATIONDSC))), collapse = " + ")),
by = EMPI]
start <- merge(start, reg, by = "EMPI", all.x = TRUE)
pts[, in_ici_file := EMPI %chin% unique(ici$EMPI)]
pts <- merge(pts, start, by = "EMPI", all.x = TRUE)
after <- merge(post[, .(EMPI, draw_date)], start[, .(EMPI, ici_start)], by = "EMPI")
after <- if (same_day_is_prior) after[draw_date >= ici_start] else after[draw_date > ici_start]
a <- after[, .(n_after_draws = .N,
n_after_dates = uniqueN(draw_date),
first_after = min(draw_date)), by = EMPI]
pts <- merge(pts, a, by = "EMPI", all.x = TRUE)
pts[is.na(n_after_draws), `:=`(n_after_draws = 0L, n_after_dates = 0L)]
## same-day: an IL2R draw on the ICI start date (reported separately)
sd <- merge(post[, .(EMPI, draw_date)], start[, .(EMPI, ici_start)], by = "EMPI")[
draw_date == ici_start, unique(EMPI)]
pts[, same_day_draw := EMPI %chin% sd]
pts[, group := factor(fcase(
n_after_dates >= 1L, GROUP_LEVELS[1],
in_ici_file & !is.na(ici_start), GROUP_LEVELS[2],
in_ici_file & is.na(ici_start), GROUP_LEVELS[3],
default = GROUP_LEVELS[4]), levels = GROUP_LEVELS)]
pts[, days_ici_to_first_after := as.integer(first_after - ici_start)]
pts[]
}
## The three requested counts from a derive_cohort() frame.
answer_counts <- function(pts) {
c(post_cutoff_patients = nrow(pts),
q1_ici_before_draw = sum(pts$n_after_dates >= 1L),
q2_ge2_after_ici = sum(pts$n_after_dates >= 2L),
q2_ge2_after_ici_draws = sum(pts$n_after_draws >= 2L),
q3_not_in_ici_cohort = sum(!pts$in_ici_file),
in_ici_not_before = sum(pts$in_ici_file & pts$n_after_dates == 0L))
}