R/quarterly_trending.R

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

#' @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)])
      )
    )
}