R/get_line_data.R

In sutsabs/rwLoT: Line of Therapy Package

#' Get line data
#'
#' Get_line_data function returns relevant line of therapy information such as line name,
#' line end date, is maintenance therapy, next line start date, line type, and line end reason.
#' The function is used in the \code{\link{LoT_main}}. The function scans through the
#' input drug episode dataframe to check for line advancement and outputs the line data.
#'
#' General Steps:\cr
#' \enumerate{
#'   \item Check if we hit last row of table - if so then there is no further data to analyze and we stop here, setting end date to be the last date activity
#'   \item Check if there is a gap between the current drug date for that line. If there is, then we move to the second pass of checks
#'   \item Check if the the next drug is a drug not within the regimen. If there is, then we move to the second pass of checks
#'   \item Second pass - analyze combo treatment and determine the correct discontinuation date and account for drug introduction
#'   \item Second pass - analyze the discontinuations and account for exceptions to discontinuations based on medication
#'   \item Second pass- analyze if the treatment is maintenance therapy. If it is, then label it as such and do not advance line number
#'   \item Compute final outputs and return it
#' }
#'
#' @param df a dataframe with \emph{PATIENT_ID ,MED_NAME, MED_START, MED_END} columns
#' @param r_regimen vector of drugs included in the line treatment regimen
#' @param l_disgap threshold number of days of gap in administration before advancing the line
#' @param l_line_number a numeric value for the current line number
#' @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 r_window period, but never administered again after, then ignore it from the regimen
#' @param input_combo_dropped_line_advance TRUE or FALSE, flag to see if a combination drug is dropped, whether or not it triggers an advance in line number
#' @param input_indication The indication of interest
#' @return A list of line data items: \emph{line_name, line_type, line_start, line_end,
#' line_next_start, line_end_reason, line_number, line_is_maintenance, line_is_next_maintenance,
#' line_add_exemption, line_sub_exemption, line_gap_exemption, line_name_exemption}
#' @export
get_line_data <-
  function(df,
           r_regimen,
           l_disgap,
           l_line_number,
           l_is_next_maintenance,
           input_r_window,
           input_drug_switch_ignore,
           input_combo_dropped_line_advance,
           input_indication) {

    # Set assumptions
    line_is_maintenance <- FALSE
    line_type <- ifelse(length(r_regimen) > 1, "combo", "mono")
    line_line_number <- l_line_number
    line_line_start <- NULL
    line_end_date_less_than_flag <- FALSE
    line_is_next_maintenance <- l_is_next_maintenance

    has_eligible_drug_addition <- FALSE
    has_eligible_drug_substition <- FALSE
    has_gap_exemption <- FALSE
    has_line_name_exemption <- FALSE

    line_name_file_path <-
      file_path(input_indication, file_name = "cases_line_name.csv")

    line_substitutions_file_path <-
      file_path(input_indication, file_name = "cases_substitutions.csv")

    line_additions_file_path <-
      file_path(input_indication, file_name = "cases_additions.csv")

    line_maintenance_file_path <-
      file_path(input_indication, file_name = "cases_maintenance.csv")

    line_episode_gap_file_path <-
      file_path(input_indication, file_name = "cases_episode_gap.csv")

    # cases reference data
    cases_line_name <-
      getRefTbl(line_name_file_path, str_toupper = FALSE)

    cases_line_substitutions <-
      getRefTbl(line_substitutions_file_path, str_toupper = TRUE)

    cases_line_additions <-
      getRefTbl(line_additions_file_path, str_toupper = TRUE)

    cases_line_maintenance <-
      getRefTbl(line_maintenance_file_path, str_toupper = TRUE)

    cases_episode_gap <-
      getRefTbl(line_episode_gap_file_path, str_toupper = TRUE)

    ############### First Pass Checks #################
    # If we hit the last row in the claims database, then stop and return outputs
    if (1 == nrow(df)) {
      line_end_date <- df[1, "MED_END"]
      line_end_reason <- "Last row hit"
      line_next_start <- NULL
    }
    # Scan all rows in the claims database and grab information on the  current drug and the next drug in the timeline
    else {
      for (i in 2:nrow(df)) {
        # Grab information on current drug and next drug
        current_drug <- df[i - 1, "MED_NAME"]
        current_drug_date <- df[i - 1, "MED_START"]
        current_drug_end <- df[i - 1, "MED_END"]
        next_drug <- df[i, "MED_NAME"]
        next_drug_date <- df[i, "MED_START"]
        remaining_drugs <- df[i:nrow(df), ]

        has_eligible_drug_addition <-
          is_eligible_drug_addition(drug_name = next_drug, regimen = r_regimen, cases_additions = cases_line_additions)
        has_eligible_drug_substition <-
          is_eligible_drug_substitution(next_drug, r_regimen, cases_line_substitutions)
        has_gap_exemption <-
          is_excluded_from_gap(r_regimen, remaining_drugs, cases_episode_gap)

        # If you hit the last row in the scan, then stop and return outputs
        if (i == nrow(df) &&
          (
            is.element(next_drug, r_regimen) ||
              has_eligible_drug_substition || has_eligible_drug_addition
          )) {
          if (next_drug_date - current_drug_end > l_disgap &&
            !has_gap_exemption) {
            line_end_date <- current_drug_end
            line_end_reason <- "Passed discontinuation gap"
            line_next_start <- next_drug_date
          }
          else {
            line_end_date <- df[i, "MED_END"]
            line_end_reason <- "Last row hit"
            line_next_start <- NULL
          }

          break
        }

        # Check if the gap between the next drug and current drug is wider than the discontinuation gap
        else if (next_drug_date - current_drug_end > l_disgap) {
          # If drug is excluded from the discontinuation gap, then skip whole process and go to the next drug
          if (has_gap_exemption) {
            next
          }
          line_end_date <- current_drug_end
          line_end_reason <- "Passed discontinuation gap"
          line_next_start <- next_drug_date
          break
        }

        # Check if the next drug is not part of the regimen
        else if (!is.element(next_drug, r_regimen) &&
          !has_eligible_drug_addition && !has_eligible_drug_substition) {
          temp_check_new_regimen <- df %>%
            filter(MED_START == current_drug_end) %>%
            select(MED_NAME)
          line_end_date_less_than_flag <-
            is.element(
              FALSE,
              temp_check_new_regimen$MED_NAME %in% r_regimen
            )

          if (line_end_date_less_than_flag) {
            temp_line_end_df <- df %>%
              filter(MED_START < current_drug_end) %>%
              select(MED_START)
          }
          else {
            temp_line_end_df <- df %>%
              filter(MED_START <= current_drug_end) %>%
              select(MED_START)
          }

          line_end_date <- max(temp_line_end_df$MED_START)
          line_end_reason <- "New line started with new drugs"
          line_next_start <- next_drug_date

          break
        }
      }
    } # End first pass of checks


    ################### Second pass on combo treatment to detect suppression and gaps ###################

    # Get Drug Summary information
    line_drug_summary <-
      get_drug_summary(df, input_r_window, line_end_date)

    # Re-compute line name and line start date
    check_line_name <-
      suppressWarnings(
        check_line_name(
          r_regimen,
          line_drug_summary,
          cases_line_name,
          input_r_window,
          input_drug_switch_ignore
        )
      )
    line_name <- check_line_name$line_name
    line_line_start <- check_line_name$line_start
    has_line_name_exemption <- check_line_name$line_switched

    # Compute Line Type
    tmp_line_regimen <- strsplit(line_name, ",")[[1]]
    line_type <-
      ifelse(length(tmp_line_regimen) == 1, "mono", "combo")

    # Re-compute if combo therapy dropped drugs should trigger a new line
    if (line_type == "combo" && input_combo_dropped_line_advance) {
      check_combo_dropped_drugs <-
        check_combo_dropped_drugs(
          line_drug_summary,
          line_end_reason
        )
      if (!is.na(check_combo_dropped_drugs)){
        line_end_date <- check_combo_dropped_drugs$line_end_date
        line_end_reason <- check_combo_dropped_drugs$line_end_reason
        line_next_start <- check_combo_dropped_drugs$line_next_start
      }

    }


    # Check to see if the current line is maintenance therapy
    if (line_line_number == 1) {
      if (line_is_next_maintenance) {
        line_is_maintenance <- TRUE
      }
      else {
        line_is_maintenance <-
          is_eligible_switch_maintenance(
            r_regimen,
            cases_line_maintenance,
            line_line_number
          )
      }
      line_is_next_maintenance <- FALSE
    }

    # Check for continuation maintenance therapy within the combo treatment
    else if (line_type == "combo" && line_line_number == 0) {
      line_is_next_maintenance <-
        is_eligible_continuation_maintenance(
          r_regimen,
          cases_line_maintenance,
          line_line_number,
          line_drug_summary
        )

      # If the line is eligible for maintenance and is combo, then split it
      if (line_is_next_maintenance) {
        line_was_previous_maintenance <- TRUE
        tmp_drug_group_dropped <-
          line_drug_summary %>% filter(DROPPED == 1)
        line_next_start <-
          as.Date(max(tmp_drug_group_dropped$LAST_SEEN), format = "%Y-%m-%d") + input_r_window
        line_end_reason <-
          "Entering continuation maintenance therapy"
      }
    }

    ########### Compute remaining final outputs ############
    if (!line_is_maintenance || line_line_number == 0) {
      line_line_number <- line_line_number + 1
    }

    ############# RETURN #############
    return(
      list(
        "line_name" = line_name,
        "line_type" = line_type,
        "line_start" = line_line_start,
        "line_end" = line_end_date,
        "line_next_start" = line_next_start,
        "line_end_reason" = line_end_reason,
        "line_number" = line_line_number,
        "line_is_maintenance" = line_is_maintenance,
        "line_is_next_maintenance" = line_is_next_maintenance,
        "line_add_exemption" = has_eligible_drug_addition,
        "line_sub_exemption" = has_eligible_drug_substition,
        "line_gap_exemption" = has_gap_exemption,
        "line_name_exemption" = has_line_name_exemption
      )
    )
  }