In JayAchar/hisreportr: hisreportr: Automating MSF OCA EMR reporting

knitr::opts_chunk$set(echo = FALSE, warning = FALSE, error = TRUE, message = FALSE, comment = "")
knitr::opts_knit$set(child.path = "fragments/")
library(ggplot2)

# set ggplot theme
ggplot2::theme_set(hisreportr::msf_theme())

# define data points for full report
data <- list()

# calculate last date of reporting time
end_date_reporting <- as.Date(paste0(params$reporting_year, "-",
               max(params$reporting_month), "-01")) + 
  months(1) - lubridate::days(1)

disease <- toupper(stringr::str_extract(params$report_type, "^hcv|^tb|^hiv"))

``` {r prepare-data, include = TRUE}

subsets

reporting year df

data$year_df <- report_data[as.numeric(format(report_data$starttre, "%Y")) == params$reporting_year, ]

reporting month df

data$month_df <- data$year_df[as.numeric(format(data$year_df$starttre, "%m")) == params$reporting_month, ]

outcomes during reporting month

data$month_outcome <- filter_year_month(df = report_data, date_var = "end_date", month = params$reporting_month, year = params$reporting_year)

ds-tb outcome cohort reporting

data$ds_outcome_cohort_df <- report_data[lubridate::quarter(end_date_reporting, with_year = TRUE) == report_data$reporting_ds_period & report_data$out_regimen == "DS-TB",]

data$ds_outcome_old_cohort_df <- report_data[lubridate::quarter(end_date_reporting, with_year = TRUE) > report_data$reporting_ds_period & report_data$out_regimen == "DS-TB",]

data$ds_periodic_outcomes_df <- report_data[lubridate::quarter(end_date_reporting, with_year = TRUE) >= report_data$reporting_ds_period & report_data$out_regimen == "DS-TB", c("start_quarter", "outcome")]

dr-tb outcome cohort reporting

data$dr_outcome_cohort_df <- report_data[lubridate::semester(end_date_reporting, with_year = TRUE) == report_data$reporting_dr_period & report_data$out_regimen == "DR-TB",]

data$dr_outcome_old_cohort_df <- report_data[lubridate::semester(end_date_reporting, with_year = TRUE) > report_data$reporting_dr_period & report_data$out_regimen == "DR-TB",]

data$dr_periodic_outcomes_df <- report_data[lubridate::semester(end_date_reporting, with_year = TRUE) >= report_data$reporting_dr_period & report_data$out_regimen == "DR-TB", c("start_semester", "outcome")]

calculate figures

earliest date of treamtent initiation for programme

data$earliest_tx_initiation <- base::format(min (report_data$starttre, na.rm = TRUE), format = "%d %b %Y")

number of treatment episodes with final outcome defined

data$total_tx_outcomes <- sum(report_data$outcome != "Missing", na.rm = TRUE)

number of treatment episodes by age

data$total_episodes_O15 <- sum(report_data$age_recalculated >= 15, na.rm = TRUE) data$total_episodes_U15 <- sum(report_data$age_recalculated < 15, na.rm = TRUE)

========================================

Monthly totals

TODO refactor to remove filter_year_month() from package

number of episodes starting 1st line drugs

data$fld_initiation <- filter_year_month(df = report_data, date_var = "starttre", month = params$reporting_month, year = params$reporting_year) %>% .[.$regimen == "Only 1st line drugs", ] %>% nrow()

number of episodes starting 2nd line drugs

data$sld_initiation <- filter_year_month(df = report_data, date_var = "starttre", month = params$reporting_month, year = params$reporting_year) %>% .[.$regimen == "Regimen including 2nd line drugs", ] %>% nrow()

```r
# indicator variables to check for empty data frames
no_data <- list()

# define 'No data' message
no_data$message <- "<br> **No data available for the reporting period**"

no_data$month_year <- nrow(data$year_df) == 0 | nrow(data$month_df) == 0

no_data$all_year <- nrow(data$year_df) == 0 | nrow(report_data) == 0

no_data$month_outcomes <- nrow(data$month_outcome) == 0

Programme summary | Figure ---------------------------- | -------------------- First treatment episode start date | r data$earliest_tx_initiation Number of adult ($\geq$ 15 years) treatment episodes | r data$total_episodes_O15 Number of childhood (< 15 years) treatment episodes | r data$total_episodes_U15 Number of treatment episodes with final outcome | r data$total_tx_outcomes

---

Data for r paste(month.name[params$reporting_month], params$reporting_year):

Monthly summary | Figure ---------------------------- | -------------------- Number of treatment episodes starting with 1st line drugs | r data$fld_initiation Number of treatment episodes started including 2nd line drugs | r data$sld_initiation Number of patients given a treatment outcome | r sum(!is.na(data$month_outcome$outcome))

---

Cohort inclusion

TB Treatment initiations {.tabset .tabset-fade}

r if(no_data$all_year) {no_data$message}

initiation_formula <- "regimen ~ start_month"
var_names <- "Month"

``` {r child = "monthly_initiations.Rmd", eval = ! no_data$all_year}

<!-- Generate monthly initiations plot -->

```r

``` {r child = "monthly_initiations_def.Rmd", eval = ! no_data$all_year}

<hr>

## Registration characteristics {.tabset .tabset-fade}  

`r if(no_data$month_year) {no_data$message}`

<!-- Generate age, gender, bmi table -->
`r if(! no_data$month_year) {"### Age, gender<br>and BMI"}` 

```r
initiation_formula <- "~ age_cat + gender + bmi_factor"
var_names <- c("Age", "Gender", "BMI")

