From df6da8c230181a692402fe5b206d805569302489 Mon Sep 17 00:00:00 2001 From: Andrew Bruce Date: Sun, 3 Dec 2023 00:08:18 -0500 Subject: [PATCH] `quality_eligibility` gains "stats" option (#61) --- NAMESPACE | 1 + R/globals.R | 7 +- R/prescribers.R | 2 +- R/provider-package.R | 1 + R/qpp.R | 221 +++++++++++++++---------------------- R/quality_eligibility.R | 55 ++++++++- R/reassignments.R | 14 +-- man/quality_eligibility.Rd | 33 ++++++ man/reassignments.Rd | 14 +-- 9 files changed, 192 insertions(+), 156 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 8c368600..d44fd424 100644 --- 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 index 86890c35..a55cc10c 100644 --- a/R/globals.R +++ b/R/globals.R @@ -192,6 +192,7 @@ utils::globalVariables(c( "y", # "y", # "org_pac_id", # + "facility_name", # "aco_id_1", # "aco_nm_1", # "aco_id_2", # @@ -207,8 +208,8 @@ utils::globalVariables(c( "collection_type", # "ccxp_ind", # "ind_pac_id", # - "frst_nm", # - "lst_nm", # + "provider_first_name", # + "provider_last_name", # "apm_affl_1", # "apm_affl_2", # "apm_affl_3", # @@ -218,8 +219,6 @@ utils::globalVariables(c( "organizations_groupScenario", # "organizations_apms", # "organizations_virtualGroups", # - "ind", # - "grp", # "npi_type", # "org_state", # "org_name", # diff --git a/R/prescribers.R b/R/prescribers.R index c87b5be0..fc4fc301 100644 --- 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 index c7c5d650..8575873e 100644 --- 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 index 8a39d531..c894cba1 100644 --- 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) } diff --git a/R/quality_eligibility.R b/R/quality_eligibility.R index 9e87d8ed..9712ca7d 100644 --- a/R/quality_eligibility.R +++ b/R/quality_eligibility.R @@ -38,13 +38,29 @@ #' + __APM Entities__ represent a group of practices which participate in an #' APM, characterized by an APM Entity ID. #' +#' @section __stats__ == `TRUE`: +#' Public statistics derived from all QPP providers: +#' +#' ## HCC Risk Score Average: +#' National average individual (NPI) or group (TIN) risk score for MIPS +#' eligible individual/group. Scores are calculated as follows: +#' +#' + __Individual__ = `sum(Clinician Risk Scores) / n(Eligible Clinicians)` +#' + __Group__ = `sum(Practice Risk Scores) / n(Eligible Practices)` +#' +#' ## Dual Eligibility Average: +#' National average individual (NPI) or group (TIN) dual-eligibility score for +#' MIPS eligible individual/group. +#' +#' + __Individual__ = `sum(Clinician Dual-Eligibility Scores) / n(Eligible Clinicians)` +#' + __Group__ = sum(Practice Dual-Eligibility Scores) / n(Eligible Practices) #' #' @section Links: #' + [QPP Eligibility API Documentation](https://cmsgov.github.io/qpp-eligibility-docs/) #' + [QPP Eligibility & MVP/CAHPS/Subgroups Registration Services (v6)](https://qpp.cms.gov/api/eligibility/docs/?urls.primaryName=Eligibility%2C%20v6) #' + [QPP Eligibility & MVP/CAHPS/Subgroups Registration Services (v6) (Multiple NPIs)](https://qpp.cms.gov/api/eligibility/docs/?urls.primaryName=Eligibility%2C%20v6#/Unauthenticated/get_api_eligibility_npis__npi_) #' -#' @section Update Frequency: **Annually** +#' @section Update Frequency: __Annually__ #' #' @name quality_eligibility #' @@ -57,6 +73,7 @@ #' @param unnest < *boolean* > // __default:__ `TRUE` Tidy output #' @param pivot < *boolean* > // __default:__ `TRUE` Tidy output #' @param na.rm < *boolean* > // __default:__ `FALSE` Remove empty rows and columns +#' @param stats < *boolean* > // __default:__ `FALSE` Return QPP stats #' @param ... For future use. #' #' @return A [tibble][tibble::tibble-package] containing the search results. @@ -87,6 +104,13 @@ #' 1043477615, #' 1144544834))) |> #' purrr::list_rbind() +#' +#' # Quality Stats +#' +#' 2017:2023 |> +#' purrr::map(\(x) quality_eligibility(year = x, stats = TRUE)) |> +#' purrr::list_rbind() +#' #' @autoglobal #' @export quality_eligibility <- function(year, @@ -95,15 +119,39 @@ quality_eligibility <- function(year, unnest = TRUE, pivot = TRUE, na.rm = FALSE, + stats = FALSE, ...) { rlang::check_required(year) year <- as.character(year) - rlang::arg_match(year, as.character(2017:2024)) + year <- rlang::arg_match(year, + as.character(2017:lubridate::year(lubridate::now()))) - rlang::check_required(npi) + if (stats) { + + url <- glue::glue("https://qpp.cms.gov/api/eligibility/stats/?year={year}") + + response <- httr2::request(url) |> + httr2::req_headers(Accept = "application/vnd.qpp.cms.gov.v6+json") |> + httr2::req_perform() |> + httr2::resp_body_json(simplifyVector = TRUE) + + ind <- response$data$individual + grp <- response$data$group + results <- dplyr::tibble( + year = as.integer(year), + type = factor(rep(c("Individual", "Group"), each = 2)), + measure = factor(rep(c("HCC Risk Score", "Dual Eligibility"), 2)), + average = as.double(c(ind$hccRiskScoreAverage %||% 0, + ind$dualEligibilityAverage %||% 0, + grp$hccRiskScoreAverage %||% 0, + grp$dualEligibilityAverage %||% 0))) + return(results) + } + + rlang::check_required(npi) if (length(npi) == 1L) npi <- npi %nn% validate_npi(npi) if (length(npi) > 1L) { @@ -111,7 +159,6 @@ quality_eligibility <- function(year, npi <- paste0(unique(npi), collapse = ",") } - url <- glue::glue("https://qpp.cms.gov/api/eligibility/npis/{npi}/?year={year}") error_body <- function(response) httr2::resp_body_json(response)$error$message diff --git a/R/reassignments.R b/R/reassignments.R index 9bb904ad..f662f8fc 100644 --- a/R/reassignments.R +++ b/R/reassignments.R @@ -16,16 +16,16 @@ #' #' *Update Frequency:* **Monthly** #' -#' @param npi < *integer* > __Individual__ National Provider Identifier -#' @param pac < *integer* > __Individual__ PECOS Associate Control ID -#' @param enid < *character* > __Individual__ Medicare Enrollment ID +#' @param npi < *integer* > __Individual__ 10-digit National Provider Identifier +#' @param pac < *integer* > __Individual__ 10-digit PECOS Associate Control ID +#' @param enid < *character* > __Individual__ 15-digit Medicare Enrollment ID #' @param first,last < *character* > __Individual__ Provider's name -#' @param state < *character* > __Individual__ Enrollment state +#' @param state < *character* > __Individual__ Enrollment state abbreviation #' @param specialty < *character* > __Individual__ Enrollment specialty #' @param organization < *character* > __Organizational__ Legal business name -#' @param pac_org < *integer* > __Organizational__ PECOS Associate Control ID -#' @param enid_org < *character* > __Organizational__ Medicare Enrollment ID -#' @param state_org < *character* > __Organizational__ Enrollment state +#' @param pac_org < *integer* > __Organizational__ 10-digit PECOS Associate Control ID +#' @param enid_org < *character* > __Organizational__ 15-digit Medicare Enrollment ID +#' @param state_org < *character* > __Organizational__ Enrollment state abbreviation #' @param entry < *character* > Entry type, reassignment (`"R"`) or employment (`"E"`) #' @param tidy < *boolean* > // __default:__ `TRUE` Tidy output #' @param na.rm < *boolean* > // __default:__ `TRUE` Remove empty rows and columns diff --git a/man/quality_eligibility.Rd b/man/quality_eligibility.Rd index 8242949d..1f7e570b 100644 --- a/man/quality_eligibility.Rd +++ b/man/quality_eligibility.Rd @@ -12,6 +12,7 @@ quality_eligibility( unnest = TRUE, pivot = TRUE, na.rm = FALSE, + stats = FALSE, ... ) @@ -33,6 +34,8 @@ the same NPI indicate multiple TIN/NPI combinations.} \item{na.rm}{< \emph{boolean} > // \strong{default:} \code{FALSE} Remove empty rows and columns} +\item{stats}{< \emph{boolean} > // \strong{default:} \code{FALSE} Return QPP stats} + \item{...}{Pass arguments to \code{\link[=quality_eligibility]{quality_eligibility()}}.} } \value{ @@ -79,6 +82,30 @@ APM, characterized by an APM Entity ID. } } +\section{\strong{stats} == \code{TRUE}}{ + +Public statistics derived from all QPP providers: +\subsection{HCC Risk Score Average:}{ + +National average individual (NPI) or group (TIN) risk score for MIPS +eligible individual/group. Scores are calculated as follows: +\itemize{ +\item \strong{Individual} = \verb{sum(Clinician Risk Scores) / n(Eligible Clinicians)} +\item \strong{Group} = \verb{sum(Practice Risk Scores) / n(Eligible Practices)} +} +} + +\subsection{Dual Eligibility Average:}{ + +National average individual (NPI) or group (TIN) dual-eligibility score for +MIPS eligible individual/group. +\itemize{ +\item \strong{Individual} = \verb{sum(Clinician Dual-Eligibility Scores) / n(Eligible Clinicians)} +\item \strong{Group} = sum(Practice Dual-Eligibility Scores) / n(Eligible Practices) +} +} +} + \section{Links}{ \itemize{ @@ -117,5 +144,11 @@ purrr::map(\(x) 1043477615, 1144544834))) |> purrr::list_rbind() + +# Quality Stats + +2017:2023 |> +purrr::map(\(x) quality_eligibility(year = x, stats = TRUE)) |> +purrr::list_rbind() \dontshow{\}) # examplesIf} } diff --git a/man/reassignments.Rd b/man/reassignments.Rd index f52f2c2a..c79371e7 100644 --- a/man/reassignments.Rd +++ b/man/reassignments.Rd @@ -22,25 +22,25 @@ reassignments( ) } \arguments{ -\item{npi}{< \emph{integer} > \strong{Individual} National Provider Identifier} +\item{npi}{< \emph{integer} > \strong{Individual} 10-digit National Provider Identifier} -\item{pac}{< \emph{integer} > \strong{Individual} PECOS Associate Control ID} +\item{pac}{< \emph{integer} > \strong{Individual} 10-digit PECOS Associate Control ID} -\item{enid}{< \emph{character} > \strong{Individual} Medicare Enrollment ID} +\item{enid}{< \emph{character} > \strong{Individual} 15-digit Medicare Enrollment ID} \item{first, last}{< \emph{character} > \strong{Individual} Provider's name} -\item{state}{< \emph{character} > \strong{Individual} Enrollment state} +\item{state}{< \emph{character} > \strong{Individual} Enrollment state abbreviation} \item{specialty}{< \emph{character} > \strong{Individual} Enrollment specialty} \item{organization}{< \emph{character} > \strong{Organizational} Legal business name} -\item{pac_org}{< \emph{integer} > \strong{Organizational} PECOS Associate Control ID} +\item{pac_org}{< \emph{integer} > \strong{Organizational} 10-digit PECOS Associate Control ID} -\item{enid_org}{< \emph{character} > \strong{Organizational} Medicare Enrollment ID} +\item{enid_org}{< \emph{character} > \strong{Organizational} 15-digit Medicare Enrollment ID} -\item{state_org}{< \emph{character} > \strong{Organizational} Enrollment state} +\item{state_org}{< \emph{character} > \strong{Organizational} Enrollment state abbreviation} \item{entry}{< \emph{character} > Entry type, reassignment (\code{"R"}) or employment (\code{"E"})}