From a79ae5ce171b2f4a6180b128f9b35f4c8f3d2595 Mon Sep 17 00:00:00 2001 From: Andrew Bruce Date: Tue, 14 Nov 2023 02:06:58 -0500 Subject: [PATCH] `quality_eligibility()` function --- NAMESPACE | 1 + R/affiliations.R | 3 +- R/clinicians.R | 2 +- R/globals.R | 31 ++-- R/open_payments.R | 11 +- R/{qpp.R => quality_eligibility.R} | 255 ++++++++++++++++++++++++++--- man/open_payments_.Rd | 4 +- man/quality_eligibility.Rd | 83 ++++++++++ vignettes/articles/open.Rmd | 32 +++- vignettes/articles/qpp.Rmd | 42 ++++- 10 files changed, 412 insertions(+), 52 deletions(-) rename R/{qpp.R => quality_eligibility.R} (51%) create mode 100644 man/quality_eligibility.Rd diff --git a/NAMESPACE b/NAMESPACE index a5bd78f7..89dddd5f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -39,6 +39,7 @@ export(pct) export(pending) export(providers) export(qpp_years) +export(quality_eligibility) export(quality_payment) export(quality_payment_) export(reassignments) diff --git a/R/affiliations.R b/R/affiliations.R index 28d27365..05c6e4eb 100644 --- a/R/affiliations.R +++ b/R/affiliations.R @@ -130,7 +130,8 @@ affiliations <- function(npi = NULL, } if (tidy) { - results <- cols_aff(tidyup(results)) |> dplyr::mutate(facility_type = fct_fac(facility_type)) + results <- cols_aff(tidyup(results)) |> + dplyr::mutate(facility_type = fct_fac(facility_type)) if (na.rm) results <- narm(results) } return(results) diff --git a/R/clinicians.R b/R/clinicians.R index cea7b605..1c242f2b 100644 --- a/R/clinicians.R +++ b/R/clinicians.R @@ -116,7 +116,7 @@ clinicians <- function(npi = NULL, "state", state, "zip_code", zip) - error_body <- function(response) {httr2::resp_body_json(response)$message} + error_body <- function(response) httr2::resp_body_json(response)$message response <- httr2::request(file_url("c", args, offset)) |> httr2::req_error(body = error_body) |> diff --git a/R/globals.R b/R/globals.R index b9e78c14..967250d7 100644 --- a/R/globals.R +++ b/R/globals.R @@ -150,21 +150,22 @@ utils::globalVariables(c( "y", # "y", # "y", # - "apms", # - "individual_scenario", # - "group_scenario", # - "apms.extremeHardshipReasons", # - "apms.qpPatientScores", # - "apms.qpPaymentScores", # - "individual_scenario.extremeHardshipReasons", # - "individual_scenario.lowVolumeStatusReasons", # - "individual_scenario.specialty", # - "individual_scenario.isEligible", # - "group_scenario.extremeHardshipReasons", # - "group_scenario.lowVolumeStatusReasons", # - "group_scenario.isEligible", # - "individual_scenario.lowVolumeStatusReasons_1", # - "group_scenario.lowVolumeStatusReasons_1", # + "y", # + "apms", # + "individual_scenario", # + "group_scenario", # + "apms.extremeHardshipReasons", # + "apms.qpPatientScores", # + "apms.qpPaymentScores", # + "individual_scenario.extremeHardshipReasons", # + "individual_scenario.lowVolumeStatusReasons", # + "individual_scenario.specialty", # + "individual_scenario.isEligible", # + "group_scenario.extremeHardshipReasons", # + "group_scenario.lowVolumeStatusReasons", # + "group_scenario.isEligible", # + "individual_scenario.lowVolumeStatusReasons_1", # + "group_scenario.lowVolumeStatusReasons_1", # "y", # "org_pac_id", # "aco_id_1", # diff --git a/R/open_payments.R b/R/open_payments.R index f95377d1..01ff5c3f 100644 --- a/R/open_payments.R +++ b/R/open_payments.R @@ -253,9 +253,9 @@ open_payments <- function(year, combine(address, c('recipient_primary_business_street_address_line1', 'recipient_primary_business_street_address_line2')) |> - cols_open() |> - narm() + cols_open() + ## ------------------------------------------------------------------------ if (pivot) { pcol <- c(paste0('name_', 1:5), paste0('covered_', 1:5), @@ -265,7 +265,7 @@ open_payments <- function(year, paste0('pdi_', 1:5)) results <- results |> - dplyr::mutate(id = dplyr::row_number(), .before = name_1) |> + dplyr::mutate(top_id = dplyr::row_number(), .before = name_1) |> tidyr::pivot_longer( cols = dplyr::any_of(pcol), names_to = c("attr", "group"), @@ -282,6 +282,7 @@ open_payments <- function(year, pay_total = dplyr::if_else(group > 1, NA, pay_total)) if (rlang::has_name(results, "pdi")) results$pdi <- dplyr::na_if(results$pdi, "N/A") + ## ------------------------------------------------------------------------ } if (na.rm) results <- narm(results) } @@ -291,12 +292,12 @@ open_payments <- function(year, #' Parallelized [open_payments()] #' @param year < *integer* > // **required** Year data was reported, in `YYYY` #' format. Run [open_years()] to return a vector of the years currently available. -#' @param na.rm < *boolean* > // __default:__ `TRUE` Remove empty rows and columns +#' @param na.rm < *boolean* > // __default:__ `FALSE` Remove empty rows and columns #' @param ... Pass arguments to [open_payments()]. #' @autoglobal #' @export open_payments_ <- function(year = open_years(), - na.rm = TRUE, + na.rm = FALSE, ...) { results <- furrr::future_map_dfr(year, open_payments, diff --git a/R/qpp.R b/R/quality_eligibility.R similarity index 51% rename from R/qpp.R rename to R/quality_eligibility.R index 1e5be376..5887aa57 100644 --- a/R/qpp.R +++ b/R/quality_eligibility.R @@ -1,24 +1,43 @@ #' Quality Payment Program Eligibility #' -#' @description Data pulled from across CMS that is used to create an -#' eligibility determination for a clinician. Using what CMS knows about a -#' clinician from their billing patterns and enrollments, eligibility is -#' "calculated" multiple times before and during the performance year. +#' @description +#' `r lifecycle::badge("experimental")` +#' +#' [quality_eligibility()] allows the user access to information on eligibility +#' in the Merit-based Incentive Payment System (MIPS) and Advanced Alternative +#' Payment Models (APMs) tracks. +#' +#' Data pulled from across CMS is used to create an eligibility determination +#' for a clinician. Using what CMS knows about a clinician from their billing +#' patterns and enrollments, eligibility is "calculated" multiple times before +#' and during the performance year. +#' +#' @section Quality Payment Program (QPP) Eligibility: +#' The QPP Eligibility System aggregates data from across CMS to create an +#' eligibility determination for every clinician in the system. Using what CMS +#' knows about a clinician from their billing patterns and enrollments, +#' eligibility is "calculated" multiple times before and during the performance +#' year. +#' +#' The information contained in these endpoints includes basic enrollment +#' information, associated organizations, information about those organizations, +#' individual and group special status information, and in the future, any +#' available Alternative Payment Model (APM) affiliations. +#' +#' @section Types: +#' + __Clinicians__ represent healthcare providers and are referenced using a NPI. +#' +#' + __Practices__ represent a clinician or group of clinicians that assign their +#' billing rights to the same TIN. These are represented with a TIN, EIN, or +#' SSN, and querying by this number requires an authorization token. +#' +#' + __Virtual Groups__ represent a combination of two or more TINs with certain +#' characteristics, represented by a virtual group identifier, also requiring an +#' authorization token. +#' +#' + __APM Entities__ represent a group of practices which participate in an +#' APM, characterized by an APM Entity ID. #' -#' @details The Quality Payment Program (QPP) Eligibility System pulls together -#' data from across the Centers for Medicare and Medicaid Services (CMS) to -#' create an eligibility determination for every clinician in the system. -#' Using what CMS knows about a clinician from their billing patterns and -#' enrollments, eligibility is "calculated" multiple times before and during -#' the performance year. Information can be obtained primarily by the -#' Clinician type. You can query the Clinician type by passing in an National -#' Provider Identifier, or NPI. This number is a unique 10-digit -#' identification number issued to health care providers in the United -#' States by CMS. The information contained in these endpoints includes -#' basic enrollment information, associated organizations, information -#' about those organizations, individual and group special status -#' information, and in the future, any available Alternative Payment Model -#' (APM) affiliations. #' #' @section Links: #' + [QPP Eligibility API Documentation](https://cmsgov.github.io/qpp-eligibility-docs/) @@ -26,20 +45,194 @@ #' #' @section Update Frequency: **Annually** #' -#' @param year integer, YYYY, QPP eligibility year. -#' @param npi NPI assigned to the clinician when they enrolled in Medicare. -#' @param tidy Tidy output; default is `TRUE`. +#' @param year < *integer* > // __required__ QPP performance year, in `YYYY`format. +#' Run [qpp_years()] to return a vector of the years currently available. +#' @param npi < *integer* > 10-digit Individual National Provider Identifier +#' assigned to the clinician when they enrolled in Medicare. Multiple rows for +#' the same NPI indicate multiple TIN/NPI combinations. +#' @param tidy < *boolean* > // __default:__ `TRUE` Tidy output +#' @param na.rm < *boolean* > // __default:__ `FALSE` Remove empty rows and columns +#' @param ... For future use. #' #' @return A [tibble][tibble::tibble-package] containing the search results. #' #' @examplesIf interactive() #' quality_eligibility(year = 2020, npi = 1144544834) #' @autoglobal -#' @noRd -# nocov start +#' @export quality_eligibility <- function(year, npi, - tidy = TRUE) { + tidy = TRUE, + na.rm = FALSE, + ...) { + + rlang::check_required(year) + year <- as.character(year) + # rlang::arg_match(year, values = as.character(qpp_years())) + npi <- npi %nn% validate_npi(npi) + url <- glue::glue("https://qpp.cms.gov/api/eligibility/npi/{npi}/?year={year}") + error_body <- function(response) httr2::resp_body_json(response)$error$message + + response <- httr2::request(url) |> + httr2::req_headers(Accept = "application/vnd.qpp.cms.gov.v6+json") |> + httr2::req_error(body = error_body) |> + httr2::req_perform() + + if (vctrs::vec_is_empty(response$body)) { + + cli_args <- dplyr::tribble( + ~x, ~y, + "year", year, + "npi", npi) |> + tidyr::unnest(cols = c(y)) + + format_cli(cli_args) + return(invisible(NULL)) + } + + results <- httr2::resp_body_json(response, simplifyVector = TRUE) + + results <- list( + year = year, + npi = results$data$npi, + npi_type = results$data$nationalProviderIdentifierType, + first = results$data$firstName, + middle = results$data$middleName, + last = results$data$lastName, + first_approved_date = results$data$firstApprovedDate, + years_in_medicare = results$data$yearsInMedicare, + pecos_enroll_year = results$data$pecosEnrollmentDate, + newly_enrolled = results$data$newlyEnrolled, + specialty_description = results$data$specialty$specialtyDescription, + specialty_type = results$data$specialty$typeDescription, + specialty_category = results$data$specialty$categoryReference, + is_maqi = results$data$isMaqi, + organization = results$data$organizations$prvdrOrgName, + hosp_vbp_name = results$data$organizations$hospitalVbpName, + facility_based = results$data$organizations$isFacilityBased, + address_1 = results$data$organizations$addressLineOne, + address_2 = results$data$organizations$addressLineTwo, + city = results$data$organizations$city, + state = results$data$organizations$state, + zip = results$data$organizations$zip, + apms = results$data$organizations$apms, + virtual = results$data$organizations$virtualGroups, + ind = results$data$organizations$individualScenario, + group = results$data$organizations$groupScenario) |> + purrr::compact() |> + purrr::list_flatten() |> + purrr::list_flatten() |> + as.data.frame() + + if (!tidy) results <- df2chr(results) + + if (tidy) { + results <- results |> + dplyr::tibble() + # results <- tidyup(results, + # yn = 'telehlth', + # int = c('num_org_mem', 'grd_yr')) |> + # combine(address, c('adr_ln_1', 'adr_ln_2')) |> + # dplyr::mutate(gndr = fct_gen(gndr), + # state = fct_stabb(state)) |> + # cols_clin() + + if (na.rm) results <- narm(results) + } + return(results) +} + +#' @param df data frame +#' @autoglobal +#' @noRd +cols_qelig <- function(df) { + + cols <- c('year', + 'npi', + 'npi_type', + 'first', + 'middle', + 'last', + 'first_approved_date', + 'years_in_medicare', + 'pecos_enroll_year', + 'newly_enrolled', + 'specialty_description', + 'specialty_type', + 'specialty_category', + 'is_maqi', + 'organization', + 'hosp_vbp_name', + 'facility_based', + 'address_1', + 'address_2', + 'city', + 'state', + 'zip', + + 'ind.aciHardship', + 'ind.aciReweighting', + 'ind.ambulatorySurgicalCenter', + 'ind.extremeHardship', + 'ind.extremeHardshipReasons', + 'ind.extremeHardshipEventType', + 'ind.extremeHardshipSources', + 'ind.hospitalBasedClinician', + 'ind.hpsaClinician', + 'ind.iaStudy', + 'ind.isOptedIn', + 'ind.isOptInEligible', + 'ind.mipsEligibleSwitch', + 'ind.nonPatientFacing', + 'ind.optInDecisionDate', + 'ind.ruralClinician', + 'ind.smallGroupPractitioner', + 'ind.lowVolumeSwitch', + 'ind.lowVolumeStatusReasons', + 'ind.hasPaymentAdjustmentCCN', + 'ind.hasHospitalVbpCCN', + 'ind.aggregationLevel', + 'ind.hospitalVbpName', + 'ind.hospitalVbpScore', + 'ind.isFacilityBased', + 'ind.specialtyCode', + 'ind.specialty', + 'ind.isEligible', + 'ind.eligibilityScenario', + + 'group.aciHardship', + 'group.aciReweighting', + 'group.ambulatorySurgicalCenter', + 'group.extremeHardship', + 'group.extremeHardshipReasons', + 'group.extremeHardshipEventType', + 'group.extremeHardshipSources', + 'group.hospitalBasedClinician', + 'group.hpsaClinician', + 'group.iaStudy', + 'group.isOptedIn', + 'group.isOptInEligible', + 'group.mipsEligibleSwitch', + 'group.nonPatientFacing', + 'group.optInDecisionDate', + 'group.ruralClinician', + 'group.smallGroupPractitioner', + 'group.lowVolumeSwitch', + 'group.lowVolumeStatusReasons', + 'group.aggregationLevel', + 'group.isEligible' + ) + + df |> dplyr::select(dplyr::any_of(cols)) +} + +##------------------------------------------------------------------------------ +#' @autoglobal +#' @noRd +# nocov start +quality_eligibility2 <- function(year, + npi, + tidy = TRUE) { rlang::check_required(year) year <- as.character(year) @@ -49,7 +242,7 @@ quality_eligibility <- function(year, url <- glue::glue("https://qpp.cms.gov/api/eligibility/npi/{npi}/?year={year}") - error_body <- function(resp) {httr2::resp_body_json(resp)$error$message} + error_body <- function(resp) httr2::resp_body_json(resp)$error$message resp <- httr2::request(url) |> httr2::req_error(body = error_body) |> @@ -73,7 +266,19 @@ quality_eligibility <- function(year, results <- dplyr::bind_cols(top, org) + if (!tidy) results <- df2chr(results) + if (tidy) { + + # tidyr::unnest_longer(e1, apms, keep_empty = TRUE) |> + # tidyr::unpack(apms, names_sep = ".") |> + # tidyr::unnest_longer(virtual_groups, keep_empty = TRUE) |> + # tidyr::unpack(virtual_groups, names_sep = ".") |> + # tidyr::unnest_longer(individual_scenario, keep_empty = TRUE) |> + # tidyr::unpack(individual_scenario, names_sep = ".") |> + # tidyr::unnest_longer(group_scenario, keep_empty = TRUE) |> + # tidyr::unpack(group_scenario, names_sep = ".") + results <- results |> tidyr::unnest_wider(c(apms, individual_scenario, diff --git a/man/open_payments_.Rd b/man/open_payments_.Rd index ec40250c..d40e4ffe 100644 --- a/man/open_payments_.Rd +++ b/man/open_payments_.Rd @@ -4,13 +4,13 @@ \alias{open_payments_} \title{Parallelized \code{\link[=open_payments]{open_payments()}}} \usage{ -open_payments_(year = open_years(), na.rm = TRUE, ...) +open_payments_(year = open_years(), na.rm = FALSE, ...) } \arguments{ \item{year}{< \emph{integer} > // \strong{required} Year data was reported, in \code{YYYY} format. Run \code{\link[=open_years]{open_years()}} to return a vector of the years currently available.} -\item{na.rm}{< \emph{boolean} > // \strong{default:} \code{TRUE} Remove empty rows and columns} +\item{na.rm}{< \emph{boolean} > // \strong{default:} \code{FALSE} Remove empty rows and columns} \item{...}{Pass arguments to \code{\link[=open_payments]{open_payments()}}.} } diff --git a/man/quality_eligibility.Rd b/man/quality_eligibility.Rd new file mode 100644 index 00000000..4219ec1b --- /dev/null +++ b/man/quality_eligibility.Rd @@ -0,0 +1,83 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/quality_eligibility.R +\name{quality_eligibility} +\alias{quality_eligibility} +\title{Quality Payment Program Eligibility} +\usage{ +quality_eligibility(year, npi, tidy = TRUE, na.rm = FALSE, ...) +} +\arguments{ +\item{year}{< \emph{integer} > // \strong{required} QPP performance year, in \code{YYYY}format. +Run \code{\link[=qpp_years]{qpp_years()}} to return a vector of the years currently available.} + +\item{npi}{< \emph{integer} > 10-digit Individual National Provider Identifier +assigned to the clinician when they enrolled in Medicare. Multiple rows for +the same NPI indicate multiple TIN/NPI combinations.} + +\item{tidy}{< \emph{boolean} > // \strong{default:} \code{TRUE} Tidy output} + +\item{na.rm}{< \emph{boolean} > // \strong{default:} \code{FALSE} Remove empty rows and columns} + +\item{...}{For future use.} +} +\value{ +A \link[tibble:tibble-package]{tibble} containing the search results. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +\code{\link[=quality_eligibility]{quality_eligibility()}} allows the user access to information on eligibility +in the Merit-based Incentive Payment System (MIPS) and Advanced Alternative +Payment Models (APMs) tracks. + +Data pulled from across CMS is used to create an eligibility determination +for a clinician. Using what CMS knows about a clinician from their billing +patterns and enrollments, eligibility is "calculated" multiple times before +and during the performance year. +} +\section{Quality Payment Program (QPP) Eligibility}{ + +The QPP Eligibility System aggregates data from across CMS to create an +eligibility determination for every clinician in the system. Using what CMS +knows about a clinician from their billing patterns and enrollments, +eligibility is "calculated" multiple times before and during the performance +year. + +The information contained in these endpoints includes basic enrollment +information, associated organizations, information about those organizations, +individual and group special status information, and in the future, any +available Alternative Payment Model (APM) affiliations. +} + +\section{Types}{ + +\itemize{ +\item \strong{Clinicians} represent healthcare providers and are referenced using a NPI. +\item \strong{Practices} represent a clinician or group of clinicians that assign their +billing rights to the same TIN. These are represented with a TIN, EIN, or +SSN, and querying by this number requires an authorization token. +\item \strong{Virtual Groups} represent a combination of two or more TINs with certain +characteristics, represented by a virtual group identifier, also requiring an +authorization token. +\item \strong{APM Entities} represent a group of practices which participate in an +APM, characterized by an APM Entity ID. +} +} + +\section{Links}{ + +\itemize{ +\item \href{https://cmsgov.github.io/qpp-eligibility-docs/}{QPP Eligibility API Documentation} +\item \href{https://qpp.cms.gov/api/eligibility/docs/?urls.primaryName=Eligibility\%2C\%20v6}{QPP Eligibility & MVP/CAHPS/Subgroups Registration Services (v6)} +} +} + +\section{Update Frequency}{ + \strong{Annually} +} + +\examples{ +\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +quality_eligibility(year = 2020, npi = 1144544834) +\dontshow{\}) # examplesIf} +} diff --git a/vignettes/articles/open.Rmd b/vignettes/articles/open.Rmd index db9013f9..91f82084 100644 --- a/vignettes/articles/open.Rmd +++ b/vignettes/articles/open.Rmd @@ -20,16 +20,44 @@ knitr::opts_chunk$set( options(scipen = 999) ``` -```{r} +```{r message=FALSE, warning=FALSE} library(provider) library(furrr) +library(dplyr) ``` ```{r} plan(multisession, workers = 4) -open <- open_payments_(npi = 1043218118) +open <- open_payments_(npi = 1043218118) plan(sequential) open ``` + + +```{r} +open |> + select(program_year, + payer_name, + pay_total, + pay_date, + pay_count, + id, + group, + name, + type) +``` + + +```{r} +open |> count(payer_name, sort = TRUE) +``` + + +```{r} +open |> count(type, sort = TRUE) +``` + + + diff --git a/vignettes/articles/qpp.Rmd b/vignettes/articles/qpp.Rmd index 543420ac..7b5c8c4e 100644 --- a/vignettes/articles/qpp.Rmd +++ b/vignettes/articles/qpp.Rmd @@ -20,7 +20,7 @@ knitr::opts_chunk$set( options(scipen = 999) ``` -```{r} +```{r message=FALSE, warning=FALSE} library(provider) library(furrr) library(dplyr) @@ -74,3 +74,43 @@ select(q, year, measures) |> unnest(measures) |> count(measure, sort = TRUE) ``` + +
+ +## Quality Eligibility + +```{r} +quality_eligibility(year = 2017, npi = 1144544834) |> glimpse() +``` + + + +```{r} +quality_eligibility(year = 2018, npi = 1144544834) |> glimpse() +``` + + + +```{r} +quality_eligibility(year = 2019, npi = 1144544834) |> glimpse() +``` + + +```{r} +quality_eligibility(year = 2020, npi = 1144544834) |> glimpse() +``` + + +```{r} +quality_eligibility(year = 2021, npi = 1144544834) |> glimpse() +``` + + +```{r} +quality_eligibility(year = 2022, npi = 1144544834) |> glimpse() +``` + + +```{r} +quality_eligibility(year = 2023, npi = 1144544834) |> glimpse() +```