From 124a25930ca2f3045dec6e91bf58b6ffa2dfb1dc Mon Sep 17 00:00:00 2001 From: Andrew Bruce Date: Tue, 14 Nov 2023 17:54:35 -0500 Subject: [PATCH] Redundant CMS functions removed (#56), `fct` tests, `conditions` bug fix --- R/conditions.R | 1 + R/globals.R | 6 --- R/open_payments.R | 2 +- R/quality_eligibility.R | 2 +- R/quality_payment.R | 67 ----------------------- R/utils-cms.R | 50 ------------------ R/utils-fct.R | 59 +++++++++++++++++++++ README.Rmd | 26 +++++---- README.md | 26 +++++---- tests/testthat/test-utils-fct.R | 94 ++++++++++++++++----------------- 10 files changed, 138 insertions(+), 195 deletions(-) diff --git a/R/conditions.R b/R/conditions.R index ce3502a9..f1df60af 100644 --- 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 index 6000f67f..20f00cdc 100644 --- a/R/globals.R +++ b/R/globals.R @@ -262,7 +262,6 @@ utils::globalVariables(c( "distribution_accessURL", # "year", # "id", # - "distro", # "title", # "modified", # "distribution", # @@ -270,16 +269,11 @@ utils::globalVariables(c( "distribution_title", # "distribution_modified", # "distribution_accessURL", # - "title", # - "description", # "title", # "modified", # "keyword", # "identifier", # "description", # - "distribution_title", # - "distribution", # - "year", # "state.abb", # "state.name", # "Variable", # diff --git a/R/open_payments.R b/R/open_payments.R index 0a5524f7..cadc4865 100644 --- 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 index a430d436..1f65dc0b 100644 --- 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 index cd86d1a2..49ce7b91 100644 --- 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 index c4c2ed89..d305835c 100644 --- 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 index 0d38905b..18b345e2 100644 --- 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 index bd9b1dc1..04c2640e 100644 --- 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 index 658aeeb8..4886fcb4 100644 --- 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 diff --git a/tests/testthat/test-utils-fct.R b/tests/testthat/test-utils-fct.R index dd6b267f..3d22312a 100644 --- a/tests/testthat/test-utils-fct.R +++ b/tests/testthat/test-utils-fct.R @@ -1,37 +1,26 @@ test_that("fct_level() works", { x <- c("National", "State", "County", "Provider") - y <- ordered(x, levels = c("National", "State", "County", "Provider")) + y <- ordered(x, levels = x) expect_equal(fct_level(x), y) }) test_that("fct_period() works", { x <- c("Year", "Month", month.name) - y <- ordered(x, levels = c( - "Year", "Month", "January", "February", "March", "April", "May", "June", - "July", "August", "September", "October", "November", "December")) + y <- ordered(x, levels = x) expect_equal(fct_period(x), y) }) test_that("fct_gen() works", { x <- c("M", "F", "9") - y <- factor(c("Male", "Female", "Unknown"), - levels = c("Male", "Female", "Unknown")) - expect_equal(fct_gen(x), y) + y <- c("Male", "Female", "Unknown") + z <- factor(y, levels = y) + expect_equal(fct_gen(x), z) }) test_that("fct_stabb() works", { x <- c('US', state.abb[1:8], 'DC', state.abb[9:50], 'AS', 'GU', 'MP', 'PR', 'VI', 'UK') - y <- ordered(x, - levels = c( - "US", "AL", "AK", "AZ", "AR", "CA", "CO", "CT", - "DE", "DC", "FL", "GA", "HI", "ID", "IL", "IN", - "IA", "KS", "KY", "LA", "ME", "MD", "MA", "MI", - "MN", "MS", "MO", "MT", "NE", "NV", "NH", "NJ", - "NM", "NY", "NC", "ND", "OH", "OK", "OR", "PA", - "RI", "SC", "SD", "TN", "TX", "UT", "VT", "VA", - "WA", "WV", "WI", "WY", "AS", "GU", "MP", "PR", - "VI", "UK")) + y <- ordered(x, levels = x) expect_equal(fct_stabb(x), y) }) @@ -39,21 +28,7 @@ test_that("fct_stname() works", { x <- c('National', state.name[1:8], 'District of Columbia', state.name[9:50], 'American Samoa', 'Guam', 'Northern Mariana Islands', 'Puerto Rico', 'Virgin Islands', 'Unknown') - y <- ordered(x, - levels = c( - "National", "Alabama", "Alaska", "Arizona", "Arkansas", - "California", "Colorado", "Connecticut", "Delaware", - "District of Columbia", "Florida", "Georgia", "Hawaii", "Idaho", - "Illinois", "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana", - "Maine", "Maryland", "Massachusetts", "Michigan", "Minnesota", - "Mississippi", "Missouri", "Montana", "Nebraska", "Nevada", - "New Hampshire", "New Jersey", "New Mexico", "New York", - "North Carolina", "North Dakota", "Ohio", "Oklahoma", "Oregon", - "Pennsylvania", "Rhode Island", "South Carolina", "South Dakota", - "Tennessee", "Texas", "Utah", "Vermont", "Virginia", "Washington", - "West Virginia", "Wisconsin", "Wyoming", "American Samoa", "Guam", - "Northern Mariana Islands", "Puerto Rico", "Virgin Islands", - "Unknown")) + y <- ordered(x, levels = x) expect_equal(fct_stname(x), y) }) @@ -77,36 +52,28 @@ test_that("fct_pos() works", { test_that("fct_purp() works", { x <- c("PRACTICE", "MAILING", "LOCATION") - y <- factor(c("Practice", "Mailing", "Location"), - levels = c("Practice", "Mailing", "Location")) - expect_equal(fct_purp(x), y) + y <- c("Practice", "Mailing", "Location") + z <- factor(y, levels = y) + expect_equal(fct_purp(x), z) }) test_that("fct_age() works", { x <- c("All", "<65", "65+") - y <- factor(c("All", "<65", "65+"), - levels = c("All", "<65", "65+")) + y <- factor(x, levels = x) expect_equal(fct_age(x), y) }) test_that("fct_demo() works", { x <- c("All", "Dual Status", "Sex", "Race") - y <- factor(c("All", "Dual Status", "Sex", "Race"), - levels = c("All", "Dual Status", "Sex", "Race")) + y <- factor(x, levels = x) expect_equal(fct_demo(x), y) }) test_that("fct_subdemo() works", { - x <- c("All", "Medicare Only", "Medicare and Medicaid", "Female", "Male", - "Asian Pacific Islander", "Hispanic", "Native American", + x <- c("All", "Medicare Only", "Medicare and Medicaid", "Female", + "Male", "Asian Pacific Islander", "Hispanic", "Native American", "non-Hispanic Black", "non-Hispanic White") - y <- factor(c("All", "Medicare Only", "Medicare and Medicaid", "Female", - "Male", "Asian Pacific Islander", "Hispanic", - "Native American", "non-Hispanic Black", "non-Hispanic White"), - levels = c("All", "Medicare Only", "Medicare and Medicaid", - "Female", "Male", "Asian Pacific Islander", - "Hispanic", "Native American", "non-Hispanic Black", - "non-Hispanic White")) + y <- factor(x, levels = x) expect_equal(fct_subdemo(x), y) }) @@ -115,3 +82,34 @@ test_that("fct_mcc() works", { y <- ordered(c("0-1", "2-3", "4-5", "6+")) expect_equal(fct_mcc(x), y) }) + +test_that("fct_part() works", { + x <- c("Group", "Individual", "MIPS APM") + y <- factor(c("Group", "Individual", "MIPS APM")) + expect_equal(fct_part(x), y) +}) + +test_that("fct_status() works", { + x <- 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") + y <- 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)") + z <- factor(y, levels = y) + expect_equal(fct_status(x), z) +}) + +test_that("fct_measure() works", { + x <- c("quality", "pi", "ia", "cost") + y <- c("Quality", "Promoting Interoperability", + "Improvement Activities", "Cost") + z <- factor(y, levels = y) + expect_equal(fct_measure(x), z) +})