R/generate_cl_docs.R

In kimjam/srms: Package to automate tasks and reporting for OCD SRMS Team.

#' @title parse_clfrm23770
#' @description Function to parse cl FRM23770
#'
#' @return Returns list of tables
parse_clfrm23770 <- function() {
  sas_path <- file.path('L:', 'Rochester-Quality Regulatory Compliance',
                        'SRMS', 'SRMS Wrkspace', 'Monthly Complaint Trending',
                        'sas2r', paste0('clfrm23770',
                                        tolower(strftime(last_month(),
                                                         format = '%b%y')),
                                        '.sas7bdat'))

  cl_table <- haven::read_sas(sas_path) %>%
    janitor::clean_names()

  reagents <- cl_table %>%
    dplyr::filter(grepl('Micro', technology)) %>%
    split(.$technology)

  sol_num <- cl_table %>%
    dplyr::filter(technology == 'Sol Number')

  equip <- cl_table %>%
    dplyr::filter(!grepl('Micro', technology),
                  technology != 'Sol Number')

  return(list(reagents = reagents,
              sol_num = sol_num,
              equip = equip))
}
#' @title generate_clre_doc
#' @description Generates monthly complaint trending .docx file for CL reagents.
#'
#' @return Writes .docx file to correct path.
#' @export
generate_clre_doc <- function() {
  tables <- parse_clfrm23770()

  # raw data for clre doc
  reagents <- tables$reagents
  sol_num <- tables$sol_num

  rocre <- srms::roc_re_v26b()

  micro_cleaner <- . %>%
    dplyr::select(trend_item, alert_limit, count, investigator) %>%
    setNames(c('Assays', 'Alert Limit',
               paste('Monthly Complaints\n', strftime(last_month(),
                                                      format = '%B-%y')),
               'Investigator'))

  solnum_cleaner <- . %>%
    dplyr::select(trend_item, count, investigator) %>%
    setNames(c('Solution Number',
               paste('Monthly Complaints\n',
                     strftime(last_month(), format = '%B-%y')),
               'Investigator'))

  # creating word document
  doc <- ReporteRs::docx()
  doc %<>% ReporteRs::addParagraph(
    value = ReporteRs::pot('Monthly Complaint Trending Summary: Clinical Laboratory Menu',
                           ReporteRs::textProperties(font.weight = 'bold')),
    par.properties = ReporteRs::parProperties(text.align = 'center')
  )
  doc %<>% ReporteRs::addParagraph(
    value = ReporteRs::pot(strftime(last_month(), format = '%B %Y'),
                           ReporteRs::textProperties(font.weight = 'bold')),
    par.properties = ReporteRs::parProperties(text.align = 'center')
  )
  doc %<>% ReporteRs::addParagraph(
    value = ReporteRs::pot(paste('Completed on',
                                 strftime(Sys.time(), format = '%B %d, %Y'))),
    par.properties = ReporteRs::parProperties(text.align = 'right')
  )
  doc %<>% ReporteRs::addTitle(
    'Clinical Laboratory Menu Complaint Trending',
    level = 1
  )
  doc %<>% ReporteRs::addTOC()
  doc %<>% ReporteRs::addPageBreak()
  doc %<>% ReporteRs::addTitle(
    'Clinical Laboratory Menu Complaint Trending Executive Summary',
    level = 2
  )
  doc %<>% ReporteRs::addPageBreak()
  doc %<>% ReporteRs::addTitle(
    'Figure 1: MS, MT, MW 13 month total complaint trend',
    level = 2
  )
  doc %<>% ReporteRs::addPlot(
    fun = print,
    x = rocre %>%
      dplyr::mutate(YYYYMM = as.character(YYYYMM)) %>%
      srms::add_clre_tech(write = FALSE) %>%
      dplyr::group_by(Technology, YYYYMM) %>%
      dplyr::summarise(Complaints = n()) %>%
      tidyr::spread(key = YYYYMM, value = Complaints, fill = 0) %>%
      add_margins() %>%
      dplyr::select(-Total) %>%
      tidyr::gather(key = YYYYMM, value = Complaints, -Technology) %>%
      ggplot(aes(x = YYYYMM, y = Complaints,
                 group = Technology, color = Technology)) +
      geom_point(size = 1) +
      geom_text(aes(label = Complaints), hjust = 'inward', vjust = 'inward',
                size = 2.5) +
      geom_line() +
      ggtitle('CL Reagent Count of Complaints Per Month') +
      xlab('Month') +
      theme(legend.position = 'top',
            title = element_text(size = 7),
            axis.text.x = element_text(size = 5),
            legend.text = element_text(size = 5)) +
      scale_color_tableau(),
    height = 4
  )
  doc %<>% ReporteRs::addTitle(
    'Figure 2: 13 month total sales volume (in millions of tests)',
    level = 2
  )
  ## ADD FIGURE HERE
  doc %<>% ReporteRs::addParagraph(
    'Note: The monthly sales volume is based on the average of previous three months of sales.'
  )
  doc %<>% ReporteRs::addTitle(
    'Figure 3: 13 month normalized complaint rate trend (per million tests sold)',
    level = 2
  )
  ## ADD FIGURE HERE
  doc %<>% ReporteRs::addPageBreak()
  doc %<>% ReporteRs::addTitle(
    'Analysis of Call Subjects Exceed Alert Limit',
    level = 2
  )

  fig_ind <- 3
  # cl reagents
  for (tech in names(reagents)) {
    tab_ind <- match(tech, names(reagents))

    if (tab_ind > 1) doc %<>% ReporteRs::addPageBreak()

    doc %<>% ReporteRs::addTitle(
      value = paste0('Table ', tab_ind ,
                     ': Summary of current month complaints for ', tech,
                     ' assays'),
      level = 3
    )

    table <- ReporteRs::FlexTable(data = reagents[[tech]] %>% micro_cleaner())
    table <- ReporteRs::setFlexTableBackgroundColors(
      table,
      i = 1,
      j = 1:4,
      colors = 'gray',
      to = 'header'
    )
    table[] <- ReporteRs::textProperties(font.size = 9.5)
    table[,,to = 'header'] <- ReporteRs::textProperties(font.size = 9.5,
                                                        font.weight = 'bold')
    table[,,to = 'header'] <- ReporteRs::parCenter()
    table[] <- ReporteRs::parCenter()

    doc %<>% ReporteRs::addFlexTable(table)
    doc %<>% ReporteRs::addPageBreak()

    for (assay in reagents[[tech]]$trend_item) {
      fig_ind <- fig_ind + 1

      cc_df <- srms::ggcc_preprocess(
        df = rocre,
        filter_str = paste0('Call_Subject == \'', assay, '\'')
      )

      cc <- srms::ggcc(df = cc_df, title = assay)

      pareto <- ggpareto(df = rocre,
                         filter = paste0('Call_Subject == \'', assay, '\' & ',
                                         'YYYYMM == max(YYYYMM)'))

      doc %<>% ReporteRs::addTitle(
        paste0('Figure ', fig_ind, ': Control chart and Pareto chart for ',
               assay),
        level = 4
      )

      doc %<>% ReporteRs::addPlot(
        fun = grid::grid.draw,
        x = cc,
        height = 4,
        width = 6.5
      )

      doc %<>% ReporteRs::addPlot(
        fun = print,
        x = pareto$plot,
        height = 4
      )

      if (assay != tail(reagents[[tech]]$trend_item, 1)) {
        doc %<>% ReporteRs::addPageBreak()
      }
    }
  }

  # cl solution numbers
  doc %<>% ReporteRs::addTitle('Analysis of Solution Number', level = 2)

  tab_ind <- tab_ind + 1
  doc %<>% ReporteRs::addTitle(
    paste0('Table ', tab_ind, ': Summary of current month complaints for Solution Number'),
    level = 3
  )
  table <- ReporteRs::FlexTable(data = sol_num %>% solnum_cleaner())
  table <- ReporteRs::setFlexTableBackgroundColors(
    table,
    i = 1,
    j = 1:3,
    colors = 'gray',
    to = 'header'
  )
  table[] <- ReporteRs::textProperties(font.size = 9.5)
  table[,,to = 'header'] <- ReporteRs::textProperties(font.size = 9.5,
                                                      font.weight = 'bold')
  table[,,to = 'header'] <- ReporteRs::parCenter()
  table[] <- ReporteRs::parCenter()

  doc %<>% ReporteRs::addFlexTable(table)
  doc %<>% ReporteRs::addPageBreak()

  for (solnum in sol_num$trend_item) {
    fig_ind <- fig_ind + 1

    cc_df <- srms::ggcc_preprocess(
      df = rocre,
      filter_str = paste0('Solution_Number == \'', solnum, '\''),
      clre = FALSE
    )

    cc <- srms::ggcc(df = cc_df, title = paste('Solution Number', assay),
                     clre = FALSE)

    pareto <- ggpareto(df = rocre,
                       filter = paste0('Solution_Number == \'', solnum, '\' & ',
                                       'YYYYMM == max(YYYYMM)'))

    doc %<>% ReporteRs::addTitle(
      paste0('Figure ', fig_ind, ': Control chart and Pareto chart for Solution Number ',
             solnum),
      level = 4
    )

    doc %<>% ReporteRs::addPlot(
      fun = grid::grid.draw,
      x = cc,
      height = 4,
      width = 6.5
    )

    doc %<>% ReporteRs::addPlot(
      fun = print,
      x = pareto$plot,
      height = 4
    )

    if (solnum != tail(sol_num$trend_item, 1)) {
      doc %<>% ReporteRs::addPageBreak()
    }
  }
  ReporteRs::writeDoc(doc, file = '~/misc/testing.docx')
}

