TSFLAB02A

Subjects With =1 Laboratory Category Laboratory Values With Elevated or Low Values Meeting Specified Levels Based on Worst On-treatment Value by Subgroup

---

Output

Preview

# Program Name:              tsflab02a

# Prep Environment

library(envsetup)
library(tern)
library(dplyr)
library(rtables)
library(junco)

# Define script level parameters:

tblid <- "TSFLAB02a"
fileid <- tblid
titles <- get_titles_from_file(input_path = '../../_data/', tblid)
string_map <- default_str_map

popfl <- "SAFFL"
trtvar <- "TRT01A"
ctrl_grp <- "Placebo"

subgrpvar <- "AGEGR1"
subgrplbl <- "Age: %s years"

page_by <- TRUE # Set page_by TRUE/FALSE if you (do not) wish to start a new page after a new subgroup
indent_adj <- -1L
if (page_by) {
  indent_adj <- 0L
}

### note : this shell covers multiple tables depending on parcat3 selections

## allowed PARCAT3 selections

# parcat3sel <- "General chemistry"
# parcat3sel <- "Kidney function"
# parcat3sel <- "Liver biochemistry"
# parcat3sel <- "Lipids"
#
# ### Hematology (HM) : has 3 subcategories that should be included on one table
# parcat3sel <- c("Complete blood count","WBC differential","Coagulation studies")

# per DPS specifications, the output identifier should include the abbreviation for the category

# 1. Present laboratory tests using separate outputs for each category as follows:
#   General chemistry (GC): Sodium, Potassium, Chloride, Bicarbonate, Urea Nitrogen, Glucose, Calcium, Magnesium, Phosphate, Protein, Albumin, Creatine Kinase, Amylase, Lipase
#   Kidney function (KF): Creatinine, GFR from Creatinine
#   Liver biochemistry (LV): Alkaline Phosphatase, Alanine Aminotransferase, Aspartate Aminotransferase, Bilirubin, Prothrombin Intl. Normalized Ratio, Gamma Glutamyl Transferase
#   Lipids (LP): Cholesterol, HDL Cholesterol, LDL Cholesterol, Triglycerides
#   Hematology (HM):  Subcategory rows should be included for Complete Blood Count, White Blood Cell Differential and for Coagulation Studies
#     Complete blood count: Leukocytes, Hemoglobin, Platelets;
#     WBC differential: Lymphocytes, Neutrophils, Eosinophils;
#     Coagulation studies: Prothrombin Time, Activated Partial Thromboplastin Time.

# The output identifier should include the abbreviation for the laboratory category (eg, TSFLAB02GC for General Chemistry)

# In current template program, only 1 version is created, without the proper abbreviation appended
# The reason for this is that TSFLAB02GC is not included in the DPS system - only the core version TSFLAB02

get_abbreviation <- function(parcat3sel) {
  parcat3sel <- toupper(parcat3sel)
  abbr <- NULL
  if (length(parcat3sel) == 1) {
    if (parcat3sel == toupper("General chemistry")) {
      abbr <- "GC"
    }
    # the line below should be removed for a true study, global jjcs standards in DPS system does not include the abbreviation
    if (parcat3sel == toupper("General chemistry")) {
      abbr <- ""
    }
    #
    if (parcat3sel == toupper("Kidney function")) {
      abbr <- "KF"
    }
    if (parcat3sel == toupper("Liver biochemistry")) {
      abbr <- "LV"
    }
    if (parcat3sel == toupper("Lipids")) abbr <- "LP"
  }
  if (length(parcat3sel) > 1) {
    if (
      all(
        parcat3sel %in%
          toupper(c(
            "Complete blood count",
            "WBC differential",
            "Coagulation studies"
          ))
      )
    ) {
      abbr <- "HM"
    }
  }

  if (is.null(abbr)) {
    message("Incorrect specification of parcat3sel")
  }

  abbr
}

get_tblid <- function(tblid, parcat3sel, method = c("after", "inbetween")) {
  abbr <- get_abbreviation(parcat3sel)

  method <- match.arg(method)
  # when inbetween, the abbreviation will be added prior to the number part of the table identifier
  # when after (default), the abbreviation will be added at the end of the table identifier

  x <- 0
  if (method == "inbetween") {
    x <- regexpr(pattern = "[0-9]", tblid)[1]
  }

  if (x > 0) {
    tblid1 <- substr(tblid, 1, x - 1)
    tblid2 <- substring(tblid, x)
    tblid_new <- paste0(tblid1, abbr, tblid2)
  } else {
    tblid_new <- paste0(tblid, abbr)
  }

  return(tblid_new)
}


