R/cards_wells_finder.R

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

#' @title well_control_extractor
#' @description Finds and extracts microtube and control well result from DT text.
#'
#' @param x character vector containing DT text.
#' @return Returns microwell or 'NA' if none found.
well_control_extractor <- function(x) {
  x <- unlist(x)
  ind <- (1:length(x))[grepl('521;0;*|1132;0;*|1133;0;*', x)]
  if (length(ind) != 0) {
    split <- unlist(strsplit(paste(x[ind:(ind+1)], collapse = ' '), ' '))
    start <- (1:length(split))[grepl('MT0*', split)][1] + 1
    end <- (1:length(split))[grepl('WAS', split)][1] - 1

    well <- paste(split[start:end], collapse = ' ')

    cwell_ind <- (1:length(x))[grepl('CONTROL WELL*', x)][1]
    if (!is.na(cwell_ind)) {
      cwell <- gsub(
        'WERE', '',
        unlist(
          strsplit(
            trimws(
              unlist(
                strsplit(
                  paste(x[cwell_ind:(cwell_ind + 2)], collapse = ' '),
                  ':'
                )
              )[2]
            ),
            ' AFFECTED'
          )
        )[1]
      )
    } else {
      cwell <- NA
    }
#     sample_ind_start <- match('FOR', split) + 1
#     sample_ind_end <- match('RESULT', split) - 1
#     sample <- gsub(',', '', paste(split[sample_ind_start:sample_ind_end], collapse = ' '))
    return(c(well, cwell))
  } else {
    return(NA)
  }
}

#' @title cards_well_finder
#' @description Function to find affected well from 4C decision tree.
#'
#' @param xlsxfile Filename to write results to. Defaults to microtube_trending_MMMYYYY.xlsx.
#' @param write If TRUE, will write to Excel Workbook. Defaults to TRUE.
#'
#' @return Writes to excel workbook. Returns value if function call is assigned
#' to a variable.
#'
#' @export

cards_well_finder <- function(xlsxfile = NA, write = TRUE) {
  complaints <- srms::tm_general_template() %>%
    df_checker()

  df <- complaints %>%
    dplyr::filter(
      Call_Subject %in% c('MT080024', 'MT081115', 'MT080515', 'MT085014'),
      Call_Area %in% c('FALSEPOS', 'FALSENEG', 'DISCRES', 'UNREACT')
    ) %>%
    split(.$Call_Area) %>%
    lapply(., function(x) x$Complaint_Nbr) %>%
    lapply(., function(x) paste0('(', paste(x, collapse = ', '), ')'))

  make_script <- . %>%
    paste0("SELECT * FROM [B502CSSD].[dbo].[T500IDR] WHERE INCIDENT_ID IN ", .,
           " AND KEY_THOUGHT = 'DT'")

  df %<>% lapply(., make_script)

  texts <- lapply(
    df,
    function(x)
      pcd_query(query = x) %>%
      dplyr::group_by(INCIDENT_ID) %>%
      dplyr::arrange(-unclass(DOC)) %>%
      dplyr::filter(row_number() == 1)
  )

  split_text <- lapply(
    texts,
    function(x)
      lapply(x$THOUGHT_TEXT,
             function(y)
               trimws(unlist(strsplit(y, '\r\n')))
      )
  )

  wells_controls <- lapply(
    split_text,
    function(x)
      lapply(x, well_control_extractor)
  )

  final <- purrr::map2(
    .x = texts,
    .y = wells_controls,
    .f = ~ cbind(.x$INCIDENT_ID, do.call(rbind, .y) %>%
                   as.data.frame(stringsAsFactors = FALSE))
  ) %>%
    do.call(rbind, .) %>%
    as.data.frame() %>%
    dplyr::rename(Complaint_Nbr = `.x$INCIDENT_ID`,
                  Well = V1,
                  Control_Well = V2) %>%
    dplyr::mutate(Complaint_Nbr = as.numeric(as.character(Complaint_Nbr))) %>%
    dplyr::left_join(
      y = complaints,
      by = 'Complaint_Nbr'
    ) %>%
    dplyr::arrange(
      Create_Audit_DT
    )

  summary <- final %>%
    dplyr::mutate(
      Well = as.character(Well),
      YYYYMM = paste0(lubridate::year(Create_Audit_DT),
                      ifelse(lubridate::month(Create_Audit_DT) < 10,
                             paste0('0', lubridate::month(Create_Audit_DT)),
                             lubridate::month(Create_Audit_DT)))
    ) %>%
    dplyr::filter(
      YYYYMM == max(YYYYMM)
    ) %>%
    dplyr::group_by(
      Call_Area,
      Well
    ) %>%
    dplyr::summarise(
      count = n()
    ) %>%
    dplyr::left_join(
      y = microtube_alert_limit,
      by = c('Call_Area' = 'Call.Area', 'Well')
    ) %>%
    dplyr::filter(
      !is.na(Alert.Limit)
    ) %>%
    dplyr::mutate(
      Category = 'MTS Microtube Trending',
      Review = ifelse(count >= Alert.Limit,
                      'Review', 'Pass')
    ) %>%
    dplyr::select(
      Category,
      Call_Area,
      Well,
      Alert.Limit,
      count,
      Review
    )

  time <- time_vals()
  names(summary) <- c(
    'Category', 'Call Area', 'Microtube', 'Alert Limit',
    paste0('Monthly Complaints ',
           lubridate::month(Sys.time() - months(1), label = TRUE),
           '-', time$year),
    'Review'
  )


  if (write) {
    if (is.na(xlsxfile)) {
      xlsxfile <- paste0(
        'microtube_trending_',
        lubridate::month(Sys.time() - months(1), label = TRUE),
        time$year, '.xlsx'
      )
    }
    wb <- openxlsx::createWorkbook()

    openxlsx::addWorksheet(wb = wb,
                           sheetName = 'Microtube Trending Summary')
    openxlsx::addWorksheet(wb = wb,
                           sheetName = 'Microtube Trending Raw')

    openxlsx::writeData(wb = wb,
                        sheet = 'Microtube Trending Summary',
                        x = summary)
    openxlsx::writeData(wb = wb,
                        sheet = 'Microtube Trending Raw',
                        x = final)

    openxlsx::saveWorkbook(wb = wb, file = xlsxfile, overwrite = TRUE)
  }

  invisible(list(summary, final))
}