#' @title tmre_error_finder
#'
#' @description Function to find incorrect Lot Numbers for TM complaints
#'
#' @param filename Filename of Excel workbook to write to. Defaults to tmre_checkMMMYYYY.xlsx.
#' MMMYYYY is the month and year.
#' @param write If TRUE, writes complaints to check to Excel Workbook. Defaults to TRUE.
#'
#' @return Returns list of dataframes either having wrong Lot Number format, or
#' Lot Numbers that have been requested but not received.
#'
#' @export
tmre_error_finder <- function(
filename = NA,
write = TRUE
) {
df <- srms::tm_general_template(
daterange = c(
strftime(lubridate::floor_date(Sys.time(), 'month'),
format = '%Y-%m-%d'),
strftime(Sys.time(), format = '%Y-%m-%d')
)
)
csname <- names(df)[grepl('*call.subject', tolower(names(df)))][1]
call_subjs <- unique(tmre_lots$Call.Subject[tmre_lots$MTS == 0])
check_list <- vector('list', length(call_subjs))
for (cs in call_subjs) {
check <- df %>%
dplyr::filter_(
paste0(csname, ' == "', cs, '"')
)
if (nrow(check) > 0) {
formats <- tmre_lots %>%
dplyr::filter(
Call.Subject == cs
) %>%
.$`Lot#.ID`
for (format in formats) {
len <- length(unlist(strsplit(format, '')))
if (nrow(check) > 0) {
if ('x' %in% unlist(strsplit(format, ''))) {
xind <- (1:len)[unlist(strsplit(format, '')) == 'x']
start <- paste(unlist(strsplit(format, ''))[1:(xind[1]-1)],
collapse = '')
len_mask <- apply(
check,
1,
function(x) length(unlist(strsplit(x[11], ''))) != len
)
len_mask[is.na(len_mask)] <- TRUE
start_mask <- apply(
check,
1,
function(x)
paste(unlist(strsplit(x[11], ''))[1:(xind[1]-1)],
collapse = '') != start
)
if (toupper(unlist(strsplit(format, ''))[len]) != 'X') {
end_mask <- apply(
check,
1,
function(x)
toupper(unlist(strsplit(x[11], ''))[len]) != toupper(
unlist(strsplit(format, ''))[len])
)
} else {
end_mask <- rep(FALSE, nrow(check))
}
mask <- (len_mask + start_mask + end_mask) > 0
check <- check[mask, ]
} else {
check_mask <- apply(
check,
1,
function(x)
paste(unlist(strsplit(x[11], ''))[1:len],
collapse = '') != format
)
check <- check[check_mask, ]
}
}
}
check_list[[match(cs, call_subjs)]] <- check
} else {
check_list[[match(cs, call_subjs)]] <- check
}
}
mts_subjs <- unique(tmre_lots$Call.Subject[tmre_lots$MTS == 1])
mts_list <- vector('list', length(mts_subjs))
for (cs in mts_subjs) {
check <- df %>%
dplyr::filter_(
paste0(csname, ' == "', cs, '"')
)
if (nrow(check) > 0) {
format <- tmre_lots %>%
dplyr::filter(
Call.Subject == cs
) %>%
.$`Lot#.ID`
end <- apply(
check,
1,
function(x)
paste(tail(unlist(strsplit(unlist(strsplit(x[11], '-'))[1], '')), 3),
collapse = '') != format
)
mts_list[[match(cs, mts_subjs)]] <- check[end, ]
} else {
mts_list[[match(cs, mts_subjs)]] <- check
}
}
final <- rbind(do.call('rbind', check_list), do.call('rbind', mts_list))
final <- final[!is.na(final$`Lot Serial Number`), ]
all_mask <- !grepl('*all lot*', tolower(final$`Lot Serial Number`))
final <- final[all_mask, ]
requested <- apply(
final,
1,
function(x) grepl('*provided*|*requested*|request*', tolower(x[11]))
) %>% as.logical() | final[, 11] == '' | final[, 11] == 'N/A'
if (write) {
if (is.na(filename)) {
filename <- file.path('~', 'reporting', 'monthly', 'Transfusion Medicine',
'errors', lubridate::year(Sys.time()),
strftime(Sys.time(), format = '%m-%b'),
paste0('tmre_errors_', strftime(Sys.time(), format = '%m_%b'), '.xlsx'))
}
wb <- openxlsx::createWorkbook()
openxlsx::addWorksheet(
wb = wb,
sheetName = 'wrong format'
)
openxlsx::writeDataTable(
wb = wb,
sheet = 'wrong format',
x = final[!requested, ]
)
openxlsx::addWorksheet(
wb = wb,
sheetName = 'requested'
)
openxlsx::writeDataTable(
wb = wb,
sheet = 'requested',
x = final[requested, ]
)
openxlsx::saveWorkbook(
wb = wb,
file = filename,
overwrite = TRUE
)
}
return(
list(wrong_format = final[!requested, ], requested = final[requested, ])
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.