rm(list = ls())

library(tidyverse)
library(Hmisc)
library(ggpubr)
library(plotly)
library(kableExtra)

Introduction

This report covers the data management and modeling associated with the ART continuum:

  • Input parameters for EpiModel – not constructed here, as the WHAMP data do not support parameter estimation for the ART continuum (see discussion below).

  • Output Dx targets – will be used in the ART output Dx report.

ART continuum

The ART continuum is represented as:

Initiate -> Discontinue -> Re-initiate

ART use is universal among Dx HIV+ in the WHAMP survey sample. This makes it impossible to estimate initiation rates, and, because only one case is not currently on ART, it is also impossible to estimate discontinuation rates.

  • For simulations, we assume that all Dx persons will initiate ART. Darcy also made this assumption in her dissertation model. The impact can be assessed with a sensitivity analysis.

Some Dx HIV+ in WHAMP report having discontinued Tx in the past, so we will examine those estimates. Everyone reporting discontinuation is currently using ART, so we do not observe “quitting”.

  • For simulations, we will assume that re-initiation is possible for everyone, i.e., that no one quits for good. Darcy also made this assumption.

Parameters – No parameters for the ART continuum are estimated here, given the WHAMP data constraints. Instead, these parameters will be taken from Darcy’s dissertation analyses, which were based on DOH surveillance data. Each flow is parameterized by a rate, and the rates are based on observed summary statistics and back calculations. The parameters from these are transcribed from Darcy’s documentation (WHAMP:DWR_dissertation/HIV_care_cascade.html), and hardcoded in the EconModelBook/ae_whamp_data.R script (this location will be rationalized later). The one exception is treatment interruption (tx.halt) which is currently hardcoded in the excel parameter sheet. Sample sizes were generally small, so breakdowns (if they exist) are typically single margin.

Data Validation Targets – The simulation output Dx data validation targets are restricted to current ART users: time since first started ART, ever interrupted, and interruption length. WHAMP sample size here is also small (87 cases), so breakdowns, while provided, are unreliable. Targets are saved in an RDS file: WHAMP2:Data/Targets/artTargets.RDS.

Adherence

WHAMP did not measure ART adherence, and ART adherence is not directly represented in EpiModel – treatment trajectories with VL are instead directly parameterized. For these, we will use the estimates that Darcy developed for her dissertation (see WHAMP:DWR_dissertation/HIV_care_cascade.html).

Data

All of the data used in this report come from the WHAMP Survey. The survey was conducted over a three month period using social media (primarily FaceBook, with a small number of Grindr and Growlr respondents) from Sep 11 - Dec 11 2019. Final sample size was 927. Attrition reduced this to 771 by the SNAP variable, and sample exclusions (for no anal sex since 2010) reduced it further to 682 for the sexual behavior analyses.

Much of the ART analysis, which is restricted to Dx HIV+, is based on less than 100 cases. Filtering for specific conditional rate estimation, can reduce the sample to smaller sizes.

Note that while the STERGMs augmented the sample with the ARTnet WA cases, we do not do that here, but they could be added.

# Either make or read in data

#dataset <- "readin"
dataset <- "makeit"

if(dataset == "makeit") {
  source(here::here("MakeData", "MM", "Scripts",
                    "makeWideData.R")) # creates wDF
} else {
  wDF <- readRDS(here::here("MakeData", "MM", "Data",
                               "wideDF.RDS"))
}

# Missing data ----

## assign missing insurance to the uninsured/NA category -- there is one case
## missing ins for Dx HIV+
## assign missing income to "Missing" category

wDF <- wDF %>%
  mutate(insurance = ifelse(is.na(insurance),
                            "missing", insurance),
         insurance = forcats::fct_relevel(insurance, "missing", after = Inf))

## complete case DF for attrs, diag.status & ins -- only 4 cases, and all of
## these are missing diag.status
wDF$complete.attrs <- with(wDF, complete.cases(age_group, race, region))
table(diag.status = wDF$diag.status, complete = wDF$complete, useNA = "al")
##            complete
## diag.status FALSE TRUE <NA>
##        0        0  831    0
##        1        0   92    0
##        <NA>     4    0    0
# Restrict to Dx HIV+ to see fraction on ART n=92
## note there are 4 cases missing art.current
dxhivDF <- wDF %>% 
  mutate(complete = complete.cases(age_group, race, region, diag.status)) %>%
  filter(complete == 1 & diag.status == 1) 
