closes #43, #46

andrewallenbruce · Nov 6, 2023 · 05f1119 · 05f1119
1 parent 0e08a4d
commit 05f1119
Show file tree

Hide file tree

Showing 11 changed files with 72 additions and 21 deletions.
diff --git a/R/betos.R b/R/betos.R
@@ -31,9 +31,10 @@
 #' + [Restructured BETOS Classification System](https://data.cms.gov/provider-summary-by-type-of-service/provider-service-classifications/restructured-betos-classification-system)
 #' + [RBCS Data Dictionary](https://data.cms.gov/resources/restructured-betos-classification-system-data-dictionary)
 #'
-#' *Update Frequency:* **Annually**
+#' @section Update Frequency: Annually
 #'
 #' @param hcpcs < *character* > HCPCS or CPT code
+#' @param rbcs < *character* > RBCS ID
 #' @param category < *character* > RBCS Category Description
 #' @param subcategory < *character* > RBCS Subcategory Description
 #' @param family < *character* > RBCS Family Description
@@ -65,6 +66,7 @@
 #' @autoglobal
 #' @export
 betos <- function(hcpcs = NULL,
+                  rbcs = NULL,
                   category = NULL,
                   subcategory = NULL,
                   family = NULL,
@@ -74,18 +76,21 @@ betos <- function(hcpcs = NULL,
   args <- dplyr::tribble(
     ~param,             ~arg,
     "HCPCS_Cd",         hcpcs,
+    "RBCS_ID",          rbcs,
     "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()
+  response <- httr2::request(build_url("bet", args)) |>
+    httr2::req_perform()
 
   if (vctrs::vec_is_empty(response$body)) {
 
     cli_args <- dplyr::tribble(
       ~x,             ~y,
       "hcpcs",        hcpcs,
+      "rbcs",         rbcs,
       "category",     category,
       "subcategory",  subcategory,
       "family",       family,
@@ -100,19 +105,20 @@ betos <- function(hcpcs = NULL,
   results <- httr2::resp_body_json(response, simplifyVector = TRUE)
 
   if (tidy) {
-    results <- tidyup(results,
-                      dtype = 'mdy',
-                      dt = 'dt') |>
-      dplyr::mutate(
-        rbcs_major_ind = dplyr::case_match(rbcs_major_ind,
-                                           "N" ~ "Non-procedure",
-                                           "M" ~ "Major",
-                                           "O" ~ "Other")) |>
+    results <- tidyup(results, dtype = 'mdy', dt = 'dt') |>
+      dplyr::mutate(rbcs_major_ind = fct_maj(rbcs_major_ind)) |>
       cols_betos()
   }
   return(results)
 }
 
+#' @autoglobal
+#' @noRd
+fct_maj <- function(x) {
+  factor(x, levels = c("N", "M", "O"),
+         labels = c("Non-procedure", "Major", "Other"))
+}
+
 #' @param df data frame
 #' @autoglobal
 #' @noRd

diff --git a/R/compare.R b/R/compare.R
@@ -44,22 +44,31 @@ compare_hcpcs <- function(df) {
 
   x$type <- "geography"
 
-  state <- furrr::future_pmap_dfr(x, utilization)
+  state <- furrr::future_pmap_dfr(x, utilization, .options = furrr::furrr_options(seed = NULL))
   # state <- purrr::pmap(x, utilization) |> purrr::list_rbind()
 
   x$state <- "National"
 
-  national <- furrr::future_pmap_dfr(x, utilization)
+  national <- furrr::future_pmap_dfr(x, utilization, .options = furrr::furrr_options(seed = NULL))
   # national <- purrr::pmap(x, utilization) |> purrr::list_rbind()
 
   vctrs::vec_rbind(
     hcpcs_cols(df),
     hcpcs_cols(state),
     hcpcs_cols(national)) |>
-    dplyr::mutate(level = forcats::fct_inorder(level)) |>
+    dplyr::mutate(level = fct_lvl(level)) |>
     dplyr::relocate(providers, .before = beneficiaries)
 }
 
+#' @param x vector
+#' @autoglobal
+#' @noRd
+fct_lvl <- function(x) {
+  factor(x,
+         levels = c("Provider", "State", "National"),
+         ordered = TRUE)
+}
+
 #' @param df data frame
 #' @autoglobal
 #' @noRd
@@ -124,15 +133,15 @@ compare_conditions <- function(df, pivot = FALSE) {
                   subdemo = "all",
                   age = "all")
 
-  state <- furrr::future_pmap_dfr(y, conditions)
+  state <- furrr::future_pmap_dfr(y, conditions, .options = furrr::furrr_options(seed = NULL))
   state <- dplyr::select(state, year, level, condition, prevalence)
   # state <- purrr::pmap(y, conditions) |>
   #   purrr::list_rbind() |>
   #   dplyr::select(year, level, condition, prevalence)
 
   y$sublevel <- "national"
 
-  national <- furrr::future_pmap_dfr(y, conditions)
+  national <- furrr::future_pmap_dfr(y, conditions, .options = furrr::furrr_options(seed = NULL))
   national <- dplyr::select(national, year, level, condition, prevalence)
   # national <- purrr::pmap(y, conditions) |>
   #   purrr::list_rbind() |>
@@ -156,7 +165,6 @@ compare_conditions <- function(df, pivot = FALSE) {
 #' @autoglobal
 #' @noRd
 cnd_rename <- function(df) {
-
   cols <- c('Atrial Fibrillation'                         = 'cc_af',
             "Alzheimer's Disease/Dementia"                = 'cc_alz',
             'Asthma'                                      = 'cc_asth',
@@ -175,5 +183,4 @@ cnd_rename <- function(df) {
             'Stroke'                                      = 'cc_strk')
 
   df |> dplyr::rename(dplyr::any_of(cols))
-
 }
diff --git a/R/open_payments.R b/R/open_payments.R
@@ -288,7 +288,7 @@ open_payments <- function(year,
 #' @autoglobal
 #' @export
 open_payments_ <- function(year = open_years(), ...) {
-  furrr::future_map_dfr(year, open_payments, ...)
+  furrr::future_map_dfr(year, open_payments, ..., .options = furrr::furrr_options(seed = NULL))
 }
 
 #' Update Open Payments API distribution IDs

diff --git a/R/quality_payment.R b/R/quality_payment.R
@@ -206,7 +206,7 @@ quality_payment <- function(year,
 #' @autoglobal
 #' @export
 quality_payment_ <- function(year = qpp_years(), ...) {
-  furrr::future_map_dfr(year, quality_payment, ...)
+  furrr::future_map_dfr(year, quality_payment, ..., .options = furrr::furrr_options(seed = NULL))
 }
 
 #' @param df data frame

diff --git a/R/utilization.R b/R/utilization.R
@@ -262,7 +262,8 @@ utilization <- function(year,
 #' @export
 utilization_ <- function(year = util_years(),
                          ...) {
-  furrr::future_map_dfr(year, utilization, ...)
+  furrr::future_map_dfr(year, utilization, ..., .options = furrr::furrr_options(seed = NULL))
+
 }
 
 #' @param results data frame from [utilization(type = "provider")]

diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml
@@ -4,7 +4,7 @@ template:
   bootstrap: 5
   bootswatch: simplex
   bslib:
-    font_scale: 1.2
+    font_scale: 1.1
     base_font: {google: "IBM Plex Sans"}
     heading_font: {google: "Kanit"}
     code_font: {google: "Fira Code"}

diff --git a/tests/testthat/test-taxonomy_crosswalk.R b/tests/testthat/test-taxonomy_crosswalk.R
@@ -0,0 +1,29 @@
+httptest2::without_internet({
+  test_that("taxonomy_crosswalk() returns correct request URL", {
+    httptest2::expect_GET(
+      taxonomy_crosswalk(taxonomy_code = "2086S0102X",
+                         specialty_code = "2",
+                         specialty_description = "Physician/General Surgery"),
+      'https://data.cms.gov/data.json')
+
+    httptest2::expect_GET(
+      taxonomy_crosswalk(keyword_search = "Histocompatibility"),
+      'https://data.cms.gov/data.json')
+  })
+})
+
+test_that("cols_cross() works", {
+  x <- dplyr::tibble(
+    medicare_specialty_code                                          = 1,
+    medicare_provider_supplier_type                                  = 1,
+    provider_taxonomy_code                                           = 1,
+    provider_taxonomy_description_type_classification_specialization = 1)
+
+  y <- dplyr::tibble(
+    specialty_code        = 1,
+    specialty_description = 1,
+    taxonomy_code         = 1,
+    taxonomy_description  = 1)
+
+  expect_equal(cols_cross(x), y)
+})
diff --git a/vignettes/articles/geospatial.Rmd b/vignettes/articles/geospatial.Rmd
@@ -1,7 +1,9 @@
 ---
 title: "Mapping Providers"
+subtitle: "Demographics, Patient Mix, and Performance"
 description: "Demographics, Patient Mix, and Performance"
 author: "Andrew Bruce"
+date: "`r Sys.Date()`"
 output: html_document
 ---
 

diff --git a/vignettes/articles/linking-providers.Rmd b/vignettes/articles/linking-providers.Rmd
@@ -1,7 +1,9 @@
 ---
 title: "Linking Providers"
+subtitle: "NPIs, PAC IDs, Enrollment IDs, CCNs, CLIAs and More"
 description: "NPIs, PAC IDs, Enrollment IDs, CCNs, CLIAs and More"
 author: "Andrew Bruce"
+date: "`r Sys.Date()`"
 output: html_document
 ---
 

diff --git a/vignettes/articles/networks.Rmd b/vignettes/articles/networks.Rmd
@@ -1,7 +1,9 @@
 ---
 title: "Provider Networks"
+subtitle: "NPIs, PAC IDs, Enrollment IDs, CCNs, CLIAs and More"
 description: "NPIs, PAC IDs, Enrollment IDs, CCNs, CLIAs and More"
 author: "Andrew Bruce"
+date: "`r Sys.Date()`"
 output: html_document
 ---
 

diff --git a/vignettes/articles/partb-stats.Rmd b/vignettes/articles/partb-stats.Rmd
@@ -1,7 +1,9 @@
 ---
 title: "Comparing Providers"
+subtitle: "Demographics, Patient Mix, and Performance"
 description: "Demographics, Patient Mix, and Performance"
 author: "Andrew Bruce"
+date: "`r Sys.Date()`"
 output: html_document
 ---