commit

NAMESPACE

@@ -3,6 +3,7 @@
 export(affiliations)
 export(bene_years)
 export(beneficiaries)
+export(betos_classification)
 export(by_geography)
 export(by_provider)
 export(by_service)

R/by_geography.R

@@ -77,8 +77,7 @@ by_geography <- function(year,
       dplyr::pull(y)
     }
 
-  id <- cms_update("Medicare Physician & Other Practitioners - by Geography and Service",
-                   "id") |>
+  id <- api_years("geo") |>
     dplyr::filter(year == {{ year }}) |>
     dplyr::pull(distro)
 

R/by_provider.R

@@ -81,8 +81,7 @@ by_provider <- function(year,
   if (!is.null(ruca)) {ruca <- as.character(ruca)}
   if (!is.null(par))  {par <- tf_2_yn(par)}
 
-  id <- cms_update("Medicare Physician & Other Practitioners - by Provider",
-                   "id") |>
+  id <- api_years("prv") |>
     dplyr::filter(year == {{ year }}) |>
     dplyr::pull(distro)
 

R/by_service.R

@@ -143,8 +143,7 @@ by_service <- function(year,
   if (!is.null(par))        {par <- tf_2_yn(par)}
   if (!is.null(drug))       {drug <- tf_2_yn(drug)}
 
-  id <- cms_update("Medicare Physician & Other Practitioners - by Provider and Service",
-                   "id") |>
+  id <- api_years("srv") |>
     dplyr::filter(year == {{ year }}) |>
     dplyr::pull(distro)
 

R/chronic_conditions.R

@@ -122,7 +122,7 @@ cc_specific <- function(year,
   "Medicare and Medicaid", "Female", "Male", "Asian Pacific Islander",
   "Hispanic", "Native American", "non-Hispanic Black", "non-Hispanic White"))}
 
-  id <- cms_update("Specific Chronic Conditions", "id") |>
+  id <- api_years("scc") |>
     dplyr::filter(year == {{ year }}) |>
     dplyr::pull(distro)
 
@@ -299,7 +299,7 @@ cc_multiple <- function(year,
             "Asian Pacific Islander", "Hispanic", "Native American",
             "non-Hispanic Black", "non-Hispanic White"))}
 
-  id <- cms_update("Multiple Chronic Conditions", "id") |>
+  id <- api_years("mcc") |>
     dplyr::filter(year == {{ year }}) |>
     dplyr::pull(distro)
 

R/globals.R

