R/identify_atc.R

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

#' Find dispensations using ATC-codes
#'
#' This function allows you to find dispensations based on ATC-codes. Creates a new column based on the ATC-codes.
#' @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 simple Only the new variable column will be returned. Support function. Defaults to FALSE.
#' @param patient_inclusion Return a vector with unique patient id:s that can be used to filter data at a later stage. Defaults to FALSE.
#'
#'@examples
#'data(data_atc)
#'identify_atc("L04AA11", "etanercept")
#'
#' @keywords ATC-codes, Quantify
#' @export
#' identify_atc
identify_atc <- function(.data, atc, new_variable, simple = FALSE, patient_inclusion = FALSE) {

  if (is.character(new_variable) == FALSE) {
    stop("'new_variable' must be a character variable")
  }

  .data <- .data %>% mutate(!!new_variable := case_when(
    str_detect(rx_atc, paste0("^", atc, collapse = "|")) ~ TRUE,
    TRUE ~ FALSE))

  if (simple == TRUE) {
    .data <- .data %>%
      select(!!new_variable)
  }

  if (patient_inclusion == TRUE & simple == FALSE) {
    x <- sym(new_variable) # To get a string into a object name
    x <- enquo(x) # To evaluate the object

    .data_temp <- .data %>%
      group_by(patid) %>%
      summarise(sum_var = sum(!!x), .groups = "drop") %>%
      mutate(!!x := case_when(
        sum_var > 0 ~ TRUE,
        sum_var == 0 ~ FALSE))

    .data <- .data_temp %>%
      filter(!!x == TRUE) %>%
      select(patid) %>%
      pull()
  }

return(.data)

}

#' Find multiple dispensations using ATC-codes
#'
#' This function allows you to find mutiple dispensations based on ATC-codes. Creates a new columns based on the ATC-codes.
#' @param .data A tibble with data in QTF-format.
#' @param atc_list A character vector (or scalar) with ATC-codes that should be identified in the data.
#' @param var_name_list A character string with the column name for the new variable.
#'
#'@examples
#'data(data_atc)
#'atc_list <- list("L04AA11", "J05AR02")
#'names <- list("etanercept", "other")
#'identify_atc(atc_list, names)
#'
#' @keywords ATC-codes, Quantify
#' @export
#' identify_atc

identify_atc_multiple <- function(.data, atc_list, names) {
  list_of_atc_vec <- map2(atc_list, names, function(.x, .y) identify_atc(.data, .x, .y, simple = TRUE))
  # Check that the vectors in the list are the same length
  if (!all(sapply(list_of_atc_vec, length) == length(list_of_atc_vec[[1]]))) {
    stop("Vectors are not the same length")
  }
  # Bind all separate vectors in the list into a tibble
  new_.data <- bind_cols(list_of_atc_vec)
  # Bind the original data with the new tibble
  bind_cols(.data, new_.data)
}