Merge pull request #866 from pepfar-datim/Release-8.0.0

Release 8.0.0

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.6.2
-Date: 2024-07-19
+Version: 8.0.0
+Date: 2024-08-23
 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")),

NEWS.md

@@ -1,4 +1,15 @@
-# datapackr 7.6.1
+# datapackr 8.0.0
+## New features
+* Ability to process COP25 datapacks full version 
+* Addition of the comparison plus file
+
+## Bug fixes
+* 
+
+## Minor improvements and fixes
+* 
+
+# datapackr 7.6.2
 ## New features
 *
 
@@ -18,6 +29,11 @@
 ## Minor improvements and fixes
 * 
 
+# datapackr 7.6.0
+## New features
+* Sunset COP21 and COP22
+* Added original versions of the COP25 templates
+
 ## Bug fixes
 * reenabled droping invalid disaggs from the year 2 sheet
 * Updated Valid Org Units for 2024 to account for regionalization.

R/generateComparisonTable.R

@@ -8,7 +8,7 @@
 #'
 #' @return A comparison table
 #'
-generateComparisonTable <- function(d) {
+generateComparisonTable <- function(d, expanded = FALSE) {
 
  if (is.null(d$memo$datapack$by_psnu)) {
  d_datapack <- data.frame("psnu_uid" = character(),
@@ -34,10 +34,20 @@ generateComparisonTable <- function(d) {
  dplyr::mutate("Identical" = dplyr::near(Current, Proposed, tol = 1e-5),
  "Diff" = Proposed - Current,
  "Percent diff" = round(Diff / Proposed * 100, digits = 1)) %>%
- dplyr::filter(!Identical) %>%
+ { if (expanded == FALSE)
+ dplyr::filter(., !Identical) else .
+ } %>%
  tidyr::pivot_longer(cols = c(Current, Proposed, Diff, `Percent diff`), names_to = "Data Type") %>%
- dplyr::mutate(`Data Type` = factor(`Data Type`, levels = c("Proposed", "Current", "Diff", "Percent diff"))) %>%
- dplyr::select(-psnu_uid, -Identical)
+ { if (expanded == TRUE)
+ dplyr::mutate(., `Data Type` = factor(`Data Type`,
+ levels = c("Proposed", "Current", "Identical",
+ "Diff", "Percent diff"))) else
+ dplyr::mutate(., `Data Type` = factor(`Data Type`, levels = c("Proposed", "Current", "Diff", "Percent diff")))
+ } %>%
+ { if (expanded == TRUE)
+ dplyr::select(., -psnu_uid) else
+ dplyr::select(., -psnu_uid, -Identical)
+ }
 
  }
 

R/getCOPDataFromDATIM.R

@@ -18,7 +18,7 @@ getCOPDataFromDATIM <- function(country_uids,
  inherits = TRUE)) {
 
 
- if (!cop_year %in% c(2023:2024)) {
+ if (!cop_year %in% c(2023:2025)) {
 
  stop("The COP year provided is not supported by the internal function getCOPDataFromDATIM")
  ### NOTE for COP23 some special handling of SUBNAT data for FY23 like the code below may be

R/getHTSModality.R

@@ -10,8 +10,10 @@
 getHTSModality <- function(cop_year = getCurrentCOPYear(),
  d2_session = dynGet("d2_default_session",
  inherits = TRUE)) {
+ #Found here https://www.datim.org/dhis-web-maintenance/index.html#/list/dataElementSection/dataElementGroupSet
  groupSet <- switch(
  as.character(cop_year),
+ "2025" = "Bm4JmNS8ciD", #Need new one created in Datim touch base with Christian
  "2024" = "Bm4JmNS8ciD",
  "2023" = "fmxSIyzexmb",
  )

R/getPSNUs.R

@@ -25,7 +25,8 @@ getValidOrgUnits <- function(cop_year = NULL) {
 
  switch(as.character(cop_year),
  "2023" = valid_OrgUnits,
- "2024" = valid_OrgUnits_2024)
+ "2024" = valid_OrgUnits_2024,
+ "2025" = valid_OrgUnits_2025)
 
 }
 

R/messageQueue.R

@@ -7,11 +7,13 @@
 #' @return Object of class data.frame and Message queue.
 #' @export
 
-MessageQueue <- function(message = character(), level = character()) {
+MessageQueue <- function(message = character(), level = character(), tool = character()) {
 
  messages <- data.frame(
  message = message,
- level = level, stringsAsFactors = FALSE
+ level = level,
+ tool = tool,
+ stringsAsFactors = FALSE
  )
 
  ## Set the name for the class
@@ -27,11 +29,12 @@ MessageQueue <- function(message = character(), level = character()) {
 #' @param x A message queue
 #' @param message A string or vector of strings of messages.
 #' @param level A string or vector of strings of
+#' @param tool A string vector of the tool (optional) description
 #' message levels (ERROR, WARNING, INFO)
 #' @return A MessageQueue class.
 #' @export
 
-appendMessage <- function(x, message, level) {
+appendMessage <- function(x, message, level, tool) {
  UseMethod("appendMessage", x)
 }
 
@@ -43,7 +46,7 @@ appendMessage <- function(x, message, level) {
 #' @return A MessageQueue object
 #' @export
 
-appendMessage.MessageQueue <- function(x, message = NA, level = NA) {
+appendMessage.MessageQueue <- function(x, message = NA_character_, level = NA_character_, tool = NA_character_) {
 
  if (!is.vector(message) || is.list(message)) {
  stop("Please supply a vector of messages")
@@ -57,9 +60,23 @@ appendMessage.MessageQueue <- function(x, message = NA, level = NA) {
  stop("Messages and warnings must be of the same length")
  }
 
+ #Make the tool argument optional, but take the shortest length if missing
+ if (missing(tool)) {
+ tool <- rep("UNKNOWN", min(length(message), length(level)))
+ } else {
+ if (!is.vector(tool) || is.list(tool)) {
+ stop("Please supply a vector of tools")
+ }
+ }
+
+
+ if (!all.equal(length(message), length(level), length(tool))) {
+ stop("Messages and tools must be of the same length")
+ }
 
  empty_messages <- sapply(message, is_empty)
  empty_levels <- sapply(level, is_empty)
+ empty_tools <- sapply(tool, is_empty)
 
  #Do nothing if everything is blank
  if (all(empty_messages) && all(empty_levels)) {
@@ -71,11 +88,16 @@ appendMessage.MessageQueue <- function(x, message = NA, level = NA) {
  level[empty_levels] <- "UNKNOWN"
  }
 
+ if (any(empty_tools)) {
+ tool[empty_tools] <- "UNKNOWN"
+ }
+
 
  if (any(empty_messages)) {
  warning("Empty message detected.")
  message <- message[!empty_messages]
  level <- level[!empty_messages]
+ tool <- tool[!empty_messages]
 
  if (length(message) == 0) {
  return(x)
@@ -93,7 +115,7 @@ appendMessage.MessageQueue <- function(x, message = NA, level = NA) {
 
  }
 
- new_me <- rbind.data.frame(x, data.frame(message = message, level = level),
+ new_me <- rbind.data.frame(x, data.frame(message = message, level = level, tool = tool),
  stringsAsFactors = FALSE)
  class(new_me) <- c("data.frame", "MessageQueue")
  return(new_me)

R/packTool.R

@@ -88,7 +88,7 @@ packTool <- function(model_data = NULL,
 
  # Save & Export Workbook ####
  interactive_print("Saving...")
- if (d$info$cop_year %in% c(2023, 2024) && d$info$tool == "Data Pack") {
+ if (d$info$cop_year %in% c(2023, 2024, 2025) && d$info$tool == "Data Pack") {
  tool_name <- "Target Setting Tool"
  } else {
  tool_name <- d$info$tool

R/packageSetup.R

@@ -17,12 +17,12 @@ getCurrentCOPYear <- function() {
 datapackrSupports <- function() {
  tibble::tribble(
  ~tools, ~yrs, ~seasons,
- "Data Pack", c(2023, 2024), c("COP", "OPU"),
+ "Data Pack", c(2023, 2024, 2025), c("COP", "OPU"),
  "OPU Data Pack", c(2023), c("OPU", "COP"),
- "Data Pack Template", c(2023, 2024), c("COP", "OPU"),
+ "Data Pack Template", c(2023, 2024, 2025), c("COP", "OPU"),
  "OPU Data Pack Template", c(2023), c("OPU", "COP"),
- "PSNUxIM", c(2023, 2024), c("COP", "OPU"),
- "PSNUxIM Template", c(2024), c("COP", "OPU"))
+ "PSNUxIM", c(2023, 2024, 2025), c("COP", "OPU"),
+ "PSNUxIM Template", c(2024, 2025), c("COP", "OPU"))
 }
 
 
@@ -138,18 +138,20 @@ skip_tabs <- function(tool = "Data Pack", cop_year) {
  switch(as.character(cop_year),
  "2023" = c("Home", "Spectrum", "Year 2"),
  "2024" = c("Home", "Spectrum", "Year 2"),
+ "2025" = c("Home", "Spectrum", "Year 2"),
  NA_character_)
 
  skip$unpack <-
  switch(as.character(cop_year),
  "2023" = c("Home", "Spectrum", "KP Validation"),
  "2024" = c("Home", "Spectrum", "KP Validation"),
+ "2025" = c("Home", "Spectrum", "KP Validation"),
  NA_character_)
 
  skip$schema <- skip$pack[skip$pack %in% skip$unpack]
 
  } else if (tool %in% c("OPU Data Pack Template", "OPU Data Pack", "PSNUxIM", "PSNUxIM Template") &&
- cop_year %in% c(2023, 2024)) {
+ cop_year %in% c(2023, 2024, 2025)) {
  skip$pack <- c("Home")
  skip$unpack <- c("Home")
  skip$schema <- c("Home")
@@ -180,7 +182,7 @@ headerRow <- function(tool, cop_year) {
  rm(params, p)
 
  #Currently all tools use row 14 as the header.
- if (cop_year %in% c(2023, 2024)) {
+ if (cop_year %in% c(2023, 2024, 2025)) {
  if (tool %in% datapackrSupports()$tools) {
  return(14)
  } else {
@@ -225,12 +227,14 @@ pick_schema <- function(cop_year, tool) {
  schema <- switch(as.character(cop_year),
  "2023" = cop23_data_pack_schema,
  "2024" = cop24_data_pack_schema,
+ "2025" = cop25_data_pack_schema,
  stop("Data Pack schema not available for the COP year provided."))
 
  } else if (tool %in% c("PSNUxIM", "PSNUxIM Template")) {
  schema <- switch(as.character(cop_year),
  "2023" = cop23_psnuxim_schema,
  "2024" = cop24_psnuxim_schema,
+ "2025" = cop25_psnuxim_schema,
  stop("PSNUxIM schema not available for the COP year provided."))
  } else {
  stop("No schema could be found for the combination of tool and COP year provided.")
@@ -273,6 +277,7 @@ pick_template_path <- function(cop_year, tool) {
  template_filename <- switch(as.character(cop_year),
  "2023" = "COP23_Data_Pack_Template.xlsx",
  "2024" = "COP24_Data_Pack_Template.xlsx",
+ "2025" = "COP25_Data_Pack_Template.xlsx",
  NULL)
 
  }

R/unPackSchema.R

@@ -398,7 +398,7 @@ unPackSchema <- function(template_path = NULL,
  # rm(params, p)
 
  if (tool %in% c("OPU Data Pack Template", "OPU Data Pack", "PSNUxIM", "PSNUxIM Template")
- && cop_year %in% c(2023, 2024)) {
+ && cop_year %in% c(2023, 2024, 2025)) {
  include_blank_cells <- TRUE
  } else {
  include_blank_cells <- FALSE

R/unPackTool.R

@@ -35,7 +35,7 @@ unPackTool <- function(submission_path = NULL,
  d <- unPackDataPack(d,
  d2_session = d2_session)
 
- if (d$info$cop_year %in% c("2023", "2024")) {
+ if (d$info$cop_year %in% c("2023", "2024", "2025")) {
  d <- unpackYear2Sheet(d)
  }
 

R/unPackToolSet.R

@@ -61,7 +61,6 @@ unPackToolSet <- function(d1_path = NULL,
  d2_path <- d2$keychain$submission_path
 
  #Deal with renaming of tools
-
  d1_tool <- masqueradeTool(d1$info$tool)
  d2_tool <- masqueradeTool(d2$info$tool)
 

R/unPackingChecks.R

@@ -758,7 +758,8 @@ checkInvalidOrgUnits <- function(sheets, d, quiet = TRUE) {
  #There may be some variation in the columns between cop years
  cols_to_filter <- switch(as.character(d$info$cop_year),
  "2023" = c("PSNU", "Age", "Sex"),
- "2024" = c("PSNU", "Age", "Sex"))
+ "2024" = c("PSNU", "Age", "Sex"),
+ "2025" = c("PSNU", "Age", "Sex"))
 
  invalid_orgunits <- d$sheets[sheets] %>%
  dplyr::bind_rows(.id = "sheet_name") %>%

R/update_de_coc_co_map.R

@@ -48,15 +48,20 @@ update_de_coc_co_map <- function(cop_year = NULL,
  "dA9C5bL44NX", "FY24 MER Targets", 2024, "targets", "mer", "psnu",
  "lHUEzkjkij1", "FY25 MER Targets", 2025, "targets", "mer", "psnu",
  "lHUEzkjkij1", "FY26 MER Targets", 2026, "targets", "mer", "psnu",
+ "lHUEzkjkij1", "FY27 MER Targets", 2027, "targets", "mer", "psnu", #Update in November 2024
  "vpDd67HlZcT", "FY24 DREAMS Targets", 2024, "targets", "dreams", "dsnu",
  "tNbhYbrKbnk", "FY25 DREAMS Targets", 2025, "targets", "dreams", "dsnu",
  "tNbhYbrKbnk", "FY26 DREAMS Targets", 2026, "targets", "dreams", "dsnu",
+ "tNbhYbrKbnk", "FY27 DREAMS Targets", 2027, "targets", "dreams", "dsnu", #Update in November 2024
  # For all FY25 SUBNAT/IMPATT, mimic FY24
+ "jgp20ElKCMD", "FY27 IMPATT", 2027, "targets", "impatt", "psnu", #Update in November 2024
  "jgp20ElKCMD", "FY26 IMPATT", 2026, "targets", "impatt", "psnu",
  "jgp20ElKCMD", "FY25 IMPATT", 2025, "targets", "impatt", "psnu",
  "kWKJQYP1uT7", "FY24 IMPATT", 2024, "targets", "impatt", "psnu",
+ "CMJtVW4ecLn", "FY27 SUBNAT Targets", 2027, "targets", "subnat", "psnu", #Update in November 2024
  "CMJtVW4ecLn", "FY26 SUBNAT Targets", 2026, "targets", "subnat", "psnu",
  "CMJtVW4ecLn", "FY25 SUBNAT Targets", 2025, "targets", "subnat", "psnu",
+ # Fri Jul 26 15:42:02 2024 -- Touch base with Christian, but believe the belwo is COP23 specific
  # For all FY23 SUBNAT/IMPATT, remap to FY24 disaggs, as these won't go to
  # DATIM, but must go to PAW alongside FY24.
  "kWKJQYP1uT7", "FY23 IMPATT", 2023, "targets", "impatt", "psnu",