R/first_date.R

In liljamathias/QRfunctions: Useful function for working with patient-data

#' Find first date of diagnosis using ICD-codes
#'
#' This function allows you to find the first date of a diagnosis using ICD-codes. Can return the full data or just the index data and patient id.
#' @param .data A tibble with data in QTF-format.
#' @param icd A character vector (or scalar) with ICD-codes that should be identified in the data.
#' @param new_variable A character string with the column name for the new variable.
#' @param keep Returns the full data, including the new date variable. Defaults to FALSE.
#'
#'@examples
#'data(data_icd)
#'data_icd %>% combine_sdia() %>% first_date_icd("L405", "psa")
#'
#' @keywords ICD-codes, Quantify
#' @export
#' first_date_icd

first_date_icd <- function(.data, icd, new_variable, primary = TRUE, secondary = TRUE, keep = FALSE) {

  x <- sym(new_variable)
  x <- enquo(x)

  if (primary == TRUE & secondary == TRUE) {

    temp_data <- .data %>%
      select(patid, pdia, sdia, indate) %>%
      identify_icd(icd, new_variable) %>%
      filter(!!x == TRUE) %>%
      group_by(patid) %>%
      arrange(patid, indate) %>%
      slice(1) %>%
      mutate(!!x := indate, !!x := as_date(!!x)) %>%
      select(patid, !!x) %>%
      ungroup

  } else if (primary == TRUE & secondary == FALSE) {

    temp_data <- .data %>%
      select(patid, pdia, indate) %>%
      identify_icd(icd, new_variable, secondary = FALSE) %>%
      filter(!!x == TRUE) %>%
      group_by(patid) %>%
      arrange(patid, indate) %>%
      slice(1) %>%
      mutate(!!x := indate, !!x := as_date(!!x)) %>%
      select(patid, !!x) %>%
      ungroup

  } else if (primary == FALSE & secondary == TRUE) {

    temp_data <- .data %>%
      select(patid, pdia, indate) %>%
      identify_icd(icd, new_variable, primary = FALSE) %>%
      filter(!!x == TRUE) %>%
      group_by(patid) %>%
      arrange(patid, indate) %>%
      slice(1) %>%
      mutate(!!x := indate, !!x := as_date(!!x)) %>%
      select(patid, !!x) %>%
      ungroup

  } else {

    stop("'Primary' or 'Secondary' must be TRUE")

  }

  if (keep == TRUE) {
    temp_data <- temp_data %>%
      select(patid, !!x) %>%
      left_join(.data, temp_data, by = "patid")
  }

  .data <- temp_data

  return(.data)
}

#' Find first date of dispensation using ATC-codes
#'
#' This function allows you to find the first date of a dispensation using ATC-codes. Can return the full data or just the index data and patient id.
#' @param .data A tibble with data in QTF-format.
#' @param atc A character vector (or scalar) with ATC-codes that should be identified in the data.
#' @param new_variable A character string with the column name for the new variable.
#' @param keep Returns the full data, including the new date variable. Defaults to FALSE.
#'
#'data(data_atc)
#'data_icd %>% first_date_atc("L04AA11", "etanercept")
#'
#' @keywords ATC-codes, Quantify
#' @export
#' first_date_atc
first_date_atc <- function(.data, atc, new_variable, keep = FALSE) {

  x <- sym(new_variable)
  x <- enquo(x)

  temp_data <- .data %>%
    select(patid, rx_atc, disp_date) %>%
    identify_atc(atc, new_variable) %>%
    filter(!!x == TRUE) %>%
    group_by(patid) %>%
    arrange(patid, disp_date) %>%
    slice(1) %>%
    mutate(!!x := disp_date, !!x := as_date(!!x)) %>%
    select(patid, !!x) %>%
    ungroup

  if (keep == TRUE) {
    temp_data <- temp_data %>%
      select(patid, !!x) %>%
      left_join(.data, temp_data, by = "patid")
  }

  .data <- temp_data

  return(.data)
}