fun: avg_dar

DESCRIPTION

@@ -2,29 +2,32 @@ Package: forager
 Title: Healthcare Revenue Cycle Analysis Suite
 Version: 0.0.0.9001
 Authors@R: 
-    person("Andrew", "Bruce", , "[email protected]", role = c("aut", "cre", "cph"))
-Description: The goal of forager is to provide a suite of analytic tools for healthcare revenue cycle management.
+    person("Andrew", "Bruce", , "[email protected]", role = c("aut", "cre", "cph"))
+Maintainer: Andrew Bruce <[email protected]>
+Description: The goal of forager is to provide a suite of analytic tools
+    for healthcare revenue cycle management.
 License: MIT + file LICENSE
 URL: https://github.com/andrewallenbruce/forager,
     https://andrewallenbruce.github.io/forager/
 BugReports: https://github.com/andrewallenbruce/forager/issues
 Depends: 
     R (>= 4.1.0)
 Imports: 
+    clock,
     dplyr,
+    fixtuRes,
     janitor,
     lubridate,
-    clock,
-    fixtuRes,
-    wakefield,
-    tidyr
+    rlang,
+    tidyr,
+    wakefield
 Suggests:
+    covr,
     gt,
     gtExtras,
-    testthat (>= 3.0.0),
     rmarkdown,
-    covr,
-    roxyglobals
+    roxyglobals,
+    testthat (>= 3.0.0)
 Config/roxyglobals/filename: generated-globals.R
 Config/roxyglobals/unique: TRUE
 Config/testthat/edition: 3

NAMESPACE

@@ -1,7 +1,9 @@
 # Generated by roxygen2: do not edit by hand
 
 export(age_days)
+export(avg_dar)
 export(count_days)
+export(dar_ex)
 export(dar_month)
 export(dar_qtr)
 export(generate_data)

R/dar.R

@@ -0,0 +1,184 @@
+#' Calculate Average Days in AR
+#'
+#' @param df `<data.frame>` or `<tibble>` with three required columns: date,
+#'   gross charges column and ending Accounts Receivables balance
+#'
+#' @param date column of `<date>`s
+#'
+#' @param gct `<dbl>` column of Gross Charges
+#'
+#' @param earb `<dbl>` column of Ending AR balances
+#'
+#' @param dart `<dbl>` Target Days in AR, default is `35` days
+#'
+#' @param period `<chr>` string specifying the calculation period; one of
+#'   `"month"`, `"quarter"`, or `"year"`; defaults to `"month"`
+#'
+#' @returns a [tibble][tibble::tibble-package]
+#'
+#' @examples
+#' avg_dar(df     = dar_ex(),
+#'         date   = monthdate,
+#'         gct    = gross_charges,
+#'         earb   = ending_ar,
+#'         dart   = 35,
+#'         period = "month")
+#'
+#' avg_dar(df     = dar_ex(),
+#'         date   = monthdate,
+#'         gct    = gross_charges,
+#'         earb   = ending_ar,
+#'         dart   = 35,
+#'         period = "quarter")
+#'
+#' @autoglobal
+#'
+#' @export
+avg_dar <- function(df,
+                    date,
+                    gct,
+                    earb,
+                    dart = 35,
+                    period = c("month", "quarter")) {
+
+  period  <- match.arg(period)
+  datecol <- rlang::englue("{{ date }}")
+  earbcol <- rlang::englue("{{ earb }}")
+  gctcol  <- rlang::englue("{{ gct }}")
+
+  df <- dplyr::mutate(
+    df,
+    "{datecol}" := clock::as_date({{ date }}),
+    nmon         = lubridate::month({{ date }}, label = FALSE),
+    month        = lubridate::month({{ date }}, label = TRUE, abbr = FALSE),
+    nqtr         = lubridate::quarter({{ date }}),
+    ndip         = lubridate::days_in_month({{ date }})
+  )
+
+  if (period == "quarter") {
+
+    qtr_max_nmons <- df |>
+      dplyr::summarise(
+        max_nmon = max(nmon),
+        .by = nqtr) |>
+      dplyr::pull(max_nmon)
+
+    earb_sub <- df |>
+      dplyr::filter(nmon %in% qtr_max_nmons) |>
+      dplyr::select({{ date }}, {{ earb }}, nmon, nqtr, month)
+
+    gct_sub <- df |>
+      dplyr::summarise(
+        "{gctcol}" := sum({{ gct }}),
+        ndip = sum(ndip),
+        .by = nqtr)
+
+    df <- dplyr::left_join(
+      earb_sub,
+      gct_sub,
+      by = dplyr::join_by(nqtr)
+    )
+  }
+
+  earb_trg_col <- rlang::sym(rlang::englue("{{ earb }}_target"))
+  earb_dc_col <- rlang::sym(rlang::englue("{{ earb }}_dec_abs"))
+
+  df |>
+    dplyr::mutate(
+
+      # Average Daily Charge
+      adc = {{ gct }} / ndip,
+
+      # Days in Accounts Receivable
+      dar = {{ earb }} / adc,
+
+      # Actual Ratio of Ending AR to Gross Charges
+      actual_ratio = {{ earb }} / {{ gct }},
+
+      # Ideal Ratio of Ending AR to Gross Charges
+      ideal_ratio = {{ dart }} / ndip,
+
+      # Actual - Ideal Ratio
+      diff_ratio = actual_ratio - ideal_ratio,
+
+      # Ending AR Target
+      "{{ earb }}_target" := ({{ gct }} * {{ dart }}) / ndip,
+
+      # Ending AR Decrease Needed
+      "{{ earb }}_dec_abs" := {{ earb }} - !!earb_trg_col,
+
+      # Ending AR Percentage Decrease Needed
+      "{{ earb }}_dec_pct" := !!earb_dc_col / {{ earb }},
+
+      # <lgl> indicating whether DAR was under/over DARt
+      pass = dplyr::case_when(dar < {{ dart }} ~ TRUE, TRUE ~ FALSE))
+  # |>
+  #   dplyr::select(
+  #     dplyr::any_of(
+  #       c("date",
+  #         "month",
+  #         "nmon",
+  #         "nqtr",
+  #         "ndip",
+  #         "gct",
+  #         "earb",
+  #         "earb_trg",
+  #         "earb_dc",
+  #         "earb_pct",
+  #         "adc",
+  #         "dar",
+  #         "pass",
+  #         "actual",
+  #         "ideal",
+  #         "radiff")
+  #     )
+  #   )
+}
+
+#' Days in AR Example Data
+#'
+#' @keywords internal
+#'
+#' @autoglobal
+#'
+#' @export
+dar_ex <- function() {
+
+  dplyr::tibble(
+    monthdate = seq(
+      as.Date("2024-01-01"),
+      by = "month",
+      length.out = 10
+    ),
+
+    gross_charges = c(
+      325982.23,
+      297731.74,
+      198655.14,
+      186047.56,
+      123654.34,
+      131440.28,
+      153991.95,
+      156975.52,
+      146878.12,
+      163799.44
+      # 151410.74,
+      # 169094.46
+    ),
+
+    ending_ar = c(
+      288432.52,
+      307871.08,
+      253976.56,
+      183684.92,
+      204227.59,
+      203460.47,
+      182771.32,
+      169633.64,
+      179347.72,
+      178051.11
+      # 162757.49,
+      # 199849.32
+    )
+  )
+}

