#' @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')
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.