ms_drg() function

test: cols_aff()

R/globals.R

@@ -87,6 +87,11 @@ utils::globalVariables(c(
   "confirmed", # <laboratories>
   "confirmed_date", # <laboratories>
   "type_of_action", # <laboratories>
+  "number", # <download_msdrg>
+  "mdc", # <download_msdrg>
+  "mdc_description", # <download_msdrg>
+  "drg_type", # <download_msdrg>
+  "drg_abbrev", # <download_msdrg>
   "y", # <medline>
   "title", # <medline>
   "title._value", # <medline>

R/ms_drg.R

@@ -0,0 +1,51 @@
+#' Download the current MS-DRG classification
+#'
+#' @description
+#' `r lifecycle::badge("questioning")`
+#'
+#' `download_msdrg()` returns a [tibble()] of the current Medicare Severity Diagnosis-Related Group (MS-DRG) codes
+#'
+#' @section MS-DRGs:
+#' The Medicare Severity Diagnosis-Related Group (MS-DRG) is a classification
+#' system used by the Centers for Medicare and Medicaid Services (CMS) to group
+#' patients with similar clinical characteristics and resource utilization into
+#' a single payment category.
+#'
+#' The system is primarily used for Medicare reimbursement purposes, but it is
+#' also adopted by many other payers as a basis for payment determination.
+#'
+#' MS-DRGs are based on the principal diagnosis, up to 24 additional diagnoses,
+#' and up to 25 procedures performed during the stay. In a small number of
+#' MS-DRGs, classification is also based on the age, sex, and discharge status
+#' of the patient.
+#'
+#' Hospitals serving more severely ill patients receive increased
+#' reimbursements, while hospitals treating less severely ill patients will
+#' receive less reimbursement.
+#'
+#' @return A [tibble][tibble::tibble-package] with the columns:
+#'
+#' @examplesIf interactive()
+#' download_msdrg()
+#' @autoglobal
+#' @noRd
+download_msdrg <- function() {
+
+  url <- "https://www.hipaaspace.com/medical.coding.library/drgs/"
+
+  ms_drg_v36 <- url |>
+    rvest::read_html() |>
+    rvest::html_table(na.strings = c("N/A", "N/S"),
+                      convert = FALSE)
+
+  ms_drg_v36[[1]] |>
+    janitor::clean_names() |>
+    dplyr::select(-number) |>
+    dplyr::mutate(mdc = dplyr::na_if(mdc, "N/A"),
+                  mdc_description = dplyr::na_if(mdc_description, "N/S")) |>
+    tidyr::separate_wider_delim(drg_type, " ", names = c("drg_type", "drg_abbrev")) |>
+    dplyr::mutate(drg_abbrev = stringr::str_remove(drg_abbrev, "\\("),
+                  drg_abbrev = stringr::str_remove(drg_abbrev, "\\)"),
+                  drg_abbrev = dplyr::na_if(drg_abbrev, ""))
+
+}

tests/testthat/test-cols.R

@@ -0,0 +1,21 @@
+test_that("cols_aff() works", {
+  x <- dplyr::tibble(npi = 123,
+                     ind_pac_id = 123,
+                     frst_nm = "a",
+                     mid_nm = "b",
+                     lst_nm = "c",
+                     suff = "d",
+                     facility_type = "e",
+                     facility_affiliations_certification_number = 123,
+                     facility_type_certification_number = 123)
+  y <- dplyr::tibble(npi = 123,
+                     pac = 123,
+                     first = "a",
+                     middle = "b",
+                     last = "c",
+                     suffix = "d",
+                     facility_type = "e",
+                     facility_ccn = 123,
+                     parent_ccn = 123)
+  expect_equal(cols_aff(x), y)
+})

vignettes/articles/partb-stats.Rmd

@@ -25,122 +25,114 @@ library(provider)
 library(tidyverse)
 library(gt)
 library(gtExtras)
-library(tictoc)
 ```
 
 
-
-## `utilization()`
-
+# `utilization()`
 
 ```{r}
-tic()
+# Retrieve provider's overall utilization data
 ind     <- map_dfr(util_years(), ~utilization(year = .x, npi = 1043477615, type = "provider"))
-srvc    <- map_dfr(util_years(), ~utilization(year = .x, npi = 1023076643, type = "service"))
+# Retrieve state & national chronic condition data to compare with
 chronic <- compare_conditions(ind)
-hcpcs   <- compare_hcpcs(srvc)
-toc()
 
-## 292.17 sec elapsed
-## 4.8695 min
+# Retrieve provider's utilization data by HCPCS
+srvc    <- map_dfr(util_years(), ~utilization(year = .x, npi = 1023076643, type = "service"))
+# Retrieve state & national HCPCS data to compare with
+hcpcs   <- compare_hcpcs(srvc)
 ```
 
 
-
-<br>
-
-### Provider Performance Data
+## Overall Performance
 
 ```{r}
 ind |> 
   unnest(performance) |> 
-  select(year, tot_hcpcs:.pymt_per_srvc)
+  select(year, tot_hcpcs:.pymt_per_srvc) |> 
+  gt_preview(top_n = 30) |> 
+  opt_table_font(font = google_font(name = "Fira Code")) |> 
+  fmt_currency(columns = starts_with("avg_"), decimals = 0)
 ```
 
 
-### Beneficiary Demographics
-
 ```{r}
 ind |> 
-  unnest(performance, demographics) |> 
-  select(year, tot_benes, starts_with("bene_")) |> 
-  gt(rowname_col = "year") |> 
-  cols_label(tot_benes = "Total") |>  
-  fmt_percent(columns = starts_with("cc_"), decimals = 0) |>
-  opt_table_font(font = google_font(name = "JetBrains Mono")) |> 
-  sub_missing(missing_text = "") |>
-  sub_zero(zero_text = "") |>
-  opt_all_caps()
+  unnest(performance) |> 
+  select(year, tot_hcpcs:tot_srvcs) |> 
+  change(!year) |> 
+  gt_preview(top_n = 30) |> 
+  opt_table_font(font = google_font(name = "Fira Code")) |> 
+  fmt_currency(columns = starts_with("avg_"), decimals = 0)
 ```
 
 
-### Beneficiary Chronic Conditions Data
-
 ```{r}
 ind |> 
   unnest(performance) |> 
-  select(year, tot_benes, conditions) |> 
-  unnest(conditions) |>
-  gt(rowname_col = "year") |> 
-  cols_label(tot_benes = "Total") |>  
-  fmt_percent(columns = starts_with("cc_"), decimals = 0) |>
-  opt_table_font(font = google_font(name = "JetBrains Mono")) |> 
-  sub_missing(missing_text = "") |>
-  sub_zero(zero_text = "") |>
-  opt_all_caps()
+  select(year, tot_charges:tot_payment) |> 
+  change(!year) |> 
+  gt_preview(top_n = 30) |> 
+  opt_table_font(font = google_font(name = "Fira Code")) |> 
+  fmt_currency(columns = starts_with("avg_"), decimals = 0)
 ```
 
 
-<br>
-
-### Chronic Condition Prevalence
-
-
 ```{r}
-chronic |>
-  # filter(prevalence > 0)
-  # filter(!if_any(contains("20"), ~ . <= 0)) |>
-  pivot_wider(names_from = year, 
-              values_from = prevalence) |>
-  gt(rowname_col = "level") |> 
-  fmt_percent(columns = contains('0'), decimals = 0) |>
-  opt_table_font(font = google_font(name = "JetBrains Mono")) |> 
-  sub_missing(missing_text = "") |> 
-  cols_nanoplot(
-    columns = starts_with("20"),
-    plot_type = "bar",
-    new_col_name = "change",
-    new_col_label = "change",
-    missing_vals = "remove",
-    options = nanoplot_options(
-      show_data_line = FALSE,
-      show_data_area = FALSE,
-      data_bar_stroke_color = "transparent"
-    )
-  )
+ind |> 
+  unnest(performance) |> 
+  select(year, .copay_deduct:.pymt_per_srvc) |> 
+  change(!year) |> 
+  gt_preview(top_n = 30) |> 
+  opt_table_font(font = google_font(name = "Fira Code")) |> 
+  fmt_currency(columns = starts_with("avg_"), decimals = 0)
 ```
 
-
-<br>
-
 ## HCPCS Utilization Data
 
 ```{r}
 srvc |> 
-  dplyr::group_by(year, family) |> 
-  dplyr::mutate(hcpcs_level = dplyr::min_rank(dplyr::pick(avg_allowed, avg_payment))) |> 
-  dplyr::select(year, hcpcs_code, family, hcpcs_level, avg_allowed, avg_payment) |> 
+  group_by(year, family) |> 
+  mutate(hcpcs_level = dplyr::min_rank(dplyr::pick(avg_allowed, avg_payment))) |> 
+  select(year, hcpcs, level = hcpcs_level, family, avg_allowed, avg_payment) |> 
+  arrange(year, family, level) |> 
   gt_preview(top_n = 30) |> 
   opt_table_font(font = google_font(name = "Fira Code")) |> 
   fmt_currency(columns = starts_with("avg_"), decimals = 0)
 ```
 
+
+```{r}
+hcpcs |> 
+  group_by(year, level, subcategory) |>
+  summarise(Beneficiaries = sum(beneficiaries),
+            Services = sum(services),
+            "Average Payment" = mean(avg_payment), .groups = "drop") |>
+  arrange(year, subcategory) |>
+  gt(rowname_col = "year") |> 
+  cols_align("left", level) |> 
+  cols_move_to_start(columns = subcategory) |> 
+  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") |> 
+  opt_all_caps()
+```
+
+
+
+
 <br>
 
 ```{r}
 srvc |> 
   select(year, 
-         hcpcs_code, 
+         hcpcs, 
          family, 
          tot_benes, 
          tot_srvcs, 
@@ -166,15 +158,12 @@ srvc |>
   opt_all_caps()
 ```
 
-<br>
-<br>
-
 
 ```{r}
 hcpcs |> 
   select(year, 
          level,
-         hcpcs_code,
+         hcpcs,
          category,
          subcategory,
          family, 
@@ -183,10 +172,10 @@ hcpcs |>
          avg_charge, 
          avg_allowed, 
          avg_payment) |> 
-  arrange(hcpcs_code, year) |>
+  arrange(hcpcs, year) |>
   gt(rowname_col = "year") |> 
   cols_label(
-    hcpcs_code = "HCPCS",
+    hcpcs = "HCPCS",
     avg_charge = "Charge",
     avg_allowed= "Allowed",
     avg_payment = "Payment") |> 
@@ -199,30 +188,70 @@ hcpcs |>
 
 
 
-<br>
-<br>
+
+## Demographics
 
 ```{r}
-hcpcs |> 
-  group_by(year, level, category) |>
-  summarise(Beneficiaries = sum(beneficiaries),
-            Services = sum(services),
-            "Average Payment" = mean(avg_payment), .groups = "drop") |>
-  arrange(year, category) |>
+ind |> 
+  unnest(performance, demographics) |> 
+  select(year, tot_benes, starts_with("bene_")) |> 
   gt(rowname_col = "year") |> 
-  cols_align("left", level) |> 
-  cols_move_to_start(columns = category) |> 
-  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") |> 
+  cols_label(tot_benes = "Total") |>  
+  fmt_percent(columns = starts_with("cc_"), decimals = 0) |>
+  opt_table_font(font = google_font(name = "JetBrains Mono")) |> 
+  sub_missing(missing_text = "") |>
+  sub_zero(zero_text = "") |>
   opt_all_caps()
 ```
 
+
+### Chronic Conditions
+
+```{r}
+ind |> 
+  unnest(performance) |> 
+  select(year, tot_benes, conditions) |> 
+  unnest(conditions) |>
+  gt(rowname_col = "year") |> 
+  cols_label(tot_benes = "Total") |>  
+  fmt_percent(columns = starts_with("cc_"), decimals = 0) |>
+  opt_table_font(font = google_font(name = "JetBrains Mono")) |> 
+  sub_missing(missing_text = "") |>
+  sub_zero(zero_text = "") |>
+  opt_all_caps()
+```
+
+
+<br>
+
+### Comparison: Chronic Conditions
+
+
+```{r}
+chronic |>
+  # filter(prevalence > 0)
+  # filter(!if_any(contains("20"), ~ . <= 0)) |>
+  pivot_wider(names_from = year, 
+              values_from = prevalence) |>
+  gt(rowname_col = "level") |> 
+  fmt_percent(columns = contains('0'), decimals = 0) |>
+  opt_table_font(font = google_font(name = "JetBrains Mono")) |> 
+  sub_missing(missing_text = "") |> 
+  cols_nanoplot(
+    columns = starts_with("20"),
+    plot_type = "bar",
+    new_col_name = "change",
+    new_col_label = "change",
+    missing_vals = "remove",
+    options = nanoplot_options(
+      show_data_line = FALSE,
+      show_data_area = FALSE,
+      data_bar_stroke_color = "transparent"
+    )
+  )
+```
+
+
+
+
 <br><br>