Merge pull request #258 from pbchase/allow_non_project_support_billing

Allow non-project support billing

DESCRIPTION

@@ -37,25 +37,26 @@ License: Apache License (>= 2)
 Encoding: UTF-8
 LazyData: true
 Imports:
-    DBI,
     bit64,
     dplyr,
     jsonlite,
     lubridate,
-    readr,
+    redcapcustodian,
     rlang,
     stringr,
     tidyr,
     writexl,
     RMariaDB
 Suggests:
     RSQLite,
+    DBI,
     DiagrammeR,
     duckdb,
     digest,
     fs,
     purrr,
     knitr,
+    readr,
     rmarkdown,
     testthat
 Remotes: 

R/get_orphaned_projects.R

@@ -2,7 +2,7 @@
 #'
 #' Return a dataframe of projects that have been orphaned
 #'
-#' @param rc_conn - a connection to a redcap database, \code{\link{connect_to_redcap_db}}
+#' @param rc_conn - a connection to a redcap database, \code{\link[redcapcustodian]{connect_to_redcap_db}}
 #' @param rcc_billing_conn - a connection to an rcc_billing database, \code{\link{connect_to_rcc_billing_db}}
 #' @param months_previous - the nth month previous to today to consider
 #'

R/get_service_request_line_items.R

@@ -2,7 +2,7 @@
 #'
 #' @param service_requests A data frame of service requests, REDCap Service Request PID 1414.
 #' @param rc_billing_conn  A connection to REDCap billing database containing an invoice_line_items table. \code{\link{connect_to_rcc_billing_db}}
-#' @param rc_conn A connection to REDCap database. \code{\link{connect_to_redcap_db}}
+#' @param rc_conn A connection to REDCap database. \code{\link[redcapcustodian]{connect_to_redcap_db}}
 #'
 #' @return A data frame of line items for service requests billing.
 #'

R/get_service_request_lines.R

@@ -3,10 +3,20 @@
 #' This function processes a dataset of service requests to extract and transform
 #' various service details. It groups response data by record_id, service_date,
 #' and probono status to summarize response data and create a source dataset for
-#' invoice line items and other tasks.
+#' invoice line items and other tasks. It returns one month of data. By default,
+#' the data returned is from the previous month. You can return the current
+#' month by setting `months_previous = 0`. Get earlier months by setting
+#' `months_previous` to higher number.
 #'
-#' @param service_requests A data frame of service requests, REDCap Service Request PID 1414.
-#' @param return_all_records A boolean to indicate every record should be returned or just last month's records
+#' To get _all_ of the data, set `return_all_records = T`.
+#'
+#' @param service_requests A data frame of service requests, REDCap Service
+#'   Request PID 1414.
+#' @param return_all_records A boolean to indicate every record should be
+#'   returned or just last month's records
+#' @param months_previous A double indicating how many months back we should
+#'   look when querying the service_requests for service_request_lines.
+#'   Defaults to 1.
 #'
 #' @return A data frame with response details to the service request
 #'
@@ -17,12 +27,14 @@
 #'
 #' # get all the records
 #' service_request_lines <- get_service_request_lines(service_requests, return_all_records = T)
-#'}
+#' }
 #' @export
