Wavelength: Wavelength

## PROJECT:  HFR
## AUTHOR:   A.CHAFETZ | USAID
## PURPOSE:  validation for FY23 reporting sites
## LICENSE:  MIT
## DATE:     2023-10-05
## UPDATED:  2023-10-13


# DEPENDENCIES ------------------------------------------------------------

library(tidyverse)
library(vroom)
library(glamr)
library(Wavelength)
library(openxlsx)
library(gophr)
library(grabr)
library(glue)
library(googledrive)
library(lubridate)


# GLOBAL VARIABLES --------------------------------------------------------

  load_secrets()

  #fiscal year
    fy_new <- 2023

  #indicators
    ind_sel <- c("HTS_TST", "TX_NEW", "TX_CURR", "PrEP_NEW", "VMMC_CIRC")

  #output folder
    fldr_out <- "out/siteval"
    dir.create(fldr_out, showWarnings = FALSE)

  #GDrive upload folder (FY23)
    gdrive_fldr <- as_id("1lwAGRqnzsOmBR4gKEthkmUEObgSIc8xf")

  #GDrive submissions folder
    gdrive_sbmsn <- as_id("1TlE2dLSAY5fCQtgwkGc8luyPl5g85wPmuawCykTNzLQhpKfs7_KHZKZBYbH5oaF9cRVq1jCu")

# IMPORT ------------------------------------------------------------------

  #import org hierarchy
    df_orgs <- si_path("path_datim") %>%
      return_latest("org") %>%
      vroom()

  #import site MER data
    df_datim <- si_path("path_datim") %>%
      return_latest("FY2.Q._GLOBAL_DATIM") %>%
      vroom(col_types = c(.default = "c", fy = "i", mer_results = "d", mer_targets = "d"))

  #import target data
    df_msd <- si_path() %>%
      return_latest("OU_IM") %>%
      read_msd()

  #import reporting level (community/facility)
    df_lvls <- get_outable(datim_user(), datim_pwd())


# MECH STATUS REFERENCE TABLE ---------------------------------------------

  #limit MSD to USAID partners for upcoming year (back table for reference)
    df_status <- df_msd %>%
      filter(fiscal_year >= fy_new - 1,
             funding_agency == "USAID",
             indicator %in% ind_sel,
             standardizeddisaggregate == "Total Numerator") %>%
      # rename_official() %>%
      mutate(operatingunit = ifelse(operatingunit!=country, glue("{operatingunit}/{country}"), operatingunit)) %>%
      distinct(operatingunit, fiscal_year, mech_code, mech_name, prime_partner_name, indicator) %>%
      mutate(x = "X",
             indicator = factor(indicator, ind_sel)) %>%
      group_by(mech_code) %>%
      mutate(status = ifelse(max(fiscal_year) == fy_new, "current", "ending")) %>%
      ungroup() %>%
      arrange(fiscal_year, indicator)

  #reshape reference table to wide
    df_ref <- df_status %>%
      pivot_wider(names_from = c(fiscal_year, indicator), #names_prefix = "FY22\n",
                  names_glue = "FY{fiscal_year-2000}\n{indicator}",
                  values_from = x) %>%
      arrange(operatingunit, mech_code)

  #combine mech info
    df_ref <- df_ref %>%
      mutate(mech_code = ifelse(status == "ending", glue("(!) {mech_code}"), mech_code),
             mech_partner = glue("{mech_code}: {mech_name} [{prime_partner_name}]"),
             mech_partner = ifelse(mech_partner == "NA: NA [NA]", NA_character_, mech_partner),
             .after = operatingunit) %>%
      select(-c(mech_code, mech_name, prime_partner_name))

