| Source | File | Use | Rows | Patients |
|---|---|---|---|---|
| RPDR Mrn | MES98_20260811_112907_Mrn.txt | Patient set (one row per patient) | 3,171 | 3,171 |
| RPDR Lab | MES98_20260811_112907_Lab.txt | Soluble IL2R results (plus creatinine, not used here) | 279,588 | 3,154 |
| RPDR Med | MES98_20260811_112907_Med.txt | Independent check for ICI exposure | 2,189,102 | - |
| RPDR Dia | MES98_20260811_112907_Dia.txt | Malignancy codes, for chart-review triage | - | - |
| ICI data pull | ICI_data_pull_07172026.csv | ICI administrations (Epic MAR ‘New Bag’) | 294,252 | 28,911 |
Soluble IL-2R × ICI — Data Management
Inputs, variable changes and linkage QC
NoteAbout this page
All patient-level processing happens locally in R/build.R (run with Rscript R/build.R). This page shows the code and the aggregate QC tables the build writes to cache/summary.rds. Counts from 1 to 10 are shown as <11.
1 Data sources
2 ICI data pull
2.1 Variable changes
Two changes are made when the file is read, so every downstream object uses the RPDR conventions:
| Raw | Cleaned | Why |
|---|---|---|
EMPI MRN (column G) |
EMPI |
Same name as the RPDR key; joins need no renaming |
SCHEDULEDSTARTDTS = YYYY-MM-DDThh:mm:ssZ |
SCHEDULEDSTARTDTS = YYYY-MM-DD (Date) |
ICI timing is compared at the day level |
Show code
## ICI data pull. Two changes are applied on read, so the rest of the pipeline
## (and every downstream file) matches the RPDR conventions:
## 1. `EMPI MRN` (column G) is renamed to `EMPI`
## 2. SCHEDULEDSTARTDTS "YYYY-MM-DDThh:mm:ssZ" becomes a Date (YYYY-MM-DD)
read_ici <- function(path) {
stopifnot(file.exists(path))
ici <- fread(path, colClasses = "character", showProgress = FALSE)
stopifnot("EMPI MRN" %in% names(ici), "SCHEDULEDSTARTDTS" %in% names(ici))
setnames(ici, "EMPI MRN", "EMPI")
ici[, SCHEDULEDSTARTDTS_raw_hour := as.integer(substr(SCHEDULEDSTARTDTS, 12, 13))]
ici[, SCHEDULEDSTARTDTS := parse_ici_date(SCHEDULEDSTARTDTS)]
ici[]
}
## ICI SCHEDULEDSTARTDTS: ISO-8601 "YYYY-MM-DDThh:mm:ssZ" -> calendar Date.
## The date is taken exactly as written (no time-zone shift): the trailing "Z"
## is an export artefact, not a real UTC offset -- scheduled hours cluster at
## 08:00-17:00, i.e. local clinic hours.
parse_ici_date <- function(x) {
ok <- is.na(x) | grepl("^\\d{4}-\\d{2}-\\d{2}T\\d{2}:\\d{2}:\\d{2}Z?$", x)
if (!all(ok)) stop(sum(!ok), " SCHEDULEDSTARTDTS values are not ISO-8601")
as.Date(substr(x, 1, 10))
}| Check | Result |
|---|---|
EMPI values that are 9 digits (ICI pull) |
100.0% |
EMPI values that are 9 digits (RPDR Lab, IL2R rows) |
100.0% |
SCHEDULEDSTARTDTS values that failed to parse |
0 |
Earliest SCHEDULEDSTARTDTS (month) |
2015-05 |
Latest SCHEDULEDSTARTDTS (month) |
2026-07 |
3 RPDR soluble IL2R labs
3.1 Records by year
| Draw year | IL2R records |
|---|---|
| 2005-2014 | 52 |
| 2015 | 13 |
| 2016 | 37 |
| 2017 | 75 |
| 2018-2020 | 31 |
| 2021 | 491 |
| 2022 | 558 |
| 2023 | 563 |
| 2024 | 896 |
| 2025 | 799 |
4 Linkage
| Check | N |
|---|---|
| IL2R patients (Lab) not in the RPDR patient set | 0 |
| Post-2015 IL2R patients found in the ICI pull | 491 |
| Patient-days with 2 or more numeric IL2R Results | 14 |
5 Full pipeline code
Show code
## =============================================================================
## R/functions.R -- helpers for the soluble IL-2 receptor (sIL2R) x ICI pipeline
##
## Pure functions. Nothing in this file prints row-level data; identifier
## columns (EMPI etc.) are used only as join keys inside data.table operations.
## =============================================================================
suppressPackageStartupMessages(library(data.table))
## ---- constants ----------------------------------------------------------------
## RPDR Lab Group_Id values that are soluble IL-2 receptor (CD25) tests.
## (Test_Id: el:5200007493, wc954.1945, mcsq-il2ra, dcsqe-il2ra)
IL2R_GROUPS <- c("INTERL2-RS", "INTERL2", "IL2R-ALPHA")
## "After 2015" = drawn on or after this date. Patients whose IL2R values are
## ALL before this date are excluded.
CUTOFF_DATE <- as.Date("2015-01-01")
## Small-cell threshold for anything rendered to the website (cells 1-10 hidden).
SMALL_CELL <- 11L
## Identifier / quasi-identifier columns: never printed, never rendered.
RESTRICTED_COLS <- c(
"EMPI", "EMPI MRN", "Enterprise_Master_Patient_Index", "EPIC_PMRN", "PMRN",
"MRN", "MGH MRN", "DFCI MRN", "MGH_MRN", "BWH_MRN", "FH_MRN", "SRH_MRN",
"NWH_MRN", "NSMC_MRN", "MCL_MRN", "MEE_MRN", "DFC_MRN", "WDH_MRN",
"IncomingId", "PATIENTID", "PATIENTENCOUNTERID", "Encounter_number",
"Accession", "Date_of_Birth", "BIRTHDTS", "Zip_code", "Date_Of_Death"
)
## Immune checkpoint inhibitors: generic names, sponsor codes, US brand names.
ICI_REGEX <- paste(c(
"pembrolizumab", "nivolumab", "ipilimumab", "atezolizumab", "durvalumab",
"avelumab", "cemiplimab", "dostarlimab", "tremelimumab", "relatlimab",
"retifanlimab", "toripalimab", "tislelizumab", "cosibelimab", "ivonescimab",
"fianlimab", "favezelimab", "vibostolimab",
"mk-?3475", "bms-?936558", "medi-?4736", "mpdl-?3280a", "tsr-?042",
"regn-?2810", "msb-?0010718c", "bms-?986213", "mk-?4280a", "mk-?7684a",
"keytruda", "opdivo", "yervoy", "tecentriq", "imfinzi", "bavencio",
"libtayo", "jemperli", "imjudo", "opdualag", "zynyz", "loqtorzi",
"tevimbra", "unloxcyt"), collapse = "|")
## Code / brand -> generic, used only for aggregate drug tables.
ICI_GENERIC_MAP <- c(
"mk-?3475" = "pembrolizumab", "keytruda" = "pembrolizumab",
"bms-?936558" = "nivolumab", "opdivo" = "nivolumab",
"yervoy" = "ipilimumab",
"mpdl-?3280a" = "atezolizumab", "tecentriq" = "atezolizumab",
"medi-?4736" = "durvalumab", "imfinzi" = "durvalumab",
"msb-?0010718c" = "avelumab", "bavencio" = "avelumab",
"regn-?2810" = "cemiplimab", "libtayo" = "cemiplimab",
"tsr-?042" = "dostarlimab", "jemperli" = "dostarlimab",
"imjudo" = "tremelimumab",
## fixed-dose co-formulations
"opdualag" = "nivolumab/relatlimab", "bms-?986213" = "nivolumab/relatlimab",
"mk-?4280a" = "favezelimab/pembrolizumab", "mk-?7684a" = "pembrolizumab/vibostolimab",
"zynyz" = "retifanlimab", "loqtorzi" = "toripalimab", "tevimbra" = "tislelizumab",
"unloxcyt" = "cosibelimab")
## Malignant neoplasm codes (RPDR Dia): ICD-10 C00-C96 incl. C4A/C7A/C7B;
## ICD-9 140-208 plus 209.0-209.3 (malignant neuroendocrine tumours).
CANCER_ICD10 <- "^C(0[0-9]|[1-8][0-9A-Z]|9[0-6])"
CANCER_ICD9 <- "^((1[4-9][0-9]|20[0-8])(\\.|$)|209\\.?[0-3])"
## Cancer history / antineoplastic treatment codes: ICD-10 Z85, Z51.1x (incl.
## Z51.12 immunotherapy encounter), Z92.21; ICD-9 V10, V58.1x.
CANCER_HX_ICD10 <- "^(Z85|Z51\\.?1|Z92\\.?21)"
CANCER_HX_ICD9 <- "^(V10|V58\\.?1)"
## Leading number, optionally with thousands separators ("12,345").
NUM_REGEX <- "^\\s*[<>]?\\s*[0-9]+(,[0-9]{3})*(\\.[0-9]+)?"
## An IL2R measurement = a row whose `Result` starts with a number. Rows with a
## blank or text-only `Result` (e.g. "SEE MANUAL REPORT", "CREDITED: ...") are
## not measurements. `Result_Text` (free-text report) is not used.
STATUS_LEVELS <- c("numeric Result", "no numeric Result")
VALID_STATUS <- STATUS_LEVELS[1]
GROUP_LEVELS <- c(
"A. ICI before >=1 post-2015 IL2R draw",
"B. In ICI cohort, ICI start on/after every post-2015 draw",
"B2. In ICI cohort, blinded (or-placebo) trial drug only",
"C. Not in ICI cohort")
## ---- readers ------------------------------------------------------------------
## RPDR text files: pipe-delimited, no quoting, read everything as character.
read_rpdr <- function(path, select = NULL) {
stopifnot(file.exists(path))
fread(path, sep = "|", quote = "", colClasses = "character", fill = TRUE,
select = select, showProgress = FALSE, na.strings = NULL)
}
## ICI data pull. Two changes are applied on read, so the rest of the pipeline
## (and every downstream file) matches the RPDR conventions:
## 1. `EMPI MRN` (column G) is renamed to `EMPI`
## 2. SCHEDULEDSTARTDTS "YYYY-MM-DDThh:mm:ssZ" becomes a Date (YYYY-MM-DD)
read_ici <- function(path) {
stopifnot(file.exists(path))
ici <- fread(path, colClasses = "character", showProgress = FALSE)
stopifnot("EMPI MRN" %in% names(ici), "SCHEDULEDSTARTDTS" %in% names(ici))
setnames(ici, "EMPI MRN", "EMPI")
ici[, SCHEDULEDSTARTDTS_raw_hour := as.integer(substr(SCHEDULEDSTARTDTS, 12, 13))]
ici[, SCHEDULEDSTARTDTS := parse_ici_date(SCHEDULEDSTARTDTS)]
ici[]
}
## ---- parsers ------------------------------------------------------------------
## RPDR dates: Lab "MM/DD/YYYY HH:MM", Med "M/D/YYYY". as.Date() ignores the
## trailing time component.
parse_rpdr_date <- function(x) as.Date(x, format = "%m/%d/%Y")
## ICI SCHEDULEDSTARTDTS: ISO-8601 "YYYY-MM-DDThh:mm:ssZ" -> calendar Date.
## The date is taken exactly as written (no time-zone shift): the trailing "Z"
## is an export artefact, not a real UTC offset -- scheduled hours cluster at
## 08:00-17:00, i.e. local clinic hours.
parse_ici_date <- function(x) {
ok <- is.na(x) | grepl("^\\d{4}-\\d{2}-\\d{2}T\\d{2}:\\d{2}:\\d{2}Z?$", x)
if (!all(ok)) stop(sum(!ok), " SCHEDULEDSTARTDTS values are not ISO-8601")
as.Date(substr(x, 1, 10))
}
extract_num <- function(x) {
out <- rep(NA_real_, length(x))
hit <- grepl(NUM_REGEX, x)
out[hit] <- as.numeric(gsub(",", "", sub(
"^\\s*[<>]?\\s*([0-9]+(,[0-9]{3})*(\\.[0-9]+)?).*$", "\\1", x[hit])))
out
}
## Classify every IL2R lab row from its `Result` field only.
classify_il2r_result <- function(result) {
result <- fifelse(is.na(result), "", result)
factor(fifelse(grepl(NUM_REGEX, result), STATUS_LEVELS[1], STATUS_LEVELS[2]),
levels = STATUS_LEVELS)
}
is_ici_med <- function(x) grepl(ICI_REGEX, x, ignore.case = TRUE)
## Blinded placebo-controlled trial product: the patient may have received
## placebo. "RELATLIMAB OR PLACEBO-NIVOLUMAB" is NOT blinded for ICI exposure
## (nivolumab is given in both arms), nor are "X OR <other ICI>" products.
is_blinded <- function(x) {
grepl("or placebo", x, ignore.case = TRUE) &
!grepl("placebo-nivolumab", x, ignore.case = TRUE)
}
## Product label for aggregate tables: the first ICI (or co-formulation) named
## in the description. In "X OR PLACEBO-Y" only Y is certain, so Y is used.
ici_generic <- function(x) {
x <- sub("^.*placebo-", "", x, ignore.case = TRUE)
m <- tolower(regmatches(x, regexpr(ICI_REGEX, x, ignore.case = TRUE)))
out <- rep(NA_character_, length(x))
out[grepl(ICI_REGEX, x, ignore.case = TRUE)] <- m
for (k in names(ICI_GENERIC_MAP)) out <- sub(paste0("^", k, "$"), ICI_GENERIC_MAP[[k]], out)
out
}
## ---- cohort derivation --------------------------------------------------------
## 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))
}
## ---- display helpers (website) ------------------------------------------------
## Format a count; 1-10 shown as "<11". Zero stays 0.
fmt_n <- function(n, threshold = SMALL_CELL) {
n <- as.numeric(n)
ifelse(is.na(n), "--",
ifelse(n > 0 & n < threshold, paste0("<", threshold),
formatC(n, format = "d", big.mark = ",")))
}
## Percent that is hidden whenever its numerator is a small cell.
fmt_pct <- function(n, d, digits = 1, threshold = SMALL_CELL) {
p <- 100 * as.numeric(n) / as.numeric(d)
ifelse(is.na(p), "--",
ifelse(n > 0 & n < threshold, "--", formatC(p, format = "f", digits = digits)))
}
## Percent shown only when the formatted count itself is shown (a percent next
## to a hidden count would reveal it).
pct_shown <- function(n_fmt, n, d, digits = 1) {
ifelse(grepl("^[0-9]", n_fmt), fmt_pct(n, d, digits), "--")
}
## Change from a reference count; changes of 1-10 in either direction are
## shown as "+<11" / "-<11" so a small difference cannot be read off.
fmt_delta <- function(x, ref, threshold = SMALL_CELL) {
d <- as.numeric(x) - as.numeric(ref)
ifelse(d == 0, "same",
ifelse(abs(d) < threshold, ifelse(d > 0, "+<11", "-<11"),
paste0(ifelse(d > 0, "+", "-"),
formatC(abs(d), format = "d", big.mark = ","))))
}
## Suppress a set of mutually exclusive parts of a SHOWN total. If exactly one
## part is small it could be recovered by subtraction, so the smallest other
## non-zero part is also hidden ("suppressed").
fmt_parts <- function(n, threshold = SMALL_CELL) {
n <- as.numeric(n)
small <- n > 0 & n < threshold
comp <- rep(FALSE, length(n))
if (sum(small) == 1L) {
cand <- which(!small & n > 0)
if (length(cand)) comp[cand[which.min(n[cand])]] <- TRUE
}
out <- fmt_n(n, threshold)
out[comp] <- "suppressed"
out
}
## "n of d": hidden when n OR its complement (d - n) is a small cell, since
## the group size d is shown elsewhere.
fmt_n_of <- function(n, d, threshold = SMALL_CELL) {
n <- as.numeric(n); d <- as.numeric(d)
hide_n <- n > 0 & n < threshold
hide_comp <- (d - n) > 0 & (d - n) < threshold
out <- fmt_n(n, threshold)
out[!hide_n & hide_comp] <- "suppressed"
out
}
## Collapse rows whose count is a small cell into one "Other" row.
collapse_small <- function(dt, label_col, n_col = "N", other = "Other",
threshold = SMALL_CELL) {
dt <- copy(as.data.table(dt))
small <- dt[[n_col]] < threshold
if (sum(small) < 2L) return(dt)
keep <- dt[!small]
oth <- data.table(other, sum(dt[[n_col]][small]))
setnames(oth, c(label_col, n_col))
rbind(keep[, c(label_col, n_col), with = FALSE], oth)
}
## Source lines of named top-level objects in a file (with their leading
## "##" comment block) -- used to show the executed definitions on the site.
src_of <- function(names, file = "R/functions.R") {
ex <- parse(file, keep.source = TRUE)
refs <- attr(ex, "srcref")
lines <- readLines(file)
out <- character()
for (nm in names) {
idx <- which(vapply(ex, function(e) is.call(e) &&
identical(e[[1]], as.name("<-")) &&
identical(e[[2]], as.name(nm)), logical(1)))
stopifnot(length(idx) == 1L)
s <- refs[[idx]][1]; e <- refs[[idx]][3]
while (s > 1 && grepl("^##", lines[s - 1])) s <- s - 1
out <- c(out, lines[s:e], "")
}
out
}Show code
## =============================================================================
## R/build.R -- LOCAL-ONLY PHI pipeline. Run from the project root:
##
## Rscript R/build.R
##
## Reads the raw RPDR extract and the ICI data pull, derives the cohort, and
## writes three things:
## cache/patient_level.rds EMPI-keyed, gitignored, never rendered
## cache/summary.rds aggregate-only list read by the .qmd pages
## output/sIL2R_ICI_patient_level.xlsx EMPI-keyed, gitignored, for chart review
##
## Console output is limited to aggregate counts.
## =============================================================================
source("R/functions.R")
if (!file.exists("R/paths_local.R"))
stop("Create R/paths_local.R from R/paths_template.R (local file paths).")
source("R/paths_local.R") # defines RPDR_DIR, RPDR_PREFIX, ICI_FILE
dir.create("cache", showWarnings = FALSE)
dir.create("output", showWarnings = FALSE)
rp <- function(x) file.path(RPDR_DIR, paste0(RPDR_PREFIX, "_", x, ".txt"))
S <- list() # aggregate-only summary
## ---- 1. RPDR patient set ------------------------------------------------------
mrn <- read_rpdr(rp("Mrn"), select = c("Enterprise_Master_Patient_Index", "Status"))
setnames(mrn, "Enterprise_Master_Patient_Index", "EMPI")
rpdr_set <- unique(mrn$EMPI)
## ---- 2. RPDR IL2R labs --------------------------------------------------------
lab <- read_rpdr(rp("Lab"), select = c("EMPI", "Seq_Date_Time", "Group_Id", "Test_Id",
"Loinc_Code", "Test_Description", "Result",
"Reference_Units", "Abnormal_Flag"))
S$lab_rows <- nrow(lab)
S$lab_patients <- uniqueN(lab$EMPI)
il2 <- lab[Group_Id %in% IL2R_GROUPS]
lab_pts <- unique(lab$EMPI) # anyone with any Lab row (IL2R or CRE)
S$lab_groups <- lab[, .(rows = .N, patients = uniqueN(EMPI)), by = Group_Id]
rm(lab); invisible(gc())
il2[, draw_date := parse_rpdr_date(Seq_Date_Time)]
stopifnot(!anyNA(il2$draw_date))
il2[, status := classify_il2r_result(Result)] # `Result` only; Result_Text not read
il2[, value := fifelse(status == STATUS_LEVELS[1], extract_num(Result), NA_real_)]
il2[, unit := fifelse(Test_Id %chin% c("5200007493", "954.1945"), "pg/mL", "U/mL")]
S$il2_tests <- il2[, .(records = .N, patients = uniqueN(EMPI),
first_year = year(min(draw_date)), last_year = year(max(draw_date))),
by = .(Group_Id, Test_Id, Loinc_Code, Test_Description, unit)][order(-records)]
S$il2_status <- il2[, .(records = .N, patients = uniqueN(EMPI)), by = status][order(status)]
S$il2_status_by_test <- dcast(il2[, .N, by = .(Test_Id, status)], Test_Id ~ status,
value.var = "N", fill = 0L)
## numeric values: shape check (anything that is not "number [unit] [flag]")
num <- il2[status == STATUS_LEVELS[1]]
S$il2_numeric_irregular <- sum(!grepl("^\\s*[0-9]+(\\.[0-9]+)?(\\s+[A-Za-z/]+)?(\\s+[HL])?\\s*$", num$Result))
S$il2_value_summary <- il2[!is.na(value), .(n = .N, median = median(value),
p25 = quantile(value, .25), p75 = quantile(value, .75)),
by = unit]
S$il2_by_year <- il2[, .(records = .N, patients = uniqueN(EMPI),
valid_records = sum(status %in% VALID_STATUS)),
by = .(year = year(draw_date))][order(year)]
S$il2_same_day_multi <- il2[status %in% VALID_STATUS, .N, by = .(EMPI, draw_date)][N > 1, .N]
## ---- 3. ICI data pull ---------------------------------------------------------
ici <- read_ici(ICI_FILE) # EMPI MRN -> EMPI; date-only start
ici[, ici_date := SCHEDULEDSTARTDTS]
ici[, blinded := is_blinded(MEDICATIONDSC)]
ici[, generic := ici_generic(MEDICATIONDSC)]
S$ici_rows <- nrow(ici)
S$ici_patients <- uniqueN(ici$EMPI)
S$ici_cols <- names(ici)
S$ici_empi_9digit <- mean(grepl("^[0-9]{9}$", ici$EMPI))
S$rpdr_empi_9digit <- mean(grepl("^[0-9]{9}$", il2$EMPI))
S$ici_date_na <- sum(is.na(ici$ici_date))
S$ici_date_range <- range(ici$ici_date, na.rm = TRUE)
S$ici_hour <- ici[, .N, by = .(hour = SCHEDULEDSTARTDTS_raw_hour)][order(hour)]
S$ici_by_year <- ici[, .(records = .N, patients = uniqueN(EMPI)),
by = .(year = year(ici_date))][order(year)]
S$ici_mar_action <- ici[, .N, by = MARACTIONDSC][order(-N)]
S$ici_order_status <- ici[, .N, by = ORDERSTATUSDSC][order(-N)]
S$ici_route <- ici[, .N, by = ROUTEDSC][order(-N)]
S$ici_drug_desc_n <- uniqueN(ici$MEDICATIONDSC)
S$ici_unmatched_desc <- ici[is.na(generic), .N]
S$ici_generic <- ici[, .(records = .N, patients = uniqueN(EMPI)), by = generic][order(-records)]
S$ici_blinded <- ici[, .(records = .N, patients = uniqueN(EMPI),
descriptions = uniqueN(MEDICATIONDSC)), by = blinded]
S$ici_blinded_only_patients <- ici[, .(all_blinded = all(blinded)), by = EMPI][all_blinded == TRUE, .N]
## ---- 4. Linkage + cohort -----------------------------------------------------
ici_empi <- unique(ici$EMPI)
il2_pts <- unique(il2$EMPI)
valid_pts <- unique(il2[status %in% VALID_STATUS, EMPI])
post_pts <- unique(il2[status %in% VALID_STATUS & draw_date >= CUTOFF_DATE, EMPI])
## Flow shows 3 steps only: an intermediate "any numeric Result" step would let
## the (small) all-pre-2015 count be recovered by subtraction.
S$flow <- data.table(
step = c("RPDR patient set (IL2R lab OR Epic IL2R procedure code)",
" with >=1 IL2R row in the Lab file",
" with >=1 numeric IL2R Result on/after 2015-01-01"),
n = c(length(rpdr_set), length(il2_pts), length(post_pts)))
S$excluded <- data.table(
reason = c("In RPDR set, but no IL2R row in the Lab file (no draw date)",
"IL2R rows, but no numeric Result on/after 2015-01-01"),
n = c(sum(!rpdr_set %chin% il2_pts), length(setdiff(il2_pts, post_pts))))
## the two reasons inside row 2 (rendered with complementary suppression)
S$excluded_sub <- data.table(
reason = c("... no numeric Result at any date",
"... numeric Results, but all before 2015-01-01"),
n = c(length(setdiff(il2_pts, valid_pts)), length(setdiff(valid_pts, post_pts))))
S$no_lab_in_ici <- sum(!rpdr_set %chin% il2_pts & rpdr_set %chin% ici_empi)
S$il2_not_in_set <- sum(!il2_pts %chin% rpdr_set)
S$overlap_any_il2 <- sum(il2_pts %chin% ici_empi)
## primary definition
pts <- derive_cohort(il2, ici)
S$answers <- answer_counts(pts)
S$groups <- pts[, .N, by = group][order(group)]
S$groups_by_first_year <- dcast(pts[, .N, by = .(year = year(first_post_draw), group)],
year ~ group, value.var = "N", fill = 0L)
S$same_day_A <- pts[group == GROUP_LEVELS[1] & same_day_draw == TRUE, .N]
S$same_day_B <- pts[group == GROUP_LEVELS[2] & same_day_draw == TRUE, .N]
A <- pts[group == GROUP_LEVELS[1]]
S$A_n_after <- A[, .N, by = .(n_after = fifelse(n_after_dates >= 5L, "5+", as.character(n_after_dates)))][order(n_after)]
S$A_days_to_first <- A[, .(n = .N, median = median(days_ici_to_first_after),
p25 = quantile(days_ici_to_first_after, .25),
p75 = quantile(days_ici_to_first_after, .75))]
S$A_time_bins <- A[, .N, by = .(bin = cut(days_ici_to_first_after,
c(0, 90, 180, 365, 730, Inf),
labels = c("1-90 days", "91-180 days", "181-365 days",
"1-2 years", "> 2 years")))][order(bin)]
S$A_first_regimen <- A[, .N, by = ici_first_regimen][order(-N)]
S$A_ici_start_year <- A[, .N, by = .(year = year(ici_start))][order(year)]
S$A_measurements_total <- A[, sum(n_after_dates)]
## ---- 5. Sensitivity grid -------------------------------------------------------
sens <- list(
"Primary" = list(),
"Include blinded or-placebo trial drug" = list(include_blinded = TRUE),
"Same-day ICI counts as prior" = list(same_day_is_prior = TRUE),
"Cutoff 2016-01-01 (after calendar 2015)" = list(cutoff = as.Date("2016-01-01")),
"Any IL2R row, numeric Result or not" = list(valid_status = STATUS_LEVELS))
S$sensitivity <- rbindlist(lapply(names(sens), function(nm) {
p <- do.call(derive_cohort, c(list(il2 = il2, ici = ici), sens[[nm]]))
as.data.table(c(list(analysis = nm), as.list(answer_counts(p))))
}))
## ---- 6. RPDR medication cross-check (ICI outside the ICI pull) -----------------
med <- read_rpdr(rp("Med"), select = c("EMPI", "Medication_Date", "Medication"))
S$med_rows <- nrow(med)
med <- med[is_ici_med(Medication)]
med[, med_date := parse_rpdr_date(Medication_Date)]
med[, generic := ici_generic(Medication)]
S$med_ici_rows <- nrow(med)
S$med_ici_patients <- uniqueN(med$EMPI)
rpdr_ici <- med[!is.na(med_date), .(rpdr_ici_first = min(med_date),
rpdr_ici_n = .N,
rpdr_ici_drugs = paste(sort(unique(generic)), collapse = "; ")),
by = EMPI]
pts <- merge(pts, rpdr_ici, by = "EMPI", all.x = TRUE)
pts[, rpdr_ici_any := !is.na(rpdr_ici_first)]
pts[, rpdr_ici_before_last_draw := rpdr_ici_any & rpdr_ici_first < last_post_draw]
pts[, rpdr_ici_pre2015 := rpdr_ici_any & rpdr_ici_first < CUTOFF_DATE]
S$med_by_group <- pts[, .(patients = .N,
rpdr_ici_any = sum(rpdr_ici_any),
rpdr_ici_before_last_draw = sum(rpdr_ici_before_last_draw),
rpdr_ici_first_pre2015 = sum(rpdr_ici_pre2015)), by = group][order(group)]
S$no_lab_rpdr_ici <- sum(!rpdr_set %chin% il2_pts & rpdr_set %chin% rpdr_ici$EMPI)
rm(med); invisible(gc())
## ---- 6b. RPDR diagnosis cross-check: malignancy codes (chart-review triage) ----
dia <- read_rpdr(rp("Dia"), select = c("EMPI", "Date", "Code_Type", "Code"))
dia[, ca := (Code_Type == "ICD10" & grepl(CANCER_ICD10, Code)) |
(Code_Type == "ICD9" & grepl(CANCER_ICD9, Code))]
dia[, hx := (Code_Type == "ICD10" & grepl(CANCER_HX_ICD10, Code)) |
(Code_Type == "ICD9" & grepl(CANCER_HX_ICD9, Code))]
dia <- dia[ca | hx]
dia[, dx_date := parse_rpdr_date(Date)]
ca <- dia[ca == TRUE & !is.na(dx_date), .(cancer_dx_first = min(dx_date)), by = EMPI]
hx <- dia[hx == TRUE, .(cancer_hx_any = TRUE), by = EMPI]
rm(dia); invisible(gc())
pts <- merge(pts, ca, by = "EMPI", all.x = TRUE)
pts <- merge(pts, hx, by = "EMPI", all.x = TRUE)
pts[, cancer_dx_any := !is.na(cancer_dx_first)]
pts[, cancer_dx_before_last_draw := cancer_dx_any & cancer_dx_first <= last_post_draw]
pts[is.na(cancer_hx_any), cancer_hx_any := FALSE]
S$dx_by_group <- pts[, .(patients = .N,
cancer_dx_any = sum(cancer_dx_any),
cancer_dx_before_last_draw = sum(cancer_dx_before_last_draw)),
by = group][order(group)]
## chart-review triage for group C (hierarchical: first tier that applies)
pts[, review_tier := NA_character_]
pts[group == GROUP_LEVELS[4], review_tier := fcase(
rpdr_ici_any, "1. ICI in RPDR Med file",
cancer_dx_before_last_draw, "2. Malignancy code on/before last IL2R draw",
cancer_dx_any, "3. Malignancy code only after last IL2R draw",
cancer_hx_any, "4. Cancer-history / chemotherapy code only",
default = "5. No malignancy, history or chemotherapy code")]
S$C_triage <- pts[group == GROUP_LEVELS[4], .N, by = .(tier = review_tier)][order(tier)]
## Group B with an RPDR-Med ICI before an IL2R draw: possibly Q1-positive
S$B_rpdr_earlier <- pts[group == GROUP_LEVELS[2] & rpdr_ici_before_last_draw == TRUE, .N]
## ---- 6c. The RPDR patients with an IL2R order but no result row ----------------
nl <- data.table(EMPI = setdiff(rpdr_set, il2_pts))
nl[, in_ici_file := EMPI %chin% ici_empi]
nl <- merge(nl, ici[blinded == FALSE & !is.na(ici_date), .(ici_start = min(ici_date)), by = EMPI],
by = "EMPI", all.x = TRUE)
nl <- merge(nl, rpdr_ici, by = "EMPI", all.x = TRUE)
nl <- merge(nl, ca, by = "EMPI", all.x = TRUE)
nl <- merge(nl, hx, by = "EMPI", all.x = TRUE)
nl[, `:=`(rpdr_ici_any = !is.na(rpdr_ici_first), cancer_dx_any = !is.na(cancer_dx_first),
cancer_hx_any = !is.na(cancer_hx_any) & cancer_hx_any)]
S$nolab <- nl[, .(patients = .N, rpdr_ici_any = sum(rpdr_ici_any),
cancer_dx_any = sum(cancer_dx_any),
cancer_or_hx = sum(cancer_dx_any | cancer_hx_any)),
by = in_ici_file][order(-in_ici_file)]
S$no_lab_cancer <- nl[, sum(cancer_dx_any)]
S$nolab_other_lab <- nl[, sum(EMPI %chin% lab_pts)] # Lab rows, but creatinine only
S$nolab_no_lab <- nl[, sum(!EMPI %chin% lab_pts)] # no Lab rows at all
S$il2_last_month <- format(max(il2$draw_date), "%Y-%m")
S$il2_first_month_epic <- format(min(il2[Test_Id == "5200007493", draw_date]), "%Y-%m")
## ---- 7. Save -----------------------------------------------------------------
S$built <- Sys.time()
S$cutoff <- CUTOFF_DATE
S$files <- list(rpdr = paste0(RPDR_PREFIX, "_{Mrn,Lab,Med}.txt"), ici = basename(ICI_FILE))
saveRDS(S, "cache/summary.rds")
saveRDS(list(pts = pts, il2 = il2[, .(EMPI, draw_date, Test_Id, status, value, unit)]),
"cache/patient_level.rds")
## local chart-review workbook (EMPI-keyed; gitignored; never published)
fmt_cols <- c("EMPI", "group", "review_tier", "n_post_dates", "first_post_draw",
"last_post_draw", "in_ici_file", "ici_start", "ici_first_regimen",
"n_after_dates", "first_after", "days_ici_to_first_after", "same_day_draw",
"rpdr_ici_any", "rpdr_ici_first", "rpdr_ici_drugs", "rpdr_ici_before_last_draw",
"cancer_dx_any", "cancer_dx_first", "cancer_dx_before_last_draw", "cancer_hx_any")
out <- pts[, ..fmt_cols][order(group, review_tier, first_post_draw)]
out[, group := as.character(group)]
nl_out <- nl[, .(EMPI, in_ici_file, ici_start, rpdr_ici_any, rpdr_ici_first, rpdr_ici_drugs,
cancer_dx_any, cancer_dx_first, cancer_hx_any)][
order(-in_ici_file, -rpdr_ici_any, -cancer_dx_any)]
writexl::write_xlsx(list(
README = data.frame(note = c(
"LOCAL ONLY - contains EMPI. Do not email, upload or commit.",
paste("Built", format(S$built, "%Y-%m-%d %H:%M"), "by R/build.R"),
"Cohort: >=1 soluble IL2R row with a numeric Result on/after 2015-01-01 (RPDR Lab; Result_Text not used).",
"ICI start = earliest SCHEDULEDSTARTDTS (date) in ICI_data_pull, excluding blinded or-placebo products.",
"ici_first_regimen = every ICI given on the ICI start date.",
"rpdr_ici_* = ICI mentions in the RPDR Med file (independent of the ICI pull).",
"cancer_dx_* = ICD-10 C00-C96 (incl. C4A/C7A/C7B) / ICD-9 140-209.3 in the RPDR Dia file.",
"cancer_hx_any = ICD-10 Z85, Z51.1x, Z92.21 / ICD-9 V10, V58.1x.",
"review_tier (Group C only): 1 = ICI in RPDR Med ... 5 = no cancer-related code.",
"no_IL2R_result_row = RPDR patients who qualified via the Epic IL2R order code but have no Lab row (no draw date).")),
not_in_ICI_cohort = out[group == GROUP_LEVELS[4]],
ICI_cohort_RPDR_ICI_earlier = out[group == GROUP_LEVELS[2] & rpdr_ici_before_last_draw == TRUE],
ICI_before_IL2R = out[group == GROUP_LEVELS[1]],
all_post2015_IL2R = out,
no_IL2R_result_row = nl_out),
"output/sIL2R_ICI_patient_level.xlsx")
cat("\n== aggregate results ==\n")
print(S$flow); print(S$excluded)
print(S$answers)
print(S$groups)
print(S$sensitivity)
print(S$med_by_group)
print(S$dx_by_group)
print(S$C_triage)
print(S$nolab)
cat("Group B with RPDR-Med ICI before last draw:", S$B_rpdr_earlier, "\n")
print(S$A_first_regimen)
cat("Built OK:", format(S$built), "\n")Aggregate results only; cells below 11 suppressed. Built from R/build.R on 2026-09-30.