@@ -330,6 +330,8 @@ utils::globalVariables(c(
   "classification", # <download_nucc_csv>
   "specialization", # <download_nucc_csv>
   "code", # <download_nucc_csv>
+  "y", # <betos_classification>
+  "rbcs_major_ind", # <betos_classification>
   "title", # <cms_update>
   "modified", # <cms_update>
   "distribution", # <cms_update>

R/providers.R

@@ -108,7 +108,7 @@ providers <- function(npi = NULL,
       "gender",                gender) |>
       tidyr::unnest(cols = c(y))
 
-    format_cli(cli_args, "providers")
+    format_cli(cli_args)
 
     return(invisible(NULL))
 
@@ -147,13 +147,27 @@ pros_cols <- function(df) {
 
 }
 
-
+#' @param npi description
+#' @param pac description
+#' @param enroll_id description
+#' @autoglobal
+#' @noRd
 individuals <- function(npi = NULL,
                         pac = NULL,
-                        enroll_id = NULL,
-                        tidy = TRUE,
-                        na.rm = TRUE) {
+                        enroll_id = NULL) {
+
+  p <- providers(npi = npi, pac = pac, enroll_id = enroll_id)
+
+  if (!is.null(pac)) {unique(pac$enroll_id)}
+
+  d <- revalidation_date(npi = npi, enroll_id = enroll_id)
+  d$specialty_description <- NULL
+
+  r <- revalidation_reassign(npi = npi, pac_ind = pac, enroll_id_ind = enroll_id)
+  r$state_ind    <- NULL
+  r$due_date_ind <- NULL
+  r$due_date_org <- NULL
 
-  if (!is.null(enroll_id)) {enroll_ind_check(enroll_id)}
+  dplyr::full_join(p, d) |> dplyr::full_join(r)
 
 }

R/taxonomy_crosswalk.R

@@ -262,3 +262,131 @@ download_nucc_csv <- function() {
                   taxonomy = code)
   return(x)
 }
+
+#' Restructured BETOS Classification System
+#'
+#' @description
+#'
+#' `betos_classification()` allows the user to group HCPCS codes into clinically
+#' meaningful categories based on the original Berenson-Eggers Type of Service
+#' (BETOS) classification. Users may use the RBCS to analyze trends and perform
+#' other types of health services analytic work.
+#'
+#' ## BETOS
+#' The Restructured BETOS Classification System (RBCS) is a taxonomy that allows
+#' researchers to group healthcare service codes for Medicare Part B services
+#' into clinically meaningful categories and subcategories. It is based on the
+#' original Berenson-Eggers Type of Service (BETOS) classification created in
+#' the 1980s, and includes notable updates such as Part B non-physician services.
+#' The RBCS will undergo annual updates by a technical expert panel of
+#' researchers and clinicians.
+#'
+#' The general framework for grouping service codes into the new RBCS taxonomy
+#' largely follows the same structure of BETOS. Like BETOS, the RBCS groups
+#' HCPCS codes into categories, subcategories, and families – with categories
+#' as the most aggregate level and families as the more granular level.
+#'
+#' All Medicare Part B service codes, including non-physician services, are
+#' assigned to a 6-character RBCS taxonomy code.
+#'
+#' Links:
+#' - [Restructured BETOS Classification System](https://data.cms.gov/provider-summary-by-type-of-service/provider-service-classifications/restructured-betos-classification-system)
+#' - [Restructured BETOS Classification System Data Dictionary](https://data.cms.gov/resources/restructured-betos-classification-system-data-dictionary)
+#'
+#' *Update Frequency:* **Annually**
+#'
+#' @param hcpcs_code < *character* > HCPCS or CPT code
+#' @param category < *character* > RBCS Category Description
+#' @param subcategory < *character* > RBCS Subcategory Description
+#' @param family < *character* > RBCS Family Description
+#' @param procedure < *character* > Whether the HCPCS code is a Major (`"M"`),
+#' Other (`"O"`), or non-procedure code (`"N"`).
+#' @param tidy < *boolean* > Tidy output; default is `TRUE`
+#'
+#' @return A [tibble][tibble::tibble-package] with the columns:
+#'
+#' |**Field**              |**Description**                                    |
+#' |:----------------------|:--------------------------------------------------|
+#' |`specialty_code`       |Code that corresponds to the Medicare specialty    |
+#' |`specialty_description`|Description of the Medicare provider/Supplier Type |
+#' |`taxonomy_code`        |Provider's taxonomy code                           |
+#' |`taxonomy_description` |Description of the taxonomy code                   |
+#'
+#' @examplesIf interactive()
+#' betos_classification(hcpcs_code = "0001U")
+#' betos_classification(category = "Test")
+#' betos_classification(subcategory = "General Laboratory")
+#' betos_classification(family = "Immunoassay")
+#' betos_classification(procedure = "M")
+#' @autoglobal
+#' @export
+betos_classification <- function(hcpcs_code = NULL,
+                                 category = NULL,
+                                 subcategory = NULL,
+                                 family = NULL,
+                                 procedure = NULL,
+                                 tidy = TRUE) {
+
+    args <- dplyr::tribble(
+      ~param,             ~arg,
+      "HCPCS_Cd",         hcpcs_code,
+      "RBCS_Cat_Desc",    category,
+      "RBCS_Subcat_Desc", subcategory,
+      "RBCS_Family_Desc", family,
+      "RBCS_Major_Ind",   procedure)
+
+    response <- httr2::request(build_url("bet", args)) |> httr2::req_perform()
+    results <- httr2::resp_body_json(response, simplifyVector = TRUE)
+
+  if (isTRUE(vctrs::vec_is_empty(results))) {
+
+    cli_args <- dplyr::tribble(
+      ~x,             ~y,
+      "hcpcs_code",   hcpcs_code,
+      "category",     category,
+      "subcategory",  subcategory,
+      "family",       family,
+      "procedure",    procedure) |>
+      tidyr::unnest(cols = c(y))
+
+    format_cli(cli_args)
+
+    return(invisible(NULL))
+
+  }
+
+  if (tidy) {
+    results <- tidyup(results) |>
+      dplyr::mutate(dplyr::across(dplyr::everything(), stringr::str_squish),
+                    dplyr::across(dplyr::contains("dt"), anytime::anydate),
+                    rbcs_major_ind = dplyr::case_match(rbcs_major_ind,
+                                                       "N" ~ "Non-procedure",
+                                                       "M" ~ "Major",
+                                                       "O" ~ "Other")) |>
+      betos_cols()
+  }
+  return(results)
+}
+
+#' @param df data frame
+#' @autoglobal
+#' @noRd
+betos_cols <- function(df) {
+
+  cols <- c('hcpcs_code' = 'hcpcs_cd',
+            'rbcs_id',
+            # 'rbcs_cat',
+            'category' = 'rbcs_cat_desc',
+            # 'rbcs_cat_subcat',
+            'subcategory' = 'rbcs_subcat_desc',
+            # 'rbcs_fam_numb',
+            'family' = 'rbcs_family_desc',
+            'procedure' = 'rbcs_major_ind',
+            'hcpcs_effective_date' = 'hcpcs_cd_add_dt',
+            'hcpcs_end_date' = 'hcpcs_cd_end_dt',
+            'rbcs_effective_date' = 'rbcs_assignment_eff_dt',
+            'rbcs_end_date' = 'rbcs_assignment_end_dt')
+
+  df |> dplyr::select(dplyr::all_of(cols))
+
+}

R/utils-args.R

@@ -121,7 +121,8 @@ build_url <- function(fn, args = NULL) {
         "opt" ~ "Opt Out Affidavits",
         "ppe" ~ "Pending Initial Logging and Tracking Physicians",
         "npe" ~ "Pending Initial Logging and Tracking Non Physicians",
-        "tax" ~ "Medicare Provider and Supplier Taxonomy Crosswalk")
+        "tax" ~ "Medicare Provider and Supplier Taxonomy Crosswalk",
+        "bet" ~ "Restructured BETOS Classification System")
 
   if (fn %in% c("tax") && is.null(args)) {
 
@@ -147,18 +148,17 @@ build_url <- function(fn, args = NULL) {
 
 #' Format empty search results
 #' @param df data frame of parameter arguments
-#' @param name function name
 #' @autoglobal
 #' @noRd
-format_cli <- function(df, name) {
+format_cli <- function(df) {
 
   x <- purrr::map2(df$x,
                    df$y,
                    stringr::str_c,
                    sep = " = ",
                    collapse = "")
 
-  cli::cli_alert_danger("{.fn {name}}: No results for {.val {x}}",
+  cli::cli_alert_danger("No results for {.val {x}}",
                         wrap = TRUE)
 
 }
@@ -168,7 +168,7 @@ format_cli <- function(df, name) {
 #' @param year tibble of parameter arguments
 #' @autoglobal
 #' @noRd
-api_years <- function(fn, year) {
+api_years <- function(fn) {
 
   api <- dplyr::case_match(fn,
     "geo" ~ "Medicare Physician & Other Practitioners - by Geography and Service",
@@ -179,9 +179,7 @@ api_years <- function(fn, year) {
     "qpp" ~ "Quality Payment Program Experience",
     .default = NULL)
 
-  cms_update(api) |>
-    dplyr::filter(year == {{ year }}) |>
-    dplyr::pull(distro)
+  cms_update(api)
 }