# SITE REPORTING TABLE ----------------------------------------------------

  #agg to orgunit x mech x ind level
    df_datim_agg <- df_datim %>%
      rename_official() %>%
      filter(fy == fy_new - 1,
             indicator %in% ind_sel,
             mer_results > 0) %>%
      group_by(orgunituid, mech_code, mech_name, prime_partner_name, indicator) %>%
      summarise(mer_results = sum(mer_results, na.rm = TRUE)) %>%
      ungroup()

  #identify mech x ind reporting in new FY
    df_status <- df_status %>%
      filter(fiscal_year == max(fiscal_year)) %>%
      distinct(mech_code, indicator) %>%
      mutate(x = "KEEP")

  #apply mech x ind status to site reporting, flagging which needs to be droped
    df_datim_agg <- df_datim_agg %>%
      left_join(df_status, by = c("mech_code", "indicator")) %>%
      mutate(x = ifelse(is.na(x), "DROP", x))

  #spread to have one obs by mech x orgunit
    df_datim_wide <- df_datim_agg %>%
      select(-starts_with("mer")) %>%
      mutate(indicator = factor(indicator, ind_sel)) %>%
      arrange(indicator) %>%
      pivot_wider(names_from = indicator, values_from = x)

  #table of reporting level for inner join (to drop higher hierarchy)
    df_lvls <- df_lvls %>%
      select(country, community_lvl, facility_lvl) %>%
      pivot_longer(-country, names_to = "type", values_to = "level") %>%
      mutate(type = str_remove(type, "_lvl"))

  #limit org hierarchy to just comm/fac
    df_orgs_cf <- df_orgs %>%
      rename_with(~str_remove(., "name")) %>% #rename countryname to country
      inner_join(df_lvls) %>%
      relocate(type, .after = level) %>%
      select(-c(level, latitude, longitude))

  #join USAID MER reporting/targets onto full org hierarchy
    df_full <- df_orgs_cf %>%
      left_join(df_datim_wide)

  #sort so orgunits with reporting are on top
    df_full <- df_full %>%
      arrange(operatingunit, country, desc(!is.na(mech_code)), orgunituid)

  #combine OU and country name & remove excess cols
    df_full <- df_full %>%
      mutate(operatingunit = ifelse(operatingunit!=country, glue("{operatingunit}/{country}"), operatingunit)) %>%
      select(-c(country, psnuuid, community, facility))

  #combine mech info
    df_full <- df_full %>%
      left_join(df_ref %>%
                  select(mech_partner, status) %>%
                  mutate(mech_code = str_extract(mech_partner, "[:digit:]+(?=:)")),
                by = "mech_code") %>%
      relocate(mech_partner, .before = mech_code) %>%
      select(-c(mech_code, mech_name, prime_partner_name))

  #change validation for ending mechanisms
    df_full <- df_full %>%
      mutate(#across(c(HTS_TST:VMMC_CIRC), ~ ifelse(status == "ending" & . == "KEEP", "DROP", .)),
             start = glue("FY{fy_new - 2000} Oct"),
             end = glue("FY{fy_new - 2000} Sep")) %>%
      select(-status)


# DATA VALIDATION ---------------------------------------------------------

  #add reporting validation options
    df_validation_type <- tibble(type = c("KEEP", "DROP", "ADD"))

  #add period validation options
    df_validation_pd <- seq.Date(glue("{fy_new-1}-10-01") %>% as.Date,
                            by = "month", length.out = 12) %>%
      format("%b") %>%
      paste0("FY",fy_new-2000," ", .) %>%
      tibble(period = .)