### the varying fileid will be handled at the end of the program, as this program will generate all levels
ad_domain <- "adlb"


## if the option TRTEMFL needs to be added to the TLF -- ensure the same setting as in tsflab04
trtemfl <- TRUE

# Initial processing of data + check if table is valid for trial:

adlb_complete <- pharmaverseadamjnj::adlb

# Process markedly abnormal values from spreadsheet:

### Markedly Abnormal spreadsheet

markedlyabnormal_file <- file.path('../../_data', "markedlyabnormal.xlsx")

markedlyabnormal_sheets <- readxl::excel_sheets(markedlyabnormal_file)

lbmarkedlyabnormal_defs <- readxl::read_excel(
  markedlyabnormal_file,
  sheet = toupper(ad_domain)
) %>%
  filter(PARAMCD != "Parameter Code")

MCRITs <- unique(
  lbmarkedlyabnormal_defs %>%
    filter(!stringr::str_ends(VARNAME, "ML")) %>%
    pull(VARNAME)
)

MCRITs_def <- unique(
  lbmarkedlyabnormal_defs %>%
    filter(VARNAME %in% MCRITs) %>%
    select(PARAMCD, VARNAME, CRIT, SEX)
) %>%
  mutate(VARNAME = paste0(VARNAME, "ML")) %>%
  rename(CRITNAME = CRIT) %>%
  mutate(
    CRITDIR = case_when(
      VARNAME == "MCRIT1ML" ~ "DIR1",
      VARNAME == "MCRIT2ML" ~ "DIR2"
    )
  )


MCRITs_def2 <- lbmarkedlyabnormal_defs %>%
  filter(VARNAME %in% paste0(MCRITs, "ML")) %>%
  mutate(CRITn = as.character(4 - as.numeric(ORDER)))


MCRITs_def3 <- MCRITs_def2 %>%
  left_join(., MCRITs_def, relationship = "many-to-one") %>%
  select(PARAMCD, CRITNAME, CRITDIR, SEX, VARNAME, CRIT, CRITn) %>%
  arrange(PARAMCD, VARNAME, CRITDIR, SEX, CRITn) %>%
  select(-SEX)


### convert dataframe into label_map that can be used with the a_freq_j afun function
xlabel_map <- MCRITs_def3 %>%
  rename(var = VARNAME, label = CRIT) %>%
  select(PARAMCD, CRITNAME, CRITDIR, var, label)


xlabel_map2 <- xlabel_map %>%
  mutate(
    MCRIT12 = CRITNAME,
    MCRIT12ML = label
  )

# Process Data:

adsl <- pharmaverseadamjnj::adsl %>%
  filter(.data[[popfl]] == "Y") %>%
  select(USUBJID, all_of(c(popfl, trtvar, subgrpvar)))

adsl$colspan_trt <- factor(
  ifelse(adsl[[trtvar]] == ctrl_grp, " ", "Active Study Agent"),
  levels = c("Active Study Agent", " ")
)

adsl$rrisk_header <- "Risk Difference (%) (95% CI)"
adsl$rrisk_label <- paste(adsl[[trtvar]], paste("vs", ctrl_grp))

colspan_trt_map <- create_colspan_map(
  adsl,
  non_active_grp = ctrl_grp,
  non_active_grp_span_lbl = " ",
  active_grp_span_lbl = "Active Study Agent",
  colspan_var = "colspan_trt",
  trt_var = trtvar
)
ref_path <- c("colspan_trt", " ", trtvar, ctrl_grp)


obs_mcrit12 <- unique(c(
  unique(adlb_complete$MCRIT1),
  unique(adlb_complete$MCRIT2)
))

adlb00 <- adlb_complete %>%
  filter(PARCAT2 == "Test with FDA abnormality criteria defined") %>%
  select(
    USUBJID,
    PARCAT1,
    PARCAT2,
    PARCAT3,
    ONTRTFL,
    TRTEMFL,
    PARAM,
    PARAMCD,
    AVISITN,
    AVISIT,
    AVAL,
    MCRIT1,
    MCRIT1ML,
    MCRIT2,
    MCRIT2ML,
    ONTRTFL,
    TRTEMFL,
    LVOTFL,
    ANL01FL,
    ANL02FL,
    ANL04FL,
    ANL05FL
    ### if per period/phase is needed, use below flag variables
    # ,ANL07FL,ANL08FL,ANL09FL,ANL10FL
  ) %>%
  inner_join(adsl)


