quality_eligibility gains "stats" option (#61)

andrewallenbruce · Dec 3, 2023 · df6da8c · df6da8c
1 parent a652dc6
commit df6da8c
Show file tree

Hide file tree

Showing 9 changed files with 192 additions and 156 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -59,5 +59,6 @@ export(utilization_)
 export(years_df)
 export(years_vec)
 importFrom(lifecycle,deprecated)
+importFrom(rlang,"%||%")
 importFrom(stringi,"%s+%")
 importFrom(zeallot,"%<-%")
diff --git a/R/globals.R b/R/globals.R
@@ -192,6 +192,7 @@ utils::globalVariables(c(
   "y", # <providers>
   "y", # <mips_2021>
   "org_pac_id", # <mips_2021>
+  "facility_name", # <mips_2021>
   "aco_id_1", # <mips_2021>
   "aco_nm_1", # <mips_2021>
   "aco_id_2", # <mips_2021>
@@ -207,8 +208,8 @@ utils::globalVariables(c(
   "collection_type", # <mips_2021>
   "ccxp_ind", # <mips_2021>
   "ind_pac_id", # <mips_2021>
-  "frst_nm", # <mips_2021>
-  "lst_nm", # <mips_2021>
+  "provider_first_name", # <mips_2021>
+  "provider_last_name", # <mips_2021>
   "apm_affl_1", # <mips_2021>
   "apm_affl_2", # <mips_2021>
   "apm_affl_3", # <mips_2021>
@@ -218,8 +219,6 @@ utils::globalVariables(c(
   "organizations_groupScenario", # <quality_eligibility>
   "organizations_apms", # <quality_eligibility>
   "organizations_virtualGroups", # <quality_eligibility>
-  "ind", # <quality_eligibility>
-  "grp", # <quality_eligibility>
   "npi_type", # <quality_eligibility>
   "org_state", # <quality_eligibility>
   "org_name", # <quality_eligibility>

diff --git a/R/prescribers.R b/R/prescribers.R
@@ -154,7 +154,7 @@ prescribers <- function(year,
   year <- as.character(year)
   year <- rlang::arg_match(year, as.character(rx_years()))
 
-  npi  <- npi %nn% validate_npi(npi)
+  npi   <- npi %nn% validate_npi(npi)
   zip   <- zip %nn% as.character(zip)
   fips  <- fips %nn% as.character(fips)
   ruca  <- ruca %nn% as.character(ruca)

diff --git a/R/provider-package.R b/R/provider-package.R
@@ -5,5 +5,6 @@
 #' @importFrom lifecycle deprecated
 #' @importFrom zeallot %<-%
 #' @importFrom stringi %s+%
+#' @importFrom rlang %||%
 ## usethis namespace: end
 NULL
diff --git a/R/qpp.R b/R/qpp.R
@@ -1,151 +1,98 @@
-#' Program-Wide Statistics from Quality Payment Program
-#'
-#' Public statistics derived from all providers.
-#'
-#' @section HCC Risk Score Average:
-#' National average individual (NPI) or group (TIN) risk score for MIPS
-#' eligible individual/group. Scores are calculated as follows:
-#'
-#' Individuals: Sum of clinician risk scores / number of eligible clinicians.
-#' Groups: Sum of practice risk scores / number of eligible practice.
-#'
-#' @section Dual Eligibility Average:
-#' National average individual (NPI) or group (TIN) dual-eligibility score for
-#' MIPS eligible individual/group.
-#'
-#' Individuals: Sum of clinician dual-eligibility scores / number of eligible clinicians.
-#' Groups: Sum of practice dual-eligibility scores / number of eligible practice.
-#'
-#' @section Links:
-#' + [QPP Eligibility API Documentation](https://cmsgov.github.io/qpp-eligibility-docs/)
-#'
-#' @section Update Frequency: **Annually**
-#'
-#' @param year QPP program year
-#'
-#' @return A [tibble()] containing the search results.
-#'
-#' @examplesIf interactive()
-#' quality_stats(year = 2020)
-#' @rdname quality_payment
-#' @autoglobal
-#' @noRd
-# nocov start
-quality_stats <- function(year) {
-
-  rlang::check_required(year)
-  year <- as.character(year)
-  rlang::arg_match(year, values = as.character(2017:2024))
-
-  url <- glue::glue("https://qpp.cms.gov/api/eligibility/stats/?year={year}")
-
-  error_body <- function(resp) httr2::resp_body_json(resp)$error$message
-
-  resp <- httr2::request(url) |>
-    httr2::req_error(body = error_body) |>
-    httr2::req_perform() |>
-    httr2::resp_body_json(simplifyVector = TRUE)
-
-  return(dplyr::tibble(
-    year = as.integer(year),
-    type = c("Individual",
-             "Individual",
-             "Group",
-             "Group"),
-    stat = c("HCC Risk Score Average",
-             "Dual Eligibility Average",
-             "HCC Risk Score Average",
-             "Dual Eligibility Average"),
-    value = c(resp$data$individual$hccRiskScoreAverage,
-              resp$data$individual$dualEligibilityAverage,
-              resp$data$group$hccRiskScoreAverage,
-              resp$data$group$dualEligibilityAverage)))
-}
-
 #' 2021 Quality Payment Performance
 #'
 #' @description
+#'
 #' Performance information for Merit-Based Incentive Payment System (MIPS)
 #' submitted by groups.
 #'
-#' @param facility_name Organization name
-#' @param pac_id_org Unique organization ID assigned by PECOS
-#' @param npi Unique clinician ID assigned by NPPES
-#' @param pac_id_ind Unique individual clinician ID assigned by PECOS
-#' @param first_name Individual clinician first name
-#' @param last_name Individual clinician last name
+#' @param npi < *integer* > __Individual__ 10-digit National Provider Identifier
+#' assigned to the clinician when they enrolled in Medicare. Multiple rows for
+#' the same NPI indicate multiple TIN/NPI combinations.
+#' @param pac_ind < *integer* > __Individual__ 10-digit PECOS Associate Control ID
+#' @param pac_org < *integer* > __Organizational__ 10-digit PECOS Associate Control ID
+#' @param facility < *character* > __Organizational__ Facility name
+#' @param first,last < *character* > __Individual__ Provider's name
 #' @param offset offset; API pagination
-#' @param tidy Tidy output; default is `TRUE`.
+#' @param tidy < *boolean* > // __default:__ `TRUE` Tidy output
+#' @param na.rm < *boolean* > // __default:__ `TRUE` Remove empty rows and columns
 #'
 #' @return A [tibble][tibble::tibble-package] containing the search results.
 #'
 #' @examplesIf interactive()
-#' mips_2021(pac_id_org = 4789842956)
+#' mips_2021(pac_org = 4789842956)
+#'
 #' mips_2021(npi = 1316172182)
 #' @autoglobal
 #' @noRd
-mips_2021 <- function(facility_name = NULL,
-                      pac_id_org = NULL,
-                      npi = NULL,
-                      pac_id_ind = NULL,
-                      first_name = NULL,
-                      last_name = NULL,
+# nocov start
+mips_2021 <- function(npi = NULL,
+                      pac_ind = NULL,
+                      pac_org = NULL,
+                      facility = NULL,
+                      first = NULL,
+                      last = NULL,
                       offset = 0L,
-                      tidy = TRUE) {
+                      tidy = TRUE,
+                      na.rm = TRUE) {
 
-  if (all(is.null(c(npi, pac_id_ind, first_name, last_name,
-                    facility_name, pac_id_org)))) {
-    cli::cli_abort(c("A non-NULL argument is required")) # nolint
+  if (all(is.null(c(npi, pac_ind, pac_org, first, last, facility)))) {
+    cli::cli_abort("A non-NULL argument is required")
   }
 
-  if (any(!is.null(c(npi, pac_id_ind, first_name, last_name)))) {
-    facility_name <- NULL
-    pac_id_org    <- NULL
+  npi <- npi %nn% validate_npi(npi)
+  pac_ind <- pac_ind %nn% check_pac(pac_ind)
+  pac_org <- pac_org %nn% check_pac(pac_org)
 
+  if (any(!is.null(c(npi, pac_ind, first, last)))) {
+    facility <- NULL; pac_org <- NULL
     id <- mips_2021_id("ind")
-
-    if (!is.null(npi)) npi <- validate_npi(npi)
-    if (!is.null(pac_id_ind)) pac_id_ind <- check_pac(pac_id_ind)
-
   }
 
-  if (any(!is.null(c(facility_name, pac_id_org)))) {
-    npi        <- NULL
-    pac_id_ind <- NULL
-    first_name <- NULL
-    last_name  <- NULL
-
+  if (any(!is.null(c(facility, pac_org)))) {
+    npi        <- NULL; pac_id_ind <- NULL
+    first_name <- NULL; last_name  <- NULL
     id <- mips_2021_id("group")
-
-    if (!is.null(pac_id_org)) pac_id_org <- check_pac(pac_id_org)
   }
 
+  # args <- dplyr::tribble(
+  #   ~param,            ~arg,
+  #   "npi",             npi,
+  #   "ind_pac_id",      pac_ind,
+  #   "org_pac_id",      pac_org,
+  #   "facility_name",   facility,
+  #   "frst_name",       first,
+  #   "lst_name",        last)
+
   args <- dplyr::tribble(
     ~param,            ~arg,
-    "facility_name",   facility_name,
-    "org_pac_id",      pac_id_org,
-    "npi",             npi,
-    "ind_pac_id",      pac_id_ind,
-    "lst_name",        last_name,
-    "frst_name",       first_name)
+    "NPI",             npi,
+    "Ind_PAC_ID",      pac_ind,
+    "Org_PAC_ID",      pac_org,
+    "facility_name",   facility,
+    "Provider First Name",       first,
+    "Provider Last Name",        last)
 
   url <- paste0("https://data.cms.gov/provider-data/api/1/datastore/sql?query=",
                 "[SELECT * FROM ", id, "]",
                 encode_param(args, type = "sql"),
                 "[LIMIT 10000 OFFSET ", offset, "]")
 
-  response <- httr2::request(encode_url(url)) |> httr2::req_perform()
+  error_body <- function(resp) httr2::resp_body_json(resp)$message
+
+  response <- httr2::request(encode_url(url)) |>
+    httr2::req_error(body = error_body) |>
+    httr2::req_perform()
 
   if (vctrs::vec_is_empty(response$body)) {
 
     cli_args <- dplyr::tribble(
-      ~x,              ~y,
-      "facility_name", facility_name,
-      "pac_id_org",    pac_id_org,
-      "npi",           npi,
-      "pac_id_ind",    pac_id_ind,
-      "last_name",     last_name,
-      "first_name",    first_name) |>
+      ~x,         ~y,
+      "npi",      npi,
+      "facility", facility,
+      "pac_org",  pac_org,
+      "pac_ind",  pac_ind,
+      "last",     last,
+      "first",    first) |>
       tidyr::unnest(cols = c(y))
 
     format_cli(cli_args)
@@ -155,50 +102,58 @@ mips_2021 <- function(facility_name = NULL,
   results <- httr2::resp_body_json(response, simplifyVector = TRUE)
 
   if (tidy) {
-    results <- tidyup(results)
-
-    if (any(!is.null(c(facility_name, pac_id_org)))) {
+    results <- tidyup(results,
+                      yn = c('invs_msr',
+                             'attestation_value',
+                             'ccxp_ind'),
+                      int = c('prf_rate',
+                              'patient_count',
+                              'star_value',
+                              'five_star_benchmark'))
+
+    if (any(!is.null(c(facility, pac_org)))) {
       results <- dplyr::select(results,
-                               org_pac_id,
-                               facility_name,
+                               pac_org              = org_pac_id,
+                               facility             = facility_name,
                                aco_id_1,
-                               aco_nm_1,
+                               aco_name_1           = aco_nm_1,
                                aco_id_2,
-                               aco_nm_2,
-                               measure_code = measure_cd,
+                               aco_name_2           = aco_nm_2,
+                               measure_code         = measure_cd,
                                measure_title,
-                               measure_inverse = invs_msr,
+                               measure_inverse      = invs_msr,
                                attestation_value,
-                               performance_rate = prf_rate,
+                               performance_rate     = prf_rate,
                                patient_count,
-                               star_value,
+                               stars                = star_value,
                                five_star_benchmark,
                                collection_type,
                                measure_care_compare = ccxp_ind,
                                dplyr::everything())
     }
 
-    if (any(!is.null(c(npi, pac_id_ind, first_name, last_name)))) {
+    if (any(!is.null(c(npi, pac_ind, first, last)))) {
       results <- dplyr::select(results,
                                npi,
-                               pac_id_ind = ind_pac_id,
-                               first_name = frst_nm,
-                               last_name = lst_nm,
-                               apm_affl_1,
-                               apm_affl_2,
-                               apm_affl_3,
-                               measure_code = measure_cd,
+                               pac_ind              = ind_pac_id,
+                               first                = provider_first_name,
+                               last                 = provider_last_name,
+                               apm_1                = apm_affl_1,
+                               apm_2                = apm_affl_2,
+                               apm_3                = apm_affl_3,
+                               measure_code         = measure_cd,
                                measure_title,
-                               measure_inverse = invs_msr,
+                               measure_inverse      = invs_msr,
                                attestation_value,
-                               performance_rate = prf_rate,
+                               performance_rate     = prf_rate,
                                patient_count,
-                               star_value,
+                               stars                = star_value,
                                five_star_benchmark,
                                collection_type,
                                measure_care_compare = ccxp_ind,
                                dplyr::everything())
     }
+    if (na.rm) results <- narm(results)
   }
   return(results)
 }