-get_service_request_lines <- function(service_requests, return_all_records = F) {
+get_service_request_lines <- function(
+    service_requests,
+    return_all_records = F,
+    months_previous = 1) {
   request_details <- service_requests |>
     dplyr::filter(is.na(.data$redcap_repeat_instrument)) |>
-    dplyr::filter(!is.na(.data$project_id)) |>
     # TODO: Is a column missing in paste?
     dplyr::mutate(
       service_identifier = paste(.data$record_id),
@@ -49,6 +61,7 @@ get_service_request_lines <- function(service_requests, return_all_records = F)
       pi_first_name = dplyr::coalesce(.data$pi_fn, .data$first_name),
       pi_email = dplyr::coalesce(.data$pi_email, .data$email)
     ) |>
+    # Keep only the request columns we need to make Service request lines
     dplyr::select(
       "record_id",
       "project_id",
@@ -67,45 +80,58 @@ get_service_request_lines <- function(service_requests, return_all_records = F)
     )
 
   response_details <- service_requests |>
-  dplyr::filter(!is.na(.data$redcap_repeat_instrument)) |>
-  dplyr::filter(!is.na(.data$billable_rate)) |>
-  dplyr::filter(.data$help_desk_response_complete == 2) |>
-  dplyr::mutate(probono = (.data$billable_rate == 0)) |>
-  dplyr::rename(price_of_service = "billable_rate") |>
-  dplyr::mutate(service_date = lubridate::floor_date(
-    dplyr::coalesce(
-      .data$end_date,
-      as.Date(.data$meeting_date_time),
-      as.Date(.data$date_of_work)
-    ),
-    unit = "month"
-  )) |>
-  dplyr::filter(return_all_records |
-    .data$service_date ==
-      lubridate::floor_date(redcapcustodian::get_script_run_time() -
-        lubridate::dmonths(1), unit = "month")) |>
-  dplyr::mutate(response = dplyr::coalesce(
-    .data$response,
-    .data$comments,
-    dplyr::if_else(.data$mtg_scheduled_yn == 1, "Meeting", NA_character_)
-  )) |>
-  dplyr::mutate(time = rcc.billing::service_request_time(.data$time2, .data$time_more)) |>
-  dplyr::group_by(.data$record_id, .data$service_date, .data$probono, .data$price_of_service) |>
-  dplyr::summarize(
-    qty_provided = sum(.data$time),
-    response = paste(.data$response, collapse = " "),
-    service_date = max(.data$service_date)
-  ) |>
-  dplyr::ungroup() |>
-  dplyr::mutate(amount_due = .data$price_of_service * .data$qty_provided)
+    # Filter for repeats to get just the responses
+    dplyr::filter(!is.na(.data$redcap_repeat_instrument)) |>
+    # Filter for set billable rates
+    dplyr::filter(!is.na(.data$billable_rate)) |>
+    # Mark records as probono
+    dplyr::mutate(probono = (.data$billable_rate == 0)) |>
+    # Filter for billable things or probono_reason is Politics
+    dplyr::filter(!.data$probono | is.na(.data$probono_reason) | .data$probono_reason == 6) |>
+    # Filter for completed responses
+    dplyr::filter(.data$help_desk_response_complete == 2) |>
+    #
+    dplyr::rename(price_of_service = "billable_rate") |>
+    dplyr::mutate(service_date = lubridate::floor_date(
+      dplyr::coalesce(
+        .data$end_date,
+        as.Date(.data$meeting_date_time),
+        as.Date(.data$date_of_work)
+      ),
+      unit = "month"
+    )) |>
+    # Filter for service_dates in the month of interest
+    dplyr::filter(return_all_records |
+      .data$service_date ==
+        lubridate::floor_date(redcapcustodian::get_script_run_time() -
+          lubridate::dmonths(months_previous), unit = "month")) |>
+    dplyr::mutate(response = dplyr::coalesce(
+      .data$response,
+      .data$comments,
+      dplyr::if_else(.data$mtg_scheduled_yn == 1, "Meeting", NA_character_)
+    )) |>
+    dplyr::mutate(time = rcc.billing::service_request_time(.data$time2, .data$time_more)) |>
+    # Summarize responses into invoice line items
+    dplyr::group_by(.data$record_id, .data$service_date, .data$probono, .data$price_of_service) |>
+    dplyr::summarize(
+      qty_provided = sum(.data$time),
+      response = paste(.data$response, collapse = " "),
+      service_date = dplyr::last(.data$service_date, order_by = .data$service_date)
+    ) |>
+    dplyr::ungroup() |>
+    # Compute the amount due for each line item
+    dplyr::mutate(amount_due = .data$price_of_service * .data$qty_provided)
 
   request_lines <- request_details |>
+    # keep records that have response details
     dplyr::inner_join(response_details, by = "record_id") |>
+    # append a probono suffix, "-PB", to the service_instance_id where needed
     dplyr::mutate(service_instance_id = dplyr::if_else(
       .data$probono,
       paste0(.data$service_instance_id, "-PB"),
       .data$service_instance_id
     )) |>
+    # Smoosh a bunch o' facts together to make a 255-character comment string
     dplyr::mutate(
       other_system_invoicing_comments =
         stringr::str_trim(stringr::str_sub(
@@ -126,6 +152,7 @@ get_service_request_lines <- function(service_requests, return_all_records = F)
       "fiscal_contact_ln",
       "fiscal_contact_email"
     ), as.character)) |>
+    # Keep only the columns we need to make Service request lines
     dplyr::select(
       "record_id",
       "project_id",

R/redcap_projects.R

@@ -305,7 +305,7 @@ get_privileged_user <- function(redcap_projects,
 #'
 #' @importFrom lubridate "%within%"
 #'
-#' @return A \code{\link{dataset_diff}} containing updates to project ownerhsip's "billable" column
+#' @return A \code{\link[redcapcustodian]{dataset_diff}} containing updates to project ownership's "billable" column
 #' @export
 #'
 #' @examples
@@ -362,7 +362,7 @@ update_billable_by_ownership <- function(conn) {
 #'
 #' @importFrom lubridate "%within%"
 #'
-#' @return A \code{\link{dataset_diff}} containing updates to project ownerhsip's "billable" column
+#' @return A \code{\link[redcapcustodian]{dataset_diff}} containing updates to project ownerhsip's "billable" column
 #' @export
 #'
 #' @examples

rcc.billing.Rproj

@@ -1,4 +1,5 @@
 Version: 1.0
+ProjectId: e4bc63f6-e77e-406c-b6a7-335f8036b963
 
 RestoreWorkspace: No
 SaveWorkspace: No

tests/testthat/get_service_request_line_items/make_test_data.R

@@ -44,6 +44,7 @@ service_requests <- read_service_requests |>
     redcap_username,
     gatorlink,
     billable_rate,
+    probono_reason,
     time2,
     time_more,
     mtg_scheduled_yn,

tests/testthat/get_service_request_lines/make_test_data_for_get_service_request_lines.R

@@ -7,7 +7,20 @@ library(rcc.billing)
 load_dot_env("prod.env")
 source_credentials <- get_redcap_credentials(Sys.getenv("REDCAP_SERVICE_REQUEST_PID"))
 
-record_ids <- c(3, 6267, 6436, 6445,6473, 6469)
+record_ids <- c(
+  3,    # A very old request that has no billable rate
+  6267, # a record with responses that span two months
+  6436, # a non-billable record
+  6445, # a non-billable record
+  6473, # a record we will choose to make billable in a mutate below
+  6469, # a record we will choose to make billable in a mutate below
+  7057, # A manually-marked non-billable record with no project ID.
+        # Records without project IDs that have been manually marked as
+        # probono are ignored instead of marked as billable. The number of
+        # probono records created would be a non-revenue generating burden
+        # on fiscal staff.
+  7093  # A billable record with no project ID.
+)
 
 read_service_requests <- redcap_read(
   redcap_uri = source_credentials$redcap_uri,
@@ -17,7 +30,11 @@ read_service_requests <- redcap_read(
 )$data
 
 service_requests <- read_service_requests |>
+  # filter for only the requests we are testing
   filter(record_id %in% record_ids) |>
+  # filter for only the responses we are testing (Because we'll
+  # be adding data to record 7093 for years)
+  filter(is.na(start_date) | start_date <= ymd("2024-12-18")) |>
   select(
     record_id,
     redcap_repeat_instrument,
@@ -33,11 +50,13 @@ service_requests <- read_service_requests |>
     redcap_username,
     gatorlink,
     billable_rate,
+    probono_reason,
     time2,
     time_more,
     mtg_scheduled_yn,
     meeting_date_time,
     date_of_work,
+    start_date,
     end_date,
     response,
     comments,
@@ -46,17 +65,27 @@ service_requests <- read_service_requests |>
     fiscal_contact_email,
     help_desk_response_complete
   ) |>
+  # de-identify the person and study identifiers
   mutate(
     irb_number = if_else(!is.na(irb_number), "123", irb_number),
     pi = if_else(!is.na(pi), "Dr. Bogus PI", pi),
-    last_name = if_else(!is.na(last_name), "l_name", last_name),
-    first_name = if_else(!is.na(first_name), "f_name", first_name),
-    pi_email = if_else(!is.na(pi_email), "[email protected]", pi_email),
-    email = if_else(!is.na(email), "[email protected]", email),
     redcap_username = if_else(!is.na(redcap_username), "bogus_rc_username", redcap_username),
-    gatorlink= if_else(!is.na(gatorlink), "bogus_gatorlink", gatorlink),
+    gatorlink = if_else(!is.na(gatorlink), "bogus_gatorlink", gatorlink),
     response = if_else(!is.na(response), "fake response", response),
-    comments = if_else(!is.na(comments), "fake comment", comments))
+    comments = if_else(!is.na(comments), "fake comment", comments)
+  ) |>
+  # de-identify more person identifiers
+  mutate(
+    across(c("last_name", "fiscal_contact_ln"), ~ if_else(!is.na(.), "l_name", .)),
+    across(c("first_name", "fiscal_contact_fn"), ~ if_else(!is.na(.), "f_name", .)),
+    across(c("pi_email"), ~ if_else(!is.na(.), "[email protected]", .)),
+    across(c("email", "fiscal_contact_email"), ~ if_else(!is.na(.), "[email protected]", .))
+  ) |>
+  # make a few more rows billable
+  mutate(
+    billable_rate = if_else(record_id %in% c(6473, 6469) & !is.na(redcap_repeat_instrument), 130, billable_rate)
+  )
+
 saveRDS(
   service_requests,
   testthat::test_path(