combodf <- tribble(
  ~valname   , ~label                , ~levelcombo                                      , ~exargs ,
  "xan-comb" , "Xanomeline Combined" , c("Xanomeline High Dose", "Xanomeline Low Dose") , list()
)

# vertical approach for analyzing MCRIT1/MCRIT2:

adlb_mcrit1 <- adlb00 %>%
  filter(!is.na(MCRIT1)) %>%
  mutate(
    MCRIT12 = MCRIT1,
    MCRIT12ML = MCRIT1ML,
    CRITDIR = "DIR1",
    ANL045FL = ANL04FL
  )

adlb_mcrit2 <- adlb00 %>%
  filter(!is.na(MCRIT2)) %>%
  mutate(
    MCRIT12 = MCRIT2,
    MCRIT12ML = MCRIT2ML,
    CRITDIR = "DIR2",
    ANL045FL = ANL05FL
  )

### note: by filter ANL04FL/ANL05FL, this table is restricted to On-treatment values, per definition of ANL04FL/ANL05FL
### therefor, no need to add ONTRTFL in filter
### if derivation of ANL04FL/ANL05FL is not restricted to ONTRTFL records, adding ONTRTFL here will not give the correct answer either
### as mixing worst with other period is not giving the proper selection !!!
adlb_mcrit <- rbind(adlb_mcrit1, adlb_mcrit2) %>%
  filter(ANL045FL == "Y") %>%
  inner_join(., adsl)

#### DO NOT USE TRTEMFL = Y in filter, as this will remove subjects from both numerator and denominator
#### instead : set MCRIT12ML to a non-reportable value (ie Level 0) and keep in dataset
if (trtemfl) {
  origlevs <- levels(adlb_mcrit$MCRIT12ML)

  adlb_mcrit <- adlb_mcrit %>%
    mutate(
      MCRIT12ML = case_when(
        !is.na(MCRIT12ML) & is.na(TRTEMFL) | TRTEMFL != "Y" ~ "Level 0",
        TRUE ~ MCRIT12ML
      )
    ) %>%
    mutate(MCRIT12ML = factor(MCRIT12ML, levels = origlevs))
}

# finalize mapping dataframe based upon abnormal spreadsheet

xlabel_map3 <- xlabel_map2 %>%
  right_join(., unique(adlb_mcrit %>% select(PARAMCD, PARCAT3))) %>%
  arrange(PARCAT3, PARAMCD, CRITDIR, MCRIT12, MCRIT12ML) %>%
  mutate_if(is.factor, as.character) %>%
  #### get rid of mapping defined in spreadsheet but not present in data
  filter(MCRIT12 %in% obs_mcrit12)

### this will ensure alphabetical sorting on abnormality
### within a test LOW needs to come prior to High
### for this reason, split a test like 'Calcium, low' and 'Calcium, High' in 2
xlabel_map3 <- xlabel_map3 %>%
  mutate(MCRIT12x = stringr::str_split_i(MCRIT12, ",", 1)) %>%
  arrange(MCRIT12x, CRITDIR, MCRIT12ML)


# MCRIT12ML needs to be a factor, with all levels (also unobserved),
# as these levels are not available on the metadata files, only in markedly abnormal
# we need to update the factor levels
# these are present in the markedly abnormal file processing, ie we can use xlabel_map3
adlb_mcrit$MCRIT12ML <- factor(
  as.character(adlb_mcrit$MCRIT12ML),
  levels = unique(xlabel_map3$MCRIT12ML)
)

# Define layout and build table:

# Core function to produce shell for specific parcat3 selection

