quality_payment_ bug

andrewallenbruce · Dec 3, 2023 · cba09b8 · cba09b8
1 parent a175f1c
commit cba09b8
Show file tree

Hide file tree

Showing 8 changed files with 140 additions and 79 deletions.
diff --git a/R/add_counties.R b/R/add_counties.R
@@ -6,7 +6,8 @@
 #' @param add_geo add county geometry column, default is `FALSE`
 #' @param as_sf convert tibble to an `{sf}` object, default is `FALSE`
 #'
-#' @examples
+#' @examplesIf interactive()
+#'
 #' # Example data frame containing state abbreviation and zip code
 #' ex <- dplyr::tibble(state = "GA",
 #'                     zip = "31605")

diff --git a/R/globals.R b/R/globals.R
@@ -234,7 +234,6 @@ utils::globalVariables(c(
   "distro", # <quality_payment>
   "y", # <quality_payment>
   "participation_type", # <quality_payment>
-  "org_state", # <quality_payment>
   "val", # <quality_payment>
   "set", # <quality_payment>
   "score", # <quality_payment>
@@ -243,19 +242,6 @@ utils::globalVariables(c(
   "qualified", # <quality_payment>
   "org_size", # <quality_payment>
   "org_id", # <quality_payment>
-  "npi_type", # <quality_payment>
-  "first", # <quality_payment>
-  "middle", # <quality_payment>
-  "last", # <quality_payment>
-  "first_approved_date", # <quality_payment>
-  "years_in_medicare", # <quality_payment>
-  "specialty_type", # <quality_payment>
-  "specialty_cat", # <quality_payment>
-  "ind_specialty_code", # <quality_payment>
-  "org_name", # <quality_payment>
-  "org_address", # <quality_payment>
-  "org_city", # <quality_payment>
-  "org_zip", # <quality_payment>
   "y", # <reassignments>
   "individual_state_code", # <reassignments>
   "group_state_code", # <reassignments>

diff --git a/R/quality_eligibility.R b/R/quality_eligibility.R
@@ -95,7 +95,6 @@
 #'                             1144544834))
 #'
 #' # Multiple NPIs/years
-#'
 #' 2017:2023 |>
 #' purrr::map(\(x)
 #'        quality_eligibility(year = x,
@@ -105,12 +104,20 @@
 #'                                    1144544834))) |>
 #'        purrr::list_rbind()
 #'
-#' # Quality Stats
+#' # Same as
+#' quality_eligibility_(npi = c(aff_npis[1:5],
+#'                              1234567893,
+#'                              1043477615,
+#'                              1144544834))
 #'
+#' # Quality Stats
 #' 2017:2023 |>
 #' purrr::map(\(x) quality_eligibility(year = x, stats = TRUE)) |>
 #' purrr::list_rbind()
 #'
+#' # Same as
+#' quality_eligibility_(stats = TRUE)
+#'
 #' @autoglobal
 #' @export
 quality_eligibility <- function(year,
@@ -378,7 +385,7 @@ cols_qelig <- function(df, type = c('tidyup', 'top', 'apms', 'ind', 'grp')) {
               # 'years_in_medicare'   = 'yearsInMedicare',
               # 'pecos_year'          = 'pecosEnrollmentDate',
               'newly_enrolled'      = 'newlyEnrolled',
-              'specialty'           = 'specialty.specialtyDescription',
+              'specialty_desc'      = 'specialty.specialtyDescription',
               'specialty_type'      = 'specialty.typeDescription',
               'specialty_cat'       = 'specialty.categoryReference',
               'is_maqi'             = 'isMaqi',
@@ -501,7 +508,7 @@ cols_qelig <- function(df, type = c('tidyup', 'top', 'apms', 'ind', 'grp')) {
                   'first_approved_date',
                   'years_in_medicare',
                   'newly_enrolled',
-                  'specialty',
+                  'specialty_desc',
                   'specialty_type',
                   'specialty_cat',
                   'is_maqi',

diff --git a/R/quality_payment.R b/R/quality_payment.R
@@ -151,7 +151,7 @@ quality_payment <- function(year,
                       "extreme_hardship_cost")) |>
       cols_qpp("tidy") |>
       dplyr::mutate(participation_type = fct_part(participation_type),
-                    org_state = fct_stabb(org_state))
+                    state = fct_stabb(state))
 
       if (nest) {
         pcol <- list(q = c('quality_measure_id_', 'quality_measure_score_') %s+% rep(1:10, each = 2),
@@ -176,7 +176,7 @@ quality_payment <- function(year,
             values_to     = "val") |>
           dplyr::filter(!is.na(val)) |>
           dplyr::mutate(x = NULL,
-                        cat_id = NULL) |> #print(n = Inf)
+                        cat_id = NULL) |>
           tidyr::pivot_wider(names_from = set,
                              values_from = val,
                              values_fn = list) |>
@@ -215,32 +215,11 @@ quality_payment <- function(year,
           dplyr::ungroup()
 
         if (eligibility) {
+          by = dplyr::join_by(year, npi, org_id)
           npi  <- unique(results$npi)
           elig <- quality_eligibility(year = year, npi = c(npi))
-          results <- dplyr::left_join(results, elig,
-                     by = dplyr::join_by(year, npi, org_id, specialty, org_state)) |>
-            dplyr::select(year,
-                          npi,
-                          npi_type,
-                          first,
-                          middle,
-                          last,
-                          first_approved_date,
-                          years_in_medicare,
-                          participation_type,
-                          specialty,
-                          specialty_type,
-                          specialty_cat,
-                          specialty_code = ind_specialty_code,
-                          org_id,
-                          org_name,
-                          org_address,
-                          org_city,
-                          org_state,
-                          org_zip,
-                          org_size,
-                          dplyr::everything())
-
+          results <- dplyr::left_join(results, elig, by) |>
+            cols_qcomb()
         }
       }
     }
@@ -259,6 +238,79 @@ quality_payment_ <- function(year = qpp_years(), ...) {
                         .options = furrr::furrr_options(seed = NULL))
 }
 
+#' @autoglobal
+#' @noRd
+cols_qcomb <- function(df) {
+
+  cols <- c('year',
+            'npi',
+            'npi_type',
+            'first',
+            'middle',
+            'last',
+            'state',
+            'first_approved_date',
+            'years_in_medicare',
+            'participation_type',
+            'beneficiaries',
+            'services',
+            'charges' = 'allowed_charges',
+            'final_score',
+            'pay_adjust',
+            'quality_score',
+            'pi_score',
+            'ia_score',
+            'cost_score',
+            'complex_bonus',
+            'qi_bonus',
+            'qp_status',
+            'qp_score_type',
+            'ams_mips_eligible',
+            'newly_enrolled',
+            'is_maqi',
+
+            'org_id',
+            'org_size',
+            'org_name',
+            'org_address',
+            'org_city',
+            'org_state',
+            'org_zip',
+            'org_hosp_vbp_name',
+            'org_facility_based',
+
+            'apms_id',
+            'apms_name',
+            'apms_entity_name',
+            'apms_sub_id',
+            'apms_sub_name',
+            'apms_relationship',
+
+            'ind_lvt_status_code',
+            'ind_lvt_status_desc',
+            'ind_hosp_vbp_score',
+
+            'specialty',
+
+            'specialty_desc',
+            'specialty_type',
+            'specialty_cat',
+
+            'ind_specialty_code',
+            'ind_specialty_desc',
+            'ind_specialty_type',
+            'ind_specialty_cat',
+
+            'qpp_status',
+            'qpp_measures',
+            'ind_status',
+            'grp_status',
+            'apms_status'
+            )
+
+  df |> dplyr::select(dplyr::any_of(cols))
+
+}
 
 #' @autoglobal
 #' @noRd
@@ -268,7 +320,7 @@ cols_qpp <- function(df, step = c("tidy", "nest")) {
 
   cols <- c('year',
             'npi',
-            'org_state'                    = 'practice_state_or_us_territory',
+            'state'                        = 'practice_state_or_us_territory',
             'org_size'                     = 'practice_size',
             'specialty'                    = 'clinician_specialty',
             #'med_years'                    = 'years_in_medicare',
@@ -318,10 +370,10 @@ cols_qpp <- function(df, step = c("tidy", "nest")) {
 
     cols <- c('year',
               'npi',
-              'org_state',
+              'state',
               'org_size',
               'specialty',
-              'med_years',
+              # 'med_years',
               'participation_type',
               'beneficiaries',
               'services',
@@ -337,6 +389,5 @@ cols_qpp <- function(df, step = c("tidy", "nest")) {
               'qpp_status',
               'qpp_measures')
   }
-
   df |> dplyr::select(dplyr::any_of(cols))
 }
diff --git a/man/add_counties.Rd b/man/add_counties.Rd
diff --git a/man/quality_eligibility.Rd b/man/quality_eligibility.Rd
diff --git a/tests/testthat/test-cols.R b/tests/testthat/test-cols.R
@@ -387,7 +387,7 @@ test_that("cols_qpp() works", {
   y <- dplyr::tibble(
     year                         = 1,
     npi                          = 1,
-    org_state                    = 1,
+    state                        = 1,
     org_size                     = 1,
     specialty                    = 1,
     # med_years                    = 1,
@@ -481,7 +481,7 @@ test_that("cols_qpp() works", {
   z <- dplyr::tibble(
     year = 1,
     npi = 1,
-    org_state = 1,
+    state = 1,
     org_size = 1,
     specialty = 1,
     # med_years = 1,
@@ -504,7 +504,7 @@ test_that("cols_qpp() works", {
   zz <- dplyr::tibble(
     year = 1,
     npi = 1,
-    org_state = 1,
+    state = 1,
     org_size = 1,
     specialty = 1,
     # med_years = 1,