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"))

# 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, ] 


# HCV outcome cohort reporting
data$hcv_regimen_outcome_df <-
  report_data[lubridate::quarter(end_date_reporting,
                                 with_year = TRUE) == report_data$reporting_hcv_period,]

data$hcv_regimen_old_outcomes_df <- 
  report_data[lubridate::quarter(end_date_reporting,
                                 with_year = TRUE) > report_data$reporting_hcv_period,]

data$hcv_quarterly_outcomes_df <- 
  report_data[lubridate::quarter(end_date_reporting,
                                 with_year = TRUE) >= report_data$reporting_hcv_period,
              c("start_quarter", "outcome")]



# 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 initiations
data$treatment_initiations <- nrow(unique(report_data[c("patient_id", "starttre")]))

# number of outcomes given in reporting month
# data$outcomes_reporting_month 
data$monthly_outcomes_reported <- sum(format(report_data$end_tx_date, "%Y-%m") == format(end_date_reporting, "%Y-%m"), 
                                      na.rm = TRUE)

# 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

Programme summary | Figure ---------------------------- | -------------------- First treatment episode start date | r data$earliest_tx_initiation Number of treatment initiations | r data$treatment_initiations

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

Monthly summary | Figure ---------------------------- | -------------------- Number of treatment episodes started | r nrow(data$month_df) Number of treatment outcomes registered | r data$monthly_outcomes_reported

Cohort inclusions

HCV treatment initiations {.tabset .tabset-fade}

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

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

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

<!-- Generate monthly initiation plot if data available --> 

```r

Registration characteristics {.tabset .tabset-fade}

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

r if(! no_data$month_year) {"### Age, gender<br>and BMI"}

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

r if(! no_data$month_year) {"### HCV genotype<br>and Fibrosis score"}

initiation_formula <- "~ factor_full_genotype + fib_score"
var_names <- c("HCV genotype", "Fibrosis score")

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

<hr>  

# Treatment monitoring  

## Regimen at initiation {.tabset .tabset-fade}

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

<!-- Generate table -->

```r
table_formula <- c("~ drug_factor")

Cohort outcome reporting {.tabset .tabset-fade}

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

r if(nrow(data$hcv_regimen_outcome_df) > 0) {"## Outcomes by quarter"}

table_formula <- "~ outcome"
table_data <- list(data$hcv_regimen_outcome_df,
                   data$hcv_regimen_old_outcomes_df)

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

r if(nrow(data$hcv_regimen_outcome_df) > 0) {"## Current quarter outcome plot"}

plot_data <- data$hcv_regimen_outcome_df
plot_title <- paste0("HCV treatment outcomes - ", table_label[1])
success_levels <- c("Cured", "Completed, post treatment VL not done")
color_palette <- hcv_outcome_colors
legend_labels <- c("Cured", 
                   "Completed, post treatment VL not done",
                   "Failed", 
                   "Died",
                   "LTFU during treatment",
                   "Other")

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

# define outcomes which equate to success
success_levels <- c("Cured", "Completed, post treatment VL not done")

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

data$hcv_quarterly_outcomes_df$simple_outcome <- factor(data$hcv_quarterly_outcomes_df$simple_outcome, 
                                   levels = c(0, 1), 
                                   labels = c("Successful", "Unsuccessful"))
# variables for plot generating fragment
table_data <- data$hcv_quarterly_outcomes_df
period_var <- quote(start_quarter)
title <- "Quarterly treatment outcomes"
x_label <- "Start quarter"