# with(dxhivDF, table(diag.status, art.current, useNA = "al"))

## complete case DF for analysis: n=87
artCurrentDF <- wDF %>%
  mutate(complete = complete.cases(age_group, race, region, 
                                   diag.status, art.current)) %>%
  filter(complete == 1 & diag.status == 1 & art.current==1) %>%
  rename(art.int.mos = ART_INTMOS) %>%
  mutate(artCurrent = ifelse(is.na(art.current) | art.current == 0, 
                             "not on ART",
                             "on ART"))

Missing data

There are 4 cases missing Dx status in the WHAMP sample, these are removed here. Among remaining cases one is missing insurance and none is missing demographic attributes.

Descriptives: Current ART use

Because ART use is universal in the WHAMP Dx HIV+ sample, this variable is used for descriptive purposes only.

  • Variable: artCurrent from the original ART_CURRENT

Insurance

Table

art.curr_ins <- artCurrentDF %>% 
  select(insurance, ego.wawt) %>%
  group_by(insurance) %>%
  dplyr::summarize(nobs = n(),
            n.wtd = round(sum(ego.wawt))) %>%
  mutate(prop.wtd = round(n.wtd/sum(n.wtd), 2)) %>%
  select(insurance, nobs, n.wtd, prop.wtd)

art.curr_ins %>%
  kable(caption= "Insurance for ART users",
        col.names = c("Insurance", "Nobs", "Wtd N", "Wtd Prop")) %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped")) %>%
  add_header_above(c("", "", "On ART" = 2)) %>%
  footnote(paste("On ART and not missing insurance; n = ",
                 sum(art.curr_ins$nobs)))
Insurance for ART users
On ART
Insurance Nobs Wtd N Wtd Prop
emplyr 51 54 0.61
indvdl_othr 5 4 0.04
medicare_caid 19 17 0.19
othr_gov 11 13 0.15
missing 1 1 0.01
Note:
On ART and not missing insurance; n = 87

Plot

fig <- ggplot(art.curr_ins, 
              aes(x = insurance, y = prop.wtd, text = prop.wtd)) +
  geom_bar(stat="identity", position = "dodge", fill = "blue",
           alpha = 0.7, ) +
  labs(x = "Insurance",
       y = "wtd. proportion") +
  theme(plot.margin = margin(t=20,r=5,b=5,l=0)) 

title.plotly <-
  list(text = paste0('Insurance among ART users',
                     '<br>',
                     '<sup>',
                     'Dx HIV+; n = ',
                     sum(art.curr_ins$nobs)/2,
                     '</sup>'))

ggplotly(fig , tooltip = "text") %>%
  layout(title = title.plotly)

SNAP

Table (5)

art.curr.snap5 <- artCurrentDF %>% 
#  filter(!is.na(snap)) %>%
  select(snap, ego.wawt) %>%
  mutate(snap5 = pmin(snap, 5)) %>%
  group_by(snap5) %>%
  dplyr::summarize(nobs = n(),
            n.wtd = round(sum(ego.wawt))) %>%
  mutate(prop.wtd = round(n.wtd/sum(n.wtd), 2)) %>%
  select(snap5, nobs, n.wtd, prop.wtd)

art.curr.snap5 %>%
  kable(caption= "SNAP5 among current ART users",
        col.names = c("SNAP", "Nobs", "Wtd N", "Wtd Prop")) %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped")) %>%
  add_header_above(c("", "", "On ART" = 2)) %>%
  footnote(paste("On ART and not missing SNAP; n = ",
                 sum(art.curr.snap5$nobs), 
                 "; snap topcoded at 5+"))
SNAP5 among current ART users
On ART
SNAP Nobs Wtd N Wtd Prop
0 14 15 0.17
1 16 15 0.17
2 4 3 0.03
3 6 6 0.07
4 2 2 0.02
5 33 35 0.39
NA 12 13 0.15
Note:
On ART and not missing SNAP; n = 87 ; snap topcoded at 5+

Plot (5)

art.curr.snap5 %>%
  ggplot(aes(x=snap5, y=prop.wtd, weight=nobs)) +
  ylim(c(0, 1)) +
  labs(title = "SNAP among ART users",
       x = "Number of anal sex partners last year",
       y = "Proportion") +
  geom_line() +
  geom_point(aes(size=nobs), color = "blue", alpha = 0.5)

