R/tx_regimen.R

Defines functions get_tx_regimen validate_regimen tx_regimen

Documented in tx_regimen

#' Subset Clients Based on their Current ART Regimen
#'
#' Generates the line-list of clients on first-line regimen who are on the choice
#' combination regimen for their age or weight. The NDR does not currently report
#' 'weight' so the function uses 'age' to approximate the choice-regimen for the
#' clients.
#'
#' @param data An NDR dataframe imported using the `read_ndr()
#' @param age_band a numeric vector of length 2 `c(min_age, max_age)`.
#' @inheritParams tx_new
#' @inheritParams tx_curr
#'
#' @return tx_regimen
#' @export
#'
#' @examples
#' tx_regimen(ndr_example)
#'
#' tx_regimen(ndr_example,
#'   status = "default",
#'   age_band = c(0, 3)
#' )
tx_regimen <- function(data,
                       age_band = NULL,
                       states = NULL,
                       facilities = NULL,
                       status = "default",
                       remove_duplicates = FALSE) {
  states <- states %||% unique(data$state)

  facilities <- facilities %||% unique(subset(data, state %in% states)$facility)

  validate_regimen(data, age_band, states, facilities, status, remove_duplicates)

  get_tx_regimen(data, age_band, states, facilities, status, remove_duplicates)
}


validate_regimen <- function(data, age_band, states, facilities, status, remove_duplicates) {
  if (!rlang::is_double(age_band) && !rlang::is_null(age_band)) {
    rlang::abort("age_band is not of the class numeric. Did you quote any of the values?")
  }

  if (length(age_band) != 2 && !rlang::is_null(age_band)) {
    rlang::abort("The age_band argument requires that you supply min and max values.")
  }

  if (!all(states %in% unique(data$state))) {
    rlang::abort("state(s) is/are not contained in the supplied data. Check the spelling and/or case.")
  }

  if (!all(facilities %in% unique(subset(data, state %in% states)$facility))) {
    rlang::abort("facilit(ies) is/are not found in the data or state supplied.
                 Check that the facility is correctly spelt and located in the state.")
  }

  if (!status %in% c("default", "calculated")) {
    rlang::abort("`status` can only be one of 'default' or 'calculated'. Check that you did not mispell, include CAPS or forget to quotation marks!")
  }

  if (!is.logical(remove_duplicates)) {
    rlang::abort("The `remove_duplicates` argument is a logical variable and can only be set to `TRUE` or `FALSE`")
  }
}


get_tx_regimen <- function(data, age_band, states, facilities, status, remove_duplicates) {
  age_range <- c(0, 150)

  df <- switch(status,
    "calculated" = dplyr::filter(
      data,
      current_status == "Active",
      !patient_has_died %in% TRUE,
      dplyr::if_else(
        current_age <= 3,
        last_regimen %in% c(
          "ABC-3TC-LPV/r",
          "AZT-3TC-LPV/r"
        ),
        last_regimen %in% c(
          "ABC-3TC-DTG",
          "TDF-3TC-DTG"
        )
      ),
      dplyr::between(
        current_age,
        age_band[[1]] %||% age_range[[1]],
        age_band[[2]] %||% age_range[[2]]
      ),
      state %in% states,
      facility %in% facilities
    ),
    "default" = dplyr::filter(
      data,
      current_status_28_days == "Active",
      !patient_has_died %in% TRUE,
      dplyr::if_else(
        current_age <= 3,
        last_regimen %in% c(
          "ABC-3TC-LPV/r",
          "AZT-3TC-LPV/r"
        ),
        last_regimen %in% c(
          "ABC-3TC-DTG",
          "TDF-3TC-DTG"
        )
      ),
      dplyr::between(
        current_age,
        age_band[[1]] %||% age_range[[1]],
        age_band[[2]] %||% age_range[[2]]
      ),
      state %in% states,
      facility %in% facilities
    )
  )

  if (remove_duplicates) {
    df <- dplyr::distinct(df, facility, patient_identifier, .keep_all = TRUE)
  }

  return(df)
}

utils::globalVariables(c(
  "last_regimen",
  "current_status",
  "patient_has_died",
  "patient_transferred_out",
  "current_age"
))

Try the tidyndr package in your browser

Any scripts or data that you put into this service are public.

tidyndr documentation built on April 8, 2022, 9:06 a.m.