build_result_parcat3 <- function(
  df = adlb_mcrit,
  PARCAT3sel = NULL,
  .adsl = adsl,
  map = xlabel_map3,
  tblid,
  save2rtf = TRUE,
  subgroup = NULL,
  label_fstr = NULL,
  .trtvar = trtvar,
  .ctrl_grp = ctrl_grp,
  .ref_path = ref_path,
  .page_by = page_by,
  .indent_adj = indent_adj
) {
  tblidx <- get_tblid(tblid, PARCAT3sel)
  titles2 <- get_titles_from_file(input_path = '../../_data/', tblidx)

  .extra_args_rr <- list(
    method = "wald",
    denom = "n_df",
    ref_path = .ref_path,
    .stats = c("denom", "count_unique_fraction"),
    denom_by = subgroup
  )

  .extra_args_rr2 <- list(
    denom = "n_altdf",
    denom_by = subgroup,
    riskdiff = FALSE,
    extrablankline = TRUE,
    .stats = c("n_altdf"),
    label_fstr = label_fstr
  )

  ### !!!! Map dataframe should not contain more tests than in data
  ### as we need to split by PARCAT3, need to have a function for lty with the appropriate PARCAT3 selection
  ### filter of the data, original factor levels can remain, no need to drop these levels

  lyt_filter <- function(
    PARCAT3sel = NULL,
    map,
    subgroup = NULL,
    label_fstr = NULL
  ) {
    if (!is.null(PARCAT3sel)) {
      map <- map %>%
        filter(PARCAT3 %in% PARCAT3sel)
    }

    lyt <- basic_table(show_colcounts = TRUE, colcount_format = "N=xx") %>%
      split_cols_by(
        "colspan_trt",
        split_fun = trim_levels_to_map(map = colspan_trt_map)
      ) %>%
      split_cols_by(
        .trtvar
        # , split_fun = add_combo_levels(combodf)
      ) %>%
      split_cols_by("rrisk_header", nested = FALSE) %>%
      split_cols_by(
        .trtvar,
        labels_var = "rrisk_label",
        split_fun = remove_split_levels(.ctrl_grp)
      )

    if (!is.null(subgroup)) {
      lyt <- lyt %>%
        split_rows_by(
          subgroup,
          label_pos = "hidden",
          section_div = " ",
          split_fun = drop_split_levels,
          page_by = .page_by
        ) %>%
        ###
        summarize_row_groups(
          var = subgroup,
          cfun = a_freq_j,
          extra_args = .extra_args_rr2
        )
    }

    lyt <- lyt %>%
      split_rows_by(
        "PARAMCD",
        split_label = "Laboratory Test",
        label_pos = "topleft",
        child_labels = "hidden",
        split_fun = trim_levels_to_map(map),
        indent_mod = .indent_adj
      ) %>%
      ## Low prior to High
      split_rows_by(
        "CRITDIR",
        label_pos = "hidden",
        child_labels = "hidden",
        split_fun = trim_levels_to_map(map)
      ) %>%
      split_rows_by(
        "MCRIT12",
        split_label = "Threshold Level, n (%)",
        label_pos = "topleft",
        split_fun = trim_levels_to_map(map),
        section_div = " "
      ) %>%
      # denominators are varying per test, therefor show denom (not yet in shell)
      analyze(
        c("MCRIT12ML"),
        a_freq_j,
        extra_args = append(.extra_args_rr, NULL),
        show_labels = "hidden",
        indent_mod = 0L
      )

    return(lyt)
  }

  lyt <- lyt_filter(
    PARCAT3sel = PARCAT3sel,
    map = map,
    subgroup = subgroup,
    label_fstr = label_fstr
  )

  if (!is.null(PARCAT3sel)) {
    df <- df %>%
      filter(PARCAT3 %in% PARCAT3sel)
  }

  if (nrow(df) > 0) {
    result <- build_table(lyt, df, alt_counts_df = .adsl)
  } else {
    result <- NULL
    message(paste0(
      "Parcat3 [",
      PARCAT3sel,
      "] is not present on input dataset"
    ))
    return(result)
  }

  ################################################################################
  # Remove Level 0 line
  ################################################################################

  remove_grade0 <- function(tr) {
    if (is(tr, "DataRow") & (tr@label == "Level 0")) {
      return(FALSE)
    } else if (is(tr, "DataRow") & (tr@label == no_data_to_report_str)) {
      return(FALSE)
    } else {
      return(TRUE)
    }
  }

  result <- result %>% prune_table(prune_func = keep_rows(remove_grade0))

  ################################################################################
  # Remove unwanted column counts
  ################################################################################

  result <- remove_col_count(result)
  ################################################################################
  # Set title
  ################################################################################

  result <- set_titles(result, titles2)

  if (save2rtf) {
    ################################################################################
    # Convert to tbl file and output table
    ################################################################################
    ### add the proper abbreviation to the tblid, and add opath path
fileid <- tblid

    tt_to_tlgrtf(string_map = string_map, tt = result, file = fileid, orientation = "landscape")
  }

  return(result)
}

# Apply core function to all specified levels of parcat3 selection

### note : the same core tblid (TSFLAB02a) will be used for all, inside the core function build_result_parcat3 the proper abbreviation will be added