# INSTRUCTIONS ------------------------------------------------------------

  #create instructions tab
    df_inst <- c("Instructions\n",
                 "Because site-level targets have not been set since COP20, the High Frequency Working Group (HFRG) does not have a list of valid sites that should be reporting HFR data starting in FY23. Without a valid site list, we cannot assess the representativeness or completess of data reported. The HFR team is requesting your assistanced in validating the sites in which implementing parters will be working in FY23. Please return this workbook to the HFRG by November 4, 2022.\n",
                 "The HFRG designed this workbook to help validate FY23 sites. The main tab, Site List, is the tab you will use to validate the orgunits reporting in FY23. The far left column (orgunit) lists all the orgnization units that reported results in FY22, through Q3. Column C (type) lists the type of organization unit (facility or community) and may be used for additional filtering. Facility or community sites thare are listed in bold indicate the active sites for FY23. Active sites are defined as those with a mechanism continuing into FY23 (i.e. a mechanism has FY23 targets) and reporting on one of the HFR indicators.\n",
                 "The mechanism/partner info in Column G (mech_partner) provides the mechanism information for the USAID partners working in a facility or community in FY22. The full facility/community list is included, but only USAID partners working at a site are listed and sorted to the top. If a mechanism is terminating in FY22 (i.e. the mechanism has no FY23 targets), the mechanism information in this column starts with \"(!)\" and colored in brown. If a partner is replacing another partner at an organization unit, use the drop down to choose the new partner from the list. This action can be performed by selecting the cell in column G and then hitting the down arrow that appears to the right of the cell.\n",
                 "The columns to the far right - HTS_TST-VMMC_CIRC (columns H - L) capture whether there were any MER results reported in FY22 (through Q3). If the mechanism is continuing into FY23, the cells will show \"KEEP\" indicating the mechanism will continue to work in these areas. For mechanisms that are ending, their cells will read \"DROP\". If a new USAID mechanism will pick up the work in the facility/community in FY23, you will need to identify the new mechanism (via the dropdown list provided) and change the indicator drop downs to \"ADD\" in the respective columns (H-L).\n",
                 "If a mechanism will be working in a new facility/community that USAID was not in before, please use Column A (orgunit) to identify the site. Once the site is identified, select the partner from the drop down in Column G and then note which indicators (Columns H-L) will be reported by selecting \"ADD\" to those indicator columns.\n",
                 "If an additional partner will be working in a facility/community already listed, you can insert a new row (right click on a cell > Insert > Table Rows Above) and then copy the facility/community information from Columns A - F. You will need to select the partner from the drop down in Column G and then note which indicators (Columns H-L) will be reported by selecting \"ADD\" to those indicator columns.\n",
                 "To help track the start and stop date of a mechanism, we added two new columns (M and N) to the worksheet last year. These columns will track the start and end period of a mechanism at a given site. The default is to start in FY23 Oct and end in FY23 Sept. If you have a mid-year shift, you should adjust the end month to reflect the end of the mechanism working there. If a new partner is starting up, insert a new line (as explained above) and indicate the new partner, period, and indicators.\n",
                 "The last tab in the workbook, Mech Ref List, provides a summary list of the mechanisms active in FY22 and FY23. If a mechanism has no MER targets (for HFR indicators) in FY23, the status in Column C (status) will say \"ending\". This tab is strictly for reference and does not require any updating or editing. However, if you need to add a mechanism that is not in the list (making it available in the dropdowns in the Site List tab), add it to a new line. For mech partner, follow the naming convention of of \"mech_code: mech_name [prime_partner_name]\"\n",
                 "If you have any questions, please reach out to HFRG, oha_hfr@usaid.gov. Site validations are due by November 4, 2022 and should be submitted through the Google form linked here - https://tinyurl.com/hfr-sitevalidation. WE WILL BE UNABLE TO PROCESS ANY OF YOUR FY23 HFR SUBMISSIONS IF WE DO NOT RECEIVE THIS LIST FROM YOU.")  %>%
      as_tibble() %>%
      rename(`FY23 HFR SITE VALIDATION` = value)


