1 Back to Outline

This section includes information on drug assistance program diagnostics. You can go back to table of contents if you would like.

Other related documents are:

if (is.null(params$sim_data)) {
  sim_loc <- "../../EpiModel/AE/sim_epimodel3/sim_on_2021-05-21_at_2033.rds"
}else{
  sim_loc <- params$sim_data
}
attr_names <- EpiModelWHAMPDX::attr_names
attr_names$insurance <- NULL
suppressPackageStartupMessages(library(tidyverse))
suppressPackageStartupMessages(library(magrittr))
suppressPackageStartupMessages(library(cowplot))
suppressPackageStartupMessages(library(ggrepel))
options(dplyr.summarise.inform = FALSE)
library(EpiModelWHAMPDX)
sim_dat <- readRDS(sim_loc)
knitr::opts_chunk$set(echo = TRUE, message = FALSE,
                      warning = FALSE, fig.width = 8)
cur_targs <- readRDS(here("Data", "EpiModelSims", "WHAMP.dx.targs.rds"))

2 DAP Outcomes

prop.dap <- list(
  adap.prop = list(name = "prop.adap",
                   sec_title = "Proportion of ART users in ADAP",
                   plot_name = "Proportion in ADAP",
                   plot_cap = "Among ART users.  Target source: WA DOH",
                   plot_ylab = "Proportion",
                   plt_type = "line",
                   vars = c("num.adap.", "tx.i.num."),
                   sum_fun = function(x, y) { x / y }
  ),
  pdap.prop = list(name = "prop.pdap",
                   sec_title = "Proportion of those on PrEP",
                   plot_name = "Proportion on PDAP",
                   plot_cap =
                     "Among individuals on PrEP, Target source: WA DOH",
                   plot_ylab = "Proportion",
                   plt_type = "line",
                   vars = c("num.pdap.", "neg.prep.num."),
                   sum_fun = function(x, y, z) { x / (y) }
  )
)
print_many_plots(prop.dap, sim_dat, targ_df = cur_targs, num_hash = 2)

2.1 Proportion of ART users in ADAP

2.1.1 ovr

2.1.2 race

2.1.3 region

2.1.4 age.grp

2.1.5 snap5

2.2 Proportion of those on PrEP

2.2.1 ovr

2.2.2 race

2.2.3 region

2.2.4 age.grp

2.2.5 snap5

2.3 Yearly Costs

sim_pop_sizes <- data.frame(pop.size = sim_dat$epi[[1]]$num)
sim_start_year <- round(
  sim_dat$control$year.start - sim_dat$control$start / 52)
sim_pop_sizes$year <- (1:nrow(sim_pop_sizes) + 1) / 52 + sim_start_year
sim_pop_sizes <- sim_pop_sizes %>% filter(year %% 1 == 0.0000000)
sim_pop_sizes$tr.pop <- NA_real_
sim_pop_sizes$year <- round(sim_pop_sizes$year)

for (yrv in 2014:2019) {
  sim_pop_sizes[which(sim_pop_sizes$year == yrv), "tr.pop"]  <-
    eval(parse(text = paste0("sum(WApopdata::msm.pop.totals_", 
               yrv, "$pop.all$num)")))
}

sim_pop_sizes$tr.pop[sim_pop_sizes$year < 2014] <- 
  sim_pop_sizes$tr.pop[sim_pop_sizes$year == 2014]

sim_pop_sizes$tr.pop[sim_pop_sizes$year > 2019] <- 
  sim_pop_sizes$tr.pop[sim_pop_sizes$year == 2019] * 
  WApopdata::growth_rate ** 
  (sim_pop_sizes$year[sim_pop_sizes$year > 2019] - 2019)

mult_df <- sim_pop_sizes %>% mutate(
  multipl = tr.pop / pop.size
)

yrl_cost <- sim_dat$whamp[[1]]$adap_cost_annual_cate %>% 
  mutate(year = year + sim_start_year) %>% 
  group_by(year) %>% summarise(cost = sum(cost))
fin_cost <- left_join(yrl_cost, mult_df, by = "year") %>%
  mutate(true_cost = round(cost * multipl / 1000000, 1))
yrl_cost_pdap <- sim_dat$whamp[[1]]$pdap_cost_annual_cate %>% 
  mutate(year = year + sim_start_year) %>% 
  group_by(year) %>% summarise(cost = sum(cost))
fin_cost_pdap <- left_join(yrl_cost_pdap, mult_df, by = "year") %>%
  mutate(true_cost = round(cost * multipl / 1000000, 1))

bind_rows(bind_cols(fin_cost, program = "ADAP"),
          bind_cols(fin_cost_pdap, program = "PDAP")) %>%
  select(year, true_cost, program) %>% 
  pivot_wider(names_from = "program", values_from = true_cost) %>%
  filter(!(is.na(ADAP) & is.na(PDAP))) %>%
  gt::gt() %>% gt::tab_header(
    title = "Cost of drug assitance programs in millions",
    subtitle = gt::html("Based on simulated costs scaled up to <br> match the size of Washington state")
  ) %>% gt::cols_label(year = "Year")
Cost of drug assitance programs in millions
Based on simulated costs scaled up to
match the size of Washington state
Year ADAP PDAP
2015 5.3 NA
2016 15.4 NA
2017 25.5 NA
2018 41.1 3.7
2019 44.7 2.0
2020 45.2 2.0
2021 44.7 1.9
2022 49.4 1.9
2023 51.1 2.0
2024 49.7 2.1
2025 49.6 2.1
2026 49.8 2.2
2027 50.7 2.3
2028 50.8 2.2
2029 52.2 2.5
2030 50.5 2.5
2031 48.5 2.4
2032 48.0 2.5
2033 47.7 2.5