ART initiation

ART initiation is represented as a fixed time from Dx to ART initiation, broken down by race and region.

Median days to ART initiation are based on Darcy’s estimates

Days from Dx to ART initiation

Median days to ART initiation
race region days
B King 46
B WesternWA 56
B EasternWA 53
H King 43
H WesternWA 53
H EasternWA 50
O King 47
O WesternWA 57
O EasternWA 53

Details

This text is taken from Darcy’s documentation.

Time from diagnosis to ART initiation

Because the date of ART initiation is not recorded in surveillance data, we use data on median time from diagnosis to viral suppression to estimate time from diagnosis to ART initiation. A limitation of this approach is that the recorded date of viral suppression does not necessarily correspond to when viral suppression was first achieved; it depends on the timing of labs. As such, based on expert consultation with Drs. Matt Golden and Julie Dombrowski, we decided to assume that men initiate ART an average of 8 weeks before the recorded date of viral suppression. For the overall population, this implies a median time from diagnosis to ART initiation of 7.14 weeks, which aligns with Matt Golden’s intiution for the average time to initiation.

While using the median to calculate a fixed time to treatment initiation does not reflect the heterogeneity in time to treatment initiation, we lack sufficient information to define a probability distribution. One option we considered is to use data on both the mean and median times to viral suppression, subtract 8 weeeks from each, and sample from a lognormal distribution with parameters μ, which can be expressed as ln(median), and σ2, which can be expressed as 2∗ln(mean/median) (see WHAMP issue #93). However, the mean observed time to viral suppression is likely influenced by people who take much longer than average to acheive suppression and likely started treatment more than 8 weeks preceding their first suppressed viral load measure. For alternative ideas and notes, see this file and WHAMP issue #97.

Because this approach only uses data from men who achieve viral suppression (~4% do not have a recorded time to viral suppression), we assume that time from diagnosis to treatment initiation is the same for men who achieve suppression as for those who don’t. In reality, men who never achieve suppression likely take longer to initiate treatment, but we don’t have data to inform this. More research to determine the implications of this parameter and identify better data to inform it are needed.

Note:

A commonly reported indicator in surveillance data is the time from diagnosis to “linkage to care,” with a case considered “linked” at the time of first CD4 or viral load lab records. In the 2018 Washington State and King County HIV/AIDS Epidemiology Report, 91% of MSM living with diagnosed HIV in King County were linked to care within 1 month of diagnosis and 97% were linked within 3 months. Linkage to care does not indicate ART initiation, as some people require additional visits before initiating, but it provides information to gauge how realistic our calculations of time to ART initiation are: they should not be wildly off from this.

Duration of ART use

This variable will be used as an external validation target.

It conditions on “current users” and measures the total interval from first initiation of ART to current date. It does not adjust for interruptions.

  • Note: we can’t get an unbiased estimate of the duration of a current ART spell, because we don’t have the start/stop dates for interrupters.

  • But we can compare the duration of interrupters to non-interrupters (for overall only)

  • Variable: mos.frst.art

Overall

Table

# Uses the artCurrentDF

art.dur_all <- artCurrentDF %>% 
  summarise(wtd.mean = wtd.mean(mos.frst.art, weights=ego.wawt),
            wtd.sd = sqrt(wtd.var(mos.frst.art, weights=ego.wawt)),
            wtd.med = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.5),
            wtd.25 = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.25),
            wtd.75 = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.75),
            nobs = n())

art.dur_comp <- artCurrentDF %>% 
  group_by(art.int) %>%
  summarise(wtd.mean = wtd.mean(mos.frst.art, weights=ego.wawt),
            wtd.sd = sqrt(wtd.var(mos.frst.art, weights=ego.wawt)),
            wtd.med = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.5),
            wtd.25 = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.25),
            wtd.75 = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.75),
            nobs = n())

art.dur <- art.dur_comp %>%
  mutate(art.int = if_else(art.int==0, "no", "yes")) %>%
  bind_rows(bind_cols("art.int" = "all", art.dur_all))

art.dur %>%
  kable(caption= "Months since first initiated ART, by ever interrupted",
        digits = 1) %>%
  kable_styling(full_width=F, position="center",
                bootstrap_options = c("striped")) %>%
  footnote(paste("Current users: n =",
                 nrow(artCurrentDF)))
