Admiral Adsl

library(admiral)
library(dplyr)
library(lubridate)
library(pharmaversesdtm)

# Load SDTM domains
dm  <- pharmaversesdtm::dm
ex  <- pharmaversesdtm::ex
ds  <- pharmaversesdtm::ds
# mh <- pharmaversesdtm::mh  # uncomment if in scope

# Confirm one record per USUBJID in DM before proceeding
stopifnot(nrow(dm) == n_distinct(dm$USUBJID))

adsl <- dm |>
  select(
    STUDYID, USUBJID, SUBJID, SITEID,
    AGE, AGEU, SEX, RACE, ETHNIC, COUNTRY,
    ARM, ARMCD, ACTARM, ACTARMCD,
    DMDTC, RFSTDTC, RFENDTC,
    DTHFL, DTHDTC
  )

ex_dtm <- ex |>
  select(-DOMAIN) |>
  derive_vars_dtm(
    dtc             = EXSTDTC,
    new_vars_prefix = "EXST",
    date_imputation = "first",
    time_imputation = "first",
    flag_imputation = "auto"
  ) |>
  derive_vars_dtm(
    dtc             = EXENDTC,
    new_vars_prefix = "EXEN",
    date_imputation = "last",
    time_imputation = "last",
    flag_imputation = "auto"
  )

# TRTSDTM / TRTSTMF: first dose datetime and imputation flag
# REVIEW: The placebo filter (EXTRT == "PLACEBO") must be confirmed against the
#   protocol. In some studies EXDOSE > 0 is sufficient; in others EXDOSE = 0
#   for placebo and EXTRT must be used. Adjust condition per protocol definition.
adsl <- adsl |>
  derive_vars_merged(
    dataset_add = ex_dtm,
    by_vars     = exprs(STUDYID, USUBJID),
    new_vars    = exprs(TRTSDTM = EXSTDTM, TRTSTMF = EXSTTMF),
    order       = exprs(EXSTDTM),
    mode        = "first",
    filter_add  = (EXDOSE > 0 | EXTRT == "PLACEBO") & !is.na(EXSTDTM)
  ) |>
  # TRTEDTM / TRTETMF: last dose datetime and imputation flag
  # REVIEW: If subjects have non-contiguous EX records, TRTEDTM reflects the
  #   last administration date only. Flag for QC if exposure gaps exist.
  derive_vars_merged(
    dataset_add = ex_dtm,
    by_vars     = exprs(STUDYID, USUBJID),
    new_vars    = exprs(TRTEDTM = EXENDTM, TRTETMF = EXENTMF),
    order       = exprs(EXENDTM),
    mode        = "last",
    filter_add  = (EXDOSE > 0 | EXTRT == "PLACEBO") & !is.na(EXENDTM)
  ) |>
  mutate(
    TRTSDT = as.Date(TRTSDTM),
    TRTEDT = as.Date(TRTEDTM)
  )

# REVIEW: Confirm ARMCD values, treatment labels, and numeric codes against
#   the randomisation schedule and ADaM spec before use.
arm_lookup <- tibble::tribble(
  ~ARMCD,    ~TRT01P,                   ~TRT01PN,
  "Pbo",     "Placebo",                 1L,
  "Xan_Lo",  "Xanomeline Low Dose",     2L,
  "Xan_Hi",  "Xanomeline High Dose",    3L
  # Screen failure subjects (Scrnfail) are not in the lookup — they receive NA
)

adsl <- adsl |>
  derive_vars_merged_lookup(
    dataset_add = arm_lookup,
    by_vars     = exprs(ARMCD),
    new_vars    = exprs(TRT01P, TRT01PN)
  ) |>
  derive_vars_merged_lookup(
    dataset_add = arm_lookup |>
      rename(ACTARMCD = ARMCD, TRT01A = TRT01P, TRT01AN = TRT01PN),
    by_vars     = exprs(ACTARMCD),
    new_vars    = exprs(TRT01A, TRT01AN)
  )

