From 2d9f8a3122f91dbb6a668f3af070ef4e27321595 Mon Sep 17 00:00:00 2001 From: Andrew Bruce Date: Fri, 10 Nov 2023 02:49:29 -0500 Subject: [PATCH] Even more factors (#38) --- R/globals.R | 8 ++++- R/nppes.R | 3 +- R/open_payments.R | 32 ++++++++----------- R/quality_payment.R | 63 +++++++++++++++++++++++++++++++++++++- vignettes/articles/qpp.Rmd | 15 ++++++++- 5 files changed, 98 insertions(+), 23 deletions(-) diff --git a/R/globals.R b/R/globals.R index cf73e1d4..6a58f934 100644 --- a/R/globals.R +++ b/R/globals.R @@ -118,10 +118,14 @@ utils::globalVariables(c( "ep", # "gender", # "entity_type", # + "status", # "identifier", # "y", # - "change_type", # "covered_recipient_type", # + "recipient_state", # + "applicable_manufacturer_or_applicable_gpo_making_payment_state", # + "covered_recipient_license_state_code1", # + "state_of_travel", # "nature_of_payment_or_transfer_of_value", # "address", # "name_1", # @@ -187,7 +191,9 @@ utils::globalVariables(c( "set", # "val", # "score", # + "measure", # "status", # + "category", # "y", # "individual_state_code", # "group_state_code", # diff --git a/R/nppes.R b/R/nppes.R index 53d83cb0..8410c49f 100644 --- a/R/nppes.R +++ b/R/nppes.R @@ -205,7 +205,8 @@ nppes <- function(npi = NULL, purpose = dplyr::if_else(purpose == "LOCATION", "PRACTICE", purpose), gender = fct_gen(gender), entity_type = fct_enum(entity_type), - state = fct_stabb(state)) |> + state = fct_stabb(state), + status = factor(status, levels = "A", labels = "Active")) |> cols_nppes(2) if (rlang::has_name(results, "tx_primary")) results$tx_primary <- as.logical(results$tx_primary) diff --git a/R/open_payments.R b/R/open_payments.R index cfa48238..39306795 100644 --- a/R/open_payments.R +++ b/R/open_payments.R @@ -243,9 +243,12 @@ open_payments <- function(year, # yn = c(yncols), dbl = 'dollars', int = c('program_year', 'pay_count')) |> #nolint - dplyr::mutate(change_type = changed_logical(change_type), - covered_recipient_type = covered_recipient(covered_recipient_type), - nature_of_payment_or_transfer_of_value = nature(nature_of_payment_or_transfer_of_value)) |> + dplyr::mutate(covered_recipient_type = fct_cov(covered_recipient_type), + recipient_state = fct_stabb(recipient_state), + applicable_manufacturer_or_applicable_gpo_making_payment_state = fct_stabb(applicable_manufacturer_or_applicable_gpo_making_payment_state), + covered_recipient_license_state_code1 = fct_stabb(covered_recipient_license_state_code1), + state_of_travel = fct_stabb(state_of_travel), + nature_of_payment_or_transfer_of_value = nature(nature_of_payment_or_transfer_of_value)) |> combine(address, c('recipient_primary_business_street_address_line1', 'recipient_primary_business_street_address_line2')) |> @@ -334,25 +337,16 @@ open_payments_error <- function(response) { strex::str_before_nth(":", 2) } -#' Convert Changed column to logical +#' Convert covered recipient types to unordered labelled factor #' @param x vector #' @autoglobal #' @noRd -changed_logical <- function(x){ - dplyr::case_match(x, "CHANGED" ~ TRUE, - "UNCHANGED" ~ FALSE, - .default = NA) -} - -#' @param x vector -#' @autoglobal -#' @noRd -covered_recipient <- function(x){ - dplyr::case_match(x, - "Covered Recipient Physician" ~ "Physician", - "Covered Recipient Non-Physician Practitioner" ~ "Non-Physician", - "Covered Recipient Teaching Hospital" ~ "Teaching Hospital", - .default = x) +fct_cov <- function(x) { + factor(x, + levels = c("Covered Recipient Physician", + "Covered Recipient Non-Physician Practitioner", + "Covered Recipient Teaching Hospital"), + labels = c("Physician", "NPP", "Teaching Hospital")) } #' @param x vector diff --git a/R/quality_payment.R b/R/quality_payment.R index 4d9ef553..39368b4c 100644 --- a/R/quality_payment.R +++ b/R/quality_payment.R @@ -174,7 +174,8 @@ quality_payment <- function(year, values_fn = list) |> tidyr::unnest(c(id, score)) |> dplyr::filter(!is.na(id)) |> - dplyr::mutate(score = as.double(score)) |> + dplyr::mutate(score = as.double(score), + measure = fct_measure(measure)) |> tidyr::nest(.by = c(year, npi, type), .key = "measures") @@ -188,6 +189,7 @@ quality_payment <- function(year, values_to = "status") |> dplyr::mutate(x = NULL) |> dplyr::filter(!is.na(status) & status != FALSE) |> + dplyr::mutate(category = fct_status(category)) |> tidyr::nest(.by = c(year, npi, type), .key = "statuses") @@ -299,3 +301,62 @@ cols_qpp <- function(df, step = c("tidy", "nest")) { 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_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"), + 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/vignettes/articles/qpp.Rmd b/vignettes/articles/qpp.Rmd index 7c42b7c7..44a8367f 100644 --- a/vignettes/articles/qpp.Rmd +++ b/vignettes/articles/qpp.Rmd @@ -24,6 +24,8 @@ options(scipen = 999) ```{r} library(provider) library(furrr) +library(dplyr) +library(tidyr) ``` ```{r} @@ -33,8 +35,19 @@ nppes(npi = 1144544834) ```{r} plan(multisession, workers = 4) -quality_payment_(npi = 1144544834) +q <- quality_payment_(npi = 1144544834) plan(sequential) +q ``` +```{r} +select(q, year, statuses) |> + unnest(statuses) +``` + + +```{r} +select(q, year, measures) |> + unnest(measures) +```