Months since first initiated ART, by ever interrupted
art.int wtd.mean wtd.sd wtd.med wtd.25 wtd.75 nobs
no 140.0 86.6 132.2 82.1 208.4 62
yes 264.1 93.7 294.0 235.0 317.9 25
all 177.6 105.3 160.0 96.2 272.1 87
Note:
Current users: n = 87

Plot (all)

ggplot(artCurrentDF, aes(x = mos.frst.art)) +
  geom_histogram(aes(y = ..density..), 
                 color = "grey30", fill = "white") +
  geom_density(alpha = .2, fill = "blue") +
  geom_vline(xintercept = art.dur_all["wtd.mean"][[1]], 
             color = "red") +
  labs(title = "Months since first started ART",
       x = "Months",
       caption = paste("Current users, includes interrupters:  n = ",
                       nrow(artCurrentDF)))

Plot (compare)

ggplot(artCurrentDF, aes(x = mos.frst.art, 
                         group = art.int, fill = factor(art.int))) +
  geom_density(alpha = .2) +
  # geom_vline(xintercept = art.dur_all["wtd.mean"][[1]], 
  #            color = "red") +
  labs(title = "Months since first started ART",
       x = "Months",
       fill = "Ever interrupted",
       caption = paste("Current users: n = ", nrow(artCurrentDF)))

Age

Table

art.dur.age <- artCurrentDF %>% 
  group_by(age_group) %>%
  summarise(wtd.mean = wtd.mean(mos.frst.art, weights=ego.wawt),
            wtd.sd = sqrt(wtd.var(mos.frst.art, weights=ego.wawt)),
            wtd.med = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.5),
            wtd.25 = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.25),
            wtd.75 = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.75),
            nobs = n())

art.dur.age %>%
  kable(caption= "Months since first initiated ART by age",
        digits = 1) %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped")) %>%
  footnote(paste("Current users, includes interrupters; n = ",
                  nrow(artCurrentDF)))
Months since first initiated ART by age
age_group wtd.mean wtd.sd wtd.med wtd.25 wtd.75 nobs
25-34 79.7 49.8 115.0 45.1 127.8 8
35-44 79.7 53.6 80.5 40.9 118.6 18
45-54 206.2 95.1 203.0 137.3 306.3 18
55-65 228.4 92.3 254.2 149.0 294.3 43
Note:
Current users, includes interrupters; n = 87

Plot

ggplot(artCurrentDF, aes(x=AGE, y=mos.frst.art)) +
  geom_point(color = "blue", alpha = 0.7) +
  labs(title = "Duration of ART use by age",
       x = "age",
       y = "months on ART") +
  geom_smooth(color = "grey")

Race

Note the very small Nobs for B and H. In addition, there is one outlier in the H group: 7, 31, 34, 37, 121, 171, 316

Table

art.dur.race <- artCurrentDF %>% 
  group_by(race) %>%
  summarise(wtd.mean = wtd.mean(mos.frst.art, weights=ego.wawt),
            wtd.sd = sqrt(wtd.var(mos.frst.art, weights=ego.wawt)),
            wtd.med = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.5),
            wtd.25 = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.25),
            wtd.75 = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.75),
            nobs = n())

art.dur.race %>%
  kable(caption= "Months since first initiated ART by race",
        digits = 1) %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped")) %>%
  footnote(paste("Current users, includes interrupters; n = ",
                 nrow(artCurrentDF)))
Months since first initiated ART by race
race wtd.mean wtd.sd wtd.med wtd.25 wtd.75 nobs
B 115.7 152.8 69 5.6 294 3
H 163.9 134.9 171 35.7 316 7
O 184.2 96.3 160 113.0 266 77
Note:
Current users, includes interrupters; n = 87

Region

Table

art.dur.region <- artCurrentDF %>% 
  group_by(region) %>%
  summarise(wtd.mean = wtd.mean(mos.frst.art, weights=ego.wawt),
            wtd.sd = sqrt(wtd.var(mos.frst.art, weights=ego.wawt)),
            wtd.med = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.5),
            wtd.25 = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.25),
            wtd.75 = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.75),
            nobs = n())

art.dur.region %>%
  kable(caption= "Months since first initiated ART by region",
        digits = 1) %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped")) %>%
  footnote(paste("Current users, includes interrupters; n = ",
                  nrow(artCurrentDF)))
