## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----eval=FALSE, echo=TRUE----------------------------------------------------
#  library(sassy)
#  
#  options("logr.notes" = FALSE,
#          "logr.autolog" = TRUE,
#          "procs.print" = FALSE)
#  
#  # Get temp location for log and report output
#  tmp <- tempdir()
#  
#  lf <- log_open(file.path(tmp, "example16.log"))
#  
#  
#  # Get data ----------------------------------------------------------------
#  
#  sep("Get data")
#  
#  # Get sample data path
#  pth <- system.file("extdata", package = "sassy")
#  
#  put("Open data library")
#  libname(sdtm, pth, "csv")
#  
#  # Create Formats ----------------------------------------------------------
#  
#  sep("Create Formats")
#  
#  put("Format for visits")
#  vfmt <- value(condition(x == "DAY 1", "Day 1"),
#                condition(x == "WEEK 2", "Week 2"),
#                condition(x == "WEEK 6", "Week 6"),
#                condition(x == "WEEK 12", "Week 12"),
#                as.factor = TRUE)
#  
#  put("Format for ARMs")
#  afmt <- value(condition(x == "ARM A", "Placebo"),
#                condition(x == "ARM B", "Drug (10mg)"),
#                condition(x == "ARM C", "Drug (20mg)"),
#                condition(x == "ARM D", "Competitor"),
#                as.factor = TRUE)
#  
#  put("Format for Lab Result Indicator")
#  rfmt <- value(condition(x == "LOW", "Low"),
#                condition(x == "NORMAL", "Normal"),
#                condition(x == "HIGH", "High"),
#                condition(x == "UNKNOWN", "Unknown"),
#                as.factor = TRUE)
#  
#  
#  # Prepare data ------------------------------------------------------------
#  
#  sep("Prepare data")
#  
#  put("Pull out needed visits and columns")
#  lbsub1 <- subset(sdtm$LB, VISIT %in% toupper(levels(vfmt)),
#                   v(USUBJID, VISIT, VISITNUM, LBCAT, LBORRESU, LBTEST,
#                     LBTESTCD, LBBLFL, LBNRIND)) |> put()
#  
#  put("Pull out baseline subset")
#  lbsub2 <- subset(lbsub1, LBBLFL == 'Y',
#                   v(USUBJID, VISIT, LBCAT, LBTESTCD, LBNRIND)) |> put()
#  
#  put("Merge and append change from baseline")
#  datastep(lbsub1, merge = lbsub2, merge_by = v(USUBJID, LBCAT, LBTESTCD),
#           rename = v(LBNRIND.1 = LBNRIND, LBNRIND.2 = BLBNRIND, VISIT.1 = VISIT),
#           drop = VISIT.2, {
#  
#             if (is.na(LBNRIND.1)) {
#  
#               LBNRIND.1 <- "UNKNOWN"
#             }
#  
#             if (is.na(LBNRIND.2)) {
#  
#               LBNRIND.2 <- "UNKNOWN"
#             }
#  
#           }) -> lbsub
#  
#  put("Pull needed ARMs and columns for DM")
#  dmsub <- subset(sdtm$DM, ARM != "SCREEN FAILURE" & is.na(ARM) == FALSE,
#                  v(USUBJID, ARMCD, ARM)) |> put()
#  
#  put("Merge DM with LB to get subject treatments")
#  datastep(lbsub, merge = dmsub, merge_by = USUBJID,
#           where = expression(toupper(VISIT) != 'SCREENING'),
#           {
#             VISIT <- fapply(VISIT, vfmt)
#           }) -> lbdat
#  
#  
#  # Get population counts ---------------------------------------------------
#  
#  sep("Get population counts")
#  
#  proc_sort(lbdat, by = v(ARM, USUBJID),
#            keep = v(ARM, USUBJID),
#            options = nodupkey) -> lb_unique
#  
#  
#  put("Get population frequencies")
#  proc_freq(lb_unique, tables = ARM,
#            output = long,
#            options = v(nopercent, nonobs)) -> lb_pop
#  
#  
#  # Prepare lab test labels -------------------------------------------------
#  
#  sep("Lab test labels")
#  
#  put("Get lookup data for lab tests")
#  proc_sort(lbdat, by = v(LBTESTCD, LBTEST, LBORRESU),
#            keep = v(LBTESTCD, LBTEST, LBORRESU),
#            options = nodupkey) -> tcodes
#  
#  put("Create test label with units")
#  datastep(tcodes, where = expression(is.na(LBORRESU) == FALSE),
#           keep = v(LBTESTCD, LABEL),
#           {
#  
#             LABEL <- paste0(LBTEST, " (", LBORRESU, ")")
#  
#           }) -> tfmtdat
#  
#  put("Create lab value lookup")
#  tfmt <- tfmtdat$LABEL
#  names(tfmt) <- tfmtdat$LBTESTCD
#  
#  
#  # Calculate frequencies ----------------------------------------------------
#  
#  sep("Calculate frequencies")
#  
#  put("Apply formats")
#  lbdat$LBNRIND <- fapply(lbdat$LBNRIND, rfmt)
#  lbdat$BLBNRIND <- fapply(lbdat$BLBNRIND, rfmt)
#  
#  put("Get freqs by ARM and visit")
#  proc_freq(lbdat, by = v(ARM, LBTESTCD, VISIT),
#            tables = LBNRIND * BLBNRIND) -> lb_freq
#  
#  put("Combine frequencies and percents")
#  datastep(lb_freq,
#           drop = v(VAR1, VAR2, CNT, PCT),
#           {
#             if (CNT == 0) {
#               CNTPCT <- fapply(CNT, "%d", width = 10, justify = "left")
#             } else {
#               CNTPCT <- fapply2(CNT, PCT, "%d", "(%5.1f%%)")
#             }
#           }) -> lb_comb
#  
#  
#  put("Transpose ARMs")
#  proc_transpose(lb_comb, id = v(BY1, CAT2), copy = N,
#                 by = v(BY2, BY3, CAT1), var = CNTPCT,
#                 options = noname) -> lb_final
#  
#  put("Apply formats")
#  lb_final$BY2 <- fapply(lb_final$BY2, tfmt)
#  
#  put("Rename variables")
#  datastep(lb_final,
#           rename = c(BY2 = "LBTEST", BY3 = "VISIT", CAT1 = "RIND"),
#           {}) -> lb_final
#  
#  put("Sort by lab test")
#  proc_sort(lb_final, by = v(LBTEST, VISIT)) -> lb_final
#  
#  
#  
#  # Create report -----------------------------------------------------------
#  
#  sep("Create report")
#  
#  put("Create output path")
#  pth <- file.path(tmp, "output/example16.pdf") |> put()
#  
#  
#  tbl <- create_table(lb_final) |>
#    spanning_header(`ARM A.Low`, `ARM A.Unknown`, "Placebo", n = lb_pop["ARM A"]) |>
#    spanning_header(`ARM B.Low`, `ARM B.Unknown`, "Drug 10mg", n = lb_pop["ARM B"]) |>
#    spanning_header(`ARM C.Low`, `ARM C.Unknown`, "Drug 20mg", n = lb_pop["ARM C"]) |>
#    spanning_header(`ARM D.Low`, `ARM D.Unknown`, "Competitor", n = lb_pop["ARM D"]) |>
#    define(LBTEST, visible = FALSE) |>
#    define(VISIT, "Visit", format = vfmt, dedupe = TRUE, align = "left",
#           id_var = TRUE, blank_after = TRUE) |>
#    define(N, "n", visible = FALSE) |>
#    define(RIND, "", align = "left", id_var = TRUE) |>
#    define(`ARM A.Low`, "Low") |>
#    define(`ARM A.Normal`, "Normal") |>
#    define(`ARM A.High`, "High") |>
#    define(`ARM A.Unknown`, "Unknown") |>
#    define(`ARM B.Low`, "Low") |>
#    define(`ARM B.Normal`, "Normal") |>
#    define(`ARM B.High`, "High") |>
#    define(`ARM B.Unknown`, "Unknown") |>
#    define(`ARM C.Low`, "Low", page_wrap = TRUE) |>
#    define(`ARM C.Normal`, "Normal") |>
#    define(`ARM C.High`, "High") |>
#    define(`ARM C.Unknown`, "Unknown") |>
#    define(`ARM D.Low`, "Low") |>
#    define(`ARM D.Normal`, "Normal") |>
#    define(`ARM D.High`, "High") |>
#    define(`ARM D.Unknown`, "Unknown") |>
#  
#  
#    put("Create report")
#  rpt <- create_report(pth, output_type = "PDF",
#                       font = "Courier", font_size = 9) |>
#    set_margins(top = 1, left = 1, right = 1, bottom = .5) |>
#    page_header(c("Protocol: ABC 12345-678", "DRUG/INDICATION: Consultopan",
#                  "TLF Version: Final Database Lock (03FEB2024)"),
#                right = c("(Page [pg] of [tpg])", "DATABASE VERSION: 01FEB2024",
#                          "TASK: CSR")) |>
#    titles("Table 4.3.1.1", "", "Shift Table of Laboratory Values - Hematology",
#           "(Safety Population)", blank_row = "below") |>
#    page_by(LBTEST, "Laboratory Value: ") |>
#    add_content(tbl) |>
#    footnotes("PROGRAM/OUTPUT: T_LABSHIFT/T_4_3_1_1_HEM",
#              "DATE (TIME): " %p% toupper(fapply(Sys.time(), "%d%b%Y (%H:%M)")),
#              columns = 2, borders = "top", blank_row = "below") |>
#    footnotes(paste("Note 1: For N(%) of participants, percentages are calculated",
#                    "as the number of participants for each ARM at each visit",
#                    "as the denominator."),
#              "Reference: Listing 2.8.1.1, 2.8.1.2", blank_row = "none")
#  
#  
#  
#  
#  
#  put("Write out report to file system")
#  res <- write_report(rpt)
#  
#  
#  # Clean Up ----------------------------------------------------------------
#  
#  sep("Clean Up")
#  
#  log_close()
#  
#  # View report
#  # file.show(res$modified_path)
#  
#  # View log
#  # file.show(lf)
#  
#  

