#' Retrieve ILINet Surveillance Data #' #' The CDC FluView Portal provides in-season and past seasons' national, regional, #' and state-level outpatient illness and viral surveillance data from both #' ILINet (Influenza-like Illness Surveillance Network) and WHO/NREVSS #' (National Respiratory and Enteric Virus Surveillance System). #' #' This function retrieves current and historical ILINet surveillance data for #' the identified region. #' #' @md #' @param region one of "`national`", "`hhs`", "`census`", or "`state`" #' @param years a vector of years to retrieve data for (i.e. `2014` for CDC #' flu season 2014-2015). CDC has data for this API going back to 1997. #' Default value (`NULL`) means retrieve **all** years. NOTE: if you #' happen to specify a 2-digit season value (i.e. `57` == 2017-2018) #' the function is smart enough to retrieve by season ID vs convert that #' to a year. #' @references #' - [CDC FluView Portal](https://gis.cdc.gov/grasp/fluview/fluportaldashboard.html) #' - [ILINet Portal](https://wwwn.cdc.gov/ilinet/) (Login required) #' - [WHO/NREVSS](https://www.cdc.gov/surveillance/nrevss/index.html) #' @export #' @examples #' national_ili <- ilinet("national", years = 2017) #' \dontrun{ #' hhs_ili <- ilinet("hhs") #' census_ili <- ilinet("census") #' state_ili <- ilinet("state") #' #' library(purrr) #' map_df( #' c("national", "hhs", "census", "state"), #' ~ ilinet(.x) #' ) #' } ilinet <- function(region = c("national", "hhs", "census", "state"), years = NULL) { #region="national"; years=1997:2018 region <- match.arg(tolower(region), c("national", "hhs", "census", "state")) meta <- jsonlite::fromJSON("https://gis.cdc.gov/grasp/flu2/GetPhase02InitApp?appVersion=Public") list( AppVersion = "Public", DatasourceDT = list(list(ID = 1, Name = "ILINet")), RegionTypeId = .region_map[region] ) -> params params$SubRegionsDT <- switch(region, national = { list(list(ID = 0, Name = "")) }, hhs = { lapply(1:10, function(i) list(ID = i, Name = as.character(i))) }, census = { lapply(1:9, function(i) list(ID = i, Name = as.character(i))) }, state = { lapply(1:59, function(i) list(ID = i, Name = as.character(i))) } ) available_seasons <- sort(meta$seasons$seasonid) if (is.null(years)) { # ALL YEARS years <- available_seasons } else { # specified years or seasons or a mix years <- as.numeric(years) years <- ifelse(years > 1996, years - 1960, years) years <- sort(unique(years)) years <- years[years %in% available_seasons] if (length(years) == 0) { years <- rev(sort(meta$seasons$seasonid))[1] curr_season_descr <- meta$seasons[meta$seasons$seasonid == years, "description"] message(sprintf( "No valid years specified, defaulting to this flu season => ID: %s [%s]", years, curr_season_descr )) } } params$SeasonsDT <- lapply(years, function(i) list(ID = i, Name = as.character(i))) tf <- tempfile(fileext = ".zip") td <- tempdir() on.exit(unlink(tf), TRUE) httr::POST( url = "https://gis.cdc.gov/grasp/flu2/PostPhase02DataDownload", httr::user_agent(.cdcfluview_ua), httr::add_headers( Origin = "https://gis.cdc.gov", Accept = "application/json, text/plain, */*", Referer = "https://gis.cdc.gov/grasp/fluview/fluportaldashboard.html" ), encode = "json", body = params, # httr::verbose(), httr::write_disk(tf) ) -> res httr::stop_for_status(res) nm <- unzip(tf, overwrite = TRUE, exdir = td) xdf <- read.csv(nm, skip = 1, stringsAsFactors = FALSE) xdf <- .mcga(xdf) xdf$weighted_ili <- to_num(xdf$weighted_ili) xdf$unweighted_ili <- to_num(xdf$unweighted_ili) xdf$age_0_4 <- to_num(xdf$age_0_4) xdf$age_25_49 <- to_num(xdf$age_25_49) xdf$age_25_64 <- to_num(xdf$age_25_64) xdf$age_5_24 <- to_num(xdf$age_5_24) xdf$age_50_64 <- to_num(xdf$age_50_64) xdf$age_65 <- to_num(xdf$age_65) xdf$ilitotal <- to_num(xdf$ilitotal) xdf$num_of_providers <- to_num(xdf$num_of_providers) xdf$total_patients <- to_num(xdf$total_patients) xdf$week_start <- MMWRweek::MMWRweek2Date(xdf$year, xdf$week) if (region == "national") xdf$region <- "National" if (region == "hhs") xdf$region <- factor(xdf$region, levels = sprintf("Region %s", 1:10)) class(xdf) <- c("tbl_df", "tbl", "data.frame") arrange(suppressMessages(readr::type_convert(xdf)), week_start) }