outpatient() function

tests updated

NAMESPACE

@@ -31,9 +31,10 @@ export(open_payments)
 export(open_years)
 export(opt_out)
 export(order_refer)
+export(out_years)
+export(outpatient)
 export(pct)
 export(pending)
-export(pop_years)
 export(providers)
 export(qpp_years)
 export(quality_payment)

R/globals.R

@@ -128,6 +128,8 @@ utils::globalVariables(c(
   "identifier", # <open_ids>
   "y", # <opt_out>
   "y", # <order_refer>
+  "distro", # <outpatient>
+  "y", # <outpatient>
   "y", # <pending>
   "y", # <providers>
   "apms", # <quality_eligibility>

R/hospitals.R

@@ -287,15 +287,15 @@ hospitals <- function(npi = NULL,
                       "P" ~ "Proprietary",
                       "N" ~ "Non-Profit",
                       .default = NA)) |>
-      hosp_cols()
+      cols_hosp()
 
     if (pivot) {
       results <- results |>
         dplyr::rowwise() |>
         dplyr::mutate(subtotal = sum(dplyr::c_across(subgroup_general:subgroup_other), na.rm = TRUE),
                       subgroup_none = dplyr::if_else(subtotal == 0, TRUE, FALSE),
                       subtotal = NULL) |>
-        hosp_cols2() |>
+        cols_hosp2() |>
         tidyr::pivot_longer(cols = dplyr::contains("Subgroup"),
                             names_to = "subgroup",
                             values_to = "flag") |>
@@ -312,7 +312,7 @@ hospitals <- function(npi = NULL,
 #' @param df data frame
 #' @autoglobal
 #' @noRd
-hosp_cols <- function(df) {
+cols_hosp <- function(df) {
 
   cols <- c('npi',
             'pac_org'           = 'associate_id',
@@ -358,7 +358,7 @@ hosp_cols <- function(df) {
 #' @param df data frame
 #' @autoglobal
 #' @noRd
-hosp_cols2 <- function(df) {
+cols_hosp2 <- function(df) {
 
   cols <- c('npi_org' = 'npi',
             'pac_org',

R/outpatient.R

@@ -0,0 +1,132 @@
+#' Outpatient Hospitals Enrolled in Medicare
+#'
+#' @note
+#' State/FIP values are restricted to 49 of the United States and the District
+#' of Columbia where hospitals are subjected to Medicare's Outpatient
+#' Prospective Payment System (OPPS). Maryland and US territory hospitals are
+#' excluded.
+#'
+#' @param year < *integer* > // **required** Year data was reported, in `YYYY`
+#' format. Run [out_years()] to return a vector of the years currently available.
+#' @param ccn < *integer* > 6-digit CMS Certification Number
+#' @param organization < *character* > Organization's name
+#' @param street < *character* > Street where provider is located
+#' @param city < *character* > City where provider is located
+#' @param state < *character* > State where provider is located
+#' @param fips < *character* > Provider's state FIPS code
+#' @param zip < *character* > Provider’s zip code
+#' @param ruca < *character* > Provider’s RUCA code
+#' @param apc < *character* > comprehensive ambulatory payment classification code
+#' @param tidy < *boolean* > // __default:__ `TRUE` Tidy output
+#' @param na.rm < *boolean* > // __default:__ `TRUE` Remove empty rows and columns
+#' @examplesIf interactive()
+#' outpatient(year = 2021, ccn = "110122")
+#'
+#' outpatient(year = 2021, state = "GA")
+#'
+#' @autoglobal
+#' @export
+outpatient <- function(year,
+                       ccn = NULL,
+                       organization = NULL,
+                       street = NULL,
+                       city = NULL,
+                       state = NULL,
+                       fips = NULL,
+                       zip = NULL,
+                       ruca = NULL,
+                       apc = NULL,
+                       tidy = TRUE,
+                       na.rm = TRUE) {
+
+  zip <- zip %nn% as.character(zip)
+  ccn <- ccn %nn% as.character(ccn)
+  apc <- apc %nn% as.character(apc)
+
+  args <- dplyr::tribble(
+    ~param,                      ~arg,
+    'Rndrng_Prvdr_CCN',	         ccn,
+    'Rndrng_Prvdr_Org_Name',	   organization,
+    'Rndrng_Prvdr_St',	         street,
+    'Rndrng_Prvdr_City',	       city,
+    'Rndrng_Prvdr_State_Abrvtn', state,
+    'Rndrng_Prvdr_State_FIPS',	 fips,
+    'Rndrng_Prvdr_Zip5',	       zip,
+    'Rndrng_Prvdr_RUCA',         ruca,
+    'APC_Cd',                    apc)
+
+  id <- dplyr::filter(api_years("outps"),
+                      year == {{ year }}) |>
+    dplyr::pull(distro)
+
+  url <- paste0("https://data.cms.gov/data-api/v1/dataset/",
+                id, "/data.json?", encode_param(args))
+
+  response <- httr2::request(url) |> httr2::req_perform()
+
+  if (vctrs::vec_is_empty(response$body)) {
+
+    cli_args <- dplyr::tribble(
+      ~x,               ~y,
+      'ccn',	        ccn,
+      'organization',	organization,
+      'street',	      street,
+      'city',	        city,
+      'state',	      state,
+      'fips',	        fips,
+      'zip',	        zip,
+      'ruca',         ruca,
+      'apc',          apc) |>
+      tidyr::unnest(cols = c(y))
+
+    format_cli(cli_args)
+    return(invisible(NULL))
+  }
+
+  results <- httr2::resp_body_json(response, simplifyVector = TRUE)
+
+  if (tidy) {
+    results$year <- year
+    results <- tidyup(results,
+                      int = c('year',
+                              'bene_cnt',
+                              'capc_srvcs',
+                              'outlier_srvcs'),
+                      dbl = c('avg_tot_sbmtd_chrgs',
+                              'avg_mdcr_alowd_amt',
+                              'avg_mdcr_pymt_amt',
+                              'avg_mdcr_outlier_amt'),
+                      yr = 'year') |>
+      cols_out()
+    if (na.rm) results <- narm(results)
+  }
+  return(results)
+}
+
+#' @param df data frame
+#' @autoglobal
+#' @noRd
+cols_out <- function(df) {
+
+    cols <- c('year',
+              'ccn'                 = 'rndrng_prvdr_ccn',
+              'organization'        = 'rndrng_prvdr_org_name',
+              'street'              = 'rndrng_prvdr_st',
+              'city'                = 'rndrng_prvdr_city',
+              'state'               = 'rndrng_prvdr_state_abrvtn',
+              'fips'                = 'rndrng_prvdr_state_fips',
+              'zip'                 = 'rndrng_prvdr_zip5',
+              'ruca'                = 'rndrng_prvdr_ruca',
+              # 'ruca_desc'         = 'rndrng_prvdr_ruca_desc',
+              'apc'                 = 'apc_cd',
+              'apc_desc',
+              'tot_benes'           = 'bene_cnt',
+              'comp_apc_srvcs'      = 'capc_srvcs',
+              'avg_charges'         = 'avg_tot_sbmtd_chrgs',
+              'avg_allowed'         = 'avg_mdcr_alowd_amt',
+              'avg_payment'         = 'avg_mdcr_pymt_amt',
+              'tot_outlier_srvcs'   = 'outlier_srvcs',
+              'avg_outlier_payment' = 'avg_mdcr_outlier_amt')
+
+    df |> dplyr::select(dplyr::any_of(cols))
+}

R/utils.R

@@ -413,6 +413,8 @@ api_years <- function(fn) {
                            "geo" ~ "Medicare Physician & Other Practitioners - by Geography and Service",
                            "srv" ~ "Medicare Physician & Other Practitioners - by Provider and Service",
                            "prv" ~ "Medicare Physician & Other Practitioners - by Provider",
+                           "outps" ~ "Medicare Outpatient Hospitals - by Provider and Service",
+                           "outgs" ~ "Medicare Outpatient Hospitals - by Geography and Service",
                            "scc" ~ "Specific Chronic Conditions",
                            "mcc" ~ "Multiple Chronic Conditions",
                            "qpp" ~ "Quality Payment Program Experience",

R/years.R

@@ -19,6 +19,9 @@
 #' # `quality_payment()`
 #' qpp_years()
 #'
+#' # `outpatient()`
+#' out_years
+#'
 #' @name years
 #' @keywords internal
 NULL
@@ -27,22 +30,22 @@ NULL
 #' @autoglobal
 #' @export
 #' @keywords internal
-pop_years <- function() {
-  as.integer(cms_update("Medicare Physician & Other Practitioners - by Geography and Service", "years"))
-}
+open_years <- function() sort(open_ids("General Payment Data")$year)
 
 #' @rdname years
 #' @autoglobal
 #' @export
 #' @keywords internal
-open_years <- function() sort(open_ids("General Payment Data")$year)
+out_years <- function() {
+  as.integer(cms_update("Medicare Outpatient Hospitals - by Provider and Service", "years"))
+}
 
 #' @rdname years
 #' @autoglobal
 #' @export
 #' @keywords internal
 util_years <- function() {
-  as.integer(cms_update("Medicare Physician & Other Practitioners - by Geography and Service", "years"))
+  as.integer(cms_update("Medicare Physician & Other Practitioners - by Provider", "years"))
 }
 
 #' @rdname years

pkgdown/_pkgdown.yml

@@ -83,6 +83,7 @@ reference:
   - nppes
   - opt_out
   - order_refer
+  - outpatient
   - pending
   - providers
   - reassignments
@@ -92,12 +93,12 @@ reference:
     Access a provider's statistical data.
   contents:
   - beneficiaries
-  - compare_hcpcs
-  - compare_conditions
   - conditions
   - open_payments
   - quality_payment
   - utilization
+  - compare_hcpcs
+  - compare_conditions
 
 - title: Classifications
   desc: >
@@ -113,10 +114,11 @@ reference:
     Years available to query for search functions.
   contents:
   - bene_years
-  - open_years
-  - pop_years
   - cc_years
+  - open_years
+  - out_years
   - qpp_years
+  - util_years
 
 - title: Utilities
   desc: >

tests/testthat/test-years.R

@@ -1,8 +1,8 @@
-test_that("pop_years() works", {
+test_that("out_years() works", {
 
-  pop <- pop_years()
-  expect_equal(pop, 2013:2021)
-  expect_vector(pop, ptype = integer(), size = 9)
+  out <- out_years()
+  expect_equal(out, 2015:2021)
+  expect_vector(out, ptype = integer(), size = 7)
 
 })