r if(! no_data$month_year) {"### Registration and <br>lab confirmation"}

initiation_formula <- "~ tb_reg_grp + mtb_confirmation"
var_names <- c("Registration group", "Lab confirmation")

r if(! no_data$month_year) {"### DST results"}

initiation_formula <- "~ dst_profile + dst_sub_profile"
var_names <- c("DST", "Detailed DST")

``` {r child = "registration_characteristics_def.Rmd", eval = ! no_data$month_year, eval = ! no_data$month_year}

<hr>

# Treatment outcomes

## Reported in `r paste0(month.name[params$reporting_month], " ", params$reporting_year)`

`r if(no_data$month_outcomes) {no_data$message}`

<!-- Generate table -->

```r
table_data <- list(data$month_outcome)
table_formula <- "out_regimen ~ outcome"
table_label <- "Current reporting month"

---

Cohort outcome reporting {.tabset .tabset-fade}

DS-TB outcomes by quarter {.tabset .tabset-fade}

r if(nrow(data$ds_outcome_cohort_df) == 0) {no_data$message}

r if(nrow(data$dr_outcome_cohort_df) > 0) {"#### Table"}

table_formula <- "~ outcome"
table_data <- list(data$ds_outcome_cohort_df, 
                   data$ds_outcome_old_cohort_df)

# Calculate reporting quarter and year
yq <- lubridate::quarter(end_date_reporting - months(15), with_year = TRUE) 
table_label <- c(paste0("Q", 
                       as.integer(round(yq %% 1 * 10)), 
                       ", ",
                       as.integer(yq)),
                 "Older programme outcomes")

r if(nrow(data$ds_outcome_cohort_df) > 0) {"#### Plot"}

plot_data <- data$ds_outcome_cohort_df
plot_title <- paste0("DS-TB treatment outcomes - ", table_label[1])
success_levels <- c("Cured", "Completed")
color_palette <- tb_outcome_colors
legend_labels <- c("Cured",
                  "Completed",
                  "Died",
                  "Failed",
                  "LTFU",
                  "Not Evaluated",
                  "Treatment adapted")

r if(nrow(data$ds_periodic_outcomes_df) > 0) {"#### Quarterly outcomes plot"}

# define outcomes which equate to success
success_levels <- c("Cured", "Completed")

# remove NA 
data$ds_periodic_outcomes_df <- data$ds_periodic_outcomes_df[complete.cases(data$ds_periodic_outcomes_df), ]

# generate simplified outcome variable
data$ds_periodic_outcomes_df$simple_outcome <- ifelse(data$ds_periodic_outcomes_df$outcome %in% success_levels, 0, 1)

data$ds_periodic_outcomes_df$simple_outcome <- factor(data$ds_periodic_outcomes_df$simple_outcome, 
                                   levels = c(0, 1), 
                                   labels = c("Successful", "Unsuccessful"))

# variables for plot generating fragment
table_data <- data$ds_periodic_outcomes_df
period_var <- quote(start_quarter)
title <- "Quarterly treatment outcomes"
x_label <- "Start quarter"

DR-TB by semester {.tabset .tabset-fade}

r if(nrow(data$dr_outcome_cohort_df) == 0) {no_data$message}

r if(nrow(data$dr_outcome_cohort_df) > 0) {"#### Table"}

table_formula <- "~ outcome"
table_data <- list(data$dr_outcome_cohort_df, 
                   data$dr_outcome_old_cohort_df)
# Calculate reporting quarter and year
yq <- lubridate::semester(end_date_reporting - months(30), with_year = TRUE) 
table_label <- c(paste0("Semester ", 
                       as.integer(round(yq %% 1 * 10)), 
                       ", ",
                       as.integer(yq)), 
                 "Older programme outcomes")

r if(nrow(data$dr_outcome_cohort_df) > 0) {"#### Plot"}

plot_data <- data$dr_outcome_cohort_df
plot_title <- paste0("DR-TB treatment outcomes - ", table_label[1])
success_levels <- c("Cured", "Completed")
color_palette <- tb_outcome_colors
legend_labels <- c("Cured",
                  "Completed",
                  "Died",
                  "Failed",
                  "LTFU",
                  "Not Evaluated",
                  "Treatment adapted")

r if(nrow(data$dr_periodic_outcomes_df) > 0) {"#### Quarterly outcomes plot"}

# define outcomes which equate to success
success_levels <- c("Cured", "Completed")

# remove NA 
data$dr_periodic_outcomes_df <- data$dr_periodic_outcomes_df[complete.cases(data$dr_periodic_outcomes_df), ]

# generate simplified outcome variable
data$dr_periodic_outcomes_df$simple_outcome <- ifelse(data$dr_periodic_outcomes_df$outcome %in% success_levels, 0, 1)

data$dr_periodic_outcomes_df$simple_outcome <- factor(data$dr_periodic_outcomes_df$simple_outcome, 
                                   levels = c(0, 1), 
                                   labels = c("Successful", "Unsuccessful"))

# variables for plot generating fragment
table_data <- data$dr_periodic_outcomes_df
period_var <- quote(start_semester)
title <- "Semester treatment outcomes"
x_label <- "Start semester"

---

JayAchar/hisreportr documentation built on March 18, 2020, 5:57 a.m.