Months since first initiated ART by region
region wtd.mean wtd.sd wtd.med wtd.25 wtd.75 nobs
EasternWA 209.9 104.7 232.4 212.3 283.1 9
King 189.1 91.7 161.8 115.0 273.0 42
WesternWA 153.1 123.6 128.9 40.7 270.5 36
Note:
Current users, includes interrupters; n = 87

Insurance

Table

Too few cases in some categories to plot.

art.dur_ins <- artCurrentDF %>% 
  group_by(insurance) %>%
  summarise(wtd.mean = wtd.mean(mos.frst.art, weights=ego.wawt),
            wtd.sd = sqrt(wtd.var(mos.frst.art, weights=ego.wawt)),
            wtd.med = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.5),
            wtd.25 = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.25),
            wtd.75 = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.75),
            nobs = n())

art.dur_ins %>%
  kable(caption= "Months since first initiated ART by ins",
        digits = 1) %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped")) %>%
  footnote(paste("Current users, includes interrupters; n = ",
                 nrow(artCurrentDF)))
Months since first initiated ART by ins
insurance wtd.mean wtd.sd wtd.med wtd.25 wtd.75 nobs
emplyr 177.1 103.9 148.0 105.7 267.4 51
indvdl_othr 243.3 83.1 277.4 264.3 287.6 5
medicare_caid 196.7 112.4 233.0 111.7 283.2 19
othr_gov 128.8 98.2 150.7 79.2 183.9 11
missing 274.0 0.0 274.0 274.0 274.0 1
Note:
Current users, includes interrupters; n = 87

SNAP

Table (5)

art.dur.snap5 <- artCurrentDF %>% 
  mutate(snap5 = pmin(snap, 5)) %>%
  group_by(snap5) %>%
  summarise(wtd.mean = wtd.mean(mos.frst.art, weights=ego.wawt),
            wtd.sd = sqrt(wtd.var(mos.frst.art, weights=ego.wawt)),
            wtd.med = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.5),
            wtd.25 = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.25),
            wtd.75 = wtd.quantile(mos.frst.art, weights=ego.wawt, probs=0.75),
            nobs = n())

art.dur.snap5 %>%
  kable(caption= "Months since first initiated ART by SNAP",
        digits = 1) %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped")) %>%
  footnote(paste0("Current users, includes interrupters; n = ",
                 nrow(artCurrentDF),
                 "; SNAP topcoded at 5+"))
Months since first initiated ART by SNAP
snap5 wtd.mean wtd.sd wtd.med wtd.25 wtd.75 nobs
0 253.2 98.6 311.8 195.8 316.9 14
1 191.0 113.7 238.7 100.8 269.2 16
2 188.6 107.8 190.4 150.1 300.0 4
3 129.8 94.5 95.4 92.0 248.6 6
4 291.5 27.2 307.0 307.0 307.0 2
5 133.8 89.1 134.0 78.5 208.7 33
NA 201.0 99.5 168.0 126.1 307.0 12
Note:
Current users, includes interrupters; n = 87; SNAP topcoded at 5+

Interruption

WHAMP asked current ART users if they had ever interrupted ART, and if so, the main reason why, and the length of the most recent interruption.

  • Variables: art.int from ART_INTRPT, art.whyint from ART_WHYINT[A-G] and art.int.mos from ART_INTMOS

Prevalence

artIntDF <- artCurrentDF %>% 
  group_by(art.int) %>%
  dplyr::summarize(nobs = n(),
            n.wtd = sum(ego.wawt)) %>%
  mutate(prop.wtd = n.wtd/sum(n.wtd)) 

artIntDF %>%
  kable(caption= "Interrupted ART", digits = c(0,0,1,2)) %>% 
  kable_styling(full_width=F, position="center",
                bootstrap_options = c("striped")) %>%
  footnote(paste("Current ART users: n = ",
                 sum(artIntDF$nobs)))
Interrupted ART
art.int nobs n.wtd prop.wtd
0 62 62.5 0.7
1 25 27.2 0.3
Note:
Current ART users: n = 87

Reason

art.int_why <- artCurrentDF %>% 
  filter(art.int == 1) %>%
  group_by(art.whyint) %>%
  dplyr::summarize(nobs = n(),
            n.wtd = sum(ego.wawt)) %>%
  mutate(prop.wtd = n.wtd/sum(n.wtd)) 