### titles will not be retrieved for these, as the table identifiers are not in the DPS system
### study teams will have to ensure all versions that are needed are included in DPS system
result1 <- build_result_parcat3(
  PARCAT3sel = "Liver biochemistry",
  tblid = tblid,
  subgroup = subgrpvar,
  label_fstr = subgrplbl,
  save2rtf = TRUE
)
result2 <- build_result_parcat3(
  PARCAT3sel = "Kidney function",
  tblid = tblid,
  subgroup = subgrpvar,
  label_fstr = subgrplbl,
  save2rtf = TRUE
)
result3 <- build_result_parcat3(
  PARCAT3sel = "Lipids",
  tblid = tblid,
  subgroup = subgrpvar,
  label_fstr = subgrplbl,
  save2rtf = TRUE
)


result4 <- build_result_parcat3(
  PARCAT3sel = c(
    "Complete blood count",
    "WBC differential",
    "Coagulation studies"
  ),
  tblid = tblid,
  subgroup = subgrpvar,
  label_fstr = subgrplbl,
  save2rtf = TRUE
)

### if a certain category is not present, no rtf will be generated

result <- build_result_parcat3(
  PARCAT3sel = "General chemistry",
  tblid = tblid,
  subgroup = subgrpvar,
  label_fstr = subgrplbl,
  save2rtf = TRUE
)

TSFLAB02a: Subjects With =1 [Laboratory Category] Laboratory Values With Elevated or Low Values Meeting Specified Levels Based on Worst On-treatment Value by [Subgroup]; Safety Analysis Set (Study jjcs - core)
	Active Study Agent			Risk Difference (%) (95% CI)
Laboratory Test	Xanomeline High Dose	Xanomeline Low Dose	Placebo	Xanomeline High Dose vs Placebo	Xanomeline Low Dose vs Placebo
Threshold Level, n (%)	N=53	N=73	N=59
Age: ≥18 to <65 years	8	5	7
Calcium, low
N	8	5	6
Level 1 (<2.096 mmol/L)	0	0	0	0.0 (0.0, 0.0)	0.0 (0.0, 0.0)
Level 2 (<1.996 mmol/L)	2 (25.0%)	1 (20.0%)	2 (33.3%)	-8.3 (-56.5, 39.9)	-13.3 (-64.8, 38.2)
Level 3 (<1.871 mmol/L)	0	0	0	0.0 (0.0, 0.0)	0.0 (0.0, 0.0)
Glucose, low
N	8	4	7
Level 1 (<3.89 mmol/L)	0	0	0	0.0 (0.0, 0.0)	0.0 (0.0, 0.0)
Level 2 (<3.00 mmol/L)	0	0	0	0.0 (0.0, 0.0)	0.0 (0.0, 0.0)
Age: ≥65 to <75 years	16	17	19
Calcium, low
N	14	12	19
Level 1 (<2.096 mmol/L)	0	0	0	0.0 (0.0, 0.0)	0.0 (0.0, 0.0)
Level 2 (<1.996 mmol/L)	2 (14.3%)	3 (25.0%)	5 (26.3%)	-12.0 (-39.0, 15.0)	-1.3 (-32.8, 30.2)
Level 3 (<1.871 mmol/L)	0	0	0	0.0 (0.0, 0.0)	0.0 (0.0, 0.0)
Glucose, low
N	13	12	19
Level 1 (<3.89 mmol/L)	0	0	0	0.0 (0.0, 0.0)	0.0 (0.0, 0.0)
Level 2 (<3.00 mmol/L)	0	0	0	0.0 (0.0, 0.0)	0.0 (0.0, 0.0)
Age: ≥75 years	29	51	33
Calcium, low
N	28	44	31
Level 1 (<2.096 mmol/L)	0	0	0	0.0 (0.0, 0.0)	0.0 (0.0, 0.0)
Level 2 (<1.996 mmol/L)	13 (46.4%)	11 (25.0%)	6 (19.4%)	27.1 (4.0, 50.2)	5.6 (-13.3, 24.5)
Level 3 (<1.871 mmol/L)	0	0	0	0.0 (0.0, 0.0)	0.0 (0.0, 0.0)
Glucose, low
N	26	42	30
Level 1 (<3.89 mmol/L)	0	0	0	0.0 (0.0, 0.0)	0.0 (0.0, 0.0)
Level 2 (<3.00 mmol/L)	0	0	0	0.0 (0.0, 0.0)	0.0 (0.0, 0.0)
Note: On-treatment is defined as treatment-emergent laboratory values obtained after the first dose and within [30 days] following treatment discontinuation. [Treatment-emergent values are those that worsened from baseline.]
Note: Subjects are counted once per laboratory test category (ie, low, high) based on the worst categorization.

Download RTF file