R/overduefu.R

In sjacobson94/clinicaltrials: A Collection of Functions for use in CCS

#' Creating overdue follow-up table
#'
#' Creates a table of over due follow-up data for the Alliance DSMB report
#' @param protnum Protocol number
#' @param casecrse Unmodified casecrse dataset
#' @param casemats Unmodified casemats dataset 
#' @param end_at Unmodified end_at dataset
#' @param protref Unmodified protref dataset
#' @param frzdate Date the data was frozen (in the format "mm/dd/yyyy")
#'
#' @return This function returns a list of class "overduefu" containing a formatted flextable (table), a protocol specific header (header), and the total number of patients (num_pts).
#' @export
#' 
#' @author Sawyer Jacobson
#' 
# Created 02/17/2020

overduefu <- function(protnum, casecrse, casemats, end_at, 
                      protref, frzdate = format(Sys.Date(), "%m/%d/%Y")){
  
  casecrse = casecrse
  casemats = casemats
  end_at = end_at
  protref = protref
  
  allpts <- casecrse %>%
    select(dcntr_id, fu_stat)
  
  end_at <- end_at %>%
    arrange(dcntr_id, endat_dt) %>%
    group_by(dcntr_id) %>%
    slice(1)%>%
    select(dcntr_id) %>%
    mutate(infu = 1)
  
  protref <- protref %>%
    select(dc_num, v_data_ctr_org_name, v_edc_utilized_code)
  
  casemats <- casemats %>%
    left_join(protref, by = "dc_num")
  
  expfu <- casemats %>%
    filter((v_edc_utilized_code != "RAVE" & mat_type == "event") | (v_edc_utilized_code == "RAVE" & mat_type == "event" & stringr::str_detect(whichone, "Patient Status"))) %>%
    mutate(
      frzdate = lubridate::mdy(frzdate),
      expect30 = expected %m+% lubridate::days(30), 
      daysexp = frzdate - expect30
    ) %>% 
    select(received, expected, expect30, dcntr_id, frzdate, daysexp) %>%
    filter(expect30 <= frzdate & is.na(received)) %>%
    arrange(dcntr_id, expect30) %>%
    group_by(dcntr_id) %>%
    slice(1) %>%
    mutate(
      od = 1
    )
  
  tabled3 <- allpts %>%
    left_join(expfu, by = "dcntr_id") %>%
    left_join(end_at, by = "dcntr_id") %>%
    mutate(
      od = ifelse(is.na(od), 0, od),
      infu = ifelse(is.na(infu), 0, infu),
      infuod = ifelse(infu == 1 & od == 1, 1, 0),
      odcat = ifelse(infu == 0 & fu_stat == 1, 1, 
                     ifelse(fu_stat == 2 | (infu == 1 & od == 0), 2, 
                            ifelse(infuod == 1 & between(daysexp, 0, 180), 3, 
                                   ifelse(infuod == 1 & between(daysexp, 181, 364), 4, 
                                          ifelse(infuod == 1 & daysexp >= 365, 5, NA))))), 
      odcat = factor(odcat, levels = 1:5, labels = c("In active treatment", 'Not overdue', 'Less than 6 months overdue',
                                                     '6 months - 1 year overdue', 'More than 1 year overdue'))
    ) 
  
  tabled <- tabled3 %>%
    group_by(odcat) %>%
    dplyr::count()
  
  num_pts <- sum(tabled$n)
  tabled1 <- tabled %>%
    mutate(n_per = paste0(n, " (", round(n*100 / num_pts, 2), "%)")) %>%
    select(-n) 
  
  header <- paste0(toupper(protnum), ": Patients in Follow-up with Overdue Follow-up Forms\nTotal number of patient:  ", num_pts)
  
  tabled2 <- tabled1 %>% 
    flextable() %>%
    delete_part(part = "header") %>%
    add_header_row(values = c("Length of time overdue", paste0("Frequency (%)\nN=", num_pts)), colwidths = c(1,1)) %>%
    bold(j = c(1, 2), bold = TRUE, part = "header" ) %>%
    theme_box() %>%
    width(j = c(1,2), width = c(2.07, 2.07)) %>%
    align(j = 1, align = "left", part = "header") %>%
    align(j = c(1), align = "left", part = "body") %>%
    align(j = c(2), align = "center", part = "all")
  out = list(table = tabled2, header = header, num_pts = num_pts, data = tabled3)
  class(out) <- "overduefu"
  out
}


print.overduefu <- function(x, ...)
{
  print(x$table)
  invisible(x)
}