art.int_why %>%
  kable(caption= "Reason for interrupting ART", 
        digits = c(0,0,1,2)) %>% 
  kable_styling(full_width=F, position="center",
                bootstrap_options = c("striped")) %>%
  footnote(paste("Interrupted ART: n = ", sum(art.int_why$nobs)))
Reason for interrupting ART
art.whyint nobs n.wtd prop.wtd
No HCP for Rx 6 6.0 0.22
CD4 and VL were good 2 1.9 0.07
Could not afford 2 1.9 0.07
Side effects 7 9.4 0.34
Did not want to 4 4.1 0.15
Other 4 4.0 0.15
Note:
Interrupted ART: n = 25

Interruption length

Note, there are only 25 cases.

Table

artCurrentDF %>% filter(art.int == 1) %>%
  group_by(art.int.mos) %>%
  dplyr::summarize(nobs = n(),
            n.wtd = sum(ego.wawt)) %>%
  mutate(prop.wtd = n.wtd/sum(n.wtd),
         cumprop.wtd = cumsum(prop.wtd)) %>%
  kable(caption= "Months of ART interruption", 
        digits = c(0,0,1,2,2)) %>% 
  kable_styling(full_width=F, position="center",
                bootstrap_options = c("striped")) %>%
  footnote(paste("Interrupted ART: n = ", 
                 table(artCurrentDF$art.int)[[2]]))
Months of ART interruption
art.int.mos nobs n.wtd prop.wtd cumprop.wtd
1 3 2.5 0.09 0.09
2 1 0.7 0.03 0.12
3 3 2.6 0.10 0.22
4 2 2.0 0.07 0.29
5 1 0.7 0.03 0.32
6 5 8.4 0.31 0.62
7 2 2.2 0.08 0.71
10 1 0.6 0.02 0.73
14 1 1.0 0.04 0.77
18 2 2.1 0.08 0.84
24 1 0.5 0.02 0.86
36 1 0.7 0.03 0.89
96 1 1.0 0.04 0.93
NA 1 2.0 0.07 1.00
Note:
Interrupted ART: n = 25 
artCurrentDF %>% filter(art.int==1) %>%
  select(art.int.mos) %>%
  summarytools::descr(stats = "common", style = "rmarkdown") %>%
  kable(caption= "Months of ART interruption", 
        digits = c(0,0,1,2,2)) %>%
    kable_styling(full_width=F, position="center",
                bootstrap_options = c("striped"))
Months of ART interruption
art.int.mos
Mean 12
Std.Dev 20
Min 1
Median 6
Max 96
N.Valid 24
Pct.Valid 96

Plot

ggplot(artCurrentDF) +
  geom_histogram(aes(art.int.mos), fill = "blue", alpha = 0.5)

Interruption rate

Estimates

We will use Darcy’s estimates of the weekly ART interruption rate for simulation. We can not estimate this from the WHAMP survey data using the prevalence = incidence * duration trick because our prevalence of “off ART” is effectively zero (1 out of 88 cases).

  • Darcy’s estimates are 0.004 for partial suppressors, and 0.002 for full and durable suppressors.

  • These are hardcoded in the excel parameter worksheet as 0.004, and a relative risk of 0.5.

Details

The following text is from Darcy’s documentation:

Rates of treatment cessation per time step

We use data on the proportion of diagnosed men who are durably suppressed and the proportion out of care to estimate the probability of treatment cessation per weekly time step among full suppressors. This calculation assumes that the process of treatment cessation follows a geometric distribution, and requires that there was a set interval (X) over which durable suppression is measured. With these conditions met, we calculate the geometric distribution parameter p that has a CDF of Y at X, where Y=(1−P(ds)), and X = the months between the initial suppressed and follow-up lab visits. The CDF of the geometric distribution is 1−(1−p)X. Solving for p, we get 1−(1−Y)1/X.

A challenge with surveillance data on viral suppression is that there are a wide range of intervals between lab records. To address this, we define a sample that includes only men who were initially suppressed (VL <200 copies/ml) at their first visit in 2016 and whose next visit was within X +/- 1 months.

Standard intervals for labs are 6 and 12 months: men who have been on treatment for a while and are managing their treatment well might be told to come back at 12-month intervals, whereas men newly on ART or who are having more difficulty with adherence will come in biannually. As such, using either the 6- or the 12-month intervals might bias our estimates. We therefore use both intervals and take the weighted average of the calculated rates.

