R/hfr_rectify_date.R

In USAID-OHA-SI/Wavelength: Wavelength

#' Rectify Incorrectly Submitted Dates
#'
#' Without access to change data directly in the database, the only means of
#' changing data is to resubmit a zeroed out version of the original submission.
#' This function replaces any cell with entered data with zero so that it can
#' be resubmitted and processed by Trifacta. The original, correct version should
#' be re-processed after the zeroed dataset has been processes
#'
#' @param subm_file submission file with incorrect dates
#' @param subm_tab tab with incorrect dates
#' @param folderpath_templates folder path where current HFR templates are located
#'
#' @return exports two files - one with zeroed out data for wrong date and one
#'  with corrected date
#' @export
#'
#' @examples
#' \dontrun{
#' #store file paths for looping over to read in
#'   df_files_tabs <- list.files(folderpath, full.names = TRUE) %>%
#'     purrr::map_dfr(~ tibble::tibble(file = .x,
#'                                     tabs = readxl::excel_sheets(.x))) %>%
#'     dplyr::filter(stringr::str_detect(tabs, "HFR"))
#' #fix date and create zeroed version for wrong date (to clean from DB)
#'  pwalk(df_files_tabs, ~hfr_rectify_date(..1, ..2)) }

hfr_rectify_date <- function(subm_file, subm_tab, folderpath_templates = "templates/"){

  package_check("janitor")
  package_check("openxlsx")

  #print status
  usethis::ui_line("reading in {usethis::ui_field(subm_tab)} from {usethis::ui_path(basename(subm_file))}")

  #read in data from submission
  df <- readxl::read_excel(subm_file, subm_tab, skip = 1, col_types = "text")

  #restrict columns
  df <- hfr_restrict_cols(df)

  #clean up date from import
  df <- df %>%
    dplyr::mutate(date = date %>%
                    as.double() %>%
                    janitor::excel_numeric_to_date() %>%
                    as.character())

  #convert values to numeric
  df <- dplyr::mutate(df, dplyr::across(dplyr::matches("^(hts|tx|vmmc|prep)"), as.numeric))

  #identify the correct date for date issues
  meta_pd <-  hfr_extract_meta(subm_file, "period")
  act_date <- meta_pd %>% stringr::str_remove("FY") %>% lubridate::ym()
  act_date <- ifelse(lubridate::month(act_date) > 9, act_date - lubridate::years(1), act_date) %>% lubridate::as_date() %>% as.character()

  #check if there are any wrong dates
  df_wrong_date <- dplyr::filter(df, date != act_date)

  if(nrow(df_wrong_date) > 0){
    #print status
    usethis::ui_info("resolving date issue")
    #update date to correct one
    df_fixed_date <- dplyr::mutate(df_wrong_date, date = act_date)

    #zero out values for wrong dates (to clear out data base)
    df_zero_out_date <- df_wrong_date %>%
      dplyr::mutate(dplyr::across(dplyr::matches("^(hts|tx|vmmc|prep|val)"), ~ifelse(is.na(.), NA, 0)))

    #table of all the unaffected data
    df_okay_date <- dplyr::filter(df, date == act_date)

    #join back together
    df <- dplyr::bind_rows(df_fixed_date, df_okay_date)
  }


  #load workbook object
  wb_type <- hfr_extract_meta(subm_file, "type") %>% stringr::str_replace(" - Limited", "_LIMITED")

  wb_template <- file.path(folderpath_templates, glue::glue("HFR_Submission_Template_{wb_type}.xlsx"))
  wb <- openxlsx::loadWorkbook(wb_template)

  #unprotect sheet to overwrite data
  openxlsx::protectWorksheet(wb, sheet = "meta", protect = FALSE)
  openxlsx::protectWorksheet(wb, sheet = "HFR", protect = FALSE)

  #pull header info
  sht_hdrs <- openxlsx::read.xlsx(wb, subm_tab, colNames = FALSE, rows = 1)

  #write meta data
  meta_ou <- hfr_extract_meta(subm_file, "ou")
  openxlsx::writeData(wb, "meta",  meta_ou, xy = c("C", 2), colNames = FALSE)
  openxlsx::writeData(wb, "meta",  meta_pd, xy = c("C", 3), colNames = FALSE)

  #write data to tab
  openxlsx:: writeData(wb, "HFR", df, startRow = 3, colNames = FALSE)

  #new name for saving, removing user/subm date (outputing as single tab)
  n_file <- glue::glue('{stringr::str_remove(subm_file, " -.*")}adj-date-tab-{subm_tab}.xlsx')

  usethis::ui_info("saving as {usethis::ui_path(basename(n_file))}")

  #export tab
  openxlsx::saveWorkbook(wb, n_file, overwrite = TRUE)

  #output zero date data
  if(nrow(df_wrong_date) > 0){
    wb_zero <- openxlsx::loadWorkbook(wb_template)
    pd_wrong <- glue::glue("FY{lubridate::quarter(df_zero_out_date$date[1], fiscal_start = 10, with_year = TRUE) %>% stringr::str_sub(3, 4)
} { lubridate::month(df_zero_out_date$date[1], TRUE)}")
    openxlsx::writeData(wb_zero, "meta",  meta_ou, xy = c("C", 2), colNames = FALSE)
    openxlsx::writeData(wb_zero, "meta",  pd_wrong, xy = c("C", 3), colNames = FALSE)
    openxlsx::writeData(wb_zero, "HFR", df_zero_out_date, startRow = 3, colNames = FALSE)
    n_file <- glue::glue('{stringr::str_remove(subm_file, " -.*")}adj-zero.xlsx')
    usethis::ui_info("saving as {usethis::ui_path(basename(n_file))}")
    openxlsx::saveWorkbook(wb_zero, n_file, overwrite = TRUE)
  }

}