Merge pull request #819 from pepfar-datim/Release-7.4.3

Release 7.4.3

DESCRIPTION

@@ -2,8 +2,8 @@ Type: Package
 Package: datapackr
 Title: A Package that Packs and Unpacks all Data Packs and Target Setting
     Tools
-Version: 7.4.2
-Date: 2024-04-05
+Version: 7.4.3
+Date: 2024-04-10
 Authors@R: c(
     person("Scott", "Jackson", , "sjackson@baosystems.com", role = c("aut", "cre")),
     person("Jason", "Pickering", , "jason.p.pickering@gmail.com", role = c("aut", "rev")),
@@ -25,8 +25,6 @@ Imports:
     crayon (>= 1.3.4),
     datimvalidation,
     dplyr (>= 0.8.3),
-    httr (>= 1.4.0),
-    jsonlite (>= 1.6),
     lubridate,
     magrittr (>= 1.5),
     methods,
@@ -45,6 +43,8 @@ Suggests:
     flextable,
     gdtools,
     httptest,
+    httr (>= 1.4.0),
+    jsonlite (>= 1.6),
     lintr (>= 3.0.0),
     officer,
     parallel,
@@ -58,4 +58,4 @@ Remotes:
     pepfar-datim/datimutils
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1

NAMESPACE

@@ -170,6 +170,7 @@ export(writeHomeTab)
 export(writePSNUxIM)
 export(writeSpectrumData)
 export(zerosToDashes)
+importFrom(datimutils,getMetadata)
 importFrom(magrittr,`%<>%`)
 importFrom(magrittr,`%>%`)
 importFrom(methods,as)

NEWS.md

@@ -1,9 +1,22 @@
+# datapackr 7.4.3
+
+## New features
+* 
+
+## Bug fixes
+* Updated `checkanalytics` and their associated tests. Relating to PMTCT & TB_STAT columns being based on COP Year.  
+
+## Minor improvements and fixes
+* Added tests related to `writePSNUxIM`
+* Updated `getCurrentCOPYear` to 2024, and started development on sunsetting this function.
+* Removed non-ASCII character from file unPackingChecks
+* Fix issue with package imports flagged by devtools::check
+
 # datapackr 7.4.1
 
 ## Bug fixes
 * Updated valid Org units with changes from 2024
 
-
 # datapackr 7.4.0
 
 ## New features

R/adorn_import_file.R

@@ -1,4 +1,5 @@
 #' @export
+#' @importFrom datimutils getMetadata
 #' @title getPSNUInfo
 #' @description Certain special PSNUs (like DREAMS) are part of the
 #' target setting process, but may exist at a level in the

R/checkAnalytics.R

@@ -208,9 +208,16 @@ analyze_vmmc_indeterminate <- function(data) {
 analyze_pmtctknownpos <- function(data) {
   a <- NULL
 
-  required_names <- c("PMTCT_STAT.N.New.Pos.T",
-                      "PMTCT_STAT.N.KnownPos.T",
-                      "PMTCT_STAT.N.New.Neg.T")
+  this_cop_year <- as.character(data$cop_year[1])
+
+  required_names <- switch(this_cop_year,
+                           "2023" =  c("PMTCT_STAT.N.New.Pos.T",
+                                       "PMTCT_STAT.N.KnownPos.T",
+                                       "PMTCT_STAT.N.New.Neg.T"),
+                           "2024" =  c("PMTCT_STAT.N.New.Pos.T",
+                                       "PMTCT_STAT.N.Known.Pos.T",
+                                       "PMTCT_STAT.N.New.Neg.T"),
+                           stop("Unsupported COP Year"))
 
   if (any(!(required_names %in% names(data)))) {
     a$test_results <- data.frame(msg = "Missing data.")
@@ -219,13 +226,14 @@ analyze_pmtctknownpos <- function(data) {
     return(a)
   }
 
-  issues <- data %>%
+  issues <- if (this_cop_year == "2023") {
+    data %>%
     dplyr::filter(is.na(key_population)) %>%
     dplyr::mutate(
       PMTCT_STAT.N.Total =
         PMTCT_STAT.N.New.Pos.T
-        + PMTCT_STAT.N.KnownPos.T
-        + PMTCT_STAT.N.New.Neg.T,
+      + PMTCT_STAT.N.KnownPos.T
+      + PMTCT_STAT.N.New.Neg.T,
       knownpos_ratio =
         (PMTCT_STAT.N.KnownPos.T / PMTCT_STAT.N.Total)) %>%
     dplyr::select(
@@ -240,6 +248,29 @@ analyze_pmtctknownpos <- function(data) {
     dplyr::filter(
       round(knownpos_ratio, 2) > 0.75
     )
+  } else if (this_cop_year == "2024") {
+    data %>%
+      dplyr::filter(is.na(key_population)) %>%
+      dplyr::mutate(
+        PMTCT_STAT.N.Total =
+          PMTCT_STAT.N.New.Pos.T
+        + PMTCT_STAT.N.Known.Pos.T
+        + PMTCT_STAT.N.New.Neg.T,
+        knownpos_ratio =
+          (PMTCT_STAT.N.Known.Pos.T / PMTCT_STAT.N.Total)) %>%
+      dplyr::select(
+        psnu, psnu_uid, age, sex, key_population,
+        PMTCT_STAT.N.Total,
+        PMTCT_STAT.N.New.Pos.T,
+        PMTCT_STAT.N.Known.Pos.T,
+        PMTCT_STAT.N.New.Neg.T,
+        knownpos_ratio
+      ) %>%
+      dplyr::filter(!is.na(knownpos_ratio)) %>%
+      dplyr::filter(
+        round(knownpos_ratio, 2) > 0.75
+      )
+    }
 
   if (NROW(issues) > 0) {
 
@@ -277,9 +308,16 @@ analyze_pmtctknownpos <- function(data) {
 analyze_tbknownpos <- function(data) {
   a <- NULL
 
-  required_names <- c("TB_STAT.N.New.Pos.T",
-                      "TB_STAT.N.KnownPos.T",
-                      "TB_STAT.N.New.Neg.T")
+  this_cop_year <- as.character(data$cop_year[1])
+
+  required_names <- switch(this_cop_year,
+                           "2023" =  c("TB_STAT.N.New.Pos.T",
+                                       "TB_STAT.N.KnownPos.T",
+                                       "TB_STAT.N.New.Neg.T"),
+                           "2024" =  c("TB_STAT.N.New.Pos.T",
+                                       "TB_STAT.N.Known.Pos.T",
+                                       "TB_STAT.N.New.Neg.T"),
+                           stop("Unsupported COP Year"))
 
   if (any(!(required_names %in% names(data)))) {
     a$test_results <- data.frame(msg = "Missing data.")
@@ -288,7 +326,8 @@ analyze_tbknownpos <- function(data) {
     return(a)
   }
 
-  issues <- data %>%
+  issues <- if (this_cop_year == "2023") {
+    data %>%
     dplyr::mutate(
       TB_STAT.N.Total =
         TB_STAT.N.New.Pos.T
@@ -305,6 +344,25 @@ analyze_tbknownpos <- function(data) {
     dplyr::filter(!is.na(knownpos_ratio)) %>%
     dplyr::filter(
       round(knownpos_ratio, 2) > 0.75)
+    } else if (this_cop_year == "2024") {
+      data %>%
+      dplyr::mutate(
+        TB_STAT.N.Total =
+          TB_STAT.N.New.Pos.T
+        + TB_STAT.N.Known.Pos.T
+        + TB_STAT.N.New.Neg.T,
+        knownpos_ratio = TB_STAT.N.Known.Pos.T / TB_STAT.N.Total) %>%
+      dplyr::select(
+        psnu, psnu_uid, age, sex, key_population,
+        TB_STAT.N.Total,
+        TB_STAT.N.New.Pos.T,
+        TB_STAT.N.Known.Pos.T,
+        TB_STAT.N.New.Neg.T,
+        knownpos_ratio) %>%
+      dplyr::filter(!is.na(knownpos_ratio)) %>%
+      dplyr::filter(
+        round(knownpos_ratio, 2) > 0.75)
+  }
 
   if (NROW(issues) > 0) {
 

R/packageSetup.R

@@ -6,7 +6,7 @@
 #' @return Current COP Year. (e.g., for COP19, returns 2019)
 #'
 getCurrentCOPYear <- function() {
-  2023
+  2024 #Should be updated with the release of Beta-Packs every year
 }
 
 

R/unPackingChecks.R

@@ -1258,7 +1258,7 @@ checkToolEmptySheets <- function(d, sheets, quiet = TRUE) {
     msg <-
       paste0(
         lvl, "! MISSING KEY COLUMNS: The following sheets are missing critical ",
-        "columns — usually PSNU, Age, Sex, and/or KeyPop. This prevents us from ",
+        "columns, usually PSNU, Age, Sex, and/or KeyPop. This prevents us from ",
         "checking and reading any data from these sheets. -> \n  * ",
         paste0(sheets[!has_all_header_columns], collapse = "\n  * "),
         "\n")

tests/testthat/helper.R

@@ -62,3 +62,6 @@ play2361 <- list(base_url = "https://play.dhis2.org/2.36.1/",
 
 training <- list(base_url = "https://training.datim.org/",
                  handle = httr::handle("https://training.datim.org/"))
+
+triage <- list(base_url = "https://triage.testing.datim.org/",
+                 handle = httr::handle("https://triage.testing.datim.org/"))

tests/testthat/test-checkAnalytics.R

@@ -122,8 +122,9 @@ test_that("PMTCT Known Pos/PMTCT Total >  0.75 expect message", {
   data <- tribble(
     ~psnu, ~psnu_uid, ~age, ~sex, ~key_population,
     ~PMTCT_STAT.N.New.Pos.T, ~PMTCT_STAT.N.KnownPos.T, ~PMTCT_STAT.N.New.Neg.T,
-    "a", 1, "<1", "M", NA, 10, 100, 10,
-    "b", 2, "<1", "M", NA, 0, 0, 0
+    ~ cop_year,
+    "a", 1, "<1", "M", NA, 10, 100, 10, 2023,
+    "b", 2, "<1", "M", NA, 0, 0, 0, 2023
   )
 
   foo <- analyze_pmtctknownpos(data)
@@ -137,9 +138,9 @@ test_that("PMTCT Known Pos/PMTCT Total >  0.75 expect message", {
 test_that("PMTCT Known Pos/PMTCT Total >  0.75 missing data", {
   data <- tribble(
     ~psnu, ~psnu_uid, ~age, ~sex, ~key_population,
-    ~PMTCT_STAT.N.New.Pos.T, ~PMTCT_STAT.N.KnownPos.T,
-    "a", 1, "<1", "M", NA, 10, 100,
-    "b", 2, "<1", "M", NA, 0, 0
+    ~PMTCT_STAT.N.New.Pos.T, ~PMTCT_STAT.N.KnownPos.T, ~ cop_year,
+    "a", 1, "<1", "M", NA, 10, 100, 2023,
+    "b", 2, "<1", "M", NA, 0, 0, 2023
   )
 
   foo <- analyze_pmtctknownpos(data)
@@ -154,10 +155,10 @@ test_that("PMTCT Known Pos/PMTCT Total >  0.75 missing data", {
 test_that("PMTCT Known Pos/PMTCT Total <  0.75 expect null", {
   data <- tribble(
     ~psnu, ~psnu_uid, ~age, ~sex, ~key_population,
-    ~PMTCT_STAT.N.New.Pos.T, ~PMTCT_STAT.N.KnownPos.T, ~PMTCT_STAT.N.New.Neg.T,
-    "a", 1, "<1", "M", NA, 10, 10, 10,
-    "b", 2, "<1", "M", NA, 0, 0, 0,
-    "c", 3, "<1", "M", NA, 25, 150, 25
+    ~PMTCT_STAT.N.New.Pos.T, ~PMTCT_STAT.N.KnownPos.T, ~PMTCT_STAT.N.New.Neg.T, ~ cop_year,
+    "a", 1, "<1", "M", NA, 10, 10, 10, 2023,
+    "b", 2, "<1", "M", NA, 0, 0, 0, 2023,
+    "c", 3, "<1", "M", NA, 25, 150, 25, 2023
   )
 
   expect_null(analyze_pmtctknownpos(data))
@@ -167,9 +168,9 @@ test_that("PMTCT Known Pos/PMTCT Total <  0.75 expect null", {
 test_that("PMTCT Known Pos/PMTCT Total all zeros expect null", {
   data <- tribble(
     ~psnu, ~psnu_uid, ~age, ~sex, ~key_population, ~PMTCT_STAT.N.New.Pos.T
-    , ~PMTCT_STAT.N.KnownPos.T, ~PMTCT_STAT.N.New.Neg.T,
-    "a", 1, "<1", "M", NA, 0, 0, 0,
-    "b", 2, "<1", "M", NA, 0, 0, 0
+    , ~PMTCT_STAT.N.KnownPos.T, ~PMTCT_STAT.N.New.Neg.T, ~ cop_year,
+    "a", 1, "<1", "M", NA, 0, 0, 0, 2023,
+    "b", 2, "<1", "M", NA, 0, 0, 0, 2023
   )
 
   expect_null(analyze_pmtctknownpos(data))
@@ -178,9 +179,10 @@ test_that("PMTCT Known Pos/PMTCT Total all zeros expect null", {
 
 test_that("TB Known Pos ratio > 75% expect message", {
   data <- tribble(
-    ~psnu, ~psnu_uid, ~age, ~sex, ~key_population, ~TB_STAT.N.New.Pos.T, ~TB_STAT.N.KnownPos.T, ~TB_STAT.N.New.Neg.T,
-    "a", 1, "<1", "M", NA, 25, 156, 25,
-    "b", 2, "<1", "M", NA, 0, 0, 0
+    ~psnu, ~psnu_uid, ~age, ~sex, ~key_population, ~TB_STAT.N.New.Pos.T,
+    ~TB_STAT.N.KnownPos.T, ~TB_STAT.N.New.Neg.T, ~ cop_year,
+    "a", 1, "<1", "M", NA, 25, 156, 25, 2023,
+    "b", 2, "<1", "M", NA, 0, 0, 0, 2023
   )
 
   foo <- analyze_tbknownpos(data)
@@ -194,9 +196,9 @@ test_that("TB Known Pos ratio > 75% expect message", {
 
 test_that("TB Known Pos ratio > 75% expect message", {
   data <- tribble(
-    ~psnu, ~psnu_uid, ~age, ~sex, ~key_population, ~TB_STAT.N.New.Pos.T, ~TB_STAT.N.KnownPos.T,
-    "a", 1, "<1", "M", NA, 25, 151,
-    "b", 2, "<1", "M", NA, 0, 0
+    ~psnu, ~psnu_uid, ~age, ~sex, ~key_population, ~TB_STAT.N.New.Pos.T, ~TB_STAT.N.KnownPos.T, ~ cop_year,
+    "a", 1, "<1", "M", NA, 25, 151, 2023,
+    "b", 2, "<1", "M", NA, 0, 0, 2023
   )
 
   foo <- analyze_tbknownpos(data)
@@ -209,9 +211,10 @@ test_that("TB Known Pos ratio > 75% expect message", {
 
 test_that("TB Known Pos ratio < 75% expect message expect null", {
   data <- tribble(
-    ~psnu, ~psnu_uid, ~age, ~sex, ~key_population, ~TB_STAT.N.New.Pos.T, ~TB_STAT.N.KnownPos.T, ~TB_STAT.N.New.Neg.T,
-    "a", 1, "<1", "M", NA, 25, 150, 25,
-    "b", 2, "<1", "M", NA, 0, 0, 0,
+    ~psnu, ~psnu_uid, ~age, ~sex, ~key_population, ~TB_STAT.N.New.Pos.T,
+    ~TB_STAT.N.KnownPos.T, ~TB_STAT.N.New.Neg.T, ~ cop_year,
+    "a", 1, "<1", "M", NA, 25, 150, 25, 2023,
+    "b", 2, "<1", "M", NA, 0, 0, 0, 2023
   )
 
   expect_null(analyze_tbknownpos(data))
@@ -220,9 +223,10 @@ test_that("TB Known Pos ratio < 75% expect message expect null", {
 
 test_that("PMTCT Known Pos/PMTCT Total all zeros expect null", {
   data <- tribble(
-    ~psnu, ~psnu_uid, ~age, ~sex, ~key_population, ~TB_STAT.N.New.Pos.T, ~TB_STAT.N.KnownPos.T, ~TB_STAT.N.New.Neg.T,
-    "a", 1, "<1", "M", NA, 0, 0, 0,
-    "b", 2, "<1", "M", NA, 0, 0, 0
+    ~psnu, ~psnu_uid, ~age, ~sex, ~key_population, ~TB_STAT.N.New.Pos.T,
+    ~TB_STAT.N.KnownPos.T, ~TB_STAT.N.New.Neg.T, ~ cop_year,
+    "a", 1, "<1", "M", NA, 0, 0, 0, 2023,
+    "b", 2, "<1", "M", NA, 0, 0, 0, 2023
   )
 
   expect_null(analyze_tbknownpos(data))

tests/testthat/test-rounding.R

@@ -13,5 +13,5 @@ test_that("can properly round numbers", {
 
 test_that("Can get current COP year", {
   expect_true(is.numeric(getCurrentCOPYear()))
-  expect_equal(getCurrentCOPYear(), 2023)
+  expect_equal(getCurrentCOPYear(), 2024)
 })