#' Drug duration calculator
#'
#' This function calculates the number of days a specific drug was prescribed
#' to a patient. It uses information from the admission data set to establish
#' the baseline treatment regimen, then adds days based on treatment adjustments
#' documented in the change data set.
#'
#' @param adm admission data set cleaned using `tbcleanr`
#' @param change change data set cleaned using `tbcleanr`
#' @param drug define which drug to calculate
#' @author Jay Achar
#' @seealso \code{\link{tbgeneratr}}
#' @importFrom rlang enquo .data sym :=
#' @importFrom dplyr filter distinct %>% bind_rows semi_join group_by ungroup left_join case_when n last
#' @importFrom tidyr gather
#' @return admission data frame with additional drug days variable added
#' @export
#'
drug_timer.koch6 <- function(adm, change, drug) {
# fix CMD note
. <- NULL
# use internal data look up table to find drug variable name (adm)
adm_drug <- drug_look_up$k6_drug[drug_look_up$drug_string == tolower(drug)]
# use internal data look up table to find drug change variable name (change)
change_drug <- drug_look_up$change_drug_name[drug_look_up$drug_string == tolower(drug)]
# define ideal drug name to add to final output variable
ideal_name <- drug_look_up$ideal_drug_name[drug_look_up$drug_string == tolower(drug)]
# define final drug_days variable name
drug_days <- paste0(quo_name(ideal_name), "_days")
# convert drug name to quosure
adm_drug <- sym(adm_drug)
change_drug <- sym(change_drug)
# calculate database time
dbtime <- max(max(adm$Starttre, na.rm = TRUE), max(change$change_dt, na.rm = TRUE))
message(paste0("drug_timer(): Database time calculated as ", dbtime))
# remove drug changes before treatment start and after treatment ending
change <- adm %>%
select(.data$registrationnb, .data$Starttre, .data$dateend) %>%
# add dbtime if end date is missing to allow filtering
mutate(dateend = as.Date(ifelse(is.na(.data$dateend),
dbtime,
.data$dateend),
origin = "1970-01-01")) %>%
left_join(change, by = "registrationnb") %>%
filter(.data$change_dt >= .data$Starttre & .data$change_dt <= .data$dateend) %>%
select(-.data$Starttre, -.data$dateend)
# Find ID numbers for all patients who received drug - start treatment
interim <- adm %>%
filter(!! adm_drug == "Yes") %>%
distinct(.data$registrationnb)
# combine all ID numbers from start and change data sets who started drug
patients <- change %>%
filter(!! change_drug == "Start") %>%
select(.data$registrationnb) %>%
bind_rows(interim) %>%
distinct(.data$registrationnb)
# check all ID numbers in patients are unique
assert_that(length(unique(patients$registrationnb)) == length(patients$registrationnb))
message(paste0(ideal_name, ": ", nrow(patients), " patients identified who received this drug."))
# filter adm data to only include patients receiving drug
adm_filtered <- adm %>%
# keep only patients IDs who received drug
semi_join(patients, by = "registrationnb") %>%
# keep ID number, start and end treatment time
select(.data$registrationnb, .data$Starttre, .data$dateend, !! adm_drug) %>%
# wide to long adjustment to prepare for row bind with change df
gather(key = !! change_drug, value = "change_dt", -.data$registrationnb, - !! adm_drug) %>%
# remove Starttre rows for patients who didn't receive drug in starting regimen
filter(!! adm_drug == "Yes" | !! change_drug == "dateend") %>%
select(- !! adm_drug) %>%
# recode adm drug change variable to match change df
mutate(!! change_drug := ifelse(!! change_drug == "Starttre",
"Start", "Stop")) %>%
mutate(!! change_drug := factor(!! change_drug, levels = c("Start", "Stop")))
# filter change data to only include patients receiving drug
change_filtered <- change %>%
# keep only patients IDs who received drug
semi_join(patients, by = "registrationnb") %>%
# keep ID number, change date and drug change variable
select(.data$registrationnb, .data$change_dt, !! change_drug)
# bind rows of adm_filtered and change_filtered for final calculation
full_long <- dplyr::bind_rows(adm_filtered, change_filtered) %>%
# remove rows where other drugs where changed - i.e. no change in selected drug
filter(! is.na(!! change_drug)) %>%
# remove rows where no date available - e.g. where treatment still ongoing
filter(! is.na(.data$change_dt))
# new var: days between each start and stop
full_days <- full_long %>%
group_by(.data$registrationnb) %>%
arrange(.data$registrationnb, .data$change_dt) %>%
mutate(n_group = n()) %>%
mutate(days_sum = case_when(lag(!! change_drug, 1) == "Start" ~
as.numeric(.data$change_dt - lag(.data$change_dt, 1)),
# if no start and stop - use dbdate as stop date
.data$change_dt == dplyr::last(.data$change_dt) & !! change_drug == "Start" ~
as.numeric(dbtime - .data$change_dt),
TRUE ~ 0)) %>%
# sum days between start and stop
mutate(!! drug_days := max(cumsum(.data$days_sum))) %>%
# subset unique patients
ungroup() %>%
distinct(.data$registrationnb, .keep_all = TRUE) %>%
# tidy ready for output
select(.data$registrationnb, !! drug_days) %>%
# merge with admission data
left_join(adm, ., by = "registrationnb")
# how many patients merged back into admisison data
merged_number <- sum(!is.na(full_days[[drug_days]]))
message(paste0(ideal_name, ": ", merged_number, " patient records merged back into admission data."))
# warning if negative days generated
negative_number <- sum(full_days[[drug_days]] < 0, na.rm = TRUE)
if (negative_number > 0) {
warning(paste0(ideal_name, ": ", negative_number, " patient records have negative days recorded"))
}
full_days
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.