# WORKBOOK TEMPLATE SETUP FUNCTION ----------------------------------------

  setup_wkbk <- function(ou){

    #filter dataframes to select OU
      df_full_ou <- filter(df_full, operatingunit == ou)
      df_ref_ou <- filter(df_ref, operatingunit == ou)

    #create workbook
      wb <- createWorkbook()

    #update font
      modifyBaseFont(wb, fontName = "Calibri Light")

    #add instructions tab
      addWorksheet(wb = wb, sheetName = "Instructions", gridLines = FALSE)
      writeData(wb, sheet = "Instructions", df_inst, startCol = 2)

    #format text
      nrow_inst <- nrow(df_inst) + 1
      setColWidths(wb, sheet = "Instructions", cols = 1, widths = 1.5)
      setColWidths(wb, sheet = "Instructions", cols = 2, widths = 110)
      style_inst_hdr <- createStyle(fontName = "Calibri", fontSize = 16, textDecoration = "bold")
      addStyle(wb, sheet = "Instructions", style = style_inst_hdr, rows = 1, cols = 2)
      style_inst <- createStyle(wrapText = TRUE, valign = "top")
      addStyle(wb, sheet = "Instructions", style = style_inst, rows = 2:nrow_inst, cols = 2)

    #add Site list worksheet as a table
      addWorksheet(wb = wb, sheetName = "Site List", gridLines = FALSE, zoom = 90)
      writeDataTable(wb, sheet = "Site List", df_full_ou, tableStyle = "TableStyleLight8", withFilter = TRUE)

    #add a copy of the original pre editing
      addWorksheet(wb = wb, sheetName = "Orig Site List", visible = FALSE)
      writeData(wb, sheet = "Orig Site List", df_full_ou, withFilter = TRUE)
      sheetVisibility(wb)[3] <- "veryHidden" # hide sheet from UI

    #freeze top row
      freezePane(wb, sheet = "Site List", firstRow = TRUE, firstCol = TRUE)

    #add ind reporting validations
      col_start <- which(colnames(df_full_ou)=="HTS_TST")
      col_end <- which(colnames(df_full_ou)=="VMMC_CIRC")
      nrow <- nrow(df_full_ou) + 1
      addWorksheet(wb, sheetName = "rs", visible = FALSE)
      writeData(wb, sheet = "rs", df_validation_type)
      nrow_valid <- nrow(df_validation_type)+1
      createNamedRegion(wb, sheet = "rs", name = "type", cols = 1, rows = 2:nrow_valid)
      suppressWarnings(
        dataValidation(wb, sheet = "Site List",
                       cols = col_start:col_end,
                       rows = 2:nrow,
                       type = "list",
                       value= "type")
      )

    #add period validations
      col_start_pd <- which(colnames(df_full_ou)=="start")
      col_end_pd <- which(colnames(df_full_ou)=="end")
      nrow <- nrow(df_full_ou) + 1
      writeData(wb, sheet = "rs", df_validation_pd, startCol = 2)
      nrow_valid <- nrow(df_validation_pd)+1
      createNamedRegion(wb, sheet = "rs", name = "period", cols = 2, rows = 2:nrow_valid)
      suppressWarnings(
        dataValidation(wb, sheet = "Site List",
                       cols = col_start_pd:col_end_pd,
                       rows = 2:nrow,
                       type = "list",
                       value= "period")
      )

    #increase column sizes
      setColWidths(wb, sheet = "Site List", cols = which(colnames(df_full_ou)=="orgunit"), widths = 42.14)
      setColWidths(wb, sheet = "Site List", cols = which(colnames(df_full_ou)=="orgunituid"), widths = 15.57)
      setColWidths(wb, sheet = "Site List", cols = which(colnames(df_full_ou)=="mech_partner"), widths = 75)

    #header styles
      style_hdr <- createStyle(fontName = "Calibri", textDecoration = "bold")
      addStyle(wb, sheet = "Site List", style = style_hdr, rows = 1, cols = 1:length(df_full_ou))
      style_hdr2 <- createStyle(fontName = "Calibri", textDecoration = "bold", halign = "center")
      addStyle(wb, sheet = "Site List", style = style_hdr, rows = 1, cols = col_start:col_end)

    #style ind valdiation
      style_vld <- createStyle(fontName = "Calibri", halign = "center", textDecoration = "bold")
      addStyle(wb, sheet = "Site List", style = style_vld, rows = 2:nrow, cols = col_start:col_end, gridExpand = TRUE)

    #add the reference table
      addWorksheet(wb, sheetName = "Mech Ref List")
      writeData(wb, sheet = "Mech Ref List", df_ref_ou)

    #adjust 1st row height
      setRowHeights(wb, sheet = "Mech Ref List", rows = 1, heights = 40)

    #header styles
      ref_style_hdr <- createStyle(fontName = "Calibri", textDecoration = "bold", wrapText = TRUE)
      addStyle(wb, sheet = "Mech Ref List", style = ref_style_hdr, rows = 1, cols = 1:length(df_ref_ou))

    #style ind
      ref_col_start <- which(colnames(df_ref_ou)=="FY22\nHTS_TST")
      ref_col_end <- which(colnames(df_ref_ou)=="FY23\nVMMC_CIRC")
      ref_nrow <- nrow(df_ref_ou) + 1
      ref_style_hdr_ind <- createStyle(fontName = "Calibri", textDecoration = "bold", halign = "center", wrapText = TRUE)
      ref_style_ind <- createStyle(halign = "center")
      addStyle(wb, sheet = "Mech Ref List", style = ref_style_hdr_ind, rows = 1, cols = ref_col_start:ref_col_end)
      addStyle(wb, sheet = "Mech Ref List", style = ref_style_ind, rows = 2:ref_nrow, cols = ref_col_start:ref_col_end, gridExpand = TRUE)

    #increase column sizes
      setColWidths(wb, sheet = "Mech Ref List", cols = which(colnames(df_ref_ou)=="operatingunit"), widths = 17)
      setColWidths(wb, sheet = "Mech Ref List", cols = which(colnames(df_ref_ou)=="mech_partner"), widths = 75)

    #add mech_partner dropdown (adding extra rows to partner to add custom)
      nrow_mech <- nrow(df_ref_ou)+1+20
      createNamedRegion(wb, sheet = "Mech Ref List", name = "mechlist",
                        cols =  which(colnames(df_ref_ou)=="mech_partner"),
                        rows = 2:nrow_mech)
      suppressWarnings(
        dataValidation(wb, sheet = "Site List",
                       cols = which(colnames(df_full_ou)=="mech_partner"),
                       rows = 2:nrow,
                       type = "list",
                       value= "mechlist")
      )

    #set column width for other drop downs columns (resized to be width of mech drop down)
      # setColWidths(wb, sheet = "Site List", cols = col_start:col_end, widths = 13.71) #indicators
      setColWidths(wb, sheet = "Site List", cols = col_start:col_end, widths = 11.75) #indicators
      setColWidths(wb, sheet = "Site List", cols = col_start_pd:col_end_pd, widths = 8.43) #periods

    #flag ending mechanisms conditional formatting
      style_oldmech <- createStyle(fontColour = "#a6611a")
      conditionalFormatting(wb, sheet = "Site List",
                            cols = which(colnames(df_full_ou)=="mech_partner"),
                            rows = 2:nrow,
                            rule = "(!)",
                            type = "contains",
                            style = style_oldmech
                            )

    #highlight ind choices
      style_type_keep <- createStyle(fontColour = "#FFFFFF", bgFill = "#8C8985", border = c("left", "right"), borderColour = "#FFFFFF")
      conditionalFormatting(wb, sheet = "Site List",
                            cols = col_start:col_end,
                            rows = 2:nrow,
                            rule = "KEEP",
                            type = "contains",
                            style = style_type_keep)

      style_type_drop <- createStyle(fontColour = "#FFFFFF", bgFill = "#a6611a", border = c("left", "right"), borderColour = "#FFFFFF")
      conditionalFormatting(wb, sheet = "Site List",
                            cols = col_start:col_end,
                            rows = 2:nrow,
                            rule = "DROP",
                            type = "contains",
                            style = style_type_drop)

      style_type_add <- createStyle(fontColour = "#FFFFFF", bgFill = "#5ab4ac", border = c("left", "right"), borderColour = "#FFFFFF")
      conditionalFormatting(wb, sheet = "Site List",
                            cols = col_start:col_end,
                            rows = 2:nrow,
                            rule = "ADD",
                            type = "contains",
                            style = style_type_add)

    #bold if active site
      style_active <- createStyle(fontName = "Calibri", textDecoration = "bold")
      conditionalFormatting(wb, sheet = "Site List",
                            cols = 1,
                            rows = 2:nrow,
                            rule = '=AND(LEN($G2)>0,NOT(ISNUMBER(SEARCH("(!)", $G2))))',
                            type = "expression",
                            style = style_active)

    #clean up name for saving
      ou_clean <- ou %>%
        str_replace("West Africa Region", "WAR") %>%
        str_replace("Western Hemisphere Region", "WHR") %>%
        str_replace("Democratic Republic of the Congo", "DRC") %>%
        str_replace("Papua New Guinea", "PNG") %>%
        str_replace("/", "-") %>%
        str_remove_all(" |'")

    #save
      saveWorkbook(wb, file.path(fldr_out, glue("HFR_FY23_SiteValidation_{ou_clean}.xlsx")), overwrite = TRUE)

  }


