Align datapack sitetool code

NAMESPACE

@@ -1,16 +1,20 @@
 # Generated by roxygen2: do not edit by hand
 
 export(addValidationsSite)
+export(addcols)
 export(api_call)
 export(api_fields)
 export(api_filter)
 export(api_get)
 export(api_version)
-export(can_read_file)
+export(canReadFile)
+export(checkColStructure)
+export(checkStructure)
 export(colorCodeSites)
 export(comparePacks)
 export(cop_year)
 export(default_catOptCombo)
+export(defunctDisaggs)
 export(exportPackr)
 export(frameDataSheet)
 export(frameMechMap)
@@ -20,27 +24,35 @@ export(getMechList)
 export(getMilitaryNodes)
 export(getPSNUs)
 export(getSiteList)
-export(handshake_file)
+export(handshakeFile)
 export(interactive_print)
 export(loginToDATIM)
 export(packDataPack)
 export(packFrame)
 export(packMechMap)
 export(packSiteTool)
+export(rePackPSNUxIM)
 export(round_trunc)
 export(selectOU)
+export(separateDataSets)
 export(swapColumns)
-export(unPackData)
+export(unPackDataPack)
+export(unPackDataPackSheet)
 export(unPackMechanismMap)
+export(unPackSNUxIM)
 export(unPackSchema)
-export(unPackSiteToolData)
+export(unPackSheets)
+export(unPackSiteTool)
+export(unPackTool)
+export(writeComparisonWorkbook)
 export(writeFxColumnwise)
 export(writeHomeTab)
 export(write_site_level_sheet)
 importFrom(lazyeval,interp)
 importFrom(lubridate,mdy)
 importFrom(magrittr,"%<>%")
 importFrom(magrittr,"%>%")
+importFrom(rlist,list.remove)
 importFrom(tools,file_ext)
 importFrom(utils,URLencode)
 importFrom(utils,packageVersion)

R/apiUtilities.R

@@ -4,16 +4,16 @@
 #' @description
 #' Constructs URL for DATIM API query against specified table without paging.
 #' 
-#' @param table Character. DATIM API table to query.
+#' @param Endpoint Character. DATIM API endpoint to query.
 #' 
 #' @return Web-encoded URL for DATIM API query.
 #' 
