#' @title extract_month
#'
#' @description A function to extract month from YYYYMM format.
#'
#' @param monyr Vector of dates in YYYYMM format.
#'
#' @return Returns month abbreviation.
extract_month <- function(monyr) {
mon <- sapply(
monyr,
function(x) as.character(
lubridate::month(
as.numeric(
paste(
tail(unlist(strsplit(x, '')), 2),
collapse = '')
),
abbr = TRUE,
label = TRUE
)
)
)
return(mon)
}
#' @title quarterly_cl_trending
#'
#' @description A function to produce reagent quarterly trending tables by
#' product group.
#'
#' @return Returns a dataframe containing cl quarterly trending summary.
#'
#' @export
quarterly_cl_trending <- function() {
df <- srms::roc_re_v26b() %>%
srms::add_clre_tech(., write = FALSE) %>%
dplyr::filter(
YYYYMM %in% tail(unique(YYYYMM), 3),
!(Call_Subject %in% c('UDA', 'MULT'))
) %>%
dplyr::group_by(
Call_Subject,
Technology,
YYYYMM
) %>%
dplyr::summarise(
count = n()
) %>%
dplyr::left_join(
y = reagent_limits,
by = c('Technology', 'Call_Subject' = 'str_callsubject')
) %>%
dplyr::mutate(
Alert.Limit = replace(
x = Alert.Limit,
list = is.na(Alert.Limit) & Technology == 'MicroSlide',
values = reagent_limits$Alert.Limit[
reagent_limits$Technology == 'MicroSlide' &
reagent_limits$str_callsubject == 'Default']
),
Alert.Limit = replace(
x = Alert.Limit,
list = is.na(Alert.Limit) & Technology == 'MicroTip',
values = reagent_limits$Alert.Limit[
reagent_limits$Technology == 'MicroTip' &
reagent_limits$str_callsubject == 'Default']
),
Alert.Limit = replace(
x = Alert.Limit,
list = is.na(Alert.Limit) & Technology == 'MicroWell',
values = reagent_limits$Alert.Limit[
reagent_limits$Technology == 'MicroWell' &
reagent_limits$str_callsubject == 'Default']
)
) %>%
dplyr::filter(
count >= Alert.Limit
) %>%
dplyr::filter(
!duplicated(Call_Subject)
) %>%
dplyr::left_join(
y = product_data %>%
dplyr::mutate(
Product.Name.Short = toupper(Product.Name.Short)
) %>%
dplyr::filter(
!duplicated(Product.Name.Short)
) %>%
dplyr::select(
Product.Name.Short,
PMS.Group,
Product.Code,
QSMR.Site
),
by = c('Call_Subject' = 'Product.Name.Short')
) %>%
dplyr::group_by(
PMS.Group
) %>%
dplyr::summarise(
call_subjs = paste(Call_Subject, collapse = ', ')
) %>%
dplyr::left_join(
y = pms_desc,
by = 'PMS.Group'
)
# clre <- read.csv(
# file = clre_path,
# strip.white = TRUE,
# stringsAsFactors = FALSE
# )
#
# clre %<>%
# dplyr::group_by(
# Technology,
# dt_AuditDate_RE_v2_6b,
# str_CallSubject
# ) %>%
# dplyr::summarise(
# count = n()
# ) %>%
# reshape2::dcast(
# data = .,
# formula = Technology + str_CallSubject ~ dt_AuditDate_RE_v2_6b,
# value.var = 'count'
# ) %>%
# dplyr::left_join(
# y = product_data %>%
# dplyr::filter(
# !duplicated(Product.Name.Short)
# ) %>%
# dplyr::select(
# Product.Name.Short,
# PMS.Group,
# Product.Code
# ),
# by = c('str_CallSubject' = 'Product.Name.Short')
# ) %>%
# dplyr::filter(
# !is.na(PMS.Group)
# ) %>%
# dplyr::left_join(
# y = reagent_limits,
# by = c('Technology', 'str_CallSubject' = 'str_callsubject')
# )
#
# clre$Alert.Limit[clre$Technology == 'MicroSlide' &
# is.na(clre$Alert.Limit)] <- reagent_limits$Alert.Limit[
# reagent_limits$Technology == 'MicroSlide' &
# reagent_limits$str_callsubject == 'Default']
# clre$Alert.Limit[clre$Technology == 'MicroTip' &
# is.na(clre$Alert.Limit)] <- reagent_limits$Alert.Limit[
# reagent_limits$Technology == 'MicroTip' &
# reagent_limits$str_callsubject == 'Default']
# clre$Alert.Limit[clre$Technology == 'MicroWell' &
# is.na(clre$Alert.Limit)] <- reagent_limits$Alert.Limit[
# reagent_limits$Technology == 'MicroWell' &
# reagent_limits$str_callsubject == 'Default']
# clre$Alert.Limit[clre$Technology == 'DT60' &
# is.na(clre$Alert.Limit)] <- reagent_limits$Alert.Limit[
# reagent_limits$Technology == 'DT60' &
# reagent_limits$str_callsubject == 'Default']
#
# clre[is.na(clre)] <- 0
#
# clre %<>%
# dplyr::filter(
# apply(
# .,
# 1,
# function(x) any(x[grepl('[0-9]', names(.))] >= x[length(x)])
# )
# )
#
# names(clre)[grepl('[0-9]', names(clre))] <- extract_month(
# monyr = names(clre)[grepl('[0-9]', names(clre))]
# )
# names(clre)[2] <- 'Product_Name'
# names(clre)[7] <- 'Product_Code'
# names(clre)[8] <- 'Alert_Limit'
#
# clre <- clre[c(1, 2, 7, 8, 3, 4, 5, 6)]
# clre$`Comments (New trend detected? If so, RCI or QERTS#)` <- ''
#
# clre_list <- split(clre, clre$PMS.Group)
# clre_list <- lapply(clre_list, function(x) x %>% dplyr::select(-PMS.Group))
# names(clre_list) <- paste('Group', names(clre_list))
return(df)
}
#' @title quarterly_tm_trending
#'
#' @description A function to produce transfusion medicine
#' quarterly trending tables by product group.
#'
#' @param dsre_path Filepath to DSRE file as a .csv
#' @param ihre_path Filepath to IHRE file as a .csv
#' @param mtsre_path Filepath to MTSRE file as a .csv
#'
#' @return Returns a list of dataframes containing the tables.
#'
#' @export
quarterly_tm_trending <- function(
dsre_path,
ihre_path,
mtsre_path
) {
time <- time_vals()
qmonths <- c(as.numeric(time$last_month)-2, as.numeric(time$last_month))
if (time$quarter == 'Q4') {
ymrange <- paste0(time$year, qmonths)
} else {
ymrange <- paste0(
time$year, paste0('0', qmonths)
)
}
drange <- c(
strftime(lubridate::floor_date(Sys.time() - months(3), 'month'),
format = '%Y-%m-%d'),
strftime(lubridate::ceiling_date(Sys.time() - months(1), 'month'),
format = '%Y-%m-%d')
)
ihre <- srms::ihre(daterange = ymrange)
mtsre <- srms::mtsre(daterange = drange)
dsre <-
srms::dsre(daterange = ymrange) %>%
dplyr::mutate(
month = lubridate::month(Create_Audit_Date)
) %>%
dplyr::group_by(
Call_Subject,
month
) %>%
dplyr::summarise(
count = n()
) %>%
dplyr::left_join(
y = tmrecat %>%
dplyr::filter(!duplicated(Call.subject)) %>%
dplyr::select(Call.subject, Category, Alert.Limit, Group),
by = c('Call_Subject' = 'Call.subject')
) %>%
dplyr::mutate(
Alert.Limit = replace(Alert.Limit, is.na(Alert.Limit), 3)
) %>%
dplyr::filter(
count >= Alert.Limit
)
cleaner <- . %>%
dplyr::group_by(
Category,
month
) %>%
dplyr::summarise(
count = n()
) %>%
reshape2::dcast(
formula = Category ~ month,
value.var = 'count'
) %>%
dplyr::mutate_each(
dplyr::funs(replace(x = ., list = is.na(.), values = 0))
)
dsre %<>%
cleaner() %>%
dplyr::left_join(
y = tmrecat %>%
dplyr::filter(
!duplicated(Category)
) %>%
dplyr::select(
Category,
Alert.Limit,
Group
),
by = 'Category'
) %>%
dplyr::filter(
!is.na(Alert.Limit),
!is.na(Group)
) %>%
dplyr::filter(
apply(
.,
1,
function(x) any(x[grepl('[0-9]', names(.))] >= x[(length(x)-1)])
)
)
ihre %<>%
dplyr::group_by(
Call_Subject,
Category,
month
) %>%
dplyr::summarise(
count = n()
) %>%
reshape2::dcast(
formula = Call_Subject + Category ~ month,
value.var = 'count'
) %>%
dplyr::mutate_each(
dplyr::funs(replace(x = ., list = is.na(.), values = 0))
) %>%
dplyr::left_join(
y = tmrecat %>%
dplyr::filter(
!duplicated(Call.subject)
) %>%
dplyr::select(
Call.subject,
Category,
Alert.Limit,
Group
),
by = c('Call_Subject' = 'Call.subject', 'Category')
) %>%
dplyr::filter(
!is.na(Alert.Limit),
!is.na(Group)
) %>%
dplyr::filter(
apply(
.,
1,
function(x) any(x[grepl('[0-9]', names(.))] >= x[(length(x)-1)])
)
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.