# EXPORT ------------------------------------------------------------------

    #export
    cntrys_w_hist_data <- df_full %>%
      filter(!is.na(mech_partner)) %>%
      distinct(operatingunit) %>%
      pull()

    walk(cntrys_w_hist_data,setup_wkbk)


# UPLOAD TO GDRIVE --------------------------------------------------------

    #grab files to upload
    ouputs <- list.files(fldr_out, full.names = TRUE)

    walk(ouputs,
         ~ drive_upload(.x,
                        path = gdrive_fldr,
                        name = basename(.x)))


# UPLOAD TO SUBMISSION FOLDER FOR FALL BACK -------------------------------

    #upload to prep folder to generate ls table off of
    gdrive_fldr_prep <- drive_mkdir("Prep Work", gdrive_sbmsn)

    walk(ouputs,
         ~ drive_upload(.x,
                        path = gdrive_fldr_prep,
                        name = .x %>%
                          basename() %>%
                          str_replace(".xlsx", " - Aaron Chafetz.xlsx")))

    #get list of files
    df_files <- drive_ls(gdrive_fldr_prep)

    #clean up table to match submission spreadsheet
    df_files_clean <- df_files %>%
      mutate(timestamp = map_chr(drive_resource, "modifiedTime") %>%
               ymd_hms(tz = "EST", quiet = TRUE),
             timestamp = timestamp - days(7),
             email_address = getOption("email"),
             country = name %>%
               str_extract("(?<=SiteValidation_).*(?= -)") %>%
               str_replace("WAR", "West Africa Region") %>%
               str_replace("WHR", "Western Hemisphere Region") %>%
               str_replace("DRC", "Democratic Republic of the Congo") %>%
               str_replace("PNG", "Papua New Guinea") %>%
               str_replace("CotedIvoire", "Cote d'Ivoire") %>%
               str_replace_all("([:lower:])([:upper:])", "\\1 \\2") %>%
               str_replace("-", "/"),
             addtl = NA,
             link = glue("https://drive.google.com/open?id={id}"),
             prefill_template = TRUE,
             period = "FY23Q1") %>%
      select(timestamp, email_address, country, addtl, link, prefill_template, period) %>%
      arrange(timestamp)

    #copy table to place in spreadsheet
    #https://docs.google.com/spreadsheets/d/1aW37FmWOc3TWQqUjoWagcZ53bj9cbaW2W8NFVIUlua4/edit?usp=sharing
    df_files_clean %>%
      clipr::write_clip()

    #move files to submission folder
    walk(df_files$id,
         ~drive_mv(as_id(.x), path = gdrive_sbmsn))

    #remove temp prep folder
    drive_rm(gdrive_fldr_prep)