-api_call <- function(table) {
+api_call <- function(endpoint) {
 
   URL <- paste0(
     getOption("baseurl"),"api/",datapackr::api_version(),
     "/",
-    table,
+    endpoint,
     ".json?paging=false") %>%
     utils::URLencode()
 

R/checkColStructure.R

@@ -0,0 +1,52 @@
+#' @export
+#' @importFrom magrittr %>% %<>%
+#' @title checkColStructure(d)
+#'
+#' @description Checks structural integrity of columns on critical sheets for
+#'    submitted Data Pack or Site Tool.
+#'
+#' @param d Datapackr object.
+#' @param sheet Sheet to check
+#' 
+#' @return d
+#' 
+checkColStructure <- function(d, sheet) {
+  msg <- NULL
+
+  if (sheet == "SNU x IM") {
+    data = d$data$SNUxIM
+  } else {
+    data = d$data$extract
+  }
+
+  submission_cols <- names(data) %>%
+    tibble::as_tibble() %>%
+    dplyr::select(indicator_code = value) %>%
+    dplyr::mutate(submission_order = as.integer(1:(dplyr::n())))
+
+  if (d$info$tool == "Data Pack") {
+    schema <- datapackr::data_pack_schema
+  } else if (d$info$tool == "Site Tool") {
+    schema <- datapackr::site_tool_schema
+  } else {stop("Cannot process that kind of tool.")}
+
+  col_check <- schema %>%
+    dplyr::filter(sheet_name == sheet
+                  & !(sheet == "SNU x IM" & indicator_code == "Mechanism1")) %>%
+    dplyr::select(indicator_code, template_order = col) %>%
+    dplyr::full_join(submission_cols, by = c("indicator_code" = "indicator_code")) %>%
+    dplyr::mutate(order_check = template_order == submission_order)
+
+  ## Alert to missing cols
+  if (any(is.na(col_check$submission_order))) {
+    missing_cols <- col_check %>%
+      dplyr::filter(is.na(submission_order)) %>%
+      dplyr::pull(indicator_code)
+    msg <- paste0("In tab", sheet, 
+                  " MISSING COLUMNS (Did you delete or rename these columns?):  ",
+                  paste(missing_cols, collapse = ", "),"")
+    d$info$warningMsg <- append(msg, d$info$warningMsg)
+  }
+
+  return(d)
+}

R/checkOUinfo.R

@@ -0,0 +1,93 @@
+#' @importFrom magrittr %>% %<>%
+#' @title checkOUinfo(d)
+#'
+#' @description Cross-checks and updates PEPFAR Operating Unit name and id as
+#'  read from Data Pack or Site Tool submission file.
+#'
+#' @param d datapackr list object containing at least d$keychain$submission_path.
+#' @return A datapackr list object, \code{d}, storing a unique UID and Name for
+#'    the PEPFAR Operating Unit related to the submitted Data Pack or Site Tool.
+checkOUinfo <- function(d) {
+  # Get OU name and uid
+  d$info$datapack_uid <-
+    names(readxl::read_excel(
+      d$keychain$submission_path,
+      sheet = "Home",
+      range = "B25"
+    ))
+
+  datapack_region_name <-
+    names(readxl::read_excel(
+      d$keychain$submission_path,
+      sheet = "Home",
+      range = "B20"
+    ))
+
+  regional_country_name <- 
+    names(readxl::read_excel(
+      d$keychain$submission_path,
+      sheet = "Home",
+      range = "B21"
+    ))
+
+  is_regional_country_pack<-length(regional_country_name) != 0
+
+  d$info$datapack_name<-ifelse( is_regional_country_pack,regional_country_name,datapack_region_name )
+
+  regional_country <-ifelse( is_regional_country_pack, "countryName","DataPack_name") 
+
+  regional_country_uid<-ifelse(is_regional_country_pack, "countryUID", "model_uid")
+
+  # Check ou_name and ou_uid match
+
+  verifyDataPackNameWithUID<-function(d,regional_country_uid,regional_country ) {
+
+    regional_country_uid <- rlang::sym(regional_country_uid)
+    regional_country <- rlang::sym(regional_country)
+
+    datapack_name <- datapackr::configFile %>%
+      dplyr::filter(!!regional_country_uid == d$info$datapack_uid) %>%
+      dplyr::select(!!regional_country) %>%
+      dplyr::pull(!!regional_country) %>% 
+      unique()
+
+    #If we get nothing here (like the UID does not exist, we need to bail early)
+    if ( length(datapack_name) == 0  ) {
+      stop("Unknown DataPack Name. Please contact the DataPack Support Team!")
+    }
+
+
+
+    datapack_uid <- datapackr::configFile %>%
+      dplyr::filter(!!regional_country == d$info$datapack_name) %>%
+      dplyr::select(!!regional_country_uid) %>%
+      dplyr::pull(!!regional_country_uid) %>% 
+      unique()
+
+    #If we get nothing here (like the UID does not exist, we need to bail early)
+    if ( length(datapack_uid) == 0 ) {
+      stop("Unknown DataPack UID. Please contact the DataPack Support Team!")
+    }
+
+
+    # If OU name and UID do not match, force identification via user prompt in Console
+    if (d$info$datapack_name != datapack_name |
+        d$info$datapack_uid != datapack_uid) {
+      msg <-
+        "The OU UID and OU name used in this submission don't match up!"
+      interactive_print(msg)
+      d$info$warningMsg <- append(msg, d$info$warningMsg)
+      if (interactive()) {
+        d$info$datapack_name <- selectOU()
+      } else {
+        stop(msg)
+      }
+    }
+
+    d
+
+  }
+
+  verifyDataPackNameWithUID(d,regional_country_uid,regional_country)
+
+}

R/checkStructure.R

@@ -0,0 +1,56 @@
+#' @export
+#' @title Check tab structure of tool submitted for validation.
+#'
+#' @description Checks structural integrity of tabs for submitted tool.
+#'
+#' @param d Datapackr object.
+#'     
+#' @return d
+#'    
+checkStructure <- function(d) {
+  # Check structural integrity of Workbook tabs
+  msg <- NULL
+
+  submission_sheets <-
+    readxl::excel_sheets(d$keychain$submission_path) %>%
+    tibble::enframe(name = NULL) %>%
+    dplyr::select(sheet_name = value) %>%
+    dplyr::mutate(submission_order = as.integer(1:(dplyr::n())))
+
+  # Check all tabs present and accounted for
+  if (d$info$tool == "Data Pack") {
+    schema <- datapackr::data_pack_schema
+  } else if (d$info$tool == "Site Tool") {
+    schema <- datapackr::site_tool_schema
+  } 
+  #TODO Add once https://github.com/pepfar-datim/datapackr/issues/43 resolved
+  #else if (d$info$tool == "Mechanism Map") {
+  #   schema <- datapackr::mech_map_schema
+  # }
+
+  sheets_check <- schema %>%
+    dplyr::select(sheet_name, template_order = sheet_num) %>%
+    dplyr::distinct() %>%
+    dplyr::left_join(submission_sheets, by = c("sheet_name")) %>%
+    dplyr::mutate(order_check = template_order == submission_order)
+
+  d$info$sheets_info <- sheets_check
+
+  ## Alert to missing Sheets
+  info_msg <- "Checking for any missing tabs..."
+  interactive_print(info_msg)
+
+  if (any(is.na(sheets_check$submission_order))) {
+    missing_sheets <- sheets_check %>%
+      dplyr::filter(is.na(submission_order)) %>%
+      dplyr::pull(sheet_name)
+
+    msg <- paste0(
+      "MISSING SHEETS (Did you delete or rename these tabs?): ",
+      paste0(missing_sheets, collapse = ", "), "")
+    d$info$warning_msg <- append(msg,d$info$warning_msg)
+  }
+
+  return(d)
+
+}

R/comparePacks.R

@@ -21,13 +21,15 @@ comparePacks <- function(datapack_path, sitetool_path) {
     stop("These Countries are apples and oranges. Recheck your fruit.")
   }
 
-  # Aggregate Site Tool data
-    country_uids <- datapackr::dataPackMap %>%
-      dplyr::filter(model_uid == st$info$datapack_uid) %>%
-      dplyr::pull(country_uid) %>%
-      unique()
+  #JPP Note: Removing this, as the info$datapack_uid should contain 
+  # The correct UID when parsed.
+  # # Aggregate Site Tool data
+  #   country_uids <- datapackr::dataPackMap %>%
+  #     dplyr::filter(model_uid == st$info$datapack_uid) %>%
+  #     dplyr::pull(country_uid) %>%
+  #     unique()
 
-    siteList <- getSiteList(country_uids, include_mil = TRUE)
+    siteList <- getSiteList(st$info$datapack_uid, include_mil = TRUE)
 
     sitetool_data_raw <- st$data$targets %>%
       dplyr::filter(indicatorCode != "VMMC_CIRC.N.Age/Sex.20T") %>%

R/datapackr.R

@@ -43,6 +43,7 @@ if (getRversion() >= "2.15.1")
       "col_type",
       "colType",
       "community",
+      "complete.cases",
       "country",
       "Country",
       "country_name",
@@ -59,6 +60,8 @@ if (getRversion() >= "2.15.1")
       "DataPackSiteID",
       "DataPackTarget",
       "dataset",
+      "delta",
+      "diffRounded",
       "disag",
       "distribution",
       "Distribution Check",
@@ -74,6 +77,7 @@ if (getRversion() >= "2.15.1")
       "groupSets",
       ".GRP",
       "grp_total",
+      "handshake_file",
       "HQID",
       "id",
       "IM",
@@ -173,6 +177,7 @@ if (getRversion() >= "2.15.1")
       "validKPs",
       "validSexes",
       "value",
+      "value_numeric",
       "value.datapack",
       "value.sitetool",
       "valueRounded.datapack",