The following documents Utah’s monthly submission of summer meal site information to USDA Food and Nutrition Service (FNS). The purpose is to make publicly available summer meals locations for families through USDA’s online interactive map, the Summer Meals for Kids Site Finder.
Federal law requires state agencies, by June 30 of each year to submit open site locations and operational details and to provide at least two updates during the summer operational period (7 C.F.R. § 225.8(e)). In Utah, This report is submitted monthly during summer months to ensure accuracy of site hours, dates, or locations.
This monthly FNS-905 submission includes site-level details such as operating dates, meal service times, and location information, along with any additions, closures, or schedule changes reported since the prior submission.
rm(list = ls(all.names = T)) #clear all objects from environment.
options(max.print=100) # Limit output.
start.time <- Sys.time() # Log start time.
options(scipen=999) # Prohibit use of scientific notation
gc() # Free up memory and report the memory usage.
curr_date <- as.numeric(format(Sys.Date(), "%Y%m%d")) # Format date as numeric
# date <- as.Date(date) # Use this code if date format is to be kept
library(lubridate)
library(janitor)
library(tidyverse)
library(openxlsx)
library(readr)
library(readxl)# Open containing folder
list <- file.info(list.files(
"P:/1_Internal/Reports/Summer/USDA 543a_FNS 905/2022_post COVID waivers",
full.names = T))
View(list)
# Specify most recent submission
filename <- rownames(list)[which.max(list$ctime)]
# Import, clean names, remove extraneous columns
previous_submission <- read_excel(filename) %>%
clean_names %>%
select(-c(so_o:map_y)) %>%
mutate(submission = "previous")
# Import both sheets of the Geocode Master List, clean names,
# rename longitude and lattitude to match FNS-905 Template, remove columns.
sso <- read_excel(
"P:/1_Internal/Reports/Summer/USDA 543a_FNS 905/Geocode Master List_CURRENT.xlsx",
sheet = 1) %>%
clean_names %>%
rename(soo_x = latitude, soo_y = longitude,
state_site_id_number = site_number) %>% # Rename unique ID in order to merge()
select(state_site_id_number, soo_x, soo_y)
sfsp <- read_excel(
"P:/1_Internal/Reports/Summer/USDA 543a_FNS 905/Geocode Master List_CURRENT.xlsx",
sheet = 2) %>%
clean_names %>%
rename(soo_x = latitude, soo_y = longitude,
state_site_id_number = site_number) %>% # Rename unique ID in order to merge()
select(state_site_id_number, soo_x, soo_y)
# Import Data1026 & Data1027, specify latin encoding,
# clean names, merge longitude and lattitude coordinates
data1026_sfsp <- read_csv(
"H:/Downloads/Data1026 (71).csv", locale = locale(encoding = "Latin1")) %>%
clean_names %>%
select(site_name:state_sponsor_id_number, last_modified_date) %>%
merge(sfsp, by = "state_site_id_number", all.x = T) %>%
relocate(state_site_id_number, .before = state_sponsor_id_number)
data1027_sso <- read_csv(
"H:/Downloads/Data1027 - 2022-07-26T040945.637.csv", locale = locale(encoding = "Latin1")) %>%
clean_names %>%
select(site_name:state_sponsor_id_number, last_modified_date) %>%
merge(sso, by = "state_site_id_number", all.x = T) %>%
relocate(state_site_id_number, .before = state_sponsor_id_number)
# Note: When transitioning between school years, it may be necessary download
# both the new SY & the previous SY of Data1027 & Data1026. If the previous SY
# has sites with end dates that are in the future, check to see if those sites
# are in the current year's data. If not, both schools years should be imported.
# After importing both years, combine the data. For Example:
# data1026 <- rbind(data1026 (1), data1026 (2))
# data1027 <- rbind(data1027 (1), data1027 (2))# Format with Tidyverse
all <- all %>%
mutate(end_date_mm_dd_yy = mdy(end_date_mm_dd_yy),
start_date_mm_dd_yy = mdy(start_date_mm_dd_yy),
last_modified_date = mdy(last_modified_date))
# Dates with Base R
#all <- all %>%
# mutate(end_date_mm_dd_yy = as.Date(format(end_date_mm_dd_yy), "%m/%d/%Y"),
# start_date_mm_dd_yy = as.Date(format(start_date_mm_dd_yy), "%m/%d/%Y"),
# last_modified_date = as.Date(format(last_modified_date), "%m/%d/%Y"))# Adddress correction function
address_correct <- function(x, y, z) {
a <- which(all$state_site_id_number == x) # Get location of row with specified site number
b <- "site_name" # Get location of column site_name
c <- y # Get location of column site_address
print(all[a, b]) # Print school name for visual inspection
print(paste("Old =", all[a, c])) # Print old address for visual inspection
print(paste("New =", z)) # Print new address for visual inspection
all[a, c] <- z # Modify address
print(paste("Confirm change:", all[a, c] == z)) # Confirm change
assign("all", all, envir = globalenv()) # Save object "all" to global environment
print("")
}
# Run function
address_correct("24-304", "site_address1", "54 E 100 S") # RICH JR HIGH/NRES
address_correct("21-704", "site_address1", "53 S 100 E") # NORTH SUMMIT HIGH
address_correct("21-110", "site_address1", "240 S BEACON DR") # NORTH SUMMIT ELEMENTARY
address_correct("21-304", "site_address1", "76 S 100 E") # NORTH SUMMIT MIDDLE
address_correct("30-740", "site_address1", "211 South Tooele Blvd") # BLUE PEAK HIGH
address_correct("Q8-1", "site_address1", "24 Highway 98") # NAA TSIS' AAN COMMUNITY SCHOOL
address_correct("Q8-1", "site_city", "Tonalea") # NAA TSIS' AAN COMMUNITY SCHOOL
address_correct("Q8-1", "site_zip", 86044) # NAA TSIS' AAN COMMUNITY SCHOOL
address_correct("03-140", "site_address1", "76785 W 11900 N") # GROUSE CREEK SCHOOL
address_correct("02-104", "site_address1", "510 North 650 East") # BELKNAP ELEMENTARY
address_correct("02-704", "site_address1", "195 E CENTER") # BEAVER HIGH
address_correct("05-154", "site_address1", "250 W 200 N") # WELLINGTON ELEMENTARY
address_correct("25-108", "site_address1", "Old Main Highway 191") # BLUFF ELEMENTARYduplicate_check <- active %>%
mutate(a = duplicated(state_site_id_number, fromLast = T),
b = duplicated(state_site_id_number, fromLast = F),
ab = paste(a, b))
duplicates <- duplicate_check %>%
filter(ab != "FALSE FALSE")
active <- duplicate_check %>%
filter(ab == "FALSE FALSE") %>%
select(-c(a, b, ab))
active.r <- active# Identify missing long and lat coordinates, get coordinates
# from Google, add to Geocode Master List_CURRENT.
NAs_1 <- active %>%
select(site_program, sponsoring_organization, state_sponsor_id_number,
site_name, state_site_id_number, site_address1, site_city,
site_state, site_zip, soo_x, soo_y) %>%
filter(is.na(soo_x) | is.na(soo_y))
write.xlsx(NAs_1, "H:/Documents/NAs_1.xlsx", overwrite=T)# Identify missing values in other required fields and save to a workbook.
NAs_2 <- active %>%
filter(is.na(site_address1) | is.na(site_zip) | is.na(site_city)
| is.na(site_state) | is.na(sponsoring_organization)
| is.na(state_site_id_number) | is.na(state_sponsor_id_number))
write.xlsx(NAs_2, "H:/Documents/NAs_2.xlsx", overwrite=T)# Combine current and previous submissions and look for unique
# site numbers. Sites added are indicated by unique site numbers
# in the current submission, sites removed are indicated by unique
# site numbers in the previous submission. Filter unique site #’s
# by submission and save as separate data objects.
current_submission <- active %>%
select(-last_modified_date) %>%
mutate(submission = "current")
# Combine
added_removed <- rbind(previous_submission,current_submission)
# Identify unique values
unique <- added_removed %>%
mutate(a = duplicated(state_site_id_number, fromLast = T),
b = duplicated(state_site_id_number, fromLast = F),
ab = paste(a, b)) %>%
filter(ab == "FALSE FALSE")
added <- unique %>%
select(site_program, sponsoring_organization, site_name,
start_date_mm_dd_yy, end_date_mm_dd_yy, submission) %>%
filter(submission == "current") %>%
select(-submission)
removed <- unique %>%
select(site_program, sponsoring_organization, site_name,
start_date_mm_dd_yy, end_date_mm_dd_yy, submission) %>%
filter(submission == "previous")%>%
select(-submission)+ – = |
the # of sites in the previous submission the # of sites added the # of sites removed the # of sites in the current submission |
# Make sure the number of sites corresponds with the number of sites added and removed
data.frame(c(
paste(" ", nrow(previous_submission), "Previous"),
paste("+", nrow(added), "Added"),
paste("-", nrow(removed), "Removed"),
paste("=", (nrow(previous_submission) + nrow(added) - nrow(removed))),
paste(nrow(current_submission), "Current"))) %>%
View()# Add spaces to site numbers to prevent data from being converted
# to dates in Excel. Reformat column headers for viewing.
all <- all %>%
mutate(state_site_id_number = paste0(" ", state_site_id_number, " ")) %>%
select(-last_modified_date)
active <- active %>%
mutate(state_site_id_number = paste0(" ", state_site_id_number, " ")) %>%
select(-last_modified_date)
# Column Names for Added / Removed Sheets
colnames(added) <- stringr::str_to_title(gsub("_", " ",colnames(added)))
colnames(removed) <- stringr::str_to_title(gsub("_", " ",colnames(removed)))
# Get the number of rows of each data frame and save it as a vector.
nrow_all<-as.vector(nrow(all))
nrow_active<-as.vector(nrow(active))
nrow_added<-as.vector(nrow(added))
nrow_removed<-as.vector(nrow(removed))# Write Data to Worksheets
writeData(wb, sheet = paste0("Active Sites (",nrow_active,")"), x = active)
writeData(wb, sheet = paste0("All Sites (",nrow_all,")"), x = all)
writeData(wb, sheet = paste0("Added (",nrow_added,")"), x = added)
writeData(wb, sheet = paste0("Removed (",nrow_removed,")"), x = removed)active <- active.r
# Subset data
modifications <- active %>%
filter(last_modified_date >= Sys.Date()-7) %>%
mutate(state_site_id_number = paste0(" ", state_site_id_number, " "))
View(modifications)
# Save to P Drive
write.csv(modifications, paste0(
"P:/1_Internal/Contracts, MOUs, State Agreements, Purchase Requests (non-conference)/DOH SFSP Health Inspections/2022/FNS 905 Operational Changes ", curr_date, ".csv"),row.names=F, na="")