commit

andrewallenbruce · Oct 6, 2023 · b0ba9da · b0ba9da
1 parent 1c5871b
commit b0ba9da
Show file tree

Hide file tree

Showing 6 changed files with 86 additions and 107 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -19,6 +19,7 @@ Imports:
     anytime,
     cli,
     dplyr,
+    forcats,
     httr2,
     janitor,
     lubridate,

diff --git a/R/compare.R b/R/compare.R
@@ -57,7 +57,8 @@ compare_hcpcs <- function(df) {
                     category, subcategory, family, procedure,
                     beneficiaries,
                     services,
-                    dplyr::contains("avg_")))
+                    dplyr::contains("avg_"))) |>
+    dplyr::mutate(level = forcats::fct_inorder(level))
 
   return(results)
 

diff --git a/R/order_refer.R b/R/order_refer.R
@@ -119,10 +119,11 @@ order_refer <- function(npi   = NULL,
   if (tidy) {
     results <- tidyup(results) |>
       dplyr::mutate(dplyr::across(
-        dplyr::contains(c("partb", "hha", "dme", "pmd")), yn_logical)) |>
-      ord_cols()
+        dplyr::contains(c("partb", "hha", "dme", "pmd")), yn_logical))
+
     if (pivot) {
-      results <- tidyr::pivot_longer(results, cols = !c(npi, first, last),
+      results <-  ord_cols(results) |>
+        tidyr::pivot_longer(cols = !c(npi, first, last),
                           names_to = "service",
                           values_to = "status") |>
         dplyr::filter(status == TRUE) |>

diff --git a/tests/testthat/_snaps/utils-checks.md b/tests/testthat/_snaps/utils-checks.md
@@ -2,79 +2,89 @@
 
     Code
       npi_check(1234567891)
-    Error <rlang_error>
-      An NPI must pass Luhn algorithm.
+    Condition
+      Error:
+      ! An NPI must pass Luhn algorithm.
       x 1234567891 fails Luhn check.
 
 ---
 
     Code
       npi_check(12345691234)
-    Error <rlang_error>
-      An NPI must be 10 digits long.
+    Condition
+      Error:
+      ! An NPI must be 10 digits long.
       x 12345691234 contains 11 digits.
 
 ---
 
     Code
       npi_check("O12345678912")
-    Error <rlang_error>
-      An NPI must be numeric.
+    Condition
+      Error:
+      ! An NPI must be numeric.
       x "O12345678912" contains non-numeric characters.
 
 # pac_check() works
 
     Code
       pac_check(123456789)
-    Error <rlang_error>
-      A PAC ID must be 10 digits long.
+    Condition
+      Error:
+      ! A PAC ID must be 10 digits long.
       x 123456789 contains 9 digits.
 
 ---
 
     Code
       pac_check("O12345678912")
-    Error <rlang_error>
-      A PAC ID must be numeric.
+    Condition
+      Error:
+      ! A PAC ID must be numeric.
       x "O12345678912" contains non-numeric characters.
 
 # enroll_check() works
 
     Code
       enroll_check(123456789123456)
-    Error <rlang_error>
-      An Enrollment ID must be a <character> vector.
+    Condition
+      Error:
+      ! An Enrollment ID must be a <character> vector.
       x 123456789123456 is a <numeric> vector.
 
 ---
 
     Code
       enroll_check("I123456789123456")
-    Error <rlang_error>
-      An Enrollment ID must be 15 characters long.
+    Condition
+      Error:
+      ! An Enrollment ID must be 15 characters long.
       x "I123456789123456" contains 16 characters.
 
 ---
 
     Code
       enroll_check("012345678912345")
-    Error <rlang_error>
-      An Enrollment ID must begin with a capital `I` or `O`.
+    Condition
+      Error:
+      ! An Enrollment ID must begin with a capital `I` or `O`.
       x "012345678912345" begins with "0".
 
 # enroll_org_check() works
 
     Code
       enroll_org_check("I20031110000070")
-    Error <rlang_error>
-      An org/group Enrollment ID must begin with a capital `O`.
+    Condition
+      Error:
+      ! An org/group Enrollment ID must begin with a capital `O`.
       x "I20031110000070" begins with "I".
 
 # enroll_ind_check() works
 
     Code
       enroll_ind_check("O20031110000070")
-    Error <rlang_error>
-      An individual Enrollment ID must begin with a capital `I`.
+    Condition
+      Error:
+      ! An individual Enrollment ID must begin with a capital `I`.
       x "O20031110000070" begins with "O".
 
diff --git a/vignettes/articles/partb-stats.Rmd b/vignettes/articles/partb-stats.Rmd
@@ -21,7 +21,6 @@ knitr::opts_chunk$set(
 library(provider)
 library(tidyverse)
 library(gt)
-library(ggthemes)
 ```
 
 
@@ -35,65 +34,6 @@ df <- map_dfr(prac_years(), ~by_provider(year = .x, npi = 1023076643))
 
 ### Counts & Amounts
 
-```{r}
-select(df, 
-       year, 
-       Charges = tot_charges,
-       Allowed = tot_allowed,
-       Payment = tot_payment) |> 
-  ggplot() +
-  geom_line(aes(year, Charges), color = "gray70", linewidth = 1) +
-  geom_line(aes(year, Allowed), color = "gray50", linewidth = 1) +
-  geom_line(aes(year, Payment), color = "gray10", linewidth = 1) +
-  geom_hline(yintercept = mean(df$tot_charges), color = "gray70", linetype = "dashed") +
-  geom_hline(yintercept = mean(df$tot_allowed), color = "gray50", linetype = "dashed") +
-  geom_hline(yintercept = mean(df$tot_payment), color = "gray10", linetype = "dashed") +
-  labs(x = NULL, y = NULL) +
-  scale_x_continuous(breaks = c(2013:2019)) +
-  scale_y_continuous(labels = scales::label_dollar(scale = 1)) +
-  ggthemes::theme_fivethirtyeight()
-```
-
-<br>
-
-```{r}
-select(df, 
-       year, 
-       Beneficiaries = tot_benes,
-       Services = tot_srvcs) |> 
-  ggplot() +
-  geom_line(aes(year, Beneficiaries), color = "gray50", linewidth = 1) +
-  geom_line(aes(year, Services), color = "gray", linewidth = 1) +
-  geom_hline(yintercept = mean(df$tot_benes), color = "gray50", linetype = "dashed") +
-  geom_hline(yintercept = mean(df$tot_srvcs), color = "gray", linetype = "dashed") +
-  labs(x = NULL, y = NULL) +
-  scale_x_continuous(breaks = c(2013:2019)) +
-  scale_y_continuous(labels = scales::label_comma()) +
-  ggthemes::theme_fivethirtyeight()
-```
-<br>
-
-```{r}
-select(df, 
-       year, 
-       Beneficiaries = tot_benes,
-       Services = tot_srvcs,
-       Payment = tot_payment) |> 
-  change(c(Beneficiaries, Services, Payment)) |> 
-  ggplot() +
-  geom_line(aes(year, Beneficiaries_chg_cum), color = "gray50", linewidth = 1) +
-  geom_line(aes(year, Services_chg_cum), color = "gray30", linewidth = 1) +
-  #geom_line(aes(year, Payment_chg_cum), color = "gray10", linewidth = 1) +
-  #geom_hline(yintercept = mean(df$tot_benes), color = "gray50", linetype = "dashed") +
-  #geom_hline(yintercept = mean(df$tot_srvcs), color = "gray", linetype = "dashed") +
-  labs(x = NULL, y = NULL) +
-  scale_x_continuous(breaks = c(2013:2019)) +
-  #scale_y_continuous(labels = scales::label_percent()) +
-  ggthemes::theme_fivethirtyeight()
-```
-
-<br>
-
 ```{r}
 select(df, 
        year, 
@@ -196,7 +136,7 @@ select(df,
     new_col_name = "nanoplots",
     new_col_label = md("*TREND*"),
     reference_line = "mean",
-    height = "3em",
+    plot_height = "3em",
     options = nanoplot_options(
       data_line_stroke_color = "black",
       show_reference_line = TRUE,
@@ -229,7 +169,7 @@ chronic |>
     new_col_name = "provider_plot",
     new_col_label = md("*Provider*"),
     missing_vals = "remove",
-    height = "3em",
+    plot_height = "3em",
     options = nanoplot_options(
       data_line_stroke_color = "black",
       show_reference_line = TRUE,
@@ -240,7 +180,7 @@ chronic |>
     new_col_name = "state_plot",
     new_col_label = md("*State*"),
     missing_vals = "remove",
-    height = "3em",
+    plot_height = "3em",
     options = nanoplot_options(
       data_line_stroke_color = "black",
       show_reference_line = TRUE,
@@ -251,7 +191,7 @@ chronic |>
     new_col_name = "national_plot",
     new_col_label = md("*National*"),
     missing_vals = "remove",
-    height = "3em",
+    plot_height = "3em",
     options = nanoplot_options(
       data_line_stroke_color = "black",
       show_reference_line = TRUE,
@@ -276,24 +216,41 @@ chronic |>
 ```{r}
 hcpcs <- prac_years() |> 
   map(\(x) by_service(year = x, npi = 1023076643)) |> 
-  list_rbind()
+  list_rbind() |> 
+  compare_hcpcs()
+
 hcpcs
 ```
 
-<br>
 
 
+<br><br>
+
 ```{r}
-hcpcs_compare <- hcpcs |> compare_hcpcs()
-hcpcs_compare
+hcpcs |> 
+  group_by(year, level, family) |>
+  summarise(beneficiaries = sum(beneficiaries),
+            services = sum(services),
+            "Average Payment" = mean(avg_payment), .groups = "drop") |>
+  arrange(year, family) |>
+  gt() |> 
+  fmt_integer(columns = c(beneficiaries, services)) |> 
+  fmt_currency(columns = c('Average Payment'), decimals = 2) |> 
+  opt_table_font(font = google_font(name = "JetBrains Mono")) |>
+  tab_header(title = md("**Medicare Part B** Utilization")) |> 
+  opt_horizontal_padding(scale = 2) |> 
+  tab_options(table.width = pct(50),
+              column_labels.font.weight = "bold",
+              row_group.font.weight = "bold",
+              heading.background.color = "black",
+              heading.align = "left")
 ```
 
 
-
-<br>
+<br><br>
 
 ```{r}
-hcpcs_compare |>
+hcpcs |>
 select(year, 
          level, 
          HCPCS = hcpcs_code,
@@ -307,13 +264,7 @@ select(year,
                values_to = "amount") |> 
   pivot_wider(names_from = level, 
               values_from = amount) |> 
-  arrange(stat, HCPCS)
-```
-
-<br>
-
-```{r}
-hcpcs |> 
+  arrange(stat, HCPCS) |>
   filter(stat %in% c("Average Payment")) |> 
   gt(rowname_col = "year") |> 
   fmt_currency(columns = c(Provider, State, National), decimals = 2) |> 
@@ -330,11 +281,24 @@ hcpcs |>
               heading.background.color = "black",
               heading.align = "left")
 ```
-
-<br>
+<br><br>
 
 ```{r}
-hcpcs |> 
+hcpcs |>
+select(year, 
+         level, 
+         HCPCS = hcpcs_code,
+         beneficiaries,
+         services, 
+         "Average Payment" = avg_payment) |> 
+  mutate("Services Per Beneficiary" = services/beneficiaries) |> 
+  select(-c(beneficiaries, services)) |> 
+  pivot_longer(!year:HCPCS, 
+               names_to = "stat", 
+               values_to = "amount") |> 
+  pivot_wider(names_from = level, 
+              values_from = amount) |> 
+  arrange(stat, HCPCS) |> 
   filter(stat %in% c("Services Per Beneficiary")) |> 
   gt(rowname_col = "year") |> 
   fmt_number(columns = c(Provider, State, National), decimals = 2) |> 
@@ -351,3 +315,5 @@ hcpcs |>
               heading.background.color = "black",
               heading.align = "left")
 ```
+
+<br>
diff --git a/vignettes/linking_providers.Rmd b/vignettes/linking_providers.Rmd
@@ -40,7 +40,7 @@ library(purrr)
 (rv <- revalidation_reassign(pac_ind = p$pac))
 ```
 ```{r}
-(cl <- clinicians(pac_ind = p$pac))
+(cl <- clinicians(pac = p$pac))
 ```
 <br>
 
@@ -75,7 +75,7 @@ full_join(
   providers(pac = 7810891009), 
   revalidation_date(enroll_id = "I20031120000251")) |> 
 full_join(revalidation_reassign(pac_ind = 7810891009)) |> 
-  full_join(clinicians(pac_ind = 7810891009)) |> 
+  full_join(clinicians(pac = 7810891009)) |> 
   glimpse()
 ```