R/clre_error_finder.R

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

#' @title extract_info
#' @description Function to extract SONUMBER, WEBGEN, and CARTLOT from
#' Lot_Serial_Number
#'
#' @param snum Lot_Serial_Number
#'
#' @return Returns list containing SONUMBER, WEBGEN, and CARTLOT
extract_info <- function(snum) {
  x <- unlist(strsplit(gsub('X|-', '', snum), ''))

  return(data.frame(SONUMBER = as.numeric(paste(x[1:2], collapse = '')),
                    WEBGEN = as.numeric(paste(x[3:4], collapse = '')),
                    CARTLOT = as.numeric(paste(x[5:8], collapse = '')))
  )
}

#' @title clre_errror_finder
#' @description Function to find potential fixes for missing / wrongly formatted
#' lot serial numbers.
#'
#' @param xlsxname Name of Excel Workbook. Defaults to clre_checkMMMYYYY.xlsx.
#'
#' @return Writes potential errors to Excel Workbook. Returns dataframe is function
#' call is assigned to a value.
#' @export
clre_error_finder <- function(
  xlsxname = NA
) {

  df <- srms::roc_re_v26b(
    daterange = c(
      strftime(lubridate::floor_date(Sys.time(), 'month'),
               format = '%Y-%m-%d'),
      strftime(Sys.time(), format = '%Y-%m-%d')
    )
  ) %>%
    srms::add_clre_tech() %>%
    dplyr::filter(
      Technology == 'MicroSlide',
      grepl('X', Lot_Serial_Number)
    ) %>%
    dplyr::mutate(row_ind = 1:nrow(.))

  standard_mask <- grepl(
    '[0-9]{4}[A-Z]+[0-9]{4}',
    gsub('-', '', df$Lot_Serial_Number)) &
    dplyr::between(x = nchar(gsub('-', '', df$Lot_Serial_Number)),
                   left = 11,
                   right = 13)

  fix <- df[standard_mask, ]
  unknown_format <- df[!standard_mask, ]

  extracted <- lapply(fix$Lot_Serial_Number, function(x) extract_info(x)) %>%
    do.call('rbind', .)

  fix %<>% cbind(., extracted) %>%
    dplyr::left_join(
      y = lims_cartlots %>%
        dplyr::select(-DATEEXPIRATION),
      by = c('SONUMBER', 'WEBGEN', 'CARTLOT')
    )

  fix$suggested_lot_serial_number <- paste(
      paste0(formatC(fix$SONUMBER, width = 2, format = 'd', flag = '0'),
             formatC(fix$WEBGEN, width = 2, format = 'd', flag = '0')),
      formatC(fix$COATING, width = 4, format = 'd', flag = '0'),
      formatC(fix$CARTLOT, width = 4, format = 'd', flag = '0'),
    sep = '-'
  )

  missing <- apply(fix, 1, function(x) any(is.na(x[20:23])))
  fix$suggested_lot_serial_number[missing] <- NA

  final <- rbind(
    fix %>%
      dplyr::select(Complaint_Nbr___CH,
                    Lot_Serial_Number,
                    suggested_lot_serial_number,
                    row_ind),
    unknown_format %>%
      dplyr::mutate(
        suggested_lot_serial_number = NA
      ) %>%
      dplyr::select(Complaint_Nbr___CH,
                    Lot_Serial_Number,
                    suggested_lot_serial_number,
                    row_ind)
  ) %>%
    dplyr::arrange(row_ind) %>%
    dplyr::select(-row_ind)

  if (is.na(xlsxname)) {
    time <- time_vals()
    xlsxname <- paste0(
      'clre_check',
      lubridate::month(as.numeric(time$last_month), label = TRUE),
      time$year,
      '.xlsx'
    )
  }

  openxlsx::write.xlsx(x = final, file = xlsxname)

  invisible(final)
}