You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
132 lines
4.4 KiB
132 lines
4.4 KiB
#' 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")
|
|
#'
|
|
#' all_ili <- suppressWarnings(
|
|
#' suppressMessages(purrr::map_df(c("national", "hhs", "census", "state"), ilinet)))
|
|
#' }
|
|
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)
|
|
|
|
}
|