A second issue is that, in defining the sample for this analysis to include only men who had a second viral load measure in the defined intervals, we will over-estimate durable suppresion because men who are out of care are not included in the denominator. So we define the probability of remaining durably suppressed through X months as the probability of being in care times the probability of remaining suppressed given that you’re in care: P(ds)=P(IC)⋅P(ds∣IC). We define the probability of being in care as 1 minus the probability of being out of care, which we measure using data on the proportion of men who were suppressed at their first visit in 2016 who had no labs for the subsequent 18 months and who are not on record as having died or moved to another jurisdiction. For more on the rationale for this method, see WHAMP GitHub issue #81.

Due to small numbers in some racial/ethnic and regional groups that limited our ability to obtain stratified estimates for these inputs, we assume the rate of treatment cessation is homogenous for all men in Washington. We set the probability of treatment cessation for partial suppressors to be twice that of full suppressors. As described below, we calculate differential rates of treatment reinitiation by racial/ethnic and regional groups such that the proportion of men on treatment in the cross-section matches observed estimates.

Re-initiation rate

Estimates

For the same data limitation reasons, these are also based on Darcy’s estimation here

ART reinitiation
race region prop
B King 0.024
B WesternWA 0.020
B EasternWA 0.022
H King 0.024
H WesternWA 0.020
H EasternWA 0.021
O King 0.028
O WesternWA 0.022
O EasternWA 0.024

Details

The following text is from Darcy’s documentation:

Rates of treatment re-initiation and proportions of diagnosed men who treat with full and partial suppression

We use the calculated rate of treatment cessation for full suppressors and observed proportions of diagnosed men on treatment and treated men with viral suppression to solve for

  • the rates of treatment reinitiation for full and partial suppressors that are consistent with the observed proportions on treatment, and

  • the proportions of men who treat with full suppression. This latter estimate will not be the same as the observed proportion with viral suppression because it accounts for the fact that, in the cross-section, some full suppressors and some partial suppressors are off treatment.

We assume that survival is equivalent for full and partial suppressors, # (see section @ref(decisions)), all diagnosed men initiate treatment, and the proportion of men who treat with full suppression is the same for regular testers and for men who are diagnosed only upon progression to symptomatic HIV.

Construct and save out ART targets

There are only 3 from the WHAMP survey:

  • duration on ART (since first initiation)

  • fraction on ART who have ever interrupted

  • length of last interruption

source(here::here("MakeData", "MM", "Scripts", "makeArtTargets.R"))

Targets description table

These are saved out into WHAMP2/Data/Targets/artTargets.RDS

descTable <- 
  tibble(Targets = all$var, 
         Description = c("Duration (mo) on ART",
                         "Ever interrupted ART",
                         "Duration (mo) of interruption"), 
         Subset = c(rep("Current ART users", 3)),
         Method = c(rep("Obs wtd summary", 3)),
         Levels = c(rep("all/age/race/region",3)))

descTable %>%
  gt::gt()
Targets Description Subset Method Levels
mos.frst.art Duration (mo) on ART Current ART users Obs wtd summary all/age/race/region
art.int Ever interrupted ART Current ART users Obs wtd summary all/age/race/region
art.int.mos Duration (mo) of interruption Current ART users Obs wtd summary all/age/race/region 
print("Structure of output object:")
## [1] "Structure of output object:"
str(all)
## tibble [3 x 9] (S3: tbl_df/tbl/data.frame)
##  $ var       : chr [1:3] "mos.frst.art" "art.int" "art.int.mos"
##  $ nobs      : int [1:3] 87 87 87
##  $ n.valid   : int [1:3] 87 87 24
##  $ n.missing : int [1:3] 0 0 63
##  $ wtd.n     : num [1:3] 89.7 89.7 25.2
##  $ wtd.mean  : num [1:3] 177.586 0.303 11.375
##  $ wtd.sd    : num [1:3] 105.273 0.462 19.361
##  $ wtd.semean: num [1:3] 11.1162 0.0488 2.0444
##  $ wtd.median: Named num [1:3] 160 0 6
##   ..- attr(*, "names")= chr [1:3] "50%" "50%" "50%"

Save output datafiles

This is currently not executed. The target datafile is saved via the makeArtTargets.R script instead.

targets <- list(all=all, age=age, race=race, region=region)
saveRDS(list(targets = targets, descTable = descTable), 
        here::here("Data", "Targets", "artTargets.RDS"))