1 Back to Outline

This section includes information on care engagement diagnostics. You can go back to table of contents if you would like.

Other related documents are:

Other related documents are:

if (is.null(params$sim_data)) {
  sim_loc <- "../../EpiModel/AE/sim_epimodel3/sim_on_2021-06-12_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("../../Data/EpiModelSims/WHAMP.dx.targs.rds")

2 Engaged in Care

2.1 ART Participation

The target for ART participation comes from the 2020 version of the Washington DOH surveillance report.

art.info <- list(
  art.prop = list(name = "prop.art",
                   sec_title = "Proportion of HIV+ diagnosed on ART",
                   plot_name = "Proportion on ART",
                   plot_cap = "Among HIV+ diagnosed individuals",
                   plot_ylab = "Proportion",
                   plt_type = "line",
                   vars = c("tx.i.num.", "diag.i.num."),
                   sum_fun = function(x, y) { x / y }
  )#,
  # adap.prop = list(name = "prop.adap.pos",
  #                  sec_title = "Proportion of diagnosed in ADAP",
  #                  plot_name = "Proportion in ADAP",
  #                  plot_cap = "Among diagnosed individuals",
  #                  plot_ylab = "Proportion",
  #                  plt_type = "line",
  #                  vars = c("num.adap.", "diag.i.num."),
  #                  sum_fun = function(x, y) { x / y }
  # )
)

print_many_plots(art.info, sim_dat, targ_df = cur_targs, num_hash = 3)

2.1.1 Proportion of HIV+ diagnosed on ART

2.1.1.1 ovr

2.1.1.2 race

2.1.1.3 region

2.1.1.4 age.grp

2.1.1.5 snap5

2.2 PrEP participation

The target for PrEP participation comes from department of health data. See this report for more details.

2.2.1 PrEP Continuum

if ("num" %in% names(sim_dat$epi)){
  epi.dat <- sim_dat$epi
  num.sims <- ncol(epi.dat$num)
  if (num.sims == 1) {
    num.steps <- 1
  }else{
    num.steps <- length(epi.dat$num)
  }
}else{
  epi.dat <- sim_dat$epi[[1]]
  num.sims <- 1
  num.steps <- length(epi.dat$num)
}

new.epi.dat <- map(epi.dat, function(x) {
  unname(do.call(c, x))
})

prep.cont.names <- names(epi.dat)[grep("prep.stage.prop.", names(epi.dat))]
better.names <- gsub("prep.stage.prop.", "", prep.cont.names) %>% 
  recode(A = "Aware", U = "Unaware", P = "On PrEP", 
         Q = "Quit", I = "Interupt")

tidy.prep.props <- data.frame(
  prop = do.call(c, new.epi.dat[prep.cont.names]),
  simno = floor(seq(new.epi.dat$num) / num.steps) + 1,
  time = seq(new.epi.dat$num) %% num.steps + 1,
  type = rep(better.names, each = length(new.epi.dat$num))) %>%
  mutate(year = (time - sim_dat$control$start) / 52 +
           sim_dat$control$year.start)

tidy.prep.props$type2 <- recode(
  tidy.prep.props$type,  Aware = "Never", Unaware = "Never", 
  "On PrEP" = "Current", Quit = "Ever", Interupt = "Ever")

## Pull out timing data from sim

year.dat <- make_epi_plot_data(sim_dat, art.info[[1]])$impt_years

ggplot(tidy.prep.props %>% group_by(year, simno, type2) %>%
         summarise(prop = sum(prop, na.rm = TRUE)),
       aes(x = year, y = prop, color = type2, 
           group = interaction(simno, type2))) + 
  geom_vline(data = year.dat, aes(xintercept = year), 
             alpha = 0.5) +
  geom_label_repel(data = year.dat, aes(x = year, label = name), 
                   group = NA,
                   y = 1, color = "black", direction = "y",
                   alpha = 0.5,
                   min.segment.length = 10) +
  geom_hline(data = cur_targs %>% filter(measure == "prop.prep"),
             aes(yintercept = targ, color = subcat), group = NA) +
  geom_line() + coord_cartesian(xlim = c(1990, NA)) + 
  scale_color_discrete("PrEP Stage") + 
  ggtitle("Proportions of individuals of each PrEP type") + 
  labs(caption = "Among HIV negative (diagnosed) individuals.")

# ggplot(tidy.prep.props, aes(x = year, y = prop, fill = type)) + 
#   geom_area(position = "stack")
# 
# ggplot(tidy.prep.props %>% group_by(year, type2) %>%
#          summarise(prop = sum(prop)),
#        aes(x = year, y = prop, fill = type2)) + 
#   geom_area(position = "stack")
prep.info <- list(
  pdap.prop = list(name = "prep.current",
                   sec_title = "Proportion of HIV negatives",
                   plot_name = "Proportion on PrEP",
                   plot_cap = "Among HIV - individuals",
                   plot_ylab = "Proportion",
                   plt_type = "line",
                   vars = c("neg.prep.num.", "num.", "i.num."),
                   sum_fun = function(x, y, z) { x / (y - z) }
  ),
  highly.adhear = list(name = "prep.highlyadhear",
                   sec_title = "Proportion PrEP users that are highly adhearent",
                   plot_name = "Proportion highly adherent",
                   plot_cap = "Among PrEP users",
                   plot_ylab = "Proportion",
                   plt_type = "line",
                   vars = c("neg.prep.num.", "num.highly.padhear."),
                   sum_fun = function(x, y) { y / x }
  )
)

print_many_plots(prep.info, sim_dat, targ_df = cur_targs, num_hash = 3)

2.2.2 Proportion of HIV negatives

2.2.2.1 ovr

2.2.2.2 race

2.2.2.3 region

2.2.2.4 age.grp

2.2.2.5 snap5

2.2.3 Proportion PrEP users that are highly adhearent

2.2.3.1 ovr

2.2.3.2 race

2.2.3.3 region

2.2.3.4 age.grp

2.2.3.5 snap5