R/check_line_name.R

In sutsabs/rwLoT: Line of Therapy Package

#' Check Line Name
#'
#' Check_line_name checks for special cases to determine line name
#'
#' @importFrom dplyr arrange filter intersect mutate_all
#' @importFrom magrittr %>%
#' @importFrom config get
#' @importFrom Hmisc capitalize
#'
#' @param regimen vector of drugs included in the line treatment regimen
#' @param drug_summary a dataframe of drug summary table generated by \code{\link{get_drug_summary}}
#' @param cases a list of drugs that, when switched to during the regimen defining period, will initiate a switch in treatment regimen (ignoring the previous drug that was switched out)
#' @param input_r_window threshold number of days for the regimen defining window to detect combination drugs
#' @param input_drug_switch_ignore TRUE or FALSE, flag to see if a drug is administered during the regimen window period, but never administered again after, then ignore it from the regimen.
#' @returns a list with line_name, line_start, line_switched
#' @export
check_line_name <-
  function(regimen,
           drug_summary,
           cases,
           input_r_window,
           input_drug_switch_ignore) {
    # Parameters
    switched <- FALSE
    original_regimen <- regimen

    # Process data inputs
    drug_summary <- drug_summary %>% arrange(FIRST_SEEN)
    line.start_date <- min(drug_summary$FIRST_SEEN)

    # Check if any drugs in the drug summary table are eligible to be checked

    if (input_drug_switch_ignore) {
      # Get max last seen date from ineligible drugs, defined as drugs that don't occur after regimen window threshold
      ineligible_drugs <-
        drug_summary %>% filter(LAST_SEEN <= line.start_date + input_r_window)
      ineligible_drugs_last_seen <-
        max(ineligible_drugs$LAST_SEEN)

      # Get all the eligible drugs min first seen date. Eligible drugs are defined as drugs that occur after the regimen window threshold
      eligible_drugs <-
        drug_summary %>% filter(LAST_SEEN > line.start_date + input_r_window)
      eligible_drugs_first_seen <- min(eligible_drugs$FIRST_SEEN)
    } else {
      # Get max last seen date from ineligible drugs
      ineligible_drugs <-
        drug_summary %>% filter(!MED_NAME %in% cases)
      ineligible_drugs_last_seen <-
        max(ineligible_drugs$LAST_SEEN)
      # Get all the eligible drugs min first seen date
      eligible_drugs <-
        drug_summary %>% filter(MED_NAME %in% cases)
      eligible_drugs_first_seen <- min(eligible_drugs$FIRST_SEEN)
    }


    if (nrow(eligible_drugs) > 0 & nrow(ineligible_drugs) > 0) {
      # If max last seen of an ineligible drug is before the min first seen of an eligible drug, then regimen is switched
      if (ineligible_drugs_last_seen <= eligible_drugs_first_seen) {
        switched <- TRUE
      }
    }

    # If switch happened, then regimen is defined by eligible drugs list, otherwise it is from the original regimen
    if (switched) {
      regimen <- eligible_drugs %>% select(MED_NAME)
      line.start_date <- min(eligible_drugs$FIRST_SEEN)
    }

    regimen <- sapply(regimen, capitalize)
    regimen <- sort(regimen)
    line.name <- paste(regimen, collapse = ", ")

    return(
      list(
        "line_name" = line.name,
        "line_start" = line.start_date,
        "line_switched" = switched
      )
    )
  }