factors, closes #38, closes #49, closes #51

andrewallenbruce · Nov 13, 2023 · aeb0b12 · aeb0b12
1 parent 5eb5c47
commit aeb0b12
Show file tree

Hide file tree

Showing 14 changed files with 141 additions and 94 deletions.
diff --git a/R/compare.R b/R/compare.R
@@ -40,7 +40,10 @@ compare_hcpcs <- function(df) {
       "x" = "{.var df} is of class {.cls {class(df)}}."))
   }
 
-  x <- df |> dplyr::select(year, state, hcpcs, pos)
+  x <- df |>
+    dplyr::select(year, state, hcpcs, pos) |>
+    dplyr::mutate(pos = as.character(pos),
+                  pos = dplyr::if_else(pos == "Facility", "F", "O"))
 
   x$type <- "geography"
 
@@ -56,19 +59,10 @@ compare_hcpcs <- function(df) {
     hcpcs_cols(df),
     hcpcs_cols(state),
     hcpcs_cols(national)) |>
-    dplyr::mutate(level = fct_lvl(level)) |>
+    dplyr::mutate(level = fct_level(level)) |>
     dplyr::relocate(providers, .before = beneficiaries)
 }
 
-#' @param x vector
-#' @autoglobal
-#' @noRd
-fct_lvl <- function(x) {
-  factor(x,
-         levels = c("Provider", "State", "National"),
-         ordered = TRUE)
-}
-
 #' @param df data frame
 #' @autoglobal
 #' @noRd

