Merge pull request #657 from pepfar-datim/DP-975

Improve validation of prioritizations

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: datapackr
 Type: Package
 Title: A Package that Packs and Unpacks all Data Packs and Target Setting Tools
-Version: 6.2.1
-Date: 2023-04-03
+Version: 6.2.2
+Date: 2023-04-05
 Authors@R: c(
  person("Scott", "Jackson", email = "sjackson@baosystems.com",
  role = c("aut", "cre")),

NEWS.md

@@ -1,3 +1,9 @@
+# datapackr 6.2.2
+
+## Bug fixes
+* Fixed an issue with countries in regions being flagged as having invalid prioritizations
+* Fixed an issue with analytics checks when only using a PSNUxIM tool
+
 # datapackr 6.2.1
 
 ## Breaking changes

R/unPackingChecks.R

@@ -851,14 +851,33 @@ checkInvalidPrioritizations <- function(sheets, d, quiet = TRUE) {
  has_error = FALSE)
 
  valid_orgunits_local <- getValidOrgUnits(d$info$cop_year)
+ valid_orgunits_local$hierarchy_level <- unlist(lapply(valid_orgunits_local$ancestors, function(x) NROW(x) + 1L))
+ valid_orgunits_local <- valid_orgunits_local[, c("uid", "ou_uid", "country_uid", "hierarchy_level")]
+
 
  data <- d$sheets[["Prioritization"]][, c("PSNU", "IMPATT.PRIORITY_SNU.T")]
  names(data)[names(data) == "IMPATT.PRIORITY_SNU.T"] <- "value"
  data <- data[, c("PSNU", "value")]
  data$snu_uid <- extract_uid(data$PSNU)
- valid_prio_units <- valid_orgunits_local[valid_orgunits_local$org_type %in% c("PSNU", "Military"), ]
- #Does the PSNU exist in the list of valid PSNUs?
- data$isInvalidPSNU <- !(data$snu_uid %in% valid_prio_units$uid)
+
+ data %<>% dplyr::left_join(valid_orgunits_local, by = c("snu_uid" = "uid"))
+
+ dataset_levels_local <- dataset_levels %>%
+ dplyr::filter(cop_year == d$info$cop_year, ou_uid == d$info$operating_unit$ou_uid) %>%
+ dplyr::select(ou_uid, country_uid, prioritization)
+
+ data %<>% dplyr::left_join(dataset_levels_local)
+
+ #
+ data <- data %>%
+ dplyr::mutate(
+ isInvalidPSNU = dplyr::case_when(
+ is.na(ou_uid) | is.na(country_uid) ~ TRUE,
+ grepl("_Military", PSNU) ~ FALSE,
+ hierarchy_level == prioritization ~ FALSE,
+ TRUE ~ TRUE
+ )
+ )
 
  isInvalidPrioritization <- function(PSNU, value) {
 
@@ -874,7 +893,6 @@ checkInvalidPrioritizations <- function(sheets, d, quiet = TRUE) {
 
  invalid_prioritizations <- data[data$isInvalidPSNU | data$isInvalidPrioritization, ]
 
-
  if (NROW(invalid_prioritizations) > 0) {
 
  inv_pzs_msg <-

tests/testthat/test-unPackingChecks.R

@@ -570,6 +570,7 @@ test_that("Can check invalid prioritizations", {
  "Central Region", "Lilongwe District [#SNU] [ScR9iFKAasW]", "4", "4", "Sustained"
  )
  d$info$cop_year <- 2022
+ d$info$operating_unit$ou_uid <- "lZsCb6y0KDX"
 
  # test no errors/warnings
  res <- checkInvalidPrioritizations(d, sheets = test_sheets)
@@ -609,6 +610,7 @@ test_that("Can check invalid prioritizations COP23", {
  "Dedza District [PekKUkKHAzY]", "4", "4", "Sustained"
  )
  d$info$cop_year <- 2023
+ d$info$operating_unit$ou_uid <- "lZsCb6y0KDX"
 
 
  # test no errors/warnings
@@ -629,6 +631,39 @@ test_that("Can check invalid prioritizations COP23", {
  expect_equal(res$has_error, TRUE)
 
 
+
+ #In the list of valid PSNUs but at the wrong level
+ #Take a DSNU from Eswatini which should not have an assigned prioritization
+ d <- list()
+ d$sheets$Prioritization <-
+ tribble(
+ ~SNU1, ~PSNU, ~IMPATT.PRIORITY_SNU.T_1, ~IMPATT.PRIORITY_SNU.T, ~PRIORITY_SNU.translation,
+ "Hhohho", "Hhohho [qYzGABaWyCf]", "4", "4", "Sustained",
+ "Lobamba", "Lobamba [ciLrwlyi1dv]", "4", "4", "Sustained"
+ )
+ d$info$cop_year <- 2023
+ d$info$operating_unit$ou_uid <- "V0qMZH29CtN"
+
+ expect_equal(nrow(res$result), 1L)
+ expect_equal(res$lvl, "ERROR")
+ expect_equal(res$has_error, TRUE)
+
+ #It looks like a PSNU, but its not
+ d <- list()
+ d$sheets$Prioritization <-
+ tribble(
+ ~SNU1, ~PSNU, ~IMPATT.PRIORITY_SNU.T_1, ~IMPATT.PRIORITY_SNU.T, ~PRIORITY_SNU.translation,
+ "Hhohho", "Hhohho [qYzGABaWyCf]", "4", "4", "Sustained",
+ "Bogus PSNU", "Bogus PSNU [ARVh1xCeJhU]", "4", "4", "Sustained"
+ )
+ d$info$cop_year <- 2023
+ d$info$operating_unit$ou_uid <- "V0qMZH29CtN"
+
+ expect_equal(nrow(res$result), 1L)
+ expect_equal(res$lvl, "ERROR")
+ expect_equal(res$has_error, TRUE)
+
+
 })
 
 # check formulas ----