Personal R code cookbook for common Revenue Cycle Management analysis.
This is intended to be a step-by-step guide for data analysis of healthcare reimbursement data reported annually; one of a series of posts I’ll be working on with the goal of turning the code into functions in the interest of speeding up repetitive analyses.
I’ll create a data frame with mock data typical of a yearly revenue cycle report for a medical practice:
rcmann <- data.frame(
date = (c(seq(
as.Date("2022-01-01"),
by = "month",
length.out = 12
))
),
gct = c(
325982, 297731.74, 198655.14,
186047, 123654, 131440.28,
153991, 156975, 146878.12,
163799.44, 151410.74, 169094.46
),
earb = c(
288432.52, 307871.08, 253976.56,
183684.90, 204227.59, 203460.47,
182771.32, 169633.64, 179347.72,
178051.11, 162757.49, 199849.30
),
adj = c(
170173.76, 153744.3, 133104.13,
84582.48, 52999.08, 66491.99,
89434.24, 102057.43, 63494.83,
83673.68, 88268.09, 62971.82
),
pmt = c(
104181.64, 124548.88, 119445.53,
71756.18, 50112.23, 65715.41,
85245.91, 68055.25, 73669.21,
81422.37, 78436.27, 69030.83
),
pos = c(
16012.80, 16304.75, 10844.50,
1824.07, 6240.95, 7376.63,
9155.36, 9740.75, 8602.64,
8599.35, 7348.15, 10461.59
),
provlag = c(
5.33, 8.08, 6.07,
3.76, 2.61, 2.77,
3.43, 3.36, 2.54,
2.63, 3.26, 3.4
),
visit = c(
1568, 1473, 1031,
553, 713, 723,
813, 798, 787,
851, 762, 834
),
pt = c(
1204, 1162, 758,
428, 609, 578,
636, 658, 624,
702, 565, 670
),
new = c(
129, 120, 61,
32, 123, 77,
93, 76, 65,
61, 61, 95
),
em = c(
1184, 1130, 813,
427, 550, 572,
599, 615, 597,
617, 487, 662
),
rvu = c(
1564.5, 1474.35, 995.6,
517.34, 739.5, 754.64,
863.41, 835.53, 826.4,
875.49, 814.78, 911.65
)
)
paged_table(rcmann)
# DAR Monthly Function
dar_month <- function(df,
gct_col = gct,
date_col = date,
earb_col = earb,
dart = 35) {
stopifnot(inherits(df, "data.frame"))
dplyr::mutate(df,
ndip = lubridate::days_in_month({{ date_col }}),
nmon = lubridate::month({{ date_col }}, label = FALSE),
month = lubridate::month({{ date_col }}, label = TRUE, abbr = FALSE),
mon = lubridate::month({{ date_col }}, label = TRUE, abbr = TRUE),
year = lubridate::year({{ date_col }}),
nqtr = lubridate::quarter({{ date_col }}),
yqtr = lubridate::quarter({{ date_col }}, with_year = TRUE),
dqtr = paste0(lubridate::quarter({{ date_col }}), "Q", format({{ date_col }}, "%y")),
ymon = as.numeric(format({{ date_col }}, "%Y.%m")),
mmon = format({{ date_col }}, "%b %Y"),
nhalf = lubridate::semester({{ date_col }}),
yhalf = lubridate::semester({{ date_col }}, with_year = TRUE),
dhalf = paste0(lubridate::semester({{ date_col }}), "H", format({{ date_col }}, "%y")),
adc = round({{ gct_col }} / ndip, digits = 2),
dar = round({{ earb_col }} / adc, digits = 2),
actual = round({{ earb_col }} / {{ gct_col }}, digits = 2),
ideal = round({{ dart }} / ndip, digits = 2),
ratio_diff = round(actual - ideal, digits = 2),
dar_diff = round(dar - {{ dart }}, digits = 2),
earb_target = round(({{ gct_col }} * {{ dart }} / ndip), digits = 2),
earb_decrease_need = round({{ earb_col }} - earb_target, digits = 2),
earb_decrease_pct = (earb_decrease_need / {{ earb_col }}),
earb_gct_diff = round({{ earb_col }} - {{ gct_col }}, digits = 2),
status = case_when(dar < {{ dart }} ~ "Pass", TRUE ~ "Fail")
)
}
# Call Function
rcmann_month <- dar_month(rcmann)
paged_table(rcmann_month)
# DAR Quarterly Function
dar_qtr <- function(df,
nmon_col = nmon,
nqtr_col = nqtr,
dqtr_col = dqtr,
earb_col = earb,
gct_col = gct,
ndip_col = ndip,
date_col = date,
dart = 35) {
stopifnot(inherits(df, "data.frame"))
earb_qtr <- dplyr::filter(
df,
{{ nmon_col }} == 3 |
{{ nmon_col }} == 6 |
{{ nmon_col }} == 9 |
{{ nmon_col }} == 12
) |>
dplyr::select({{ nqtr_col }}, {{ earb_col }})
gct_qtr <- dplyr::group_by(
df,
{{ nqtr_col }},
{{ dqtr_col }}
) |>
dplyr::summarise(
gct = round(sum({{ gct_col }}), 2),
ndip = sum({{ ndip_col }}),
.groups = "drop"
)
quarters <- merge(earb_qtr, gct_qtr)
dplyr::mutate(quarters,
adc = round(gct / ndip, digits = 2),
dar = round(earb / adc, digits = 2),
actual = round(earb / gct, digits = 2),
ideal = round({{ dart }} / ndip, digits = 2),
ratio_diff = round(actual - ideal, digits = 2),
dar_diff = round(dar - {{ dart }}, digits = 2),
earb_target = round((gct * {{ dart }} / ndip), digits = 2),
earb_decrease_need = round(earb - earb_target, digits = 2),
earb_decrease_pct = (earb_decrease_need / earb),
earb_gct_diff = round(earb - gct, digits = 2),
status = case_when(dar < {{ dart }} ~ "Pass", TRUE ~ "Fail")
)
}
# Call Function
rcmann_qtr <- dar_qtr(df = rcmann_month)
paged_table(rcmann_qtr)
Let’s take a look at a tidied-up table of our data so far:
rcm_tb1 <- rcmann_month |>
arrange(nmon) |>
reactable(
pagination = FALSE,
highlight = TRUE,
bordered = TRUE,
defaultColDef = colDef(
headerClass = "col-header",
align = "left"
),
columns = list(
nmon = colDef(
name = " ",
width = 50
),
month = colDef(
name = "Month"
),
gct = colDef(
name = "Gross Charges",
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left"
),
earb = colDef(
name = "Ending AR",
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left"
),
adj = colDef(
name = "Adjustments",
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left"
),
pmt = colDef(
name = "Payments",
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left"
),
pos = colDef(
name = "POS Payments",
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left"
),
provlag = colDef(
name = "Provider Lag",
format = colFormat(
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left"
),
visit = colDef(
name = "Visits",
format = colFormat(
separators = TRUE,
digits = 0
),
defaultSortOrder = "desc",
align = "left"
),
pt = colDef(
name = "Patients",
format = colFormat(
separators = TRUE,
digits = 0
),
defaultSortOrder = "desc",
align = "left"
),
new = colDef(
name = "New Patients",
format = colFormat(
separators = TRUE,
digits = 0
),
defaultSortOrder = "desc",
align = "left"
),
em = colDef(
name = "E/M Visits",
format = colFormat(
separators = TRUE,
digits = 0
),
defaultSortOrder = "desc",
align = "left"
),
rvu = colDef(
name = "RVUs",
format = colFormat(
separators = TRUE,
digits = 0
),
defaultSortOrder = "desc",
align = "left"
),
html = TRUE
),
compact = TRUE,
class = "rcm-tbl"
)
div(
class = "rcm-analysis",
rcm_tb1
)
# Dollar Amounts Pivot
rcmann_long1 <- rcmann_month |>
arrange(date) |>
select(
mon,
gct,
earb,
adj,
pmt
) |>
rename(
"Gross Charges" = gct,
"Ending AR Balance" = earb,
"Adjustments" = adj,
"Payments" = pmt
) |>
tidyr::pivot_longer(
!mon,
names_to = "measures",
values_to = "values"
)
head(rcmann_long1)
# A tibble: 6 × 3
mon measures values
<ord> <chr> <dbl>
1 Jan Gross Charges 325982
2 Jan Ending AR Balance 288433.
3 Jan Adjustments 170174.
4 Jan Payments 104182.
5 Feb Gross Charges 297732.
6 Feb Ending AR Balance 307871.# Counts Pivot
rcmann_long2 <- rcmann_month |>
arrange(date) |>
select(
mon,
visit,
pt,
em,
rvu
) |>
rename(
"Encounters" = visit,
"Patients" = pt,
"E/M Visits" = em,
"RVUs" = rvu
) |>
tidyr::pivot_longer(
!mon,
names_to = "measures",
values_to = "values"
)
head(rcmann_long2)
# A tibble: 6 × 3
mon measures values
<ord> <chr> <dbl>
1 Jan Encounters 1568
2 Jan Patients 1204
3 Jan E/M Visits 1184
4 Jan RVUs 1564.
5 Feb Encounters 1473
6 Feb Patients 1162 hc_theme_aab <- hc_theme(
colors = c(
"#0C2340", # Navy
"#C8102E", # Red
"wheat",
"salmon",
"honeydew"
),
chart = list(
style = list(
fontSize = "16",
color = "#000000",
fontWeight = "normal",
fontFamily = "Karla"
)
),
title = list(
align = "left",
style = list(
fontSize = "20",
color = "#0C2340",
fontWeight = "bold",
fontFamily = "Karla"
)
),
subtitle = list(
align = "left",
style = list(
fontSize = "16",
color = "#C8102E",
fontWeight = "normal",
fontFamily = "Karla"
)
),
plotOptions = list(
line = list(
marker = list(
symbol = "circle",
lineWidth = 2,
radius = 5
)
)
)
)
# Dollar Amounts
high1 <- hchart(
rcmann_long1, "line",
hcaes(x = mon, y = values, group = measures)
) |>
hc_yAxis(
title = list(text = " "),
labels = list(format = "{value}"),
crosshair = list(
snap = TRUE,
width = 2,
zIndex = 0
)
) |>
hc_xAxis(
title = list(text = NULL),
labels = list(format = "{value}"),
crosshair = list(
snap = TRUE,
width = 2,
zIndex = 0
)
) |>
hc_title(text = "2021 Yearly RCM Analysis: Dollar Amounts") |>
hc_subtitle(text = "Monthly Charges, AR Balance, Adjustments & Payments") |>
hc_plotOptions(
line = list(
marker = list(
symbol = "circle",
lineWidth = 3,
radius = 5
)
)
) |>
hc_add_theme(hc_theme_aab) |>
hc_tooltip(
useHTML = TRUE,
crosshairs = TRUE,
borderWidth = 1,
sort = TRUE
) |>
hc_legend(
align = "right",
verticalAlign = "bottom",
layout = "horizontal",
x = 0,
y = 10
) |>
hc_size(height = 500)
# Counts
high2 <- hchart(
rcmann_long2, "line",
hcaes(x = mon, y = values, group = measures)
) |>
hc_yAxis(
title = list(text = " "),
labels = list(format = "{value}"),
crosshair = list(
snap = TRUE,
width = 2,
zIndex = 0
)
) |>
hc_xAxis(
title = list(text = NULL),
labels = list(format = "{value}"),
crosshair = list(
snap = TRUE,
width = 2,
zIndex = 0
)
) |>
hc_title(text = "2021 Yearly RCM Analysis: Counts") |>
hc_subtitle(text = "Monthly Encounters, Patients, E/M Visits & RVUs") |>
hc_plotOptions(
line = list(
marker = list(
symbol = "circle",
lineWidth = 3,
radius = 5
)
)
) |>
hc_add_theme(hc_theme_aab) |>
hc_tooltip(
useHTML = TRUE,
crosshairs = TRUE,
borderWidth = 1,
sort = TRUE
) |>
hc_legend(
align = "right",
verticalAlign = "bottom",
layout = "horizontal",
x = 0,
y = 10
) |>
hc_size(height = 500)
high1
An alternative way to communicate change over time is through the use of absolute and relative change. Absolute change is simply the difference between a number’s initial amount and it’s current amount. Relative change expresses the absolute change as a percentage of the number in the initial period. When choosing between reporting relative change or absolute change, the best practice is to provide both. There are many good reasons for this:
Another thing to keep in mind is that, given the same absolute change, the relative change is larger if the initial value is at a lower level than if it is higher.
Relative change equals the change in value divided by the absolute value of the original value, multiplied by 100:
\[ \text{Percentage Change} = \dfrac{(V_2-V_1)}{|V_1|} \times 100 \]
A positive change is expressed as an increase amount of the percentage value while a negative change is expressed as a decrease amount of the absolute value of the percentage value. For instance, a -25% change is equivalent to stating a 25% decrease. A 200% change is equivalent to stating a 200% increase.
I’ll code four examples, the dollar amounts:
# Ending AR Change
rcmann <- rcmann_month |>
arrange(date) |>
mutate(archgab = earb - lag(earb)) |>
mutate(archgrel = (archgab / lag(earb))) |>
mutate(
archgab = coalesce(archgab, 0),
archgrel = coalesce(archgrel, 0)
) |>
mutate(archgrel = round(archgrel, digits = 5))
# Gross Charges Change
rcmann <- rcmann |>
arrange(date) |>
mutate(gcchgab = gct - lag(gct)) |>
mutate(gcchgrel = (gcchgab / lag(gct))) |>
mutate(
gcchgab = coalesce(gcchgab, 0),
gcchgrel = coalesce(gcchgrel, 0)
) |>
mutate(gcchgrel = round(gcchgrel, digits = 5))
# Adjustments Change
rcmann <- rcmann |>
arrange(date) |>
mutate(adjchgab = adj - lag(adj)) |>
mutate(adjchgrel = (adjchgab / lag(adj))) |>
mutate(
adjchgab = coalesce(adjchgab, 0),
adjchgrel = coalesce(adjchgrel, 0)
) |>
mutate(adjchgrel = round(adjchgrel, digits = 5))
# Payments Change
rcmann <- rcmann |>
arrange(date) |>
mutate(pmtchgab = pmt - lag(pmt)) |>
mutate(pmtchgrel = (pmtchgab / lag(pmt))) |>
mutate(
pmtchgab = coalesce(pmtchgab, 0),
pmtchgrel = coalesce(pmtchgrel, 0)
) |>
mutate(pmtchgrel = round(pmtchgrel, digits = 5))
pct_tbl <- rcmann |>
arrange(date) |>
select(
nmon,
month,
gct,
gcchgab,
gcchgrel,
earb,
archgab,
archgrel,
adj,
adjchgab,
adjchgrel,
pmt,
pmtchgab,
pmtchgrel
) |>
reactable(
pagination = FALSE,
bordered = TRUE,
highlight = TRUE,
defaultColDef = colDef(
headerClass = "col-header",
align = "left"
),
columns = list(
nmon = colDef(
name = " ",
show = TRUE,
width = 60
),
month = colDef(
name = "Month",
show = TRUE
),
gct = colDef(
name = "Gross Charges",
cell = data_bars(rcmann,
fill_color = "red",
fill_gradient = FALSE,
align_bars = "left",
text_position = "above",
number_fmt = scales::number_format(
accuracy = 0.01,
big.mark = ",",
trim = "FALSE"
),
round_edges = FALSE
),
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left",
style = list(
whiteSpace = "pre"
)
),
gcchgab = colDef(
name = "Absolute",
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
show = TRUE,
align = "right",
cell = function(value) {
value <- format(value, big.mark = ",")
if (value > 0) paste0("+", value)
if (value == 0) {
paste0("--")
} else {
value
}
},
style = function(value) {
color <- if (value > 0) {
"black"
} else if (value < 0) {
"red"
}
list(
fontWeight = 600,
color = color
)
}
),
gcchgrel = colDef(
name = "Relative",
format = colFormat(
digits = 2,
percent = TRUE
),
show = TRUE,
align = "right",
cell = function(value) {
value <- paste0(format(
value * 100,
nsmall = 2
), "%")
if (value > 0) paste0("+", value)
if (value == 0) {
paste0("--")
} else {
value
}
},
style = function(value) {
color <- if (value > 0) {
"black"
} else if (value < 0) {
"red"
}
list(fontWeight = 600, color = color)
}
),
earb = colDef(
name = "Ending A/R",
cell = data_bars(rcmann,
fill_color = "red",
fill_gradient = FALSE,
align_bars = "left",
text_position = "above",
number_fmt = scales::number_format(
accuracy = 0.01,
big.mark = ",",
trim = "FALSE"
),
round_edges = FALSE
),
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left",
style = list(whiteSpace = "pre")
),
archgab = colDef(
name = "Absolute",
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
show = TRUE,
align = "right",
cell = function(value) {
value <- format(value, big.mark = ",")
if (value > 0) paste0("+", value)
if (value == 0) {
paste0("--")
} else {
value
}
},
style = function(value) {
color <- if (value > 0) {
"#ef4035"
} else if (value < 0) {
"black"
}
list(
fontWeight = 600,
color = color
)
}
),
archgrel = colDef(
name = "Relative",
format = colFormat(
digits = 2,
percent = TRUE
),
show = TRUE,
align = "right",
cell = function(value) {
value <- paste0(
format(
value * 100,
nsmall = 2
),
"%"
)
if (value > 0) paste0("+", value)
if (value == 0) {
paste0("-")
} else {
value
}
},
style = function(value) {
color <- if (value > 0) {
"#ef4035"
} else if (value < 0) {
"black"
}
list(
fontWeight = 600,
color = color
)
}
),
adj = colDef(
name = "Adjustments",
cell = data_bars(rcmann,
fill_color = "red",
fill_gradient = FALSE,
align_bars = "left",
text_position = "above",
number_fmt = scales::number_format(
accuracy = 0.01,
big.mark = ",",
trim = "FALSE"
),
round_edges = FALSE
),
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left",
style = list(whiteSpace = "pre")
),
adjchgab = colDef(
name = "Absolute",
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
show = TRUE,
align = "right",
cell = function(value) {
value <- format(value, big.mark = ",")
if (value > 0) paste0("+", value)
if (value == 0) {
paste0("--")
} else {
value
}
},
style = function(value) {
color <- if (value > 0) {
"#ef4035"
} else if (value < 0) {
"black"
}
list(
fontWeight = 600,
color = color
)
}
),
adjchgrel = colDef(
name = "Relative",
format = colFormat(
digits = 2,
percent = TRUE
),
show = TRUE,
align = "right",
cell = function(value) {
value <- paste0(format(value * 100, nsmall = 2), "%")
if (value > 0) paste0("+", value)
if (value == 0) {
paste0("-")
} else {
value
}
},
style = function(value) {
color <- if (value > 0) {
"#ef4035"
} else if (value < 0) {
"black"
}
list(fontWeight = 600, color = color)
}
),
pmt = colDef(
name = "Payments",
cell = data_bars(rcmann,
fill_color = "red",
fill_gradient = FALSE,
align_bars = "left",
text_position = "above",
number_fmt = scales::number_format(
accuracy = 0.01,
big.mark = ",",
trim = "FALSE"
),
round_edges = FALSE
),
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left",
style = list(whiteSpace = "pre")
),
pmtchgab = colDef(
name = "Absolute",
format = colFormat(prefix = "$", separators = TRUE, digits = 2),
show = TRUE,
align = "right",
cell = function(value) {
if (value > 0) paste0("+", value)
if (value == 0) {
paste0("--")
} else {
value
}
},
style = function(value) {
color <- if (value > 0) {
"black"
} else if (value < 0) {
"#ef4035"
}
list(fontWeight = 600, color = color)
}
),
pmtchgrel = colDef(
name = "Relative",
format = colFormat(digits = 2, percent = TRUE),
show = TRUE,
align = "right",
cell = function(value) {
value <- paste0(format(value * 100, nsmall = 2), "%")
if (value > 0) paste0("+", value)
if (value == 0) {
paste0("-")
} else {
value
}
},
style = function(value) {
color <- if (value > 0) {
"black"
} else if (value < 0) {
"#ef4035"
}
list(fontWeight = 600, color = color)
}
),
html = TRUE
),
compact = TRUE,
class = "rcm-tbl"
)
div(
class = "rcm-analysis",
div(
class = "rcm-header",
div(class = "rcm-title", "2021 Yearly RCM Analysis: Dollar Amounts"),
"Month-to-Month Absolute & Relative Change"
),
pct_tbl
)
A waterfall chart is an effective way to visualize change, month-over-month. {highcharter} has a great waterfall chart option. First I’ll need to do some data wrangling to get the data ready for visualization:
# Subset January
rcm_jan <- rcmann |>
filter(mon == "Jan") |>
select(
mon,
gct,
earb,
adj,
pmt
) |>
rename(
gcchgab = gct,
archgab = earb,
adjchgab = adj,
pmtchgab = pmt
) |>
tidyr::pivot_longer(
!mon,
names_to = "figures",
values_to = "amount"
)
# Pivot data
rcmann_ab <- rcmann |>
arrange(date) |>
select(
mon,
gcchgab,
archgab,
adjchgab,
pmtchgab,
) |>
filter(
mon != "Jan"
) |>
tidyr::pivot_longer(
!mon,
names_to = "figures",
values_to = "amount"
)
# Bind January rows to data frame
rcmann_ab <- rbind(rcm_jan, rcmann_ab)
# Rename columns
rcmann_ab <- rcmann_ab |>
mutate(measure = case_when(
rcmann_ab$figures == "gcchgab" ~ "Gross Charges",
rcmann_ab$figures == "archgab" ~ "AR Balance",
rcmann_ab$figures == "adjchgab" ~ "Adjustments",
rcmann_ab$figures == "pmtchgab" ~ "Payments",
TRUE ~ "NA"
))
# Ending AR Waterfall
hc_ar_water <- rcmann_ab |>
filter(
measure == "AR Balance"
) |>
hchart("waterfall",
hcaes(x = mon, y = amount),
name = "AR Balance"
) |>
hc_yAxis(
gridLineWidth = 0,
labels = list(style = list(color = "#000000")),
title = list(text = "", style = list(color = "#000000"))
) |>
hc_xAxis(
labels = list(style = list(color = "#000000")),
title = list(text = ""),
lineWidth = 0,
tickWidth = 0
) |>
hc_title(text = "2021 RCM Analysis: AR Balance") |>
hc_subtitle(text = "Absolute Change, Month-over-Month") |>
hc_tooltip(
useHTML = TRUE,
crosshairs = TRUE,
valueDecimals = 2,
borderWidth = 1,
sort = TRUE
) |>
hc_add_theme(hc_theme_aab)
# Gross Charges Waterfall
hc_gc_water <- rcmann_ab |>
filter(
measure == "Gross Charges"
) |>
hchart("waterfall",
hcaes(x = mon, y = amount),
name = "Gross Charges",
color = "#C8102E"
) |>
hc_yAxis(
gridLineWidth = 0,
labels = list(style = list(color = "#000000")),
title = list(text = "", style = list(color = "#000000"))
) |>
hc_xAxis(
labels = list(style = list(color = "#000000")),
title = list(text = ""),
lineWidth = 0,
tickWidth = 0
) |>
hc_title(text = "2021 RCM Analysis: Gross Charges") |>
hc_subtitle(text = "Absolute Change, Month-over-Month") |>
hc_tooltip(
useHTML = TRUE,
crosshairs = TRUE,
valueDecimals = 2,
borderWidth = 1,
sort = TRUE
) |>
hc_add_theme(hc_theme_aab)
# Payments Waterfall
hc_pmt_water <- rcmann_ab |>
filter(
measure == "Payments"
) |>
hchart("waterfall",
hcaes(x = mon, y = amount),
name = "Payments",
color = "wheat"
) |>
hc_yAxis(
gridLineWidth = 0,
labels = list(style = list(color = "#000000")),
title = list(text = "", style = list(color = "#000000"))
) |>
hc_xAxis(
labels = list(style = list(color = "#000000")),
title = list(text = ""),
lineWidth = 0,
tickWidth = 0
) |>
hc_title(text = "2021 RCM Analysis: Payments") |>
hc_subtitle(text = "Absolute Change, Month-over-Month") |>
hc_tooltip(
useHTML = TRUE,
crosshairs = TRUE,
valueDecimals = 2,
borderWidth = 1,
sort = TRUE
) |>
hc_add_theme(hc_theme_aab)
# Adjustments Waterfall
hc_adj_water <- rcmann_ab |>
filter(
measure == "Adjustments"
) |>
hchart("waterfall",
hcaes(x = mon, y = amount),
name = "Adjustments",
color = "salmon"
) |>
hc_yAxis(
gridLineWidth = 0,
labels = list(style = list(color = "#000000")),
title = list(text = "", style = list(color = "#000000"))
) |>
hc_xAxis(
labels = list(style = list(color = "#000000")),
title = list(text = ""),
lineWidth = 0,
tickWidth = 0
) |>
hc_title(text = "2021 RCM Analysis: Adjustments") |>
hc_subtitle(text = "Absolute Change, Month-over-Month") |>
hc_tooltip(
useHTML = TRUE,
crosshairs = TRUE,
valueDecimals = 2,
borderWidth = 1,
sort = TRUE
) |>
hc_add_theme(hc_theme_aab)
crosstalk::bscols(
widths = NA,
hc_ar_water,
hc_gc_water
)
Days in Accounts Receivable (also known as DAR or Days in AR) is a common financial metric belonging to a group of ratios called efficiency ratios. It measures the average amount of time it takes for a business to collect money owed from the responsible party for services rendered and billed. As its name implies, the unit of measurement employed by this particular metric is days, or rather the average number of days from the moment a physician provides a service until the patient or guarantor pays for that service.
DAR is calculated by first dividing the total Gross Charges
(gct) by the Number of Days in the Period
(ndip) that you are measuring. This gives you the
Average Daily Charge (adc). Next, divide the
Ending AR Balance (earb) for that period by the
Average Daily Charge. This will give you the Average Days in AR. An
organization will usually have an internal benchmark for Days in AR,
also known as the target Days in AR (dart), to
compare against the actual Days in AR.
The Ideal Ratio is the ratio of the target Days in
AR (dart) to the Number of Days in the Period
(ndip). The Actual Ratio is the ratio of
the ending AR balance (earb) to the total gross charges
(gct). The Ratio Difference
(radif) is the Ideal Ratio minus the Actual Ratio.
Calculating these allows you to calculate the AR Target
(artrg), which is the ending AR balance required to achieve
the target Days in AR. The AR Difference
(ardif) is the AR Target minus the AR balance. A negative
difference let’s the client know how much more needed to be removed from
AR, dollar-wise, to reach the DAR target. If Days in AR is failing, both
the Ratio Difference and the AR Difference will be negative.
Provider Lag (provlag) is the average
time it takes for the supervising provider to sign an encounter’s chart
(thus, making it billable) after charges have been added to the
encounter. This delay negatively affects Days in AR so I’ll include it
for reference.
# declare dart
dart <- 35
rcmann <- rcmann |>
# average daily charge
mutate(adc = round(gct / ndip, digits = 2)) |>
# days in ar
mutate(dar = round(earb / adc, digits = 2)) |>
# ideal ratio
mutate(ideal = round(dart / ndip, digits = 2)) |>
# actual ratio
mutate(act = round(earb / gct, digits = 2)) |>
# ratio difference
mutate(radif = round(ideal - act, digits = 2)) |>
# ar target
mutate(artrg = round(gct * ideal, digits = 2)) |>
# ar difference
mutate(ardif = round(artrg - earb, digits = 2))
# add 'Pass' column
rcmann <- rcmann |>
mutate(pass = case_when(
rcmann$dar < dart ~ "Yes",
TRUE ~ "No"
))
dar_rcmann <- rcmann |>
arrange(date) |>
select(
nmon,
month,
pass,
dar,
provlag,
gct,
earb,
artrg,
ardif
)
dar_tbl <- reactable(dar_rcmann,
pagination = FALSE,
outlined = TRUE,
defaultColDef = colDef(
footerStyle = list(fontWeight = "bold"),
headerClass = "col-header",
footerClass = "col-footer",
align = "left"
),
columns = list(
nmon = colDef(
name = " ",
width = 60
),
month = colDef(
name = "Month"
),
dar = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Days in AR",
format = colFormat(
digits = 2
),
style = color_scales(dar_rcmann,
colors = pal_material(
"red",
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
provlag = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Provider Lag",
format = colFormat(
digits = 2
),
style = color_scales(dar_rcmann,
colors = pal_material(
"red",
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
pass = colDef(
name = "Pass",
footer = "Averages",
cell =
function(value) {
class <- paste0("tag pass-", tolower(value))
div(class = class, value)
}
),
gct = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Gross Charges",
format = colFormat(
digits = 2
),
style = color_scales(dar_rcmann,
colors = pal_material(
"red",
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
earb = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Ending AR",
format = colFormat(
digits = 2
),
style = color_scales(dar_rcmann,
colors = pal_material(
"red",
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
artrg = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "AR Target",
format = colFormat(
digits = 2
),
style = color_scales(dar_rcmann,
colors = pal_material(
"red",
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
ardif = colDef(
name = "Difference",
format = colFormat(
digits = 2
),
show = TRUE,
align = "right",
cell = function(value) {
value <- format(
value,
big.mark = ","
)
if (value > 0) {
paste0("+", value)
} else {
value
}
},
style = function(value) {
color <- if (value > 0) {
"black"
} else if (value < 0) {
"#ef4035"
}
list(fontWeight = 600, color = color)
}
),
html = TRUE
),
compact = TRUE,
class = "rcm-tbl"
) |>
add_title("Days in Accounts Receivable & Related Measurements", align = "left", font_color = "black", font_size = 24)
div(class = "rcm-analysis", dar_tbl)
The Net Collections Ratio measures how well a practice collects on Allowable Charges. It it the total payments received divided by the total charges, minus all write-offs and adjustments. Month-to-month, this percentage rate may change due to differences in timing between when charges are posted and when collections are received. For this reason, it is most beneficial to look at net collections rates over a 3-6-9-12 month rolling average. A collection ratio of 90% is not optimal, as this essentially means that for every dime coming in, only nine cents is actually collected. This means that AR is increasing and, as such, net working capital is decreasing.
The Adjustments to Collections Ratio is a tool used to monitor the effect that adjustments are having on the Net Collections Rate and Days in AR. Adjustments should be monitored by category (i.e., contractual adjustments, bad-debt write offs, small balance write-offs, etc.) to verify that money is not being written off unnecessarily. We don’t have that level of detail with this dataset, so we’ll just have to calculate and infer as best we can.
## reactable
color <- "red"
rcmann_ncr <- rcmann |>
arrange(date) |>
select(
nmon,
month,
gct,
adj,
pmt,
ncr,
atc
)
rcm_ncr_tb <- reactable(rcmann_ncr,
pagination = FALSE,
outlined = TRUE,
defaultColDef = colDef(
footerStyle = list(fontWeight = "bold"),
headerClass = "col-header",
footerClass = "col-footer",
align = "left"
),
columns = list(
nmon = colDef(
name = " ",
width = 50
),
month = colDef(
name = "Month",
footer = "Averages"
),
gct = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Gross Charges",
format = colFormat(
digits = 2
),
style = color_scales(rcmann_ncr,
colors = pal_material(
color,
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
adj = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Adjustments",
format = colFormat(
digits = 2
),
style = color_scales(rcmann_ncr,
colors = pal_material(
color,
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
pmt = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Payments",
format = colFormat(
digits = 2
),
style = color_scales(rcmann_ncr,
colors = pal_material(
color,
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
ncr = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Net Collections Rate",
format = colFormat(
digits = 2
),
style = color_scales(rcmann_ncr,
colors = pal_material(
color,
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
atc = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Adjustments to Collections Ratio",
format = colFormat(
digits = 2
),
style = color_scales(rcmann_ncr,
colors = pal_material(
color,
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
html = TRUE
),
compact = TRUE,
class = "rcm-tbl"
) |>
add_title("Net Collections Rate & Adjustments to Collections Ratio", align = "left", font_color = "black", font_size = 24)
div(class = "rcm-analysis", rcm_ncr_tb)
## higcharter
hchart(rcmann_ncr,
"area",
hcaes(
x = month,
y = gct
),
name = "Gross Charges",
yAxis = 0
) |>
hc_xAxis(
title = list(text = NULL),
crosshair = list(
snap = TRUE,
width = 2,
zIndex = 0
)
) |>
hc_yAxis_multiples(
list(title = list(text = "Gross Charges"), top = "0%", height = "20%"),
list(title = list(text = "Adjustments"), top = "25%", height = "20%", opposite = TRUE),
list(title = list(text = "Payments"), top = "50%", height = "20%"),
list(title = list(text = "Net Collections Rate"), top = "75%", height = "20%", opposite = TRUE)
) |>
hc_add_series(rcmann_ncr,
"area",
hcaes(
x = month,
y = adj
),
name = "Adjustments",
yAxis = 1
) |>
hc_add_series(rcmann_ncr,
"area",
hcaes(
x = month,
y = pmt
),
name = "Payments",
yAxis = 2
) |>
hc_add_series(rcmann_ncr,
"area",
hcaes(
x = month,
y = ncr
),
name = "Net Collections Rate",
yAxis = 3
) |>
hc_title(text = "2021 RCM Analysis: Gross Charges, Adjustments, Payments, Net Collections Rate") |>
hc_tooltip(
useHTML = TRUE,
crosshairs = TRUE,
valueDecimals = 2,
table = TRUE,
shared = TRUE,
borderWidth = 1,
sort = FALSE
) |>
hc_add_theme(hc_theme_aab) |>
hc_size(height = 1000)
This dataset has three columns explicitly concerned with patient
volume: visit (the number of visits/encounters the provider
had each month), uniqpt (the number of unique patients the
provider saw, i.e. visit includes encounters/visits by the
same patient in the same month) and newpt (the number of
new patients seen by the provider).
We can calculate the number of Established Patients seen by subtracting the number of New Patients from the number of Unique Patients. We can calculate the number of patients seen multiple times in a month by subtracting the number of unique patients seen from the number of visits in a month.
Monitoring the number of encounters with the same patient in a short time frame is important because it could mean that those additional encounters are for diagnostics or procedures that generally pay less. A higher than usual number of these encounters could explain a dip in charges and payments. Note: This is not a hard and fast rule. Depending on the provider’s specialty or a patient’s medical circumstances the opposite could be true. This is simply a good number to be aware of.
## reactable
color <- "red"
rcmann_pt <- rcmann |>
arrange(date) |>
select(
nmon,
month,
visit,
pt,
new,
est,
mult
)
rcm_pt_tb <- reactable(rcmann_pt,
pagination = FALSE,
highlight = TRUE,
bordered = TRUE,
defaultColDef = colDef(
footerStyle = list(fontWeight = "bold"),
headerClass = "col-header",
footerClass = "col-footer",
align = "left"
),
columns = list(
nmon = colDef(
name = " ",
width = 50
),
month = colDef(
name = "Month",
footer = "Averages"
),
visit = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Visits",
defaultSortOrder = "desc",
align = "left",
style = color_scales(rcmann_pt,
colors = pal_material(
color,
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
pt = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Patients",
defaultSortOrder = "desc",
align = "left",
style = color_scales(rcmann_pt,
colors = pal_material(
color,
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
new = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "New Patients",
defaultSortOrder = "desc",
align = "left",
style = color_scales(rcmann_pt,
colors = pal_material(
color,
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
est = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Established Patients",
defaultSortOrder = "desc",
align = "left",
style = color_scales(rcmann_pt,
colors = pal_material(
color,
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
mult = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Patients Seen Multiple Times",
defaultSortOrder = "desc",
align = "left",
style = color_scales(rcmann_pt,
colors = pal_material(
color,
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
html = TRUE
),
compact = TRUE,
class = "rcm-tbl"
) |>
add_title("Patient Volume Metrics", align = "left", font_color = "black", font_size = 24)
div(class = "rcm-analysis", rcm_pt_tb)
## highcharter
# Monthly Encounters Chart
hc_visits <- rcmann |>
arrange(date) |>
select(
mon,
visit,
pt,
new,
est,
mult
) |>
hchart("column", hcaes(x = mon, y = visit), name = "Visits") |>
hc_yAxis(
gridLineWidth = 0,
labels = list(style = list(color = "#000000")),
title = list(text = "", style = list(color = "#000000"))
) |>
hc_xAxis(
labels = list(style = list(color = "#000000")),
title = list(text = ""),
lineWidth = 0,
tickWidth = 0
) |>
hc_title(text = "Monthly Encounters") |>
hc_subtitle(text = "2021 Yearly RCM Feedback") |>
hc_add_theme(hc_theme_aab) |>
hc_tooltip(
useHTML = TRUE,
crosshairs = TRUE,
borderWidth = 1,
sort = TRUE
) |>
hc_plotOptions(
column = list(
# color = "#4BBD85",
dataLabels = list(
valueDecimals = 2,
valueSuffix = "%",
enabled = TRUE
)
)
)
# Monthly Patient Types - Visit Frequency
hc_mult <- rcmann |>
arrange(date) |>
select(
mon,
pt,
mult
) |>
rename(
"Seen Once" = pt,
"More Than Once" = mult
) |>
tidyr::pivot_longer(
!mon,
names_to = "measures",
values_to = "values"
) |>
hchart(
"column",
hcaes(x = mon, y = values, group = measures)
) |>
hc_yAxis(
gridLineWidth = 0,
labels = list(style = list(color = "#000000")),
title = list(text = "", style = list(color = "#000000"))
) |>
hc_xAxis(
labels = list(style = list(color = "#000000")),
title = list(text = ""),
lineWidth = 0,
tickWidth = 0
) |>
hc_title(text = "Single vs. Multiple Visit Patients") |>
hc_subtitle(text = "2021 Yearly RCM Analysis") |>
hc_add_theme(hc_theme_aab) |>
hc_legend(
align = "right",
verticalAlign = "bottom",
layout = "horizontal",
x = 0,
y = 10
) |>
hc_tooltip(
useHTML = TRUE,
crosshairs = TRUE,
borderWidth = 1,
sort = TRUE
) |>
hc_plotOptions(
column = list(
# color = "#4BBD85",
dataLabels = list(
enabled = TRUE
)
)
)
# Monthly Patient Types - New / Established
hc_newest <- rcmann |>
arrange(date) |>
select(
mon,
new,
est,
) |>
rename(
"New" = new,
"Established" = est
) |>
tidyr::pivot_longer(
!mon,
names_to = "measures",
values_to = "values"
) |>
hchart(
"column",
hcaes(x = mon, y = values, group = measures)
) |>
hc_yAxis(
gridLineWidth = 0,
labels = list(style = list(color = "#000000")),
title = list(text = "", style = list(color = "#000000"))
) |>
hc_xAxis(
labels = list(style = list(color = "#000000")),
title = list(text = ""),
lineWidth = 0,
tickWidth = 0
) |>
hc_title(text = "New vs. Established Patients") |>
hc_subtitle(text = "2021 Yearly RCM Analysis") |>
hc_add_theme(hc_theme_aab) |>
hc_legend(
align = "right",
verticalAlign = "bottom",
layout = "horizontal",
x = 0,
y = 10
) |>
hc_tooltip(
useHTML = TRUE,
crosshairs = TRUE,
borderWidth = 1,
sort = TRUE
) |>
hc_plotOptions(
column = list(
# color = "#4BBD85",
dataLabels = list(
enabled = TRUE
)
)
)
crosstalk::bscols(
widths = NA,
hc_mult,
hc_newest
)
RVUs and Gross Charges submitted are essentially measures of a provider’s work. As such, a common group of metrics calculated involve several averages per visit/encounter and per RVU to compare against the average payment received per visit and RVU:
rcmann <- rcmann |>
# RVUs per Visit
mutate(rvu_vis = round(rvu / visit, digits = 2)) |>
# Gross Charge per Visit
mutate(gct_vis = round(gct / pt, digits = 2)) |>
# Payment per Visit
mutate(pmt_vis = round(pmt / pt, digits = 2)) |>
# Gross Charge per RVU
mutate(gct_rvu = round(gct / rvu, digits = 2)) |>
# Payment per RVU
mutate(pmt_rvu = round(pmt / rvu, digits = 2))
rcmann_wrk <- rcmann |>
arrange(date) |>
select(
nmon,
month,
visit,
rvu,
rvu_vis,
gct,
gct_vis,
gct_rvu,
pmt,
pmt_vis,
pmt_rvu
)
rcm_wrk_tb <- reactable(rcmann_wrk,
pagination = FALSE,
highlight = TRUE,
bordered = TRUE,
defaultColDef = colDef(
footerStyle = list(fontWeight = "bold"),
headerClass = "col-header",
footerClass = "col-footer",
align = "left"
),
columns = list(
nmon = colDef(
name = " ",
width = 50
),
month = colDef(
name = "Month",
footer = "Averages"
),
gct = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Gross Charges",
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left",
style = color_scales(rcmann_wrk,
colors = pal_material(
color,
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
visit = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Visits",
defaultSortOrder = "desc",
align = "left",
style = color_scales(rcmann_wrk,
colors = pal_material(
color,
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
rvu = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "RVUs",
format = colFormat(
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left",
style = color_scales(rcmann_wrk,
colors = pal_material(
color,
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
rvu_vis = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "RVUs Per Visit",
format = colFormat(
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left",
style = color_scales(rcmann_wrk,
colors = pal_material(
color,
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
gct_vis = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Charges Per Visit",
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left",
style = color_scales(rcmann_wrk,
colors = pal_material(
color,
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
pmt = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Payments",
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left",
style = color_scales(rcmann_wrk,
colors = pal_material(
color,
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
pmt_vis = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Payment Per Visit",
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left",
style = color_scales(rcmann_wrk,
colors = pal_material(
color,
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
gct_rvu = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Charges Per RVU",
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left",
style = color_scales(rcmann_wrk,
colors = pal_material(
color,
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
pmt_rvu = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Payment Per RVU",
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left",
style = color_scales(rcmann_wrk,
colors = pal_material(
color,
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
html = TRUE
),
compact = TRUE,
class = "rcm-tbl"
) |>
add_title("Work Measure Average Metrics", align = "left", font_color = "black", font_size = 24)
div(class = "rcm-analysis", rcm_wrk_tb)
## highcharter
# Average Charge vs. Payment Per Visit
hc_avgvis <- rcmann |>
arrange(date) |>
select(
mon,
gct_vis,
pmt_vis
) |>
rename(
"Average Charge" = gct_vis,
"Average Payment" = pmt_vis
) |>
tidyr::pivot_longer(
!mon,
names_to = "measures",
values_to = "values"
) |>
hchart(
"column",
hcaes(x = mon, y = values, group = measures)
) |>
hc_yAxis(
gridLineWidth = 0,
labels = list(style = list(color = "#000000")),
title = list(text = "", style = list(color = "#000000"))
) |>
hc_xAxis(
labels = list(style = list(color = "#000000")),
title = list(text = ""),
lineWidth = 0,
tickWidth = 0
) |>
hc_title(text = "Averages Per Visit: Gross Charge vs. Net Payment") |>
hc_subtitle(text = "2021 Yearly RCM Analysis") |>
hc_add_theme(hc_theme_aab) |>
hc_legend(
align = "right",
verticalAlign = "bottom",
layout = "horizontal",
x = 0,
y = 10
) |>
hc_tooltip(
useHTML = TRUE,
crosshairs = TRUE,
borderWidth = 1,
sort = TRUE
) |>
hc_plotOptions(
column = list(
dataLabels = list(
enabled = TRUE
)
)
)
# Average Charge vs. Payment Per RVU
hc_avgrvu <- rcmann |>
arrange(date) |>
select(
mon,
gct_rvu,
pmt_rvu
) |>
rename(
"Average Charge" = gct_rvu,
"Average Payment" = pmt_rvu
) |>
tidyr::pivot_longer(
!mon,
names_to = "measures",
values_to = "values"
) |>
hchart("column", hcaes(x = mon, y = values, group = measures)) |>
hc_yAxis(
gridLineWidth = 0,
labels = list(style = list(color = "#000000")),
title = list(text = "", style = list(color = "#000000"))
) |>
hc_xAxis(
labels = list(style = list(color = "#000000")),
title = list(text = ""),
lineWidth = 0,
tickWidth = 0
) |>
hc_title(text = "Averages Per RVU: Gross Charge vs. Net Payment") |>
hc_subtitle(text = "2021 Yearly RCM Analysis") |>
hc_add_theme(hc_theme_aab) |>
hc_legend(
align = "right",
verticalAlign = "bottom",
layout = "horizontal",
x = 0,
y = 10
) |>
hc_tooltip(
useHTML = TRUE,
crosshairs = TRUE,
borderWidth = 1,
sort = TRUE
) |>
hc_plotOptions(
column = list(
dataLabels = list(
enabled = TRUE
)
)
)
crosstalk::bscols(
widths = NA,
hc_avgvis,
hc_avgrvu
)
Because of the unique characteristics of the American healthcare reimbursement model, some clients prefer to analyze their reimbursement data on a quarterly basis. This doesn’t mean that monthly analysis isn’t important – it is an absolute necessity. However, the chaotic nature of the provider-payer reimbursement process can sometimes be more easily understood when viewed from a quarterly perspective.
I’ll use the original data frame and perform some wrangling to calculate the summary statistics needed. The one problem is the Ending AR Balance. Since it’s static (i.e., rather than sum the AR balances per quarter, you would instead use the AR balance from the last month of each quarter as the quarterly figure), I’ll need to create a subset of the original data frame with just the AR balance from each of those months, then join it to the summary frame:
# Copy original data frame
rcmqtr <- rcmann
# Subset every third month's AR Balance
rcmq_earb <- rcmqtr |>
filter(
nmon == 3 |
nmon == 6 |
nmon == 9 |
nmon == 12
) |>
select(
nqtr,
dqtr,
earb
)
# Summarize quarterly data
rcmqtr <- rcmqtr |>
group_by(nqtr, dqtr) |>
summarise(
gct = round(sum(gct), digits = 2),
adj = round(sum(adj), digits = 2),
pmt = sum(pmt),
pos = sum(pos),
provlag = mean(provlag),
visit = sum(visit),
pt = sum(pt),
new = sum(new),
em = sum(em),
rvu = sum(rvu),
ndip = sum(ndip)
)
# Merge the data frames
rcmqtr <- merge(rcmq_earb, rcmqtr, by = "nqtr")
rcmqtr <- rcmqtr |>
rename(
dqtr = dqtr.x
) |>
arrange(nqtr) |>
select(!(dqtr.y))
rcmqtr
nqtr dqtr earb gct adj pmt pos provlag visit pt new em rvu ndip
1 1 1Q22 253976.6 822368.9 457022.2 348176.0 43162.05 6.493333 4072 3124 310 3127 4034.45 90
2 2 2Q22 203460.5 441141.3 204073.5 187583.8 15441.65 3.046667 1989 1615 232 1549 2011.48 91
3 3 3Q22 179347.7 457844.1 254986.5 226970.4 27498.75 3.110000 2398 1918 234 1811 2525.34 92
4 4 4Q22 199849.3 484304.6 234913.6 228889.5 26409.09 3.096667 2447 1937 217 1766 2601.92 92Now I can take all of the code I’ve written for the monthly calculations and apply it to my quarterly data frame:
# declare dart
dart <- 35
# calculate adc and dar
rcmqtr <- rcmqtr |>
mutate(adc = gct / ndip) |>
mutate(dar = earb / adc)
# calculate ideal and actual ratios
rcmqtr <- rcmqtr |>
mutate(ideal = dart / ndip) |>
mutate(act = earb / gct)
# calculate ar target and difference
rcmqtr <- rcmqtr |>
mutate(artrg = gct * ideal) |>
mutate(ardif = artrg - earb)
# Add 'Pass' Column
rcmqtr <- rcmqtr |>
mutate(pass = case_when(
rcmqtr$dar < dart ~ "Yes",
TRUE ~ "No"
))
# Net Collections Ratio / Adjustments to Collections Ratio
rcmqtr <- rcmqtr |>
mutate(ncr = pmt / (gct - adj)) |>
mutate(atc = adj / pmt)
# Ending AR Change
rcmqtr <- rcmqtr |>
mutate(archgab = earb - lag(earb)) |>
mutate(archgrel = (archgab / lag(earb))) |>
mutate(
archgab = coalesce(archgab, 0),
archgrel = coalesce(archgrel, 0)
) |>
mutate(archgrel = round(archgrel, digits = 5))
# Gross Charges Change
rcmqtr <- rcmqtr |>
mutate(gcchgab = gct - lag(gct)) |>
mutate(gcchgrel = (gcchgab / lag(gct))) |>
mutate(
gcchgab = coalesce(gcchgab, 0),
gcchgrel = coalesce(gcchgrel, 0)
) |>
mutate(gcchgrel = round(gcchgrel, digits = 5))
# Adjustments Change
rcmqtr <- rcmqtr |>
mutate(adjchgab = adj - lag(adj)) |>
mutate(adjchgrel = (adjchgab / lag(adj))) |>
mutate(
adjchgab = coalesce(adjchgab, 0),
adjchgrel = coalesce(adjchgrel, 0)
) |>
mutate(adjchgrel = round(adjchgrel, digits = 5))
# Payments Change
rcmqtr <- rcmqtr |>
mutate(pmtchgab = pmt - lag(pmt)) |>
mutate(pmtchgrel = (pmtchgab / lag(pmt))) |>
mutate(
pmtchgab = coalesce(pmtchgab, 0),
pmtchgrel = coalesce(pmtchgrel, 0)
) |>
mutate(pmtchgrel = round(pmtchgrel, digits = 5))
rcmqtr <- rcmqtr |>
# established patients
mutate(est = pt - new) |>
# patients with multiple visits
mutate(mult = visit - pt)
rcmqtr <- rcmqtr |>
# RVUs per Visit
mutate(rvu_vis = round(rvu / visit, digits = 2)) |>
# Gross Charge per Visit
mutate(gct_vis = round(gct / pt, digits = 2)) |>
# Payment per Visit
mutate(pmt_vis = round(pmt / pt, digits = 2)) |>
# Gross Charge per RVU
mutate(gct_rvu = round(gct / rvu, digits = 2)) |>
# Payment per RVU
mutate(pmt_rvu = round(pmt / rvu, digits = 2))
## reactable
# absolute / relative change
rcmqtr_chng <- rcmqtr |>
arrange(nqtr) |>
select(
dqtr,
gct,
gcchgab,
gcchgrel,
earb,
archgab,
archgrel,
adj,
adjchgab,
adjchgrel,
pmt,
pmtchgab,
pmtchgrel
)
Qpct_tbl <- reactable(rcmqtr_chng,
pagination = FALSE,
bordered = TRUE,
highlight = TRUE,
defaultColDef = colDef(
headerClass = "col-header",
align = "left"
),
columns = list(
nqtr = colDef(
name = " ",
show = TRUE
),
dqtr = colDef(
name = "Quarter",
show = TRUE
),
gct = colDef(
name = "Gross Charges",
cell = data_bars(rcmqtr_chng,
fill_color = "red",
fill_gradient = FALSE,
align_bars = "left",
text_position = "above",
number_fmt = scales::number_format(
accuracy = 0.01,
big.mark = ",",
trim = "FALSE"
),
round_edges = FALSE
),
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left",
style = list(
whiteSpace = "pre"
)
),
gcchgab = colDef(
name = "Absolute",
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
show = TRUE,
align = "right",
cell = function(value) {
value <- format(value, big.mark = ",")
if (value > 0) paste0("+", value)
if (value == 0) {
paste0("--")
} else {
value
}
},
style = function(value) {
color <- if (value > 0) {
"black"
} else if (value < 0) {
"red"
}
list(
fontWeight = 600,
color = color
)
}
),
gcchgrel = colDef(
name = "Relative",
format = colFormat(
digits = 2,
percent = TRUE
),
show = TRUE,
align = "right",
cell = function(value) {
value <- paste0(format(
value * 100,
nsmall = 2
), "%")
if (value > 0) paste0("+", value)
if (value == 0) {
paste0("--")
} else {
value
}
},
style = function(value) {
color <- if (value > 0) {
"black"
} else if (value < 0) {
"red"
}
list(fontWeight = 600, color = color)
}
),
earb = colDef(
name = "Ending A/R",
cell = data_bars(rcmqtr_chng,
fill_color = "red",
fill_gradient = FALSE,
align_bars = "left",
text_position = "above",
number_fmt = scales::number_format(
accuracy = 0.01,
big.mark = ",",
trim = "FALSE"
),
round_edges = FALSE
),
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left",
style = list(whiteSpace = "pre")
),
archgab = colDef(
name = "Absolute",
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
show = TRUE,
align = "right",
cell = function(value) {
value <- format(value, big.mark = ",")
if (value > 0) paste0("+", value)
if (value == 0) {
paste0("--")
} else {
value
}
},
style = function(value) {
color <- if (value > 0) {
"#ef4035"
} else if (value < 0) {
"black"
}
list(
fontWeight = 600,
color = color
)
}
),
archgrel = colDef(
name = "Relative",
format = colFormat(
digits = 2,
percent = TRUE
),
show = TRUE,
align = "right",
cell = function(value) {
value <- paste0(
format(
value * 100,
nsmall = 2
),
"%"
)
if (value > 0) paste0("+", value)
if (value == 0) {
paste0("-")
} else {
value
}
},
style = function(value) {
color <- if (value > 0) {
"#ef4035"
} else if (value < 0) {
"black"
}
list(
fontWeight = 600,
color = color
)
}
),
adj = colDef(
name = "Adjustments",
cell = data_bars(rcmqtr_chng,
fill_color = "red",
fill_gradient = FALSE,
align_bars = "left",
text_position = "above",
number_fmt = scales::number_format(
accuracy = 0.01,
big.mark = ",",
trim = "FALSE"
),
round_edges = FALSE
),
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left",
style = list(whiteSpace = "pre")
),
adjchgab = colDef(
name = "Absolute",
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
show = TRUE,
align = "right",
cell = function(value) {
value <- format(value, big.mark = ",")
if (value > 0) paste0("+", value)
if (value == 0) {
paste0("--")
} else {
value
}
},
style = function(value) {
color <- if (value > 0) {
"#ef4035"
} else if (value < 0) {
"black"
}
list(
fontWeight = 600,
color = color
)
}
),
adjchgrel = colDef(
name = "Relative",
format = colFormat(
digits = 2,
percent = TRUE
),
show = TRUE,
align = "right",
cell = function(value) {
value <- paste0(format(value * 100, nsmall = 2), "%")
if (value > 0) paste0("+", value)
if (value == 0) {
paste0("-")
} else {
value
}
},
style = function(value) {
color <- if (value > 0) {
"#ef4035"
} else if (value < 0) {
"black"
}
list(fontWeight = 600, color = color)
}
),
pmt = colDef(
name = "Payments",
cell = data_bars(rcmqtr_chng,
fill_color = "red",
fill_gradient = FALSE,
align_bars = "left",
text_position = "above",
number_fmt = scales::number_format(
accuracy = 0.01,
big.mark = ",",
trim = "FALSE"
),
round_edges = FALSE
),
format = colFormat(
prefix = "$",
separators = TRUE,
digits = 2
),
defaultSortOrder = "desc",
align = "left",
style = list(whiteSpace = "pre")
),
pmtchgab = colDef(
name = "Absolute",
format = colFormat(prefix = "$", separators = TRUE, digits = 2),
show = TRUE,
align = "right",
cell = function(value) {
if (value > 0) paste0("+", value)
if (value == 0) {
paste0("--")
} else {
value
}
},
style = function(value) {
color <- if (value > 0) {
"black"
} else if (value < 0) {
"#ef4035"
}
list(fontWeight = 600, color = color)
}
),
pmtchgrel = colDef(
name = "Relative",
format = colFormat(digits = 2, percent = TRUE),
show = TRUE,
align = "right",
cell = function(value) {
value <- paste0(format(value * 100, nsmall = 2), "%")
if (value > 0) paste0("+", value)
if (value == 0) {
paste0("-")
} else {
value
}
},
style = function(value) {
color <- if (value > 0) {
"black"
} else if (value < 0) {
"#ef4035"
}
list(fontWeight = 600, color = color)
}
),
html = TRUE
),
compact = TRUE,
class = "rcm-tbl"
) |>
add_title("Quarterly RCM Analysis", align = "left", font_color = "black", font_size = 24) |>
add_subtitle("Absolute / Relative Change & Days in Accounts Receivable", align = "left", font_color = "black", font_size = 18, font_weight = "normal")
div(class = "rcm-analysis", Qpct_tbl)
# Days in AR reactable
rcmqtr_dar <- rcmqtr |>
arrange(nqtr) |>
select(
dqtr,
pass,
dar,
gct,
earb,
artrg,
ardif
)
Qdar_tbl <- reactable(rcmqtr_dar,
pagination = FALSE,
outlined = TRUE,
defaultColDef = colDef(
footerStyle = list(fontWeight = "bold"),
headerClass = "col-header",
footerClass = "col-footer",
align = "left"
),
columns = list(
dqtr = colDef(
name = "Quarter"
),
dar = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Days in AR",
format = colFormat(
digits = 2
),
style = color_scales(rcmqtr_dar,
colors = pal_material(
"red",
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
pass = colDef(
name = "Pass",
footer = "Averages",
cell =
function(value) {
class <- paste0("tag pass-", tolower(value))
div(class = class, value)
}
),
gct = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Gross Charges",
format = colFormat(
digits = 2
),
style = color_scales(rcmqtr_dar,
colors = pal_material(
"red",
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
earb = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Ending AR Balance",
format = colFormat(
digits = 2
),
style = color_scales(rcmqtr_dar,
colors = pal_material(
"red",
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
artrg = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Ending AR Target",
format = colFormat(
digits = 2
),
style = color_scales(rcmqtr_dar,
colors = pal_material(
"red",
n = 6,
alpha = 1.0,
reverse = FALSE
)(6)
)
),
ardif = colDef(
name = "Difference",
format = colFormat(
digits = 2
),
show = TRUE,
align = "right",
cell = function(value) {
value <- format(
value,
big.mark = ","
)
if (value > 0) {
paste0("+", value)
} else {
value
}
},
style = function(value) {
color <- if (value > 0) {
"black"
} else if (value < 0) {
"#ef4035"
}
list(fontWeight = 600, color = color)
}
),
html = TRUE
),
compact = TRUE,
class = "rcm-tbl"
)
div(class = "rcm-analysis", Qdar_tbl)
# Quarterly Encounters Chart
hc_visitsQ <- rcmqtr |>
arrange(nqtr) |>
select(
dqtr,
visit
) |>
hchart("column",
hcaes(x = dqtr, y = visit),
name = "Visits"
) |>
hc_yAxis(
gridLineWidth = 0,
labels = list(style = list(color = "#000000")),
title = list(text = "", style = list(color = "#000000"))
) |>
hc_xAxis(
labels = list(style = list(color = "#000000")),
title = list(text = ""),
lineWidth = 0,
tickWidth = 0
) |>
hc_title(text = "Quarterly Encounters") |>
hc_subtitle(text = "2021 Yearly RCM Analysis") |>
hc_add_theme(hc_theme_aab) |>
hc_tooltip(
useHTML = TRUE,
crosshairs = TRUE,
borderWidth = 1,
sort = TRUE
) |>
hc_plotOptions(
column = list(
dataLabels = list(
valueDecimals = 2,
valueSuffix = "%",
enabled = TRUE
)
)
)
# Quarterly Patient Types - Visit Frequency
hc_multQ <- rcmqtr |>
arrange(nqtr) |>
select(
dqtr,
pt,
mult
) |>
rename(
"Seen Once" = pt,
"More Than Once" = mult
) |>
tidyr::pivot_longer(
!dqtr,
names_to = "measures",
values_to = "values"
) |>
hchart("column", hcaes(x = dqtr, y = values, group = measures)) |>
hc_yAxis(
gridLineWidth = 0,
labels = list(style = list(color = "#000000")),
title = list(text = "", style = list(color = "#000000"))
) |>
hc_xAxis(
labels = list(style = list(color = "#000000")),
title = list(text = ""),
lineWidth = 0,
tickWidth = 0
) |>
hc_title(text = "Single vs. Multiple Visit Patients") |>
hc_subtitle(text = "2021 Yearly RCM Analysis") |>
hc_add_theme(hc_theme_aab) |>
hc_legend(
align = "right",
verticalAlign = "bottom",
layout = "horizontal",
x = 0,
y = 10
) |>
hc_tooltip(
useHTML = TRUE,
crosshairs = TRUE,
borderWidth = 1,
sort = TRUE
) |>
hc_plotOptions(
column = list(
dataLabels = list(
enabled = TRUE
)
)
)
# Quarterly Patient Types - New / Established
hc_newestQ <- rcmqtr |>
arrange(nqtr) |>
select(
dqtr,
new,
est,
) |>
rename(
"New" = new,
"Established" = est
) |>
tidyr::pivot_longer(
!dqtr,
names_to = "measures",
values_to = "values"
) |>
hchart(
"column",
hcaes(x = dqtr, y = values, group = measures)
) |>
hc_yAxis(
gridLineWidth = 0,
labels = list(style = list(color = "#000000")),
title = list(text = "", style = list(color = "#000000"))
) |>
hc_xAxis(
labels = list(style = list(color = "#000000")),
title = list(text = ""),
lineWidth = 0,
tickWidth = 0
) |>
hc_title(text = "New vs. Established Patients") |>
hc_subtitle(text = "2021 Yearly RCM Analysis") |>
hc_add_theme(hc_theme_aab) |>
hc_legend(
align = "right",
verticalAlign = "bottom",
layout = "horizontal",
x = 0,
y = 10
) |>
hc_tooltip(
useHTML = TRUE,
crosshairs = TRUE,
borderWidth = 1,
sort = TRUE
) |>
hc_plotOptions(
column = list(
dataLabels = list(
enabled = TRUE
)
)
)
# Average Charge vs. Payment Per Visit
hc_avgvisQ <- rcmqtr |>
arrange(nqtr) |>
select(
dqtr,
gct_vis,
pmt_vis
) |>
rename(
"Average Charge" = gct_vis,
"Average Payment" = pmt_vis
) |>
tidyr::pivot_longer(
!dqtr,
names_to = "measures",
values_to = "values"
) |>
hchart("column", hcaes(x = dqtr, y = values, group = measures)) |>
hc_yAxis(
gridLineWidth = 0,
labels = list(style = list(color = "#000000")),
title = list(text = "", style = list(color = "#000000"))
) |>
hc_xAxis(
labels = list(style = list(color = "#000000")),
title = list(text = ""),
lineWidth = 0,
tickWidth = 0
) |>
hc_title(text = "Averages Per Visit: Gross Charge vs. Net Payment") |>
hc_subtitle(text = "2021 Yearly RCM Analysis") |>
hc_add_theme(hc_theme_aab) |>
hc_legend(
align = "right",
verticalAlign = "bottom",
layout = "horizontal",
x = 0,
y = 10
) |>
hc_tooltip(
useHTML = TRUE,
crosshairs = TRUE,
borderWidth = 1,
sort = TRUE
) |>
hc_plotOptions(
column = list(
dataLabels = list(
enabled = TRUE
)
)
)
# Average Charge vs. Payment Per RVU
hc_avgrvuQ <- rcmqtr |>
arrange(nqtr) |>
select(
dqtr,
gct_rvu,
pmt_rvu
) |>
rename(
"Average Charge" = gct_rvu,
"Average Payment" = pmt_rvu
) |>
tidyr::pivot_longer(
!dqtr,
names_to = "measures",
values_to = "values"
) |>
hchart(
"column",
hcaes(x = dqtr, y = values, group = measures)
) |>
hc_yAxis(
gridLineWidth = 0,
labels = list(style = list(color = "#000000")),
title = list(text = "", style = list(color = "#000000"))
) |>
hc_xAxis(
labels = list(style = list(color = "#000000")),
title = list(text = ""),
lineWidth = 0,
tickWidth = 0
) |>
hc_title(text = "Averages Per RVU: Gross Charge vs. Net Payment") |>
hc_subtitle(text = "2021 Yearly RCM Analysis") |>
hc_add_theme(hc_theme_aab) |>
hc_legend(
align = "right",
verticalAlign = "bottom",
layout = "horizontal",
x = 0,
y = 10
) |>
hc_tooltip(
useHTML = TRUE,
crosshairs = TRUE,
borderWidth = 1,
sort = TRUE
) |>
hc_plotOptions(
column = list(
dataLabels = list(
enabled = TRUE
)
)
)
crosstalk::bscols(
widths = NA,
hc_multQ,
hc_newestQ
)
Yearly analysis generally consists of presentation of averages of all of monthly metrics, as well as minimums/maximums, any significant variances and a handful of year-end calculations:
The A/R Turnover Ratio (also known as the Debtor’s Turnover Ratio) is an efficiency ratio that measures how efficiently a company is collecting revenue. It measures the number of times over a given period that a company collects its average accounts receivable balance.
A/R Turnover in Days (also known as Days in Sales Receivables) is a measure that shows the average number of days that it takes a customer to pay the company for sales on credit.
# AR Turnover Ratio
ar_turnover <- sum(rcmann$gct) / ((as.numeric(rcmann[1, 4]) + as.numeric(rcmann[12, 4])) / 2)
# Days in Sales Receivable
days_in_sales_receive <- 365 / ar_turnover
# Net Collections Ratio - Annual
ncrann <- sum(rcmann$pmt) / (sum(rcmann$gct) - sum(rcmann$adj))
# Adjustments to Collections Ratio - Annual
atcann <- sum(rcmann$adj) / sum(rcmann$pmt)
# Average Charges Per Month
avggct <- sum(rcmann$gct) / 12
# Average Encounters Per Month
avgenc <- sum(rcmann$visit) / 12
# Average RVUs Per Month
avgrvu <- sum(rcmann$rvu) / 12
# Average New Patients Per Month
avgnew <- sum(rcmann$new) / 12
I’ll use {apexcharter}’s sparkline function to create a series of interactive value boxes to present these:
# AR Turnover Ratio
# with Monthly AR Balance
spark_arto <- rcmann |>
arrange(date) |>
select(
date,
earb
)
box_arto <- spark_box(
data = spark_arto,
title = round(ar_turnover, digits = 2),
subtitle = "A/R Turnover Ratio",
type = "area",
color = "#FFFFFF",
background = color,
height = 200,
title_style = list(fontSize = 24, color = "white"),
subtitle_style = list(fontSize = 16, color = "white"),
elementId = spkbx,
synchronize = FALSE
)
# Days in Sales Receivable
# with Monthly Days in AR
spark_disr <- rcmann |>
arrange(date) |>
select(
date,
dar
)
box_disr <- spark_box(
data = spark_disr,
title = round(days_in_sales_receive, digits = 2),
subtitle = "Days in Sales Receivable",
type = "column",
color = "#FFFFFF",
background = color,
title_style = list(fontSize = 24, color = "white"),
subtitle_style = list(fontSize = 16, color = "white"),
elementId = spkbx,
synchronize = FALSE
)
# Adjustments to Collections Ratio - Annual
# with Monthly Adjustments
spark_adj <- rcmann |>
arrange(date) |>
select(
date,
adj
)
box_adj <- spark_box(
data = spark_adj,
title = round(atcann, digits = 2),
subtitle = "Adjustments to Collections",
type = "column",
color = "#FFFFFF",
background = color,
height = 200,
title_style = list(fontSize = 24, color = "white"),
subtitle_style = list(fontSize = 16, color = "white"),
elementId = spkbx,
synchronize = FALSE
)
# Net Collections Ratio - Annual
spark_ncr <- rcmann |>
arrange(date) |>
select(
date,
ncr
)
box_ncr <- spark_box(
data = spark_ncr,
title = round(ncrann * 100, digits = 2),
subtitle = "Net Collections Ratio",
type = "area",
color = "#FFFFFF",
background = color,
height = 200,
title_style = list(fontSize = 24, color = "white"),
subtitle_style = list(fontSize = 16, color = "white"),
elementId = spkbx,
synchronize = FALSE
)
# Average Charges Per Month
spark_gct <- rcmann |>
arrange(date) |>
select(
date,
gct
)
box_gct <- spark_box(
data = spark_gct,
title = round(avggct, digits = 2),
subtitle = "Average Gross Charges",
type = "column",
color = "#FFFFFF",
background = color,
height = 200,
title_style = list(fontSize = 24, color = "white"),
subtitle_style = list(fontSize = 16, color = "white"),
elementId = spkbx2,
synchronize = FALSE
)
# Average Encounters Per Month
spark_enc <- rcmann |>
arrange(date) |>
select(
date,
visit
)
box_enc <- spark_box(
data = spark_enc,
title = round(avgenc, digits = 2),
subtitle = "Average Encounters",
type = "area",
color = "#FFFFFF",
background = color,
height = 200,
title_style = list(fontSize = 24, color = "white"),
subtitle_style = list(fontSize = 16, color = "white"),
elementId = spkbx2,
synchronize = FALSE
)
# Average RVUs Per Month
spark_rvu <- rcmann |>
arrange(date) |>
select(
date,
rvu
)
box_rvu <- spark_box(
data = spark_rvu,
title = round(avgrvu, digits = 2),
subtitle = "Average RVUs",
type = "column",
color = "#FFFFFF",
background = color,
height = 200,
title_style = list(fontSize = 24, color = "white"),
subtitle_style = list(fontSize = 16, color = "white"),
elementId = spkbx2,
synchronize = FALSE
)
# Average New Patients Per Month
spark_new <- rcmann |>
arrange(date) |>
select(
date,
new
)
box_new <- spark_box(
data = spark_new,
title = round(avgnew, digits = 2),
subtitle = "Average New Patients",
type = "area",
color = "#FFFFFF",
background = color,
height = 200,
title_style = list(fontSize = 24, color = "white"),
subtitle_style = list(fontSize = 16, color = "white"),
elementId = spkbx2,
synchronize = FALSE
)
crosstalk::bscols(
widths = NA,
box_arto,
box_disr,
box_ncr,
box_adj
)
# Create data frame
rcm_df <- data.frame(
date = c(
"2021-01-01", "2021-02-01", "2021-03-01",
"2021-04-01", "2021-05-01", "2021-06-01",
"2021-07-01", "2021-08-01", "2021-09-01",
"2021-10-01", "2021-11-01", "2021-12-01",
"2022-01-01", "2022-02-01", "2022-03-01",
"2022-04-01"
),
gct = c(
372026.23, 488189.83, 486557.14,
372933.37, 407866.75, 418267.28,
349662.24, 381510.05, 412980.16,
343056.21, 443048.52, 395482.44,
489675.16, 360452.15, 495234.24,
384729.38
),
earb = c(
558039.35, 562992.85, 558149.85,
563850.21, 563097.33, 569884.91,
573488.55, 576993.27, 577998.93,
585281.47, 589676.47, 594984.65,
611679.13, 621725.17, 614629.40,
624732.06
),
adj = c(
139546.20, 215187.32, 198306.23,
145408.77, 144358.11, 159506.74,
129276.26, 131911.88, 141539.78,
126171.62, 181177.84, 130005.34,
179666.94, 132363.44, 179199.89,
142708.35
),
col = c(
227526.53, 277845.51, 282550.55,
228277.48, 256721.06, 255156.90,
216881.26, 248592.51, 264157.84,
212489.59, 256562.50, 248782.62,
299962.18, 235184.48, 305931.69,
230923.03
)
)
# Convert Date column to date object
rcm_df$date <- as.Date(rcm_df$date)
# function to create different date types
rcm_ymq <- function(df, date_col) {
stopifnot(
inherits(df, "data.frame")
)
stopifnot(
class(
df |>
dplyr::pull({{ date_col }})
) == "Date"
)
dplyr::mutate(df,
nmon = lubridate::month({{ date_col }}, label = FALSE),
ndip = lubridate::days_in_month({{ date_col }}),
month = lubridate::month({{ date_col }}, label = TRUE, abbr = FALSE),
mon = lubridate::month({{ date_col }}, label = TRUE, abbr = TRUE),
year = lubridate::year({{ date_col }}),
nqtr = lubridate::quarter({{ date_col }}),
yqtr = lubridate::quarter({{ date_col }}, with_year = TRUE),
dqtr = paste0(
lubridate::quarter({{ date_col }}), "Q",
format({{ date_col }}, "%y")
),
ymon = as.numeric(
format({{ date_col }}, "%Y.%m")
),
mmon = format({{ date_col }}, "%b %Y"),
nhalf = lubridate::semester({{ date_col }}),
yhalf = lubridate::semester({{ date_col }}, with_year = TRUE),
dhalf = paste0(
lubridate::semester({{ date_col }}), "H",
format({{ date_col }}, "%y")
)
)
}
# call function
rcm_df <- rcm_ymq(
df = rcm_df,
date_col = date
)
rcm_df <- rownames_to_column(rcm_df, "id")
paged_table(rcm_df)
# Subset every third month's AR Balance
rcmq_earb <- rcm_df |>
filter(
id == 3 |
id == 6 |
id == 9 |
id == 12 |
id == 15 |
id == 16
) |>
select(
yqtr,
earb
)
# Summarize quarterly data
rcmq_df <- rcm_df |>
group_by(yqtr, dqtr) |>
summarise(
gct = round(sum(gct), digits = 2),
adj = round(sum(adj), digits = 2),
col = sum(col),
ndip = sum(ndip),
.groups = "drop"
) |>
arrange(yqtr)
# Merge the data frames
rcmq_df <- merge(rcmq_earb, rcmq_df, by = "yqtr") |>
select(yqtr, dqtr, ndip, gct, earb, adj, col)
paged_table(rcmq_df)
# declare dart
dart <- 40
rcm_df <- rcm_df |>
# average daily charge
mutate(adc = round(gct / ndip, digits = 2)) |>
# days in ar
mutate(dar = round(earb / adc, digits = 2)) |>
# ideal ratio
mutate(ideal = round(dart / ndip, digits = 2)) |>
# actual ratio
mutate(act = round(earb / gct, digits = 2)) |>
# ratio difference
mutate(radif = round(ideal - act, digits = 2)) |>
# earb target
mutate(earb_n = round(gct * ideal, digits = 2)) |>
# ar difference
mutate(ardif = round(earb_n - earb, digits = 2)) |>
# add 'Status' column
mutate(status = case_when(dar < dart ~ "Pass", TRUE ~ "Fail")) |>
# net collections rate
mutate(ncr = (col / (gct - adj) * 100)) |>
# adjustments to collections ratio
mutate(atcr = adj / col)
paged_table(rcm_df)
rcmq_df <- rcmq_df |>
# average daily charge
mutate(adc = round(gct / ndip, digits = 2)) |>
# days in ar
mutate(dar = round(earb / adc, digits = 2)) |>
# ideal ratio
mutate(ideal = round(dart / ndip, digits = 2)) |>
# actual ratio
mutate(act = round(earb / gct, digits = 2)) |>
# ratio difference
mutate(radif = round(ideal - act, digits = 2)) |>
# earb target
mutate(earb_n = round(gct * ideal, digits = 2)) |>
# ar difference
mutate(ardif = round(earb_n - earb, digits = 2)) |>
# add 'Status' column
mutate(status = case_when(dar < dart ~ "Pass", TRUE ~ "Fail")) |>
# net collections rate
mutate(ncr = (col / (gct - adj) * 100)) |>
# adjustments to collections ratio
mutate(atcr = adj / col) |>
# conditionally assign colors to dar based on status
mutate(color_assign = case_when(
status == "Fail" ~ "red",
TRUE ~ "grey"
))
paged_table(rcmq_df)
rcm_top <- rcmq_df |>
select(
yqtr, gct, earb, adj, col, adc, dar, status, color_assign,
ideal, act, radif, earb_n, ardif, ncr, atcr
)
paged_table(rcm_top)
rcm_sec <- rcm_df |>
select(
yqtr, id, month, mon, mmon, gct, earb, adj,
col, adc, dar, status, ideal, act,
radif, earb_n, ardif, ncr, atcr
)
paged_table(rcm_sec)
drilldown_tbl <- reactable(
data = rcm_top,
elementId = "rcm-drilldown-table",
pagination = F,
highlight = TRUE,
striped = F,
filterable = F,
compact = TRUE,
showPageSizeOptions = F,
onClick = "expand",
class = "packages-table",
rowStyle = list(cursor = "pointer"),
theme = nytimes(),
defaultSorted = "yqtr",
defaultColDef = colDef(
headerClass = "col-header",
footerClass = "col-footer"
),
columns = list(
yqtr = colDef(
name = "Quarter",
width = 80,
align = "left",
footer = "Averages"
),
gct = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Gross Charges",
cell = color_tiles(rcm_top,
box_shadow = TRUE,
number_fmt = scales::number_format(
prefix = "$",
accuracy = 0.01,
big.mark = ",",
trim = "FALSE"
)
)
),
earb = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Ending AR",
cell = color_tiles(rcm_top,
box_shadow = TRUE,
number_fmt = scales::number_format(
prefix = "$",
accuracy = 0.01,
big.mark = ",",
trim = "FALSE"
)
)
),
adj = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Adjustments",
cell = color_tiles(rcm_top,
box_shadow = TRUE,
number_fmt = scales::number_format(
prefix = "$",
accuracy = 0.01,
big.mark = ",",
trim = "FALSE"
)
)
),
col = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Collections",
cell = color_tiles(rcm_top,
box_shadow = TRUE,
number_fmt = scales::number_format(
prefix = "$",
accuracy = 0.01,
big.mark = ",",
trim = "FALSE"
)
)
),
adc = colDef(
name = "Avg. Daily Charge",
footer = function(values) sprintf("%.2f", mean(values)),
cell = color_tiles(rcm_top,
box_shadow = TRUE,
number_fmt = scales::number_format(
prefix = "$",
accuracy = 0.01,
big.mark = ",",
trim = "FALSE"
)
)
),
# dar = colDef(
# name = "Days in AR",
# footer = function(values) sprintf("%.2f", mean(values)),
# cell = color_tiles(rcm_top,
# box_shadow = TRUE,
# number_fmt = scales::number_format(
# accuracy = 0.01,
# trim = "FALSE"))),
dar = colDef(
name = "Days in AR",
width = 70,
align = "left",
footer = function(values) sprintf("%.2f", mean(values)),
cell = gauge_chart(rcm_top, tooltip = T, fill_color_ref = "color_assign")
),
color_assign = colDef(show = F),
status = colDef(name = "Status", width = 70, show = F),
ideal = colDef(show = F),
act = colDef(show = F),
radif = colDef(show = F),
earb_n = colDef(
name = "AR Target",
class = "number",
footer = function(values) sprintf("%.2f", mean(values)),
cell = data_bars(rcm_top,
fill_color = c("#15607A", "orange"),
align_bars = "left",
text_position = "above",
number_fmt = scales::number_format(
prefix = "$",
accuracy = 0.01,
big.mark = ",",
trim = "FALSE"
),
round_edges = TRUE
)
),
ardif = colDef(
name = "AR Difference",
class = "number",
footer = function(values) sprintf("%.2f", mean(values)),
cell = data_bars(rcm_top,
fill_color = c("#15607A", "orange"),
align_bars = "left",
text_position = "above",
number_fmt = scales::number_format(
accuracy = 0.01,
big.mark = ",",
trim = "FALSE"
),
round_edges = TRUE
)
),
ncr = colDef(
name = "Net Collections Rate",
footer = function(values) sprintf("%.2f", mean(values)),
class = "number",
cell = data_bars(rcm_top,
fill_color = c("#15607A", "orange"),
align_bars = "left",
text_position = "above",
number_fmt = scales::number_format(
accuracy = 0.01,
big.mark = ",",
suffix = "%",
trim = "FALSE"
),
round_edges = TRUE
)
),
atcr = colDef(
footer = function(values) sprintf("%.2f", mean(values)),
name = "Adjustments to Collections",
class = "number",
cell = data_bars(rcm_top,
fill_color = c("#15607A", "orange"),
align_bars = "left",
text_position = "above",
number_fmt = scales::number_format(
accuracy = 0.01,
big.mark = ",",
trim = "FALSE"
),
round_edges = TRUE
)
)
),
details = function(index) {
sec_lvl <- rcm_sec[rcm_sec$yqtr == rcm_top$yqtr[index], ]
reactable(
data = sec_lvl,
pagination = F,
highlight = TRUE,
striped = F,
outlined = TRUE,
compact = F,
showPageSizeOptions = F,
theme = nytimes(),
defaultSorted = "id",
defaultColDef = colDef(
headerClass = "col-header",
footerClass = "col-footer",
align = "left"
),
columns = list(
yqtr = colDef(show = F),
id = colDef(name = " ", width = 45),
month = colDef(name = "Month"),
mon = colDef(show = F),
mmon = colDef(show = F),
gct = colDef(
name = "Gross Charges",
class = "number"
),
earb = colDef(
name = "Ending AR",
class = "number"
),
adj = colDef(
name = "Adjustments",
class = "number"
),
col = colDef(
name = "Collections",
class = "number"
),
adc = colDef(
name = "Avg. Daily Charge",
footer = function(values) sprintf("%.2f", mean(values)),
cell = color_tiles(sec_lvl, number_fmt = scales::comma)
),
dar = colDef(
name = "Days in AR",
footer = function(values) sprintf("%.2f", mean(values))
),
status = colDef(name = "Status", width = 70),
ideal = colDef(show = F),
act = colDef(show = F),
radif = colDef(show = F),
earb_n = colDef(
name = "AR Target",
class = "number",
footer = function(values) sprintf("%.2f", mean(values)),
cell = data_bars(sec_lvl,
fill_color = c("#15607A", "orange"),
align_bars = "left",
text_position = "above",
number_fmt = scales::number_format(
accuracy = 0.01,
big.mark = ",",
trim = "FALSE"
),
round_edges = TRUE
)
),
ardif = colDef(
name = "AR Difference",
class = "number",
footer = function(values) sprintf("%.2f", mean(values)),
cell = data_bars(sec_lvl,
fill_color = c("#15607A", "orange"),
align_bars = "left",
text_position = "above",
number_fmt = scales::number_format(
accuracy = 0.01,
big.mark = ",",
trim = "FALSE"
),
round_edges = TRUE
)
),
ncr = colDef(
name = "Net Collections Rate",
class = "number",
cell = data_bars(sec_lvl,
fill_color = c("#15607A", "orange"),
align_bars = "left",
text_position = "above",
number_fmt = scales::number_format(
accuracy = 0.01,
big.mark = ",",
suffix = "%",
trim = "FALSE"
),
round_edges = TRUE
)
),
atcr = colDef(
name = "Adjustments to Collections",
class = "number",
cell = data_bars(sec_lvl,
fill_color = c("#15607A", "orange"),
align_bars = "left",
text_position = "above",
number_fmt = scales::number_format(
accuracy = 0.01,
big.mark = ",",
trim = "FALSE"
),
round_edges = TRUE
)
)
)
)
}
) |>
add_title("Revenue Cycle Management Report", align = "left", font_color = "black", font_size = 24) |>
add_subtitle("January 2021 - April 2022", align = "left", font_color = "black", font_size = 18, font_weight = "normal")
div(class = "rcm-analysis", drilldown_tbl)
This comes from a function I came across on Andrew Bates’ Github. It’s actually a gist, located here. He based it on a chapter from Thomas Wilburn’s online book, The Elegant Selection, Building stacked charts with flexbox.
# reactable stacked bar chart function
bar_chart <-
function(value,
color_left = "salmon",
color_right = "wheat",
height = "30px",
border_right = "3px solid white",
border_color = "white",
text_color = "white") {
val_left <- paste0(round(value * 100, 2), "%")
val_right <- paste0(round((1 - value) * 100, 2), "%")
bar_left <- div(
style = list(
background = color_left,
height = height,
borderRight = border_right
),
val_left
)
chart_left <- div(
style = list(
flexGrow = 1,
textAlign = "center",
flexBasis = val_left
),
bar_left
)
bar_right <- div(
style = list(
background = color_right,
height = height
),
val_right
)
chart_right <- div(
style = list(
flexGrow = 1,
textAlign = "center",
flexBasis = val_right
),
bar_right
)
div(
style = list(
display = "flex",
alignItems = "stretch",
justifyContent = "center"
),
chart_left,
chart_right
)
}
# data frame
dat <- rcm_top |>
select(yqtr, gct, earb, dar, status) |>
mutate(
gct_pct = gct / (gct + earb)
)
# reactable
drilldown_tbl2 <- reactable(
data = dat,
columns = list(
gct_pct = colDef(
name = "Percentages: GCt / EARB",
class = "number",
cell = function(value) {
bar_chart(value)
},
align = "center"
)
),
theme = reactableTheme(
# Vertically center cells
cellStyle = list(display = "flex", flexDirection = "column", justifyContent = "center")
)
)
# html output
div(class = "rcm-analysis", drilldown_tbl2)
library(compareBars)
rcm_sec |>
select(mmon, gct, earb) |>
rename(
Month = mmon,
"Gross Charges" = gct,
"Ending AR" = earb
) |>
compareBars(
Month,
"Gross Charges",
"Ending AR",
xLabel = NULL,
yLabel = NULL,
titleLabel = "2022 Comparing Monthly Gross Charges & Ending AR Balance",
subtitleLabel = "The Color of the Bar Top Indicates Which is Larger, the Tooltip Displays the Difference",
fontFamily = "Karla",
compareVarFill1 = "#5FA0CB",
compareVarFill2 = "#DE7F40",
orientation = "horizontal",
width = 800,
height = 600,
tooltipFormat = ".0s"
)
hc_theme_aab <- hc_theme(
colors = c(
"#0C2340", # Navy
"#C8102E", # Red
"#85714D" # Gold
),
chart = list(
style = list(
fontSize = "16",
color = "#000000",
fontWeight = "normal",
fontFamily = "Karla"
)
),
title = list(
align = "left",
style = list(
fontSize = "20",
color = "#0C2340",
fontWeight = "bold",
fontFamily = "Karla"
)
),
subtitle = list(
align = "left",
style = list(
fontSize = "16",
color = "#C8102E",
fontWeight = "normal",
fontFamily = "Karla"
)
),
plotOptions = list(
line = list(
marker = list(
symbol = "circle",
lineWidth = 2,
radius = 5
)
)
)
)
# stacked area chart
rcm_sec |>
select(mmon, gct, earb, col, adj) |>
tidyr::pivot_longer(
!mmon,
names_to = "names",
values_to = "values"
) |>
hchart(
type = "area",
hcaes(
x = mmon,
y = values,
group = names
)
) |>
hc_plotOptions(
series = list(
stacking = "normal",
marker = list(
enabled = F,
states = list(
hover = list(
enabled = F
)
)
),
lineWidth = 0.8,
lineColor = "white"
)
) |>
hc_xAxis(title = list(text = "Month")) |>
hc_yAxis(title = list(text = "Amount ($USD)")) |>
hc_legend(
align = "right", verticalAlign = "bottom",
layout = "horizontal"
) |>
hc_add_theme(hc_theme_aab) |>
hc_size(width = 1000, height = 600) |>
hc_tooltip(shared = TRUE)
# stacked bar chart
rcm_sec |>
select(mmon, gct, earb) |>
tidyr::pivot_longer(
!mmon,
names_to = "names",
values_to = "values"
) |>
hchart(
type = "bar",
hcaes(
x = mmon,
y = values,
group = names
)
) |>
hc_plotOptions(
series = list(
stacking = "percent",
pointPadding = 0.2,
pointWidth = 25,
borderWidth = 2,
marker = list(
enabled = F,
states = list(
hover = list(
enabled = F
)
)
),
lineWidth = 2,
lineColor = "white"
)
) |>
hc_xAxis(title = list(text = "")) |>
hc_yAxis(title = list(text = "")) |>
hc_legend(
reversed = TRUE,
align = "right",
verticalAlign = "bottom",
layout = "horizontal"
) |>
hc_add_theme(hc_theme_aab) |>
hc_size(width = 1000, height = 600) |>
hc_tooltip(shared = TRUE) |>
hc_chart(zoomType = "xy")
# DAR Function
dar <- function(gct = 1, ndip = 30, earb = 1.5, dart = 40) {
earb / (gct / ndip)
}
dar()
[1] 45# Create data frame
dar_example <- data.frame(
date = (c(seq(
as.Date("2022-01-01"),
by = "month",
length.out = 12
))
),
gct = c(
325982, 297731.74, 198655.14,
186047, 123654, 131440.28,
153991, 156975, 146878.12,
163799.44, 151410.74, 169094.46
),
earb = c(
288432.52, 307871.08, 253976.56,
183684.90, 204227.59, 203460.47,
182771.32, 169633.64, 179347.72,
178051.11, 162757.49, 199849.30
),
adj = c(
170173.76, 153744.3, 133104.13,
84582.48, 52999.08, 66491.99,
89434.24, 102057.43, 63494.83,
83673.68, 88268.09, 62971.82
),
pmt = c(
104181.64, 124548.88, 119445.53,
71756.18, 50112.23, 65715.41,
85245.91, 68055.25, 73669.21,
81422.37, 78436.27, 69030.83
),
pos = c(
16012.80, 16304.75, 10844.50,
1824.07, 6240.95, 7376.63,
9155.36, 9740.75, 8602.64,
8599.35, 7348.15, 10461.59
),
provlag = c(
5.33, 8.08, 6.07,
3.76, 2.61, 2.77,
3.43, 3.36, 2.54,
2.63, 3.26, 3.4
),
visit = c(
1568, 1473, 1031,
553, 713, 723,
813, 798, 787,
851, 762, 834
),
pt = c(
1204, 1162, 758,
428, 609, 578,
636, 658, 624,
702, 565, 670
),
new = c(
129, 120, 61,
32, 123, 77,
93, 76, 65,
61, 61, 95
),
em = c(
1184, 1130, 813,
427, 550, 572,
599, 615, 597,
617, 487, 662
),
rvu = c(
1564.5, 1474.35, 995.6,
517.34, 739.5, 754.64,
863.41, 835.53, 826.4,
875.49, 814.78, 911.65
)
)
# DAR Monthly Function
ager_dar_month <- function(df, gct_col, date_col, earb_col, dart = 35) {
stopifnot(inherits(df, "data.frame"))
dplyr::mutate(df,
ndip = lubridate::days_in_month({{ date_col }}),
nmon = lubridate::month({{ date_col }}, label = FALSE),
month = lubridate::month({{ date_col }}, label = TRUE, abbr = FALSE),
mon = lubridate::month({{ date_col }}, label = TRUE, abbr = TRUE),
year = lubridate::year({{ date_col }}),
nqtr = lubridate::quarter({{ date_col }}),
yqtr = lubridate::quarter({{ date_col }}, with_year = TRUE),
dqtr = paste0(lubridate::quarter({{ date_col }}), "Q", format({{ date_col }}, "%y")),
ymon = as.numeric(format({{ date_col }}, "%Y.%m")),
mmon = format({{ date_col }}, "%b %Y"),
nhalf = lubridate::semester({{ date_col }}),
yhalf = lubridate::semester({{ date_col }}, with_year = TRUE),
dhalf = paste0(lubridate::semester({{ date_col }}), "H", format({{ date_col }}, "%y")),
adc = round({{ gct_col }} / ndip, digits = 2),
dar = round({{ earb_col }} / adc, digits = 2),
actual = round({{ earb_col }} / {{ gct_col }}, digits = 2),
ideal = round({{ dart }} / ndip, digits = 2),
ratio_diff = round(actual - ideal, digits = 2),
dar_diff = round(dar - {{ dart }}, digits = 2),
earb_target = round(({{ gct_col }} * {{ dart }} / ndip), digits = 2),
earb_decrease_need = round({{ earb_col }} - earb_target, digits = 2),
earb_decrease_pct = (earb_decrease_need / {{ earb_col }}),
earb_gct_diff = round({{ earb_col }} - {{ gct_col }}, digits = 2),
status = case_when(dar < {{ dart }} ~ "Pass", TRUE ~ "Fail")
)
}
# Call Function
dar_example1 <- ager_dar_month(
df = dar_example,
gct_col = gct,
date_col = date,
earb_col = earb,
dart = 35
)
paged_table(dar_example1)
ager_dar_qtr <- function(df,
nmon_col = nmon,
nqtr_col = nqtr,
dqtr_col = dqtr,
earb_col = earb,
gct_col = gct,
ndip_col = ndip,
date_col = date,
dart = 35) {
stopifnot(inherits(df, "data.frame"))
earb_qtr <- dplyr::filter(df, {{ nmon_col }} == 3 | {{ nmon_col }} == 6 | {{ nmon_col }} == 9 | {{ nmon_col }} == 12) |>
dplyr::select({{ nqtr_col }}, {{ earb_col }})
gct_qtr <- dplyr::group_by(df, {{ nqtr_col }}, {{ dqtr_col }}) |>
dplyr::summarise(
gct = round(sum({{ gct_col }}), 2),
ndip = sum({{ ndip_col }}),
.groups = "drop"
)
quarters <- merge(earb_qtr, gct_qtr)
dplyr::mutate(quarters,
adc = round(gct / ndip, digits = 2),
dar = round(earb / adc, digits = 2),
actual = round(earb / gct, digits = 2),
ideal = round({{ dart }} / ndip, digits = 2),
ratio_diff = round(actual - ideal, digits = 2),
dar_diff = round(dar - {{ dart }}, digits = 2),
earb_target = round((gct * {{ dart }} / ndip), digits = 2),
earb_decrease_need = round(earb - earb_target, digits = 2),
earb_decrease_pct = (earb_decrease_need / earb),
earb_gct_diff = round(earb - gct, digits = 2),
status = case_when(dar < {{ dart }} ~ "Pass", TRUE ~ "Fail")
)
}
# Call Function
ager_dar_qtr(df = dar_example1)
nqtr earb dqtr gct ndip adc dar actual ideal ratio_diff dar_diff earb_target
1 1 253976.6 1Q22 822368.9 90 9137.43 27.80 0.31 0.39 -0.08 -7.20 319810.1
2 2 203460.5 2Q22 441141.3 91 4847.71 41.97 0.46 0.38 0.08 6.97 169669.7
3 3 179347.7 3Q22 457844.1 92 4976.57 36.04 0.39 0.38 0.01 1.04 174179.8
4 4 199849.3 4Q22 484304.6 92 5264.18 37.96 0.41 0.38 0.03 2.96 184246.3
earb_decrease_need earb_decrease_pct earb_gct_diff status
1 -65833.56 -0.25921116 -568392.3 Pass
2 33790.75 0.16608017 -237680.8 Fail
3 5167.89 0.02881492 -278496.4 Fail
4 15602.97 0.07807368 -284455.3 FailAn account is a billable episode of care. It begins to age once it is billed to an insurance company or patient. These outstanding accounts are monitored by age in 30-day increments (0 - 30, 31 - 60, 61 - 90, and so forth.) AR departments monitor the number of accounts outstanding, the dollar amount in each 30-day increment (sometimes called “bins” or “buckets”), and the responsible parties. As well, aging should be broken down by many metrics, such as Provider, Patient, Insurance Types (Commercial, Primary, Secondary, Worker’s Compensation, Managed Care), Facility, Diagnosis/Procedure code, Specialty, etc. The older the account or the longer the account remains unpaid, the less likely it will be reimbursed.
Most claims are originally billed to insurance and, until the insurance makes a payment, the responsibility for the payment continues to be with the insurance payer. After the payer makes or denies a payment (with no just cause for an appeal), the responsibility for the balance of goes to the patient (to be sent an invoice) or the physician (to be written off.)
aging_df <- data.frame(
level1 = rep(c("Primary", "Secondary"), each = 7),
level2 = rep(c(
"Cigna",
"BCBS",
"Medicare",
"Aetna",
"Humana",
"UHC",
"Medicaid"
), 2),
size = c(
101586.44, 813932.10, 244682.06,
315442.09, 338892.56, 692951.00,
172394.44, 30869.21, 75555.29,
12601.41, 39003.59, 27713.18,
14384.15, 222480.09
),
stringsAsFactors = FALSE
)
# http://timelyportfolio.github.io/sunburstR/reference/sunburst.html
tree <- d3_nest(aging_df, value_cols = "size")
sb1 <- sunburst(tree, width = "100%", height = 600)
sb3 <- sund2b(
tree,
width = "100%",
height = 600,
rootLabel = "Aging",
showLabels = T,
breadcrumbs = sund2bBreadcrumb(enabled = T),
colors = list(range = RColorBrewer::brewer.pal(9, "Paired"))
)
div(
style = "display: flex; align-items:center;",
div(style = "width:50%; border:1px solid #ccc;", sb1),
div(style = "width:50%; border:1px solid #ccc;", sb3)
)
aging_df2 <- data.frame(
parents = c(
"",
"Primary", "Primary",
"Primary", "Primary",
"Primary", "Primary", "Primary",
"Secondary", "Secondary",
"Secondary", "Secondary",
"Secondary", "Secondary", "Secondary",
"Everything", "Everything"
),
labels = c(
"Everything",
"Cigna", "BCBS", "Medicare",
"Aetna", "Humana", "UHC",
"Medicaid", "Cigna", "BCBS",
"Medicare", "Aetna", "Humana",
"UHC", "Medicaid",
"Primary", "Secondary"
),
value = c(
0,
101586.44, 813932.10, 244682.06,
315442.09, 338892.56, 692951.00,
172394.44, 30869.21, 75555.29,
12601.41, 39003.59, 27713.18,
14384.15, 222480.09, 2679880.7,
422606.9
)
)
# create a tree object
etree <- data.tree::FromDataFrameNetwork(aging_df2)
# use it in echarts4r
etree |>
e_charts(
width = "100%",
height = 700
) |>
e_sunburst() |>
e_tooltip(style = "currency", locale = "US") |>
e_title("Primary & Secondary Aging") |>
e_theme("dark")
| Package | Version | Citation |
|---|---|---|
| apexcharter | 0.3.1 | Perrier and Meyer (2022) |
| base | 4.2.0 | R Core Team (2022) |
| compareBars | 0.0.1 | Ranzolin (2022) |
| crosstalk | 1.2.0 | Cheng and Sievert (2021) |
| d3r | 1.0.0 | Bostock, Russell, et al. (2021) |
| data.tree | 1.0.0 | Glur (2020) |
| distill | 1.4 | Dervieux et al. (2022) |
| echarts4r | 0.4.4 | Coene (2022) |
| ggsci | 2.9 | Xiao (2018) |
| grateful | 0.1.11 | Rodríguez-Sánchez, Jackson, and Hutchins (2022) |
| highcharter | 0.9.4 | Kunst (2022) |
| htmltools | 0.5.2 | Cheng et al. (2021) |
| knitr | 1.39 | Xie (2014); Xie (2015); Xie (2022) |
| RColorBrewer | 1.1.3 | Neuwirth (2022) |
| reactable | 0.3.0 | Lin (2022) |
| reactablefmtr | 2.0.0 | Cuilla (2022) |
| rmarkdown | 2.14 | Xie, Allaire, and Grolemund (2018); Xie, Dervieux, and Riederer (2020); Allaire et al. (2022) |
| scales | 1.2.0 | Wickham and Seidel (2022) |
| sessioninfo | 1.2.2 | Wickham et al. (2021) |
| sunburstR | 2.1.6 | Bostock, Rodden, et al. (2021) |
| tidyverse | 1.3.1 | Wickham et al. (2019) |
| xaringanExtra | 0.6.0 | Aden-Buie and Warkentin (2022) |
[1] "2022-06-09 17:57:29 EDT"─ Session info ───────────────────────────────────────────────────────────────────────────────────
setting value
version R version 4.2.0 (2022-04-22 ucrt)
os Windows 10 x64 (build 25131)
system x86_64, mingw32
ui RTerm
language (EN)
collate English_United States.utf8
ctype English_United States.utf8
tz America/New_York
date 2022-06-09
pandoc 2.17.1.1 @ C:/Program Files/RStudio/bin/quarto/bin/ (via rmarkdown)
─ Packages ───────────────────────────────────────────────────────────────────────────────────────
package * version date (UTC) lib source
apexcharter * 0.3.1 2022-02-27 [1] CRAN (R 4.2.0)
assertthat 0.2.1 2019-03-21 [1] CRAN (R 4.2.0)
backports 1.4.1 2021-12-13 [1] CRAN (R 4.2.0)
broom 0.8.0 2022-04-13 [1] CRAN (R 4.2.0)
bslib 0.3.1 2021-10-06 [1] CRAN (R 4.2.0)
cachem 1.0.6 2021-08-19 [1] CRAN (R 4.2.0)
cellranger 1.1.0 2016-07-27 [1] CRAN (R 4.2.0)
cli 3.3.0 2022-04-25 [1] CRAN (R 4.2.0)
colorspace 2.0-3 2022-02-21 [1] CRAN (R 4.2.0)
compareBars * 0.0.1 2022-05-15 [1] Github (daranzolin/compareBars@3c56dae)
crayon 1.5.1 2022-03-26 [1] CRAN (R 4.2.0)
crosstalk 1.2.0 2021-11-04 [1] CRAN (R 4.2.0)
curl 4.3.2 2021-06-23 [1] CRAN (R 4.2.0)
d3r * 1.0.0 2022-04-26 [1] Github (timelyportfolio/d3r@f77d0a0)
data.table 1.14.2 2021-09-27 [1] CRAN (R 4.2.0)
data.tree 1.0.0 2020-08-03 [1] CRAN (R 4.2.0)
DBI 1.1.2 2021-12-20 [1] CRAN (R 4.2.0)
dbplyr 2.2.0 2022-06-05 [1] CRAN (R 4.2.0)
digest 0.6.29 2021-12-01 [1] CRAN (R 4.2.0)
distill 1.4 2022-05-12 [1] CRAN (R 4.2.0)
downlit 0.4.0 2021-10-29 [1] CRAN (R 4.2.0)
dplyr * 1.0.9 2022-04-28 [1] CRAN (R 4.2.0)
echarts4r * 0.4.4 2022-05-28 [1] CRAN (R 4.2.0)
ellipsis 0.3.2 2021-04-29 [1] CRAN (R 4.2.0)
evaluate 0.15 2022-02-18 [1] CRAN (R 4.2.0)
fansi 1.0.3 2022-03-24 [1] CRAN (R 4.2.0)
fastmap 1.1.0 2021-01-25 [1] CRAN (R 4.2.0)
forcats * 0.5.1 2021-01-27 [1] CRAN (R 4.2.0)
fs 1.5.2 2021-12-08 [1] CRAN (R 4.2.0)
generics 0.1.2 2022-01-31 [1] CRAN (R 4.2.0)
ggplot2 * 3.3.6 2022-05-03 [1] CRAN (R 4.2.0)
ggsci * 2.9 2018-05-14 [1] CRAN (R 4.2.0)
glue 1.6.2 2022-02-24 [1] CRAN (R 4.2.0)
grateful * 0.1.11 2022-05-07 [1] Github (Pakillo/grateful@ba9b003)
gtable 0.3.0 2019-03-25 [1] CRAN (R 4.2.0)
haven 2.5.0 2022-04-15 [1] CRAN (R 4.2.0)
highcharter * 0.9.4 2022-01-03 [1] CRAN (R 4.2.0)
highr 0.9 2021-04-16 [1] CRAN (R 4.2.0)
hms 1.1.1 2021-09-26 [1] CRAN (R 4.2.0)
htmltools * 0.5.2 2021-08-25 [1] CRAN (R 4.2.0)
htmlwidgets 1.5.4 2021-09-08 [1] CRAN (R 4.2.0)
httpuv 1.6.5 2022-01-05 [1] CRAN (R 4.2.0)
httr 1.4.3 2022-05-04 [1] CRAN (R 4.2.0)
igraph 1.3.1 2022-04-20 [1] CRAN (R 4.2.0)
jquerylib 0.1.4 2021-04-26 [1] CRAN (R 4.2.0)
jsonlite 1.8.0 2022-02-22 [1] CRAN (R 4.2.0)
knitr * 1.39 2022-04-26 [1] CRAN (R 4.2.0)
later 1.3.0 2021-08-18 [1] CRAN (R 4.2.0)
lattice 0.20-45 2021-09-22 [2] CRAN (R 4.2.0)
lifecycle 1.0.1 2021-09-24 [1] CRAN (R 4.2.0)
lubridate * 1.8.0 2021-10-07 [1] CRAN (R 4.2.0)
magrittr 2.0.3 2022-03-30 [1] CRAN (R 4.2.0)
memoise 2.0.1 2021-11-26 [1] CRAN (R 4.2.0)
mime 0.12 2021-09-28 [1] CRAN (R 4.2.0)
modelr 0.1.8 2020-05-19 [1] CRAN (R 4.2.0)
munsell 0.5.0 2018-06-12 [1] CRAN (R 4.2.0)
pillar 1.7.0 2022-02-01 [1] CRAN (R 4.2.0)
pkgconfig 2.0.3 2019-09-22 [1] CRAN (R 4.2.0)
promises 1.2.0.1 2021-02-11 [1] CRAN (R 4.2.0)
purrr * 0.3.4 2020-04-17 [1] CRAN (R 4.2.0)
quantmod 0.4.20 2022-04-29 [1] CRAN (R 4.2.0)
R.cache 0.15.0 2021-04-30 [1] CRAN (R 4.2.0)
R.methodsS3 1.8.1 2020-08-26 [1] CRAN (R 4.2.0)
R.oo 1.24.0 2020-08-26 [1] CRAN (R 4.2.0)
R.utils 2.11.0 2021-09-26 [1] CRAN (R 4.2.0)
R6 2.5.1 2021-08-19 [1] CRAN (R 4.2.0)
RColorBrewer 1.1-3 2022-04-03 [1] CRAN (R 4.2.0)
Rcpp 1.0.8.3 2022-03-17 [1] CRAN (R 4.2.0)
reactable * 0.3.0 2022-05-26 [1] CRAN (R 4.2.0)
reactablefmtr * 2.0.0 2022-03-16 [1] CRAN (R 4.2.0)
reactR 0.4.4 2021-02-22 [1] CRAN (R 4.2.0)
readr * 2.1.2 2022-01-30 [1] CRAN (R 4.2.0)
readxl 1.4.0 2022-03-28 [1] CRAN (R 4.2.0)
rematch2 2.1.2 2020-05-01 [1] CRAN (R 4.2.0)
renv 0.15.5 2022-05-26 [1] CRAN (R 4.2.0)
reprex 2.0.1 2021-08-05 [1] CRAN (R 4.2.0)
rlang 1.0.2 2022-03-04 [1] CRAN (R 4.2.0)
rlist 0.4.6.2 2021-09-03 [1] CRAN (R 4.2.0)
rmarkdown * 2.14 2022-04-25 [1] CRAN (R 4.2.0)
rstudioapi 0.13 2020-11-12 [1] CRAN (R 4.2.0)
rvest 1.0.2 2021-10-16 [1] CRAN (R 4.2.0)
sass 0.4.1 2022-03-23 [1] CRAN (R 4.2.0)
scales 1.2.0 2022-04-13 [1] CRAN (R 4.2.0)
sessioninfo 1.2.2 2021-12-06 [1] CRAN (R 4.2.0)
shiny 1.7.1 2021-10-02 [1] CRAN (R 4.2.0)
stringi 1.7.6 2021-11-29 [1] CRAN (R 4.2.0)
stringr * 1.4.0 2019-02-10 [1] CRAN (R 4.2.0)
styler 1.7.0 2022-03-13 [1] CRAN (R 4.2.0)
sunburstR * 2.1.6 2022-04-26 [1] Github (timelyportfolio/sunburstR@9f47439)
tibble * 3.1.7 2022-05-03 [1] CRAN (R 4.2.0)
tidyr * 1.2.0 2022-02-01 [1] CRAN (R 4.2.0)
tidyselect 1.1.2 2022-02-21 [1] CRAN (R 4.2.0)
tidyverse * 1.3.1 2021-04-15 [1] CRAN (R 4.2.0)
tippy 0.1.0 2021-01-11 [1] CRAN (R 4.2.0)
TTR 0.24.3 2021-12-12 [1] CRAN (R 4.2.0)
tzdb 0.3.0 2022-03-28 [1] CRAN (R 4.2.0)
utf8 1.2.2 2021-07-24 [1] CRAN (R 4.2.0)
uuid 1.1-0 2022-04-19 [1] CRAN (R 4.2.0)
vctrs 0.4.1 2022-04-13 [1] CRAN (R 4.2.0)
withr 2.5.0 2022-03-03 [1] CRAN (R 4.2.0)
xaringanExtra 0.6.0 2022-06-07 [1] CRAN (R 4.2.0)
xfun 0.31 2022-05-10 [1] CRAN (R 4.2.0)
xml2 1.3.3 2021-11-30 [1] CRAN (R 4.2.0)
xtable 1.8-4 2019-04-21 [1] CRAN (R 4.2.0)
xts 0.12.1 2020-09-09 [1] CRAN (R 4.2.0)
yaml 2.3.5 2022-02-21 [1] CRAN (R 4.2.0)
zoo 1.8-10 2022-04-15 [1] CRAN (R 4.2.0)
[1] C:/Users/andyb/AppData/Local/R/win-library/4.2
[2] C:/Program Files/R/R-4.2.0/library
──────────────────────────────────────────────────────────────────────────────────────────────────If you see mistakes or want to suggest changes, please create an issue on the source repository.
Text and figures are licensed under Creative Commons Attribution CC BY 4.0. Source code is available at https://github.com/andrewallenbruce, unless otherwise noted. The figures that have been reused from other sources don't fall under this license and can be recognized by a note in their caption: "Figure from ...".
For attribution, please cite this work as
Bruce (2022, March 27). Andrew Bruce: R Cookbook: Healthcare Revenue Cycle. Retrieved from https://andrewbruce.netlify.app/posts/r-cookbook-healthcare-rcm/
BibTeX citation
@misc{bruce2022r,
author = {Bruce, Andrew},
title = {Andrew Bruce: R Cookbook: Healthcare Revenue Cycle},
url = {https://andrewbruce.netlify.app/posts/r-cookbook-healthcare-rcm/},
year = {2022}
}