add function dp_read_viral_suppression()

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: leapfrog
 Title: Multistate Population Projection Model for Demographic and HIV Estimation
-Version: 0.0.3
+Version: 0.0.4
 Authors@R: 
     person(given = "Jeffrey",
            family = "Eaton",
@@ -11,7 +11,7 @@ Description: Leapfrog is a multistate population projection model for estimating
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.2.1
+RoxygenNote: 7.3.1
 LinkingTo: 
     Rcpp,
     RcppEigen

NAMESPACE

@@ -7,6 +7,7 @@ export(dp_read_childart)
 export(dp_read_childltfu)
 export(dp_read_pmtct)
 export(dp_read_pmtct_retained)
+export(dp_read_viral_suppression)
 export(leapfrogR)
 export(prepare_leapfrog_demp)
 export(prepare_leapfrog_projp)

NEWS.md

@@ -1,3 +1,7 @@
+# leapfrog 0.0.4
+
+* Function `dp_read_viral_suppression()` to read VL testing and suppression Program Statistics tab
+
 # leapfrog 0.0.3
 
 * Implement Spectrum ART allocation.

R/read-spectrum.R

@@ -83,6 +83,11 @@ get_dp_years <- function(dp) {
        time_data_idx = time_data_idx)
 }
 
+stop_tag_not_found <- function(tag) {
+  stop('Tag "', tag, '" not recognized. Function probably needs update for this .DP file.')
+}
+
+
 
 #' Read Spectrum programme data inputs
 #' 
@@ -111,12 +116,14 @@ get_dp_years <- function(dp) {
 #' dp <- read_dp(pjnz)
 #' dp_anc_testing <- dp_read_anc_testing(dp)
 #' dp_pmtct <- dp_read_pmtct(dp)
-#' dp_read_pmtct <- dp_read_pmtct_retained(dp)
+#' dp_pmtct_ret <- dp_read_pmtct_retained(dp)
 #' dp_abortion <- dp_read_abortion(dp)
 #' dp_notbreastfeeding <- dp_read_breastfeeding(dp)
 #' dp_childart <- dp_read_childart(dp)
 #' dp_childltfu <- dp_read_childltfu(dp)
 #'
+#' dp_vls <- dp_read_viral_suppression(dp)
+#'
 #' ## Can either pass PJNZ path or parsed "spectrum_dp" object
 #'
 #' anc_testing1 <- dp_read_anc_testing(pjnz)
@@ -342,3 +349,53 @@ dp_read_childltfu <- function(dp) {
 
   childart_ltfu
 }
+
+#' @rdname dp_read_anc_testing
+#' @export 
+dp_read_viral_suppression <- function(dp) {
+
+  dp <- get_dp_data(dp)
+  dpy <- get_dp_years(dp)
+
+  tag <- "<ViralSuppressionInputType MV2>"
+  if (exists_dptag(dp, tag)) {
+    vls_input_type <- as.integer(dpsub(dp, tag, 2, 4))
+  } else {
+    stop_tag_not_found(tag)
+  }
+
+  tag <- "<ViralSuppressionThreshold MV4>"
+  if (exists_dptag(dp, tag)) {
+    vls_threshold <- as.numeric(dpsub(dp, tag, 2, dpy$time_data_idx))
+  } else {
+    stop_tag_not_found(tag)
+  }
+
+  vl_indicators <- c("BLANK",
+                     "vl_tested_child",
+                     "vl_suppressed_child",
+                     "BLANK",
+                     "vl_tested_male15pl",
+                     "vl_suppressed_male15pl",
+                     "BLANK",
+                     "vl_tested_female15pl",
+                     "vl_suppressed_female15pl")
+
+  tag <- "<ViralSuppressionInput MV4>"
+  if (exists_dptag(dp, tag)) {
+    vl_suppression <- dpsub(dp, tag, 2:10, dpy$time_data_idx)
+    vl_suppression <- sapply(vl_suppression, as.numeric)
+    dimnames(vl_suppression) <- list(indicator = vl_indicators, year = dpy$proj_years)
+  } else {
+    stop_tag_not_found(tag)
+  }
+
+  vl_suppression <- vl_suppression[vl_indicators != "BLANK", ]
+  vl_suppression[vl_suppression == -9999] <- NA_real_
+
+  vl_suppression <- rbind(vl_suppression,
+                          vls_threshold = vls_threshold,
+                          vls_input_type = vls_input_type)
+
+  vl_suppression
+}