R/check_eligible.R

In sutsabs/rwLoT: Line of Therapy Package

#' Is eligible drug substitution
#'
#' Is_eligible_drug_substitution checks for drugs that are exempt from line advancement
#' when it can be substituted to another, usually similar, drug. Line does not advance if
#' the current regimen and next drug are similar drugs that can be substituted.
#'
#' @param drug_name a string for drug name
#' @param regimen a vector of drugs included in the line treatment regimen
#' @param cases_substitution list of special cases for that are eligible for substitution
#' The list has two columns: \emph{original, substitue}
#' @return a boolean, TRUE or FALSE
#'
#' @export
is_eligible_drug_substitution <-
  function(drug_name, regimen, cases_substitutions) {
    drug_name <- toupper(drug_name)
    regimen <- sapply(regimen, toupper)

    # Is the regimen in the cases_substitutions original column? If not, return False
    # If regimen is in cases_substitutions original, then are any of the corresponding substitutions containing the drug name? If not, return False
    return(drug_name %in% cases_substitutions$substitute[cases_substitutions$original %in% regimen])
  }

#' Is eligible drug addition
#'
#' Is_eligible_drug_addition checks for addition drugs that are exempt from line advancement (i.e. Bevocizumab)
#' @param drug_name a string for drug name
#' @param regimen a vector of drugs included in the line treatment regimen.
#' @param cases_additions list of special cases for additions
#' The list has two columns: \emph{current_treatment, drug_name}
#' @return a boolean, TRUE or FALSE
#'
#' @export
is_eligible_drug_addition <- function(drug_name, cases_additions, regimen) {
  if (nrow(cases_additions) == 0) {
    return(FALSE)
  }

  drug_name <- toupper(drug_name)
  regimen <- sapply(regimen, toupper)
  eligible <- FALSE
  for (row in 1:nrow(cases_additions)) {
    addition_drug <- toupper(cases_additions[row, "drug_name"])
    background_trt <- toupper(cases_additions[row, "current_treatment"])
    is_next_drug_additional_drug <- is.element(drug_name, addition_drug)
    is_regimen <- is.element(background_trt, regimen)
    if (is_next_drug_additional_drug && is_regimen) {
      eligible <- TRUE
    }
  }

  if (eligible) {
    return(TRUE)
  } else {
    return(FALSE)
  }
}

#' Is eligible switch maintenance
#'
#' Is_elgible_swich_maintenance checks if the line of therapy is a maintenance therapy for mono drug
#'
#' @param regimen a vector of drugs included in the line treatment regimen.
#' @param cases_maintenance list of special cases for maintenance
#' @param line_number a numeric value for the current line number
#' @return a boolean, TRUE or FALSE
#'
#' @export
is_eligible_switch_maintenance <-
  function(regimen, cases_maintenance, line_number) {
    regimen <- sapply(regimen, toupper)
    cases_maintenance <-
      as.data.frame(cases_maintenance) %>% filter(maintenance_type == "SWITCH")
    return(!is.element(FALSE, regimen %in% cases_maintenance$drug_name) &&
      line_number == 1)
  }

#' Is eligible continuation maintenance
#'
#' Is_elgible_continuation_maintenance checks if the line of therapy is a maintenance therapy for combo drug
#'
#' @param regimen a vector of drugs included in the line treatment regimen.
#' @param cases_maintenance list of special cases for maintenance
#' @param line_number a numeric value for the current line number
#' @param drug_group a dataframe of drug summary table generated by \code{\link{get_drug_summary}}
#' @return a boolean, TRUE or FALSE
#' @export
is_eligible_continuation_maintenance <-
  function(regimen,
           cases_maintenance,
           line_number,
           drug_group) {
    regimen <- sapply(regimen, toupper)
    drug_group <- as.data.frame(sapply(drug_group, toupper))
    drug_group <- drug_group[drug_group$MED_NAME %in% regimen, ]
    cases_maintenance <-
      as.data.frame(cases_maintenance) %>% filter(maintenance_type == "CONTINUATION")
    intersect <- intersect(regimen, cases_maintenance$drug_name)

    # make sure we have existence of maintenance therapy drug
    if (length(intersect) == 0) {
      return(FALSE)
    }

    # Check if the undropped drug is a maintenance drop
    # Step 1: Checked for undropped drugs and check that all undropped drugs are maintenance drugs
    # Step 2: Checked that there are at least 1 dropped drug
    # Step 3: Checked that not all the drugs are dropped
    is_maintenance_therapy <-
      !is.element(FALSE, drug_group$MED_NAME[drug_group$DROPPED == 0] %in% intersect) &&
        length(drug_group$MED_NAME[drug_group$DROPPED == 1]) >= 1 &&
        length(drug_group$MED_NAME[drug_group$DROPPED == 1]) < length(drug_group$MED_NAME)

    # make sure at least one maintenance drug is continued and all non-maintenance drug is dropped
    return(is_maintenance_therapy && line_number == 0)
  }



#' Is excluded from gap
#'
#' Is_excluded_from_gap checks to see if the drug is eligible to be excluded from the discontinuation gap.
#' There are special cases when line advancement should not occur even after discontinuation
#' gap if it involves certain drugs.
#'
#' @param regimen a vector of drugs included in the line treatment regimen
#' @param remaining_drugs a claims dataframe with remaining drugs while scanning through each drug record
#' @param cases_episode_gap a list of special cases for exclusions from discontinuation gap
#' @return a boolean, TRUE or FALSE
#' @export
is_excluded_from_gap <-
  function(regimen,
           remaining_drugs,
           cases_episode_gap) {
    regimen <- sapply(regimen, toupper)
    exclude <- FALSE

    for (i in 1:nrow(remaining_drugs))
    {
      current_drug_name <- toupper(remaining_drugs[i, "MED_NAME"])

      if (!is.element(current_drug_name, regimen)) {
        break
      }

      if (is.element(current_drug_name, cases_episode_gap)) {
        exclude <- TRUE
      }
    }
    return(exclude)
  }