R/drug_timer.R

In JayAchar/tbreportr: Tools for Reporting TB Data

#' Duration of TB drug consumption
#'
#' This function is designed to take cleaned data from Koch 6, calculate the number of days
#' a subject has been prescribed a drug and output a total per subject. Additionally, 
#' it will output a binary variable defined by a pre-specified duration in days (e.g. 180 days). 
#' Where no end date is available either for treatment, or drug cessation, the most recent documented
#' change in the data is used as a censor date. 
#' 
#' @param x list with two cleaned data frames called `adm` and `change` from Koch 6
#' @param drug define which drug duration is to be analysed
#' @param duration define how many days to use to define output binary variable
#'
#' @return tibble with ID, total days on drug and a binary drug outcome
#' @export
#' @importFrom assertthat assert_that
#' @importFrom lubridate is.Date
#' @importFrom magrittr %>%
#' @importFrom rlang .data enquo quo_name sym :=
#' @importFrom dplyr filter arrange group_by distinct mutate select case_when bind_rows ungroup left_join n last lag
#' @seealso \code{\link{tbreportr}}
#' @seealso Report bugs at \url{https://github.com/JayAchar/tbreportr/issues}
#' @author \strong{Jay Achar} 


drug_timer <- function(x, drug = bdq, duration = 180)
{
## Checks
        ## x
    assert_that(class(x) == "list")
    assert_that(length(x) >= 2L)
    assert_that(class(x$adm$Starttre) == "Date")
    assert_that(class(x$change$change_date) == "Date")
    assert_that(class(x$adm$id) == "character")
    assert_that(all(c("adm", "change") %in% names(x)))

        ## drug

        ## duration
    assert_that(is.numeric(duration))
    assert_that(duration > 0)

# convert drug arg to quosure
        drug <- enquo(drug)
        
        change_drug <- paste0("change_", quo_name(drug)) %>% sym()
                change_drug_name <- paste0("change_", quo_name(drug))
                
        duration_drug <- paste0("duration_", quo_name(drug)) %>% sym()
                duration_drug_name <- paste0("duration_", quo_name(drug))
                
        days_drug <- paste0("days_", quo_name(drug)) %>% sym()
                days_drug_name <- paste0("days_", quo_name(drug))
        

# Fix for R CMD check                
        bdq = NULL
        
# prepare data frames for this functions analysis
        adm <- x$adm
                names(adm) <- tolower(names(adm))
        change <- x$change
        
# generate database time
        dbtime <- max(max(adm$starttre, na.rm = T), max(change$change_date, na.rm = T))

# subset all patients who received drug - start treatment and change
   interim <- adm %>% 
                filter(!! drug == "Yes") %>%
                distinct(.data$id) 

   patients <- change %>% 
                filter(!! change_drug == 1) %>% 
                select(.data$id) %>% 
                bind_rows(interim) %>% 
                distinct(.data$id)

# reformat adm data to allow row_bind
   df <- adm %>% 
           filter(!! drug == "Yes") %>% 
           select(.data$id, .data$starttre, !! drug) %>% 
           mutate(!! change_drug_name := ifelse(!! drug == "Yes", 1L, NA_integer_)) %>%
           select(.data$id, change_date = .data$starttre, !! change_drug) %>%
        # row_bind with change df
           bind_rows(change) %>%
        # keep Ids from `patients` list
           filter(.data$id %in% patients$id) %>%
           select(.data$id, .data$change_date, !! change_drug) %>%
        # remove rows with no change information
           filter((!! change_drug) %in% c(1, 2))


# add end of treatment date from adm file
   eot <- adm %>%
           select(.data$id, .data$datedeat, .data$dateend, .data$dateout) %>% 
           mutate(out_date = pmax(.data$datedeat, .data$dateend, .data$dateout, na.rm = TRUE)) %>% 
           select(.data$id, .data$out_date)
   # merge with df
   df <- left_join(df, eot, by = "id")

# new var: days between each start and stop
   df <- df %>% 
           group_by(.data$id) %>% 
           arrange(.data$id, .data$change_date) %>% 
           mutate(n_group = n()) %>% 
           mutate(days_sum = case_when(lag(!! change_drug, 1) == 1L ~ 
                                as.numeric(.data$change_date - lag(.data$change_date, 1)),
   # if no start and stop - use dbdate as stop date                                
                                .data$change_date == last(.data$change_date) & !! change_drug == 1 ~ 
                                        as.numeric(min(.data$out_date, dbtime, na.rm = TRUE) - .data$change_date),
                                TRUE ~ 0)) %>% 
           
   # sum days between start and stop
           mutate(!! days_drug_name := max(cumsum(.data$days_sum))) %>% 
           
   # subset unique patients
           ungroup() %>% 
           distinct(.data$id, .keep_all = TRUE) %>% 
   # mutate binary variable dependent on time boundry
           mutate(!! duration_drug_name := ifelse(!! days_drug >= duration, 1, 0)) %>% 

   # tidy ready for output
           select(.data$id, !! days_drug_name, !! duration_drug_name)
           
        
df
}