Output index provided with EPT

EpiModel · Jun 20, 2018 · 5d5674d · 5d5674d
1 parent a90ff1e
commit 5d5674d
Show file tree

Hide file tree

Showing 3 changed files with 13 additions and 0 deletions.
diff --git a/R/mod.ept.R b/R/mod.ept.R
@@ -666,6 +666,8 @@ sti_ept_msm <- function(dat, at) {
 
     # Update with new trackers
     if (is.null(dat$epi$eptpartprovided_gc)) {
+      dat$epi$eptindexprovided_gc <- rep(NA, dat$control$nsteps)
+      dat$epi$eptindexprovided_ct <- rep(NA, dat$control$nsteps)
       dat$epi$eptpartprovided_gc <- rep(NA, dat$control$nsteps)
       dat$epi$eptpartprovided_ct <- rep(NA, dat$control$nsteps)
       dat$epi$eptpartelig_main <- rep(NA, dat$control$nsteps)

diff --git a/R/mod.prevalence.R b/R/mod.prevalence.R
@@ -330,6 +330,8 @@ prevalence_msm <- function(dat, at) {
     dat$epi$eptpartelig_main <- rNA
     dat$epi$eptpartelig_main <- rNA
     dat$epi$eptpartelig_main <- rNA
+    dat$epi$eptindexprovided_gc <- rNA
+    dat$epi$eptindexprovided_ct <- rNA
     dat$epi$eptpartprovided <- rNA
     dat$epi$eptpartprovided_gc <- rNA
     dat$epi$eptpartprovided_ct <- rNA

diff --git a/R/mod.sti.R b/R/mod.sti.R
@@ -1086,6 +1086,8 @@ sti_tx_msm <- function(dat, at) {
   ept_txUGC_all <- txUGC_all[dat$attr$recentpartners[txUGC_all] > 0]
   ept_txRCT_all <- txRCT_all[dat$attr$recentpartners[txRCT_all] > 0]
   ept_txUCT_all <- txUCT_all[dat$attr$recentpartners[txUCT_all] > 0]
+  ept_txGC_all <- c(ept_txRGC_all, ept_txUGC_all)
+  ept_txCT_all <- c(ept_txRCT_all, ept_txUCT_all)
   ept_tx_all <- unique(c(ept_txRGC_all, ept_txUGC_all, ept_txRCT_all, ept_txUCT_all))
 
   # Update EPT index status and eligibility for GC/CT treated with partners
@@ -1171,6 +1173,9 @@ sti_tx_msm <- function(dat, at) {
   # Update EPT index status for those selected to receive EPT for their partners
   dat$attr$eptindexStat[ept_idsStart] <- 1
 
+  index_gc <- intersect(ept_txGC_all, ept_idsStart)
+  index_ct <- intersect(ept_txCT_all, ept_idsStart)
+
   # Correlated testing for other STIs if symptomatic for one -------------------
 
   # All treated for other site of STIs, minus those getting treated for STI through EPT
@@ -1728,6 +1733,10 @@ sti_tx_msm <- function(dat, at) {
 
 
   # EPT
+  # Number of index provided with EPT
+  dat$epi$eptindexprovided_gc[at] <- length(index_gc)
+  dat$epi$eptindexprovided_ct[at] <- length(index_ct)
+
   # Proportion of treated GC/CT index who have current partners - e.g. eligibility for EPT
   dat$epi$propindexeptElig[at] <- ifelse(length(unique(c(txRGC_all, txUGC_all, txRCT_all, txUCT_all))) > 0,
                                          length(unique(ept_tx_all)) /