Redundant CMS functions removed (#56), fct tests, conditions bug fix

andrewallenbruce · Nov 14, 2023 · 124a259 · 124a259
1 parent ba0b311
commit 124a259
Show file tree

Hide file tree

Showing 10 changed files with 138 additions and 195 deletions.
diff --git a/R/conditions.R b/R/conditions.R
@@ -162,6 +162,7 @@ conditions <- function(year,
       cli::cli_abort(c("{.arg mcc} is only available for {.arg set = 'Multiple'}."))} # nolint
     mcc <- rlang::arg_match(mcc, names(mcc()))
     mcc <- lookup(mcc(), mcc)
+    condition2 <- NULL
   }
 
   if (!is.null(condition)) {

diff --git a/R/globals.R b/R/globals.R
@@ -262,24 +262,18 @@ utils::globalVariables(c(
   "distribution_accessURL", # <cms_update>
   "year", # <cms_update>
   "id", # <cms_update>
-  "distro", # <cms_match>
   "title", # <cms_update_ids>
   "modified", # <cms_update_ids>
   "distribution", # <cms_update_ids>
   "distribution_format", # <cms_update_ids>
   "distribution_title", # <cms_update_ids>
   "distribution_modified", # <cms_update_ids>
   "distribution_accessURL", # <cms_update_ids>
-  "title", # <cms_dataset_full>
-  "description", # <cms_dataset_full>
   "title", # <cms_dataset_search>
   "modified", # <cms_dataset_search>
   "keyword", # <cms_dataset_search>
   "identifier", # <cms_dataset_search>
   "description", # <cms_dataset_search>
-  "distribution_title", # <cms_get_dates>
-  "distribution", # <cms_get_dates>
-  "year", # <cms_get_dates>
   "state.abb", # <fct_stabb>
   "state.name", # <fct_stname>
   "Variable", # <gt_datadict>

diff --git a/R/open_payments.R b/R/open_payments.R
@@ -241,7 +241,7 @@ open_payments <- function(year,
 
     results <- tidyup(results,
                       dtype = 'mdy',
-                      yn = c(yncols),
+                      yn = c(yncols), #nolint
                       dbl = 'dollars',
                       int = c('program_year', 'number_of_payments_included_in_total_amount')) |> #nolint
       dplyr::mutate(covered_recipient_type                                         = fct_cov(covered_recipient_type),

diff --git a/R/quality_eligibility.R b/R/quality_eligibility.R
@@ -135,7 +135,7 @@ quality_eligibility <- function(year,
     #   combine(address, c('adr_ln_1', 'adr_ln_2')) |>
     #   dplyr::mutate(gndr = fct_gen(gndr),
     #                 state = fct_stabb(state)) |>
-    #   cols_clin()
+    #   cols_qelig()
 
     if (na.rm) results <- narm(results)
   }

diff --git a/R/quality_payment.R b/R/quality_payment.R
@@ -296,70 +296,3 @@ cols_qpp <- function(df, step = c("tidy", "nest")) {
 
   df |> dplyr::select(dplyr::any_of(cols))
 }
-
-#' @autoglobal
-#' @noRd
-fct_part <- function(x) {
-  factor(x, levels = c("Group",
-                       "Individual",
-                       "MIPS APM"))
-}
-
-#' @autoglobal
-#' @noRd
-fct_status <- function(x) {
-  factor(x,
-         levels = c("engaged",
-                    "opted_into_mips",
-                    "small_practitioner",
-                    "rural",
-                    "hpsa",
-                    "ambulatory_surgical_center",
-                    "hospital_based_clinician",
-                    "non_patient_facing",
-                    "facility_based",
-                    "extreme_hardship",
-                    "extreme_hardship_quality",
-                    "quality_bonus",
-                    "extreme_hardship_pi",
-                    "pi_hardship",
-                    "pi_reweighting",
-                    "pi_bonus",
-                    "extreme_hardship_ia",
-                    "ia_study",
-                    "extreme_hardship_cost"),
-         labels = c("Engaged",
-                    "Opted into MIPS",
-                    "Small Practitioner",
-                    "Rural Clinician",
-                    "HPSA Clinician",
-                    "Ambulatory Surgical Center",
-                    "Hospital-Based Clinician",
-                    "Non-Patient Facing",
-                    "Facility-Based",
-                    "Extreme Hardship",
-                    "Extreme Hardship (Quality)",
-                    "Quality Bonus",
-                    "Extreme Hardship (PI)",
-                    "PI Hardship",
-                    "PI Reweighting",
-                    "PI Bonus",
-                    "Extreme Hardship (IA)",
-                    "IA Study",
-                    "Extreme Hardship (Cost)")
-         )
-}
-
-#' @autoglobal
-#' @noRd
-fct_measure <- function(x) {
-  factor(x,
-         levels = c("quality",
-                    "pi",
-                    "ia",
-                    "cost"),
-         labels = c("Quality",
-                    "Promoting Interoperability",
-                    "Improvement Activities",
-                    "Cost"))
-}
diff --git a/R/utils-cms.R b/R/utils-cms.R
@@ -56,18 +56,6 @@ cms_update <- function(api, check = "id") {
   }
 }
 
-#' Update CMS.gov API distribution IDs
-#' @param api name of the api
-#' @param year int, year of the data distribution to return
-#' @return A [tibble][tibble::tibble-package] containing the updated ids.
-#' @noRd
-#' @autoglobal
-cms_match <- function(api, year) {
-  cms_update(api = {{ api }}, check = "id") |>
-    dplyr::filter(year == {{ year }}) |>
-    dplyr::pull(distro)
-}
-
 #' Update CMS.gov API distribution IDs
 #' @param api name of the api
 #' @return A [tibble][tibble::tibble-package] containing the updated ids.
@@ -103,26 +91,6 @@ cms_update_ids <- function(api = NULL) {
   return(ids)
 }
 
-
-#' Browse full CMS.gov API datasets
-#' @autoglobal
-#' @noRd
-cms_dataset_full <- function() {
-
-  resp <- httr2::request("https://data.cms.gov/data.json") |>
-    httr2::req_perform() |>
-    httr2::resp_body_json(check_type = FALSE,
-                          simplifyVector = TRUE)
-
-  ids <- resp$dataset |>
-    dplyr::tibble() |>
-    dplyr::select(title,
-                  description)
-
-  return(ids)
-}
-
-
 #' Search CMS.gov API datasets by keyword
 #' @param keyword search term
 #' @autoglobal
@@ -148,21 +116,3 @@ cms_dataset_search <- function(search = NULL) {
   }
   return(ids)
 }
-
-#' Search CMS.gov API datasets by keyword
-#' @param api search api distribution dates
-#' @autoglobal
-#' @noRd
-cms_get_dates <- function(api = NULL) {
-
-  cms_update_ids(api = {{ api }}) |>
-    dplyr::select(distribution_title,
-                  distribution) |>
-    tidyr::separate_wider_delim(distribution_title,
-                                delim = " : ",
-                                names = c("title", "date"),
-                                cols_remove = TRUE) |>
-    dplyr::mutate(year = lubridate::year(date)) |>
-    dplyr::select(year, distribution)
-
-}
diff --git a/R/utils-fct.R b/R/utils-fct.R
@@ -148,3 +148,62 @@ fct_mcc <- function(x) {
          labels = c("0-1", "2-3", "4-5", "6+"),
          ordered = TRUE)
 }
+
+#' @autoglobal
+#' @noRd
+fct_part <- function(x) {
+  factor(x, levels = c("Group", "Individual", "MIPS APM"))
+}
+
+#' @autoglobal
+#' @noRd
+fct_status <- function(x) {
+  factor(x,
+         levels = c("engaged",
+                    "opted_into_mips",
+                    "small_practitioner",
+                    "rural",
+                    "hpsa",
+                    "ambulatory_surgical_center",
+                    "hospital_based_clinician",
+                    "non_patient_facing",
+                    "facility_based",
+                    "extreme_hardship",
+                    "extreme_hardship_quality",
+                    "quality_bonus",
+                    "extreme_hardship_pi",
+                    "pi_hardship",
+                    "pi_reweighting",
+                    "pi_bonus",
+                    "extreme_hardship_ia",
+                    "ia_study",
+                    "extreme_hardship_cost"),
+         labels = c("Engaged",
+                    "Opted into MIPS",
+                    "Small Practitioner",
+                    "Rural Clinician",
+                    "HPSA Clinician",
+                    "Ambulatory Surgical Center",
+                    "Hospital-Based Clinician",
+                    "Non-Patient Facing",
+                    "Facility-Based",
+                    "Extreme Hardship",
+                    "Extreme Hardship (Quality)",
+                    "Quality Bonus",
+                    "Extreme Hardship (PI)",
+                    "PI Hardship",
+                    "PI Reweighting",
+                    "PI Bonus",
+                    "Extreme Hardship (IA)",
+                    "IA Study",
+                    "Extreme Hardship (Cost)"))
+}
+
+#' @autoglobal
+#' @noRd
+fct_measure <- function(x) {
+  factor(x,
+         levels = c("quality", "pi", "ia", "cost"),
+         labels = c("Quality", "Promoting Interoperability",
+                    "Improvement Activities", "Cost"))
+}
diff --git a/README.Rmd b/README.Rmd
@@ -78,20 +78,20 @@ clinicians(npi = 1932365699) |> glimpse()
 
 ```{r}
 conditions(year  = 2018, 
-           set   = "multiple", 
-           level = "national", 
-           age   = "all", 
-           demo  = "all", 
+           set   = "Multiple", 
+           level = "National", 
+           age   = "All", 
+           demo  = "All", 
            mcc   = "6+") |> glimpse()
 ```
 
 
 ```{r}
 conditions(year      = 2018, 
-           set       = "specific", 
-           level     = "national", 
-           age       = "all", 
-           demo      = "all",
+           set       = "Specific", 
+           level     = "National", 
+           age       = "All", 
+           demo      = "All",
            condition = "Arthritis") |> glimpse()
 ```
 
@@ -118,9 +118,13 @@ nppes(npi = 1720098791) |> glimpse()
 ### `open_payments()`
 
 ```{r}
-open_payments(year = 2021, npi = 1023630738, na.rm = TRUE) |> 
-  mutate(info = ndc_lookup(ndc), ndc = NULL) |> 
-  unnest(info) |> glimpse()
+open_payments(year = 2021, 
+              npi = 1023630738, 
+              na.rm = TRUE) |> 
+  mutate(info = ndc_lookup(ndc), 
+         ndc = NULL) |> 
+  unnest(info) |> 
+  glimpse()
 ```
 
 

diff --git a/README.md b/README.md
@@ -128,10 +128,10 @@ clinicians(npi = 1932365699) |> glimpse()
 
 ``` r
 conditions(year  = 2018, 
-           set   = "multiple", 
-           level = "national", 
-           age   = "all", 
-           demo  = "all", 
+           set   = "Multiple", 
+           level = "National", 
+           age   = "All", 
+           demo  = "All", 
            mcc   = "6+") |> glimpse()
 ```
 
@@ -152,10 +152,10 @@ conditions(year  = 2018,
 
 ``` r
 conditions(year      = 2018, 
-           set       = "specific", 
-           level     = "national", 
-           age       = "all", 
-           demo      = "all",
+           set       = "Specific", 
+           level     = "National", 
+           age       = "All", 
+           demo      = "All",
            condition = "Arthritis") |> glimpse()
 ```
 
@@ -282,9 +282,13 @@ nppes(npi = 1720098791) |> glimpse()
 ### `open_payments()`
 
 ``` r
-open_payments(year = 2021, npi = 1023630738, na.rm = TRUE) |> 
-  mutate(info = ndc_lookup(ndc), ndc = NULL) |> 
-  unnest(info) |> glimpse()
+open_payments(year = 2021, 
+              npi = 1023630738, 
+              na.rm = TRUE) |> 
+  mutate(info = ndc_lookup(ndc), 
+         ndc = NULL) |> 
+  unnest(info) |> 
+  glimpse()
 ```
 
     #> ✖ No results for NDC = 78206-145-01