adsl <- adsl |>
  # RANDDT: date of randomisation from DM.DMDTC
  # REVIEW: Confirm DMDTC is the randomisation date in this study. In some
  #   studies randomisation date comes from a separate SDTM domain (e.g. RS).
  derive_vars_dt(
    dtc             = DMDTC,
    new_vars_prefix = "RAND",
    date_imputation = "first",
    flag_imputation = "auto"
  ) |>
  derive_vars_dt(
    dtc             = RFSTDTC,
    new_vars_prefix = "RFST",
    date_imputation = "first",
    flag_imputation = "auto"
  ) |>
  derive_vars_dt(
    dtc             = RFENDTC,
    new_vars_prefix = "RFEND",
    date_imputation = "last",
    flag_imputation = "auto"
  )

adsl <- adsl |>
  derive_vars_dt(
    dtc             = DTHDTC,
    new_vars_prefix = "DTH",
    date_imputation = "first",
    flag_imputation = "auto"
  ) |>
  mutate(
    # Ensure CDISC flag convention: "Y" or NA — never "N"
    DTHFL = if_else(DTHFL == "Y", "Y", NA_character_)
  )

adsl <- adsl |>
  derive_vars_dy(
    reference_date = TRTSDT,
    source_vars    = exprs(RANDDT)
  )

adsl <- adsl |>
  derive_var_trtdurd()
  # Requires TRTSDT and TRTEDT to be present. NA for untreated subjects.

ds_eos <- ds |>
  select(-DOMAIN) |>
  filter(DSCAT == "DISPOSITION EVENT") |>
  derive_vars_dt(
    dtc             = DSDTC,
    new_vars_prefix = "DS",
    date_imputation = "last",
    flag_imputation = "auto"
  )

# Confirm one DISPOSITION EVENT record per subject
stopifnot(n_distinct(ds_eos$USUBJID) == nrow(ds_eos))

# EOSSTT: end of study status — "COMPLETED" or "DISCONTINUED" only
# REVIEW: Verify the COMPLETED/DISCONTINUED mapping covers all DSDECOD values
#   in this study's DS domain. Some protocols require a third category for
#   "STUDY TERMINATED BY SPONSOR". Confirm with the statistician.
adsl <- adsl |>
  derive_vars_merged(
    dataset_add = ds_eos |>
      mutate(
        EOSSTT = if_else(DSDECOD == "COMPLETED", "COMPLETED", "DISCONTINUED")
      ),
    by_vars  = exprs(STUDYID, USUBJID),
    new_vars = exprs(EOSSTT, EOSDT = DSDT)
  ) |>
  # DCSREAS: decoded discontinuation reason — NA for completers per CDISC convention
  # REVIEW: DCSREAS is sourced from DS.DSDECOD (decoded value). DS.DSTERM
  #   (verbatim text) belongs in DCSREASP. Do not swap these.
  derive_vars_merged(
    dataset_add = ds_eos |>
      filter(DSDECOD != "COMPLETED"),
    by_vars  = exprs(STUDYID, USUBJID),
    new_vars = exprs(DCSREAS = DSDECOD, DCSREASP = DSTERM)
  )

# REVIEW: Age cut-points must come from the ADaM spec — they are study-specific.
#   The values below are placeholders. Replace before use.
adsl <- adsl |>
  mutate(
    AGEGR1 = case_when(
      AGE < 65              ~ "<65",     # PLACEHOLDER — confirm from spec
      AGE >= 65 & AGE <= 80 ~ "65-80",  # PLACEHOLDER — confirm from spec
      AGE > 80              ~ ">80"      # PLACEHOLDER — confirm from spec
    ),
    AGEGR1N = case_when(
      AGEGR1 == "<65"   ~ 1L,
      AGEGR1 == "65-80" ~ 2L,
      AGEGR1 == ">80"   ~ 3L
    )
  )

# SAFFL: received at least one dose
# REVIEW: SAFFL definition is protocol-specific. The condition below includes
#   placebo subjects (EXTRT == "PLACEBO") who have EXDOSE = 0 in some studies.
#   Verify EXTRT values in EX exhaustively and confirm with the statistician.
adsl <- adsl |>
  derive_var_merged_exist_flag(
    dataset_add   = ex,
    by_vars       = exprs(STUDYID, USUBJID),
    new_var       = SAFFL,
    condition     = (EXDOSE > 0 | EXTRT == "PLACEBO") & !is.na(EXSTDTC),
    true_value    = "Y",
    false_value   = NA_character_,
    missing_value = NA_character_
  ) |>
  # ITTFL: randomised subjects — ARMCD != "Scrnfail" AND ARM != "Screen Failure"
  # REVIEW: Confirm ITTFL exclusion criteria with the statistician. The ARMCD
  #   condition is more reliable than ARM text matching — use both as a safeguard.
  mutate(
    ITTFL = if_else(
      ARMCD != "Scrnfail" & ARM != "Screen Failure",
      "Y",
      NA_character_
    )
  )
# ITTFL pipe chain ends here; PPROTFL is derived separately below.

# PPROTFL: per-protocol — ITT subjects with no major protocol deviations.
# Uses derive_vars_merged() + filter_add (not derive_var_merged_exist_flag) because
# the exclusion criterion belongs in filter_add, and NA absence of a match is the
# natural signal that no major deviation record was found for the subject.
#
# Guard: DV-absent and DV-present-but-no-major-deviations are different states
# and must not produce the same PPROTFL output. If DV is not loaded, halt so the
# analyst can decide explicitly — do not silently set NA.
# REVIEW: DVCAT values must match the protocol deviation management plan (PDMP).
#   Some studies categorise by DVCAT == "MAJOR"; others use DVSCAT or a study-
#   specific flag. Confirm the filter_add condition with the statistician before use.
if (!exists("dv")) {
  stop(
    "DV domain is required for PPROTFL derivation but is not loaded. ",
    "Load DV, or set adsl$PPROTFL <- NA_character_ explicitly if the study ",
    "has no protocol deviation records and this has been confirmed with the statistician."
  )
}

dv_major <- dv |>
  select(-DOMAIN) |>
  mutate(MAJDVFL = "Y")

adsl <- adsl |>
  derive_vars_merged(
    dataset_add = dv_major,
    by_vars     = exprs(STUDYID, USUBJID),
    new_vars    = exprs(MAJDVFL),
    filter_add  = DVCAT == "MAJOR",
    mode        = "first"   # subjects may have >1 major deviation record; any match suffices
  ) |>
  mutate(
    PPROTFL = if_else(ITTFL == "Y" & is.na(MAJDVFL), "Y", NA_character_)
  ) |>
  select(-MAJDVFL)  # intermediate exclusion flag; not an ADSL output variable

# One record per USUBJID — non-negotiable per ADaMIG; FDA will reject if violated
stopifnot(nrow(adsl) == n_distinct(adsl$USUBJID))

# Check required variables are present
required_vars <- c(
  "STUDYID", "USUBJID", "TRTSDT", "TRTEDT",
  "TRT01P", "TRT01PN", "TRT01A", "TRT01AN",
  "TRTSDTM", "TRTSTMF", "TRTEDTM", "TRTETMF",
  "EOSSTT", "SAFFL", "ITTFL"
)
missing_vars <- setdiff(required_vars, names(adsl))
if (length(missing_vars) > 0) {
  stop("Missing required ADSL variables: ", paste(missing_vars, collapse = ", "))
}

# Apply variable labels — use xportr for submission context
# adsl <- adsl |>
#   xportr_label(metacore_obj, domain = "ADSL") |>
#   xportr_type(metacore_obj, domain = "ADSL") |>
#   xportr_length(metacore_obj, domain = "ADSL") |>
#   xportr_order(metacore_obj, domain = "ADSL")
# xportr_write(adsl, "adsl.xpt", label = "Subject-Level Analysis Dataset")
#
# For non-submission contexts:
# Hmisc::label(adsl$TRTSDT) <- "Date of First Study Treatment"
# Hmisc::label(adsl$SAFFL)  <- "Safety Population Flag"