inst/hbcdtlfb/www/R/observe/update_data_start_session.R

In ucsd-dsm/hbcd-tlfb: HBCD TLFB shiny app

if (tlfb_v() == 1) {
  date_lmp(
    as.Date(
      redcap_dta()[redcap_dta()$redcap_event_name == "screening_arm_1", "setup_lmp"]
    )
  )
  
  redcap_dta_substances <- redcap_dta() |>
    filter(redcap_event_name == "v01_arm_1") |> 
    select(contains("pre_use_") | contains("mid_use_")) |>
    pivot_longer(everything()) |>
    filter(value == 1) |>
    pull(name) |>
    stringr::str_extract("(?=use).+")
}

if (tlfb_v() == 2) {
  date_delivery(
    as.Date(
      redcap_dta()[redcap_dta()$redcap_event_name == "screening_arm_1", "setup_delivery"]
    )
  )
  
  redcap_dta_substances <- redcap_dta() |>
    filter(redcap_event_name == "v02_arm_1") |> 
    select(contains("end_use_") | contains("after_use_")) |>
    pivot_longer(everything()) |>
    filter(value == 1) |>
    pull(name) |>
    stringr::str_extract("(?=use).+")
}

# For dropdown list.
substances_names_grouped(
  substances |>
    filter(code_redcap %in% redcap_dta_substances) |>
    prepare_choices(name_short_html, name_short_html, group)
)

# Stop if no substance is recorded for the ID.
if(length(redcap_dta_substances) == 0) {
  shinyalert::shinyalert(
    title = "No Substance Found",
    text = "No substance use has been recorded in ASSIST for this ID.</br>
    You will be disconnected from the app.",
    size = "m",
    animation = FALSE,
    closeOnEsc = FALSE,
    closeOnClickOutside = FALSE,
    showConfirmButton = FALSE,
    html = TRUE,
    type = "error"
  )
  
  Sys.sleep(3)
  stopApp("No substance for this ID.")
}



# Create an empty dataset if there isn't an existing record.
if (tlfb_v() == 1) {
  
  timevis_data_cal(
    tibble(
      id = "0",
      calendarId = c(rep(1, 3), 2),
      event = NA,
      substance = NA,
      frequency = NA,
      title = c("Two Weeks Pre-LMP", "Four Weeks Post-LMP", "Last Week",
                "Last Day of LMP"),
      body = c(rep("Period of Interest", 3), ""),
      recurrenceRule = NA,
      start = c(dates_study()$P1[1],
                dates_study()$P2[1],
                dates_study()$P3[1],
                date_lmp()),
      end = c(dates_study()$P1[2],
              dates_study()$P2[2],
              dates_study()$P3[2],
              date_lmp()), 
      category = "allday",
      location = NA,
      bgColor = NA,
      color = NA,
      borderColor = NA
    ) |> 
      bind_rows(
        holidays |>
          filter(
            (date >= dates_study()$P1[1] & date <= dates_study()$P1[2]) |
              (date >= dates_study()$P2[1] & date <= dates_study()$P2[2]) |
              (date >= dates_study()$P3[1] & date <= dates_study()$P3[2])
          ) |>
          transmute(
            id = "0",
            calendarId = 3,
            period = NA,
            what = NA,
            event = NA,
            substance = NA,
            frequency = NA,
            title = holiday,
            body = holiday,
            recurrenceRule = NA,
            start = as.Date(date),
            end = as.Date(date), 
            category = "allday",
            location = NA,
            bgColor = NA,
            color = NA,
            borderColor = NA)
      )
  )
  
}

if (tlfb_v() == 2) {
  
  timevis_data_cal(
    tibble(
      id = "0",
      calendarId = c(1, 2),
      event = NA,
      substance = NA,
      frequency = NA,
      title = c("Last Two Weeks Before Delivery",
                "Delivery Day"),
      body = c("Period of Interest", ""),
      recurrenceRule = NA,
      start = c(dates_study()$P4[1],
                date_delivery()),
      end = c(dates_study()$P4[2],
              date_delivery()), 
      category = "allday",
      location = NA,
      bgColor = NA,
      color = NA,
      borderColor = NA
    ) |> 
      bind_rows(
        holidays |>
          filter(date >= dates_study()$P4[1] & date <= dates_study()$P4[2]) |>
          transmute(
            id = "0",
            calendarId = 3,
            period = NA,
            what = NA,
            event = NA,
            substance = NA,
            frequency = NA,
            title = holiday,
            body = holiday,
            recurrenceRule = NA,
            start = as.Date(date),
            end = as.Date(date), 
            category = "allday",
            location = NA,
            bgColor = NA,
            color = NA,
            borderColor = NA)
      )
  )
}

# Add data if there is an exisiting record.
if(! is.null(existing_record())) {
  # Main dataset.
  timevis_data_cal(
      timevis_data_cal() |> 
        bind_rows(
      existing_record()$data
        )
    )
  
  # Dataset to edit/delete routine data.
  table_substance_routine_data(
    existing_record()$data_routine
  )
}