Nothing
## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# library(sassy)
#
# # Prepare Log -------------------------------------------------------------
#
# options("logr.autolog" = TRUE,
# "logr.on" = TRUE,
# "logr.notes" = FALSE)
#
# # Get path to temp directory
# tmp <- tempdir()
#
# # Get sample data directory
# dir <- system.file("extdata", package = "sassy")
#
# # Open log
# lf <- log_open(file.path(tmp, "example11.log"))
#
#
# # Prepare formats ---------------------------------------------------------
#
# sep("Prepare formats")
#
# fc <- fcat(SEX = c("M" = "Male", "F" = "Female"),
# AGE = "%d Years",
# RACE = value(condition(x == "WHITE", "White"),
# condition(x == "BLACK OR AFRICAN AMERICAN", "Black or African American"),
# condition(x == "ASIAN OR PACIFIC ISLANDER", "Asian or Pacific Islander"),
# condition(TRUE, "Other")),
# WEIGHT = "%6.2f kg",
# EAR = c("L" = "Left", "R" = "Right"),
# DOSE = "%4.2fug",
# ETHNIC = value(condition(x == "NOT HISPANIC OR LATINO", "Not Hispanic or Latino"),
# condition(x == "HISPANIC OR LATINO", "Hispanic or Latino"),
# condition(TRUE, "Unknown")),
# ARMT = value(condition(x == "ARM A", "Placebo"),
# condition(x == "ARM B", "Drug 50mg"),
# condition(x == "ARM C", "Drug 100mg"),
# condition(x == "ARM D", "Competitor"),
# condition(TRUE, "Not Treated/Screen Failure")),
# UNITS = value(condition(x == "BEATS/MIN", "bpm"),
# condition(x == "BREATHS/MIN", "brths/min"),
# condition(x == "C", symbol("degC")),
# condition(x == "mmHg", "")),
# VISIT = value(condition(x == "DAY 1", "Day 1"),
# condition(x == "WEEK 2", "Week 2"),
# condition(x == "WEEK 4", "Week 4"),
# condition(x == "WEEK 6", "Week 6"),
# condition(x == "WEEK 8", "Week 8"),
# condition(x == "WEEK 12", "Week 12"),
# condition(x == "WEEK 16", "Week 16"),
# condition(TRUE, "Early Termination"))
# )
#
# # Prepare Data ------------------------------------------------------------
#
# sep("Prepare Data")
#
# libname(sdtm, dir, "csv")
#
# lib_load(sdtm)
#
# put("Format desired vital signs")
# datastep(sdtm.VS,
# keep = v(USUBJID, VSTESTCD, VSCOMB, VISITNUM, VISIT),
# where = expression(VSTESTCD != 'HEIGHT' & VISITNUM > 0),
# {
#
# if (VSORRESU == "C")
# VSCOMB <- paste0(VSORRES, fapply(VSORRESU, fc$UNITS))
# else
# VSCOMB <- paste(VSORRES, fapply(VSORRESU, fc$UNITS))
# }) -> vso
#
# put("Pivot vitals signs")
# proc_transpose(vso, id = VSTESTCD, var = VSCOMB,
# by = v(USUBJID, VISITNUM, VISIT)) |>
# proc_sort(by = v(USUBJID, VISITNUM)) -> vsot
#
#
# put("Assign and apply formats")
# formats(sdtm.DM) <- fc
# dmf <- fdata(sdtm.DM) |> put()
#
# put("Prepare final data for reporting")
# datastep(dmf, format = fc,
# by = USUBJID,
# retain = list(PTCNT = 0, PG = 1),
# merge = vsot, merge_by = USUBJID,
# {
#
# # Combine subject info into label row
# BASELINE <- paste0(USUBJID, ", Site=", SITEID,
# ", Age=", AGE, ", Sex=", SEX, ", Race=", RACE,
# ", Ethnic=", ETHNIC)
#
# # Deal with non-recorded blood pressure
# if (is.na(DIABP))
# DIABP <- "-"
#
# if (is.na(SYSBP))
# SYSBP <- "-"
#
# # Combine distolic and systolic in one column
# BP <- paste0(trimws(DIABP), "/", trimws(SYSBP), " mmHg")
#
# # Format treatment group
# if (first.)
# TREATMENT <- fapply(ARM, fc$ARMT)
# else
# TREATMENT <- ""
#
# # Count up patients
# if (first.) {
# PTCNT <- PTCNT + 1
# }
#
# # Create paging variable with 3 patients per page
# if (PTCNT == 4) {
#
# PTCNT <- 1
# PG <- PG + 1
# }
#
# }) -> final
#
#
# # Create report -----------------------------------------------------------
#
# sep("Create and Print Report")
#
# tbl <- create_table(final, show_cols = "none",
# width = 9, first_row_blank = FALSE,
# header_bold = TRUE) |>
# column_defaults(from = "VISIT", to = "BP", width = 1.25) |>
# stub(v(BASELINE, TREATMENT), label = "Subject/Treatment") |>
# define(BASELINE, label_row = TRUE) |>
# define(TREATMENT) |>
# define(VISIT, label = "Visit") |>
# define(TEMP, label = "Temperature") |>
# define(PULSE, label = "Pulse") |>
# define(RESP, label = "Respirations") |>
# define(BP, label = "Blood Pressure") |>
# define(USUBJID, blank_after = TRUE, visible = FALSE) |>
# define(PG, page_break = TRUE, visible = FALSE)
#
# rpt <- create_report(file.path(tmp, "example11"), font = "Courier", font_size = 9) |>
# add_content(tbl) |>
# set_margins(top = 1, bottom = 1) |>
# page_header("Program:" %p% Sys.path(), right = "Draft", width = 7) |>
# titles( "Study: ABC", "Appendix 10.2.6.1.2.1", "Source: DM, VS",
# columns = 3, header = TRUE, blank_row = "none") |>
# titles("Subject Listing with Vital Signs by Visit{supsc('1')}",
# "All Randomized Patients", align = "center", header = TRUE, blank_row = "below") |>
# footnotes("{supsc('1')} Baseline through completion of study or early termination.",
# "Values flagged with {symbol('dagger')} were excluded from the by-visit " %p%
# "analysis in tables showing the qualitative test results.",
# blank_row = "none", footer = TRUE) |>
# page_footer("Date: " %p% toupper(fapply(Sys.time(), "%d%b%Y %H:%M:%S")),
# "Archytas", "Page [pg] of [tpg]")
#
# # Generate both RTF and PDF with same report object
# res1 <- write_report(rpt, output_type = "RTF")
# res2 <- write_report(rpt, output_type = "PDF")
#
#
# # Uncomment to show reports
# # file.show(res1$modified_path)
# # file.show(res2$modified_path)
#
# # Uncomment to show log
# # file.show(lf)
#
#
# # Clean Up ----------------------------------------------------------------
#
# lib_unload(sdtm)
#
# log_close()
#
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.