R/generated-globals.R

@@ -1,12 +1,16 @@
 # Generated by roxyglobals: do not edit by hand
 
 utils::globalVariables(c(
+  # <avg_dar>
   # <count_days>
   # <age_days>
   ":=",
   # <dar_month>
   # <dar_qtr>
   "actual",
+  # <avg_dar>
+  "actual_ratio",
+  # <avg_dar>
   # <dar_month>
   # <dar_qtr>
   "adc",
@@ -35,14 +39,22 @@ utils::globalVariables(c(
   # <dar_month>
   # <dar_qtr>
   "ideal",
+  # <avg_dar>
+  "ideal_ratio",
+  # <avg_dar>
+  "max_nmon",
+  # <avg_dar>
   # <dar_month>
   "month",
+  # <avg_dar>
   # <dar_month>
   # <dar_qtr>
   "ndip",
+  # <avg_dar>
   # <dar_month>
   # <dar_qtr>
   "nmon",
+  # <avg_dar>
   # <dar_qtr>
   "nqtr",
   # <dar_month>

R/utils.R

@@ -11,23 +11,26 @@
 #'
 #' @export
 generate_data <- function(rows = 100){
-  x <- dplyr::tibble(
-    claim_id = wakefield::id(n = rows),
-    date_of_service = wakefield::date_stamp(n = rows,
-                      start = lubridate::today() - lubridate::dyears(2),
-                      random = TRUE),
-    payer = fixtuRes::set_vector(rows,
-            set = c("Medicare", "Medicaid", "Cigna", "Humana",
-                    "UnitedHealth", "Anthem", "BCBS", "Centene")),
-    ins_class = fixtuRes::set_vector(rows, set = c("Primary", "Secondary")),
-    balance = wakefield::income(n = rows, digits = 2) / 300) |>
-    dplyr::mutate(date_of_service = lubridate::as_date(date_of_service),
-    date_of_release = date_of_service + round(abs(stats::rnorm(length(date_of_service), 11, 4))),
-    date_of_submission = date_of_release + round(abs(stats::rnorm(length(date_of_release), 2, 2))),
-    date_of_acceptance = date_of_submission + round(abs(stats::rnorm(length(date_of_submission), 3, 2))),
-    date_of_adjudication = date_of_acceptance + round(abs(stats::rnorm(length(date_of_acceptance), 30, 3))))
 
-  x |> tidyr::nest(dates = tidyr::contains("date"))
+  dplyr::tibble(
+    claim_id        = wakefield::id(n = rows),
+    date_of_service = wakefield::date_stamp(
+      n             = rows,
+      start         = lubridate::today() - lubridate::dyears(2),
+      random        = TRUE),
+    payer           = fixtuRes::set_vector(
+      rows,
+      set           = c("Medicare", "Medicaid", "Cigna", "Humana", "UnitedHealth", "Anthem", "BCBS", "Centene")),
+    ins_class       = fixtuRes::set_vector(rows, set = c("Primary", "Secondary")),
+    balance         = wakefield::income(n = rows, digits = 2) / 300) |>
+    dplyr::mutate(
+      date_of_service = lubridate::as_date(date_of_service),
+      date_of_release = date_of_service + round(abs(stats::rnorm(length(date_of_service), 11, 4))),
+      date_of_submission = date_of_release + round(abs(stats::rnorm(length(date_of_release), 2, 2))),
+      date_of_acceptance = date_of_submission + round(abs(stats::rnorm(length(date_of_submission), 3, 2))),
+      date_of_adjudication = date_of_acceptance + round(abs(stats::rnorm(length(date_of_acceptance), 30, 3)))) |>
+    tidyr::nest(dates = tidyr::contains("date"))
+
 }
 
 #' Count days between two dates