diff --git a/R/globals.R b/R/globals.R
@@ -145,6 +145,7 @@ utils::globalVariables(c(
   "state_code", # <opt_out>
   "y", # <order_refer>
   "status", # <order_refer>
+  "service", # <order_refer>
   "distro", # <outpatient>
   "y", # <outpatient>
   "y", # <pending>
@@ -230,12 +231,21 @@ utils::globalVariables(c(
   "tot_payment", # <tidyup_provider>
   "tot_srvcs", # <tidyup_provider>
   "tot_benes", # <tidyup_provider>
+  "entity_type", # <tidyup_provider>
+  "gender", # <tidyup_provider>
+  "state", # <tidyup_provider>
   "hcc_risk_avg", # <tidyup_provider>
   "medical", # <tidyup_provider>
   "drug", # <tidyup_provider>
   "address", # <tidyup_service>
   "specialty", # <tidyup_service>
+  "gender", # <tidyup_service>
+  "state", # <tidyup_service>
+  "pos", # <tidyup_service>
+  "level", # <tidyup_service>
+  "rndrng_prvdr_geo_desc", # <tidyup_geography>
   "place_of_srvc", # <tidyup_geography>
+  "rndrng_prvdr_geo_lvl", # <tidyup_geography>
   "title", # <cms_update>
   "modified", # <cms_update>
   "distribution", # <cms_update>

diff --git a/R/nppes.R b/R/nppes.R
@@ -65,6 +65,7 @@
 #' @section Links:
 #' + [NPPES NPI Registry API Documentation](https://npiregistry.cms.hhs.gov/api-page)
 #' + [NPPES NPI Registry API Demo](https://npiregistry.cms.hhs.gov/demo-api)
+#' + [NPPES Available Countries](https://npiregistry.cms.hhs.gov/help-api/country)
 #'
 #' @section Trailing Wildcard Entries:
 #' Arguments that allow trailing wildcard entries are denoted in the parameter

diff --git a/R/open_payments.R b/R/open_payments.R
@@ -171,9 +171,10 @@ open_payments <- function(year,
   zip <- zip %nn% as.character(zip)
 
   if (!is.null(covered_type)) {
-    covered_type <- rlang::arg_match(covered_type, c("Physician",
-                                     "Non-Physician Practitioner",
-                                     "Teaching Hospital"))
+    covered_type <- rlang::arg_match(
+      covered_type, c("Physician",
+                      "Non-Physician Practitioner",
+                      "Teaching Hospital"))
     covered_type <- paste0("Covered Recipient ", covered_type)
   }
 
@@ -240,7 +241,7 @@ open_payments <- function(year,
 
     results <- tidyup(results,
                       dtype = 'mdy',
-                      # yn = c(yncols),
+                      yn = c(yncols),
                       dbl = 'dollars',
                       int = c('program_year', 'pay_count')) |> #nolint
       dplyr::mutate(covered_recipient_type                                         = fct_cov(covered_recipient_type),
@@ -279,6 +280,8 @@ open_payments <- function(year,
         dplyr::filter(!is.na(name)) |>
         dplyr::mutate(group = as.integer(group),
                       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)
   }
@@ -346,7 +349,7 @@ fct_cov <- function(x) {
          levels = c("Covered Recipient Physician",
                     "Covered Recipient Non-Physician Practitioner",
                     "Covered Recipient Teaching Hospital"),
-         labels = c("Physician", "NPP", "Teaching Hospital"))
+         labels = c("Physician", "Non-Physician Practitioner", "Teaching Hospital"))
 }
 
 #' @param x vector

diff --git a/R/order_refer.R b/R/order_refer.R
@@ -117,7 +117,8 @@ order_refer <- function(npi   = NULL,
                           names_to = "service",
                           values_to = "status") |>
         dplyr::filter(status == TRUE) |>
-        dplyr::mutate(status = NULL)
+        dplyr::mutate(status = NULL,
+                      service = fct_ord(service))
       }
     }
   return(results)
@@ -138,3 +139,13 @@ cols_ord <- function(df) {
 
   df |> dplyr::select(dplyr::any_of(cols))
 }
+
+#' @autoglobal
+#' @noRd
+fct_ord <- function(x) {
+  factor(x,
+         levels = c("Medicare Part B",
+                    "Home Health Agency",
+                    "Durable Medical Equipment",
+                    "Power Mobility Devices"))
+}
diff --git a/R/quality_payment.R b/R/quality_payment.R
@@ -189,7 +189,8 @@ quality_payment <- function(year,
             values_to     = "status") |>
           dplyr::mutate(x = NULL) |>
           dplyr::filter(!is.na(status) & status != FALSE) |>
-          dplyr::mutate(category = fct_status(category)) |>
+          dplyr::mutate(category = fct_status(category),
+                        status = NULL) |>
           tidyr::nest(.by = c(year, npi, type),
                       .key = "statuses")
 
@@ -299,7 +300,9 @@ cols_qpp <- function(df, step = c("tidy", "nest")) {
 #' @autoglobal
 #' @noRd
 fct_part <- function(x) {
-  factor(x, levels = c("Group", "Individual", "MIPS APM"))
+  factor(x, levels = c("Group",
+                       "Individual",
+                       "MIPS APM"))
 }
 
 #' @autoglobal

diff --git a/R/utilization.R b/R/utilization.R
@@ -164,11 +164,7 @@ utilization <- function(year,
   par   <- par %nn% tf_2_yn(par) # nolint
   hcpcs <- hcpcs %nn% as.character(hcpcs)
   drug  <- drug %nn% tf_2_yn(drug)
-
-  if (!is.null(pos)) {
-    rlang::arg_match(pos, c("F", "O"))
-    pos <- pos_char(pos)
-  }
+  pos   <- pos %nn% rlang::arg_match(pos, c("F", "O"))
 
   args <- dplyr::tribble(
     ~param,                           ~arg,
@@ -284,7 +280,10 @@ tidyup_provider <- function(results, nest, detailed) {
                   .copay_deduct   = tot_allowed - tot_payment,
                   .srvcs_per_bene = tot_srvcs   / tot_benes,
                   .pymt_per_bene  = tot_payment / tot_benes,
-                  .pymt_per_srvc  = tot_payment / tot_srvcs)
+                  .pymt_per_srvc  = tot_payment / tot_srvcs,
+                  entity_type     = fct_ent(entity_type),
+                  gender          = fct_gen(gender),
+                  state           = fct_stabb(state))
 
   if (nest) {
     results <- tidyr::nest(
@@ -320,7 +319,11 @@ tidyup_service <- function(results, rbcs) {
                     dbl     = "avg_") |>
     combine(address, c('rndrng_prvdr_st1', 'rndrng_prvdr_st2')) |>
     cols_util("service") |>
-    dplyr::mutate(specialty = correct_specialty(specialty))
+    dplyr::mutate(specialty = correct_specialty(specialty),
+                  gender    = fct_gen(gender),
+                  state     = fct_stabb(state),
+                  pos       = fct_pos(pos),
+                  level     = fct_level(level))
 
   if (rbcs) results <- rbcs_util(results)
 
@@ -338,7 +341,9 @@ tidyup_geography <- function(results, rbcs) {
                     yn           = "_ind",
                     int          = c("year", "tot_"),
                     dbl          = "avg_") |>
-    dplyr::mutate(place_of_srvc  = pos_char(place_of_srvc)) |>
+    dplyr::mutate(rndrng_prvdr_geo_desc = fct_stabb(rndrng_prvdr_geo_desc),
+                  place_of_srvc         = fct_pos(place_of_srvc),
+                  rndrng_prvdr_geo_lvl  = fct_level(rndrng_prvdr_geo_lvl)) |>
     cols_util("geography")
 
   if (rbcs) results <- rbcs_util(results)

diff --git a/R/utils-fct.R b/R/utils-fct.R
@@ -3,7 +3,7 @@
 #' @autoglobal
 #' @noRd
 fct_level <- function(x) {
-  factor(x, levels = c("National", "State", "County"), ordered = TRUE)
+  factor(x, levels = c("National", "State", "County", "Provider"), ordered = TRUE)
 }
 
 #' Convert time period levels to ordered factor
@@ -66,13 +66,23 @@ fct_enum <- function(x) {
          labels = c("Individual", "Organization"))
 }
 
+#' Convert entity types to labelled factor
+#' @param x vector
+#' @autoglobal
+#' @noRd
+fct_ent <- function(x) {
+  factor(x,
+         levels = c("I", "O"),
+         labels = c("Individual", "Organization"))
+}
+
 #' Convert entity types to labelled factor
 #' @param x vector
 #' @autoglobal
 #' @noRd
 fct_pos <- function(x) {
   factor(x,
-         levels = c("F", "N"),
+         levels = c("F", "O"),
          labels = c("Facility", "Non-facility"))
 }
 

diff --git a/R/utils.R b/R/utils.R
@@ -112,18 +112,6 @@ abb2full <- function(abb,
   return(results)
 }
 
-#' Convert Place of Service values
-#' @param x vector
-#' @autoglobal
-#' @noRd
-pos_char <- function(x) {
-
-    dplyr::case_match(x,
-      c("facility", "Facility", "F", "f") ~ "F",
-      c("office", "Office", "O", "o") ~ "O",
-      .default = NULL)
-}
-
 #' Pivot data frame to long format for easy printing
 #' @param df data frame
 #' @param cols columns to pivot long, default is [dplyr::everything()]

diff --git a/README.Rmd b/README.Rmd
@@ -134,8 +134,7 @@ opt_out(npi = 1043522824) |> glimpse()
 ### `order_refer()`
 
 ```{r}
-order_refer(npi   = 1043522824, 
-            pivot = FALSE) |> glimpse()
+order_refer(npi   = 1043522824)
 ```
 
 
@@ -201,12 +200,16 @@ select(p, year, performance) |> unnest(performance) |> glimpse()
 
 
 ```{r}
-select(p, year, demographics) |> unnest(demographics) |> glimpse()
+select(p, year, demographics) |> 
+  unnest(demographics) |> 
+  glimpse()
 ```
 
 
 ```{r}
-select(p, year, conditions) |> unnest(conditions) |> glimpse()
+select(p, year, conditions) |> 
+  unnest(conditions) |> 
+  glimpse()
 ```