Skip to content

Commit

Permalink
Bill for some support requests without project IDs #257
Browse files Browse the repository at this point in the history
Remove filters that require a PID in get_service_request_lines().
Use probono_reason to exclude some PID-less service requests.
Add months_previous parameter to get_service_request_lines() to simplify testing.
Add comments to get_service_request_lines() to improve readability.
Add detail to docs for get_service_request_lines().
Update test data and add tests for get_service_request_lines().
Update test data for get_service_request_line_items().
Fix documentation with bad cross-references.
Fix package dependencies.
  • Loading branch information
pbchase committed Dec 21, 2024
1 parent 6764bd6 commit e0dc7b9
Show file tree
Hide file tree
Showing 19 changed files with 148 additions and 52 deletions.
5 changes: 3 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -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:
Expand Down
2 changes: 1 addition & 1 deletion R/get_orphaned_projects.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
#'
Expand Down
2 changes: 1 addition & 1 deletion R/get_service_request_line_items.R
Original file line number Diff line number Diff line change
Expand Up @@ -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.
#'
Expand Down
43 changes: 35 additions & 8 deletions R/get_service_request_lines.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
#'
Expand All @@ -19,10 +29,12 @@
#' 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),
Expand All @@ -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",
Expand All @@ -67,10 +80,17 @@ get_service_request_lines <- function(service_requests, return_all_records = F)
)

response_details <- service_requests |>
# 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)) |>
dplyr::filter(.data$help_desk_response_complete == 2) |>
# 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(
Expand All @@ -80,32 +100,38 @@ get_service_request_lines <- function(service_requests, return_all_records = F)
),
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(1), unit = "month")) |>
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 = max(.data$service_date)
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(
Expand All @@ -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",
Expand Down
4 changes: 2 additions & 2 deletions R/redcap_projects.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion man/get_orphaned_projects.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/get_service_request_line_items.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

24 changes: 20 additions & 4 deletions man/get_service_request_lines.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/update_billable_by_ownership.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/update_billable_if_owned_by_ctsit.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Binary file not shown.
Original file line number Diff line number Diff line change
Expand Up @@ -44,6 +44,7 @@ service_requests <- read_service_requests |>
redcap_username,
gatorlink,
billable_rate,
probono_reason,
time2,
time_more,
mtg_scheduled_yn,
Expand Down
Binary file not shown.
Binary file modified tests/testthat/get_service_request_line_items/redcap_projects.rds
Binary file not shown.
Binary file not shown.
Binary file modified tests/testthat/get_service_request_line_items/service_requests.rds
Binary file not shown.
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand All @@ -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,
Expand All @@ -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,
Expand All @@ -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(
Expand Down
Binary file modified tests/testthat/get_service_request_lines/service_requests.rds
Binary file not shown.
Loading

0 comments on commit e0dc7b9

Please sign in to comment.