#' @title generate_cleq_doc
#' @description Generates monthly complaint trending .docx file for CL equipment.
#'
#' @return Writes .docx file to correct path.
#' @export
generate_cleq_doc <- function() {
  tables <- parse_clfrm23770()

  eq <- tables$equip %>%
    dplyr::mutate(analyzer = dplyr::case_when(
      .$technology == '250 Equipment' ~ '250',
      .$technology == '3600 Equipment' ~ '3600',
      .$technology == '4600 Equipment' ~ 'FS 4600 SYS',
      .$technology == '5600 Equipment' ~ '5600',
      .$technology == 'Lab Automation' ~ 'enGen',
      .$technology == 'ECI Equipment' ~ 'ECI',
      .$technology == 'FS Equipment' ~ 'FS',
      TRUE ~ .$technology
    ))

  roceq <- srms::roc_eq_v26b() %>%
    dplyr::mutate(YYYYMM = as.character(YYYYMM)) %>%
    dplyr::rename(Analyzer = Family_Code)

  eq1 <- c('250', '5600', 'ECI', 'FS', 'Total')
  eq2 <- c('3600', 'enGen', 'FS 4600 SYS')

  ib <- srms::qrc_query(db = 'qrc_raw',
                        query = 'select * from installbase;') %>%
    dplyr::filter(analyzer %in% c(eq1, eq2),
                  region == 'GLOBAL',
                  yyyymm %in% unique(roceq$YYYYMM)) %>%
    dplyr::group_by(analyzer, yyyymm) %>%
    dplyr::summarise(installbase = sum(installbase)) %>%
    tidyr::spread(yyyymm, installbase) %>%
    add_margins(rowsum = FALSE) %>%
    tidyr::gather(yyyymm, installbase, -analyzer)


  # creating word document
  doc <- ReporteRs::docx()
  doc %<>% ReporteRs::addParagraph(
    value = ReporteRs::pot('Monthly Complaint Trending Summary: Clinical Laboratory Platform',
                           ReporteRs::textProperties(font.weight = 'bold')),
    par.properties = ReporteRs::parProperties(text.align = 'center')
  )
  doc %<>% ReporteRs::addParagraph(
    value = ReporteRs::pot(strftime(last_month(), format = '%B %Y'),
                           ReporteRs::textProperties(font.weight = 'bold')),
    par.properties = ReporteRs::parProperties(text.align = 'center')
  )
  doc %<>% ReporteRs::addParagraph(
    value = ReporteRs::pot(paste('Completed on',
                                 strftime(Sys.time(), format = '%B %d, %Y'))),
    par.properties = ReporteRs::parProperties(text.align = 'right')
  )
  doc %<>% ReporteRs::addTitle(
    'Clinical Laboratory Plantform Complaint Trending',
    level = 1
  )
  doc %<>% ReporteRs::addTOC()
  doc %<>% ReporteRs::addPageBreak()
  doc %<>% ReporteRs::addTitle(
    'Clinical Laboratory Platform Complaint Trending Executive Summary',
    level = 2
  )
  doc %<>% ReporteRs::addPageBreak()
  doc %<>% ReporteRs::addTitle(
    'Figure 1: 13 month Total and Platforms complaint trend',
    level = 2
  )

  fig1_df <- roceq %>%
    dplyr::group_by(YYYYMM, Analyzer) %>%
    dplyr::summarise(Complaints = n()) %>%
    tidyr::spread(key = YYYYMM, value = Complaints, fill = 0) %>%
    add_margins(rowsum = FALSE) %>%
    tidyr::gather(key = YYYYMM, value = Complaints, -Analyzer)

  fig1_plot <- function(df) {
    ggplot(data = df,
           aes(x = YYYYMM, y = Complaints, color = Analyzer, group = Analyzer)) +
    geom_point() +
    geom_line() +
    geom_text_repel(aes(label = Complaints),
                    size = 2.5) +
    ggtitle(paste0('CL Equipment Complaints per Month (',
                   paste(unique(df$Analyzer), collapse = ', '),
                   ')')) +
    xlab('Month') +
    theme(legend.position = 'top',
          title = element_text(size = 7),
          axis.text.x = element_text(size = 5),
          legend.text = element_text(size = 5)) +
    scale_color_tableau()
  }
  doc %<>% ReporteRs::addPlot(
    fun = print,
    x = fig1_df %>% dplyr::filter(Analyzer %in% eq1) %>% fig1_plot(),
    height = 4
  )
  doc %<>% ReporteRs::addPlot(
    fun = print,
    x = fig1_df %>% dplyr::filter(Analyzer %in% eq2) %>% fig1_plot(),
    height = 4
  )

  doc %<>% ReporteRs::addTitle(
    'Figure 2: 13 month Total and Platforms Install Base',
    level = 2
  )
  doc %<>% ReporteRs::addPlot(
    fun = print,
    x = ib %>%
      ggplot(aes(x = yyyymm, y = installbase,
                 color = analyzer, group = analyzer)) +
        geom_point() +
        geom_line() +
        geom_text_repel(aes(label = installbase),
                        size = 2.5) +
        ggtitle('CL Equipment Install Base') +
        xlab('Month') +
        theme(legend.position = 'top',
              title = element_text(size = 7),
              axis.text.x = element_text(size = 5),
              legend.text = element_text(size = 5)) +
        scale_color_tableau()
  )
  doc %<>% ReporteRs::addTitle(
    'Figure 3: 13 month Total and Platforms Normalized Complaint Trend',
    level = 2
  )
  doc %<>% ReporteRs::addPlot(
    fun = print,
    x = fig1_df %>%
      dplyr::left_join(y = ib,
                       by = c('YYYYMM' = 'yyyymm', 'Analyzer' = 'analyzer')) %>%
      dplyr::mutate(normalized_complaints = round(Complaints / installbase, 2)) %>%
      ggplot(aes(x = YYYYMM, y = normalized_complaints,
                 group = Analyzer, color = Analyzer)) +
      geom_point() +
      geom_line() +
      geom_text_repel(aes(label = normalized_complaints),
                      size = 2.5) +
      ggtitle('CL Equipment Normalized # of complaints per instrument per month') +
      xlab('Month') +
      ylab('Complaints per Instrument') +
      theme(legend.position = 'top',
            title = element_text(size = 7),
            axis.text.x = element_text(size = 5),
            legend.text = element_text(size = 5)) +
      scale_color_tableau()
  )

  doc %<>% ReporteRs::addPageBreak()
  doc %<>% ReporteRs::addTitle('Analysis of Call Subjects Exceeding Alert Limit',
                               level = 2)

  fig_ind <- 3
  doc %<>% ReporteRs::addTitle(
    value = 'Table 1: Call subject/Product exceeding alert limit and violated control chart rules',
    level = 3
  )
  table <- ReporteRs::FlexTable(
    data = eq %>%
      dplyr::select(technology, trend_item, alert_limit, count, investigator,
                    group_by, subgroup_variable) %>%
      dplyr::mutate(dummy = ifelse(group_by != 'Total',
                                   paste(group_by, subgroup_variable, sep = '='),
                                   '')) %>%
      dplyr::select(-group_by, -subgroup_variable) %>%
      dplyr::select(technology, trend_item, alert_limit, count, dummy, investigator) %>%
      setNames(c('Analyzer', 'Call Subject / Product', 'Alert Limit',
                 paste('Monthly Complaints\n', strftime(last_month(),
                                                        format = '%B-%y')),
                'Resolution / J number / Call area', 'Investigator'))
  )
  table <- ReporteRs::setFlexTableBackgroundColors(
    table,
    i = 1,
    j = 1:6,
    colors = 'gray',
    to = 'header'
  )
  table[] <- ReporteRs::textProperties(font.size = 9.5)
  table[,,to = 'header'] <- ReporteRs::textProperties(font.size = 9.5,
                                                      font.weight = 'bold')
  table[,,to = 'header'] <- ReporteRs::parCenter()
  table[] <- ReporteRs::parCenter()

  doc %<>% ReporteRs::addFlexTable(table)
  doc %<>% ReporteRs::addPageBreak()

  for (i in 1:nrow(eq)) {
    fig_ind <- fig_ind + 1

    filter <- paste0(
      'Analyzer == \'', eq$analyzer[i], '\' & Call_Subject == \'',
      eq$trend_item[i], '\'',
      switch(eq$group_by[i],
             Total = NULL,
             Resolution = paste0(' & Resolution == \'', eq$subgroup_variable[i], '\''),
             `Call Area` = paste0(' & Call_Area == \'', eq$subgroup_variable[i], '\''),
             `J Number` = paste0(' & J_Number == \'', eq$subgroup_variable[i], '\''))
    )

    if (eq$group_by[i] == 'Total') {
      pareto <- ggpareto(df = roceq,
                         filter = paste0(filter, ' & YYYYMM == max(YYYYMM)'))

      doc %<>% ReporteRs::addTitle(
        paste0('Figure ', fig_ind, ': Control chart and Pareto chart for ',
               gsub('\'', '', gsub('==', '=', filter))),
        level = 4
      )
    } else {
      doc %<>% ReporteRs::addTitle(
        paste0('Figure ', fig_ind, ': Control chart for ',
               gsub('\'', '', gsub('==', '=', filter))),
        level = 4
      )
    }

    cc_df <- srms::ggcc_preprocess(
      df = roceq,
      filter_str = filter,
      clre = FALSE
    )

    cc <- srms::ggcc(df = cc_df,
                     title = gsub('\'', '', gsub('==', '=', filter)),
                     clre = FALSE)

    doc %<>% ReporteRs::addPlot(
      fun = grid::grid.draw,
      x = cc,
      height = 4,
      width = 6.5
    )

    if (eq$group_by[i] == 'Total') {
      doc %<>% ReporteRs::addPlot(
        fun = print,
        x = pareto$plot,
        height = 4
      )
    }

    if (eq$group_by[i] == 'Total') {
      doc %<>% ReporteRs::addPageBreak()
    }
  }
  ReporteRs::writeDoc(doc, file = '~/misc/testing_eq.docx')
}