Skip to content

Commit

Permalink
commit
Browse files Browse the repository at this point in the history
  • Loading branch information
@andrewallenbruce
andrewallenbruce committed Oct 10, 2023
1 parent 1f01e93 commit 6b9c09d
Show file tree
Hide file tree
Showing 13 changed files with 411 additions and 551 deletions.
3 changes: 1 addition & 2 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,8 +30,7 @@ export(quality_eligibility)
export(quality_payment)
export(quality_stats)
export(quality_years)
export(revalidation_date)
export(revalidation_reassign)
export(reassignments)
export(taxonomy_crosswalk)
export(years_df)
importFrom(lifecycle,deprecated)
153 changes: 78 additions & 75 deletions R/compare.R
View file
Original file line number Diff line number Diff line change
@@ -1,107 +1,110 @@
#' Compare Yearly HCPCS Utilization Data
#' Compare Yearly Provider Data To State And National Averages
#'
#' @description
#' `compare_hcpcs()` allows you to compare yearly HCPCS utilization by provider,
#' state and national averages
#' + `compare_hcpcs()` allows the user to compare a provider's yearly HCPCS
#' utilization data to state and national averages
#'
#' @param df data frame returned by `by_service()`
#' @return A [tibble][tibble::tibble-package] containing the results.
#' + `compare_conditions()` allows the user to compare the average yearly
#' prevalence of chronic conditions among a provider's patient mix to state and
#' national averages
#'
#' @return A [tibble][tibble::tibble-package] containing:
#' + `compare_hcpcs()`
#' + `compare_conditions()`
#' @examplesIf interactive()
#' prac_years() |>
#' map(\(x) by_service(year = x, npi = 1023076643)) |>
#' list_rbind() |>
#' compare_hcpcs(by_service(year = 2018, npi = 1023076643))
#'
#' map_dfr(prac_years(), ~by_service(year = .x, npi = 1023076643)) |>
#' compare_hcpcs()
#'
#' map_dfr(prac_years(), ~by_provider(year = .x, npi = 1023076643)) |>
#' compare_conditions()
#' @name compare
NULL

#' @param tbl A [tibble][tibble::tibble-package] returned from [by_service()]
#' @rdname compare
#' @autoglobal
#' @export
compare_hcpcs <- function(df) {
compare_hcpcs <- function(tbl) {

g <- df |>
x <- tbl |>
dplyr::select(year, state, hcpcs_code, pos) |>
dplyr::rowwise() |>
dplyr::mutate(state = by_geography(year, state, hcpcs_code, pos),
national = by_geography(year,
state = "National",
hcpcs_code,
pos),
.keep = "none")
national = by_geography(year, state = "National",
hcpcs_code, pos), .keep = "none")

results <- vctrs::vec_rbind(
dplyr::select(df,
year,
level,
hcpcs_code,
pos,
category, subcategory, family, procedure,
dplyr::rename(tbl,
beneficiaries = tot_benes,
services = tot_srvcs,
dplyr::contains("avg_")),
dplyr::mutate(g$state,
services = tot_srvcs) |>
cols_hcpcs(),

dplyr::mutate(x$state,
beneficiaries = tot_benes / tot_provs,
services = tot_srvcs / tot_provs) |>
dplyr::select(year,
level,
hcpcs_code,
pos,
category, subcategory, family, procedure,
beneficiaries,
services,
dplyr::contains("avg_")),
dplyr::mutate(g$national,
cols_hcpcs(),

dplyr::mutate(x$national,
beneficiaries = tot_benes / tot_provs,
services = tot_srvcs / tot_provs) |>
dplyr::select(year,
level,
hcpcs_code,
pos,
category, subcategory, family, procedure,
beneficiaries,
services,
dplyr::contains("avg_"))) |>
cols_hcpcs()) |>
dplyr::mutate(level = forcats::fct_inorder(level))

return(results)

}

#' Compare Yearly Chronic Condition Prevalence Data
#'
#' @description
#' `compare_conditions()` allows you to compare yearly chronic condition
#' prevalence by provider, state and national averages
#'
#' @param df data frame returned by `by_provider()`
#' @return A [tibble][tibble::tibble-package] containing the results.
#'
#' @examplesIf interactive()
#' prac_years() |>
#' map(\(x) by_provider(year = x, npi = 1023076643)) |>
#' list_rbind() |>
#' compare_conditions()
#' @param df data frame
#' @autoglobal
#' @export
#' @noRd
cols_hcpcs <- function(df) {

cols <- c('year',
'level',
'hcpcs_code',
'pos',
'category',
'subcategory',
'family',
'procedure',
'beneficiaries',
'services',
'avg_charge',
'avg_allowed',
'avg_payment',
'avg_std_pymt')

compare_conditions <- function(df) {
df |> dplyr::select(dplyr::any_of(cols))
}

#' @param tbl A [tibble][tibble::tibble-package] returned from [by_provider()]
#' @rdname compare
#' @autoglobal
#' @export
compare_conditions <- function(tbl) {

p <- dplyr::select(df, year, conditions) |>
p <- dplyr::select(tbl, year, conditions) |>
tidyr::unnest(conditions) |>
dplyr::mutate(level = "Provider", .after = year) |>
dplyr::rename("Atrial Fibrillation" = cc_af,
"Alzheimer's Disease/Dementia" = cc_alz,
"Asthma" = cc_asth,
"Cancer" = cc_canc,
"Heart Failure" = cc_chf,
"Chronic Kidney Disease" = cc_ckd,
"COPD" = cc_copd,
"Depression" = cc_dep,
"Diabetes" = cc_diab,
"Hyperlipidemia" = cc_hplip,
"Hypertension" = cc_hpten,
"Ischemic Heart Disease" = cc_ihd,
"Osteoporosis" = cc_opo,
"Arthritis" = cc_raoa,
"Schizophrenia and Other Psychotic Disorders" = cc_sz,
"Stroke" = cc_strk) |>
dplyr::rename(
"Atrial Fibrillation" = cc_af,
"Alzheimer's Disease/Dementia" = cc_alz,
"Asthma" = cc_asth,
"Cancer" = cc_canc,
"Heart Failure" = cc_chf,
"Chronic Kidney Disease" = cc_ckd,
"COPD" = cc_copd,
"Depression" = cc_dep,
"Diabetes" = cc_diab,
"Hyperlipidemia" = cc_hplip,
"Hypertension" = cc_hpten,
"Ischemic Heart Disease" = cc_ihd,
"Osteoporosis" = cc_opo,
"Arthritis" = cc_raoa,
"Schizophrenia and Other Psychotic Disorders" = cc_sz,
"Stroke" = cc_strk) |>
tidyr::pivot_longer(cols = !c(year, level),
names_to = "condition",
values_to = "prevalence") |>
Expand All @@ -118,7 +121,7 @@ compare_conditions <- function(df) {
age_group = "All"), .keep = "none")

s <- dplyr::left_join(dplyr::select(p, year, condition),
dplyr::select(df, year, sublevel = state),
dplyr::select(tbl, year, sublevel = state),
by = dplyr::join_by(year)) |>
dplyr::rowwise() |>
dplyr::mutate(statewide = cc_specific(year,
Expand Down
132 changes: 132 additions & 0 deletions R/deprecated.R
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,135 @@
#' Search the Medicare Revalidation Due Date List API
#'
#' @description Information on revalidation due dates for Medicare providers.
#' Medicare Providers must validate their enrollment record every three or
#' five years. CMS sets every Provider’s Revalidation due date at the end
#' of a month and posts the upcoming six to seven months of due dates
#' online. A due date of ‘TBD’ means that CMS has not set the due date yet.
#' These lists are refreshed every two months and two months’ worth of due
#' dates are appended to the list
#'
#' @details The Revalidation Due Date List dataset contains revalidation due
#' dates for Medicare providers who are due to revalidate in the following
#' six months. If a provider's due date does not fall within the ensuing
#' six months, the due date is marked 'TBD'. In addition the dataset also
#' includes subfiles with reassignment information for a given provider
#' as well as due date listings for clinics and group practices and
#' their providers.
#'
#' Links:
#' * [Medicare Revalidation Due Date API](https://data.cms.gov/provider-characteristics/medicare-provider-supplier-enrollment/revalidation-due-date-list)
#'
#' *Update Frequency:* **Monthly**
#'
#' @param npi < *integer* > 10-digit national provider identifier
#' @param enid < *character* > 15-digit provider enrollment ID
#' @param first,last < *character* > Individual provider's first/last name
#' @param organization < *character* > Organizational provider's legal business name
#' @param state < *character* > Enrollment state
#' @param enrollment_type < *integer* > Provider enrollment type:
#' * `1`: Part A
#' * `2`: DME
#' * `3`: Non-DME Part B
#' @param specialty < *character* > Enrollment specialty
#' @param tidy Tidy output; default is `TRUE`
#' @param na.rm < *boolean* > Remove empty rows and columns; default is `TRUE`
#'
#' @return A [tibble][tibble::tibble-package] containing the search results.
#'
#' @examplesIf interactive()
#' revalidation_date(enid = "I20031110000070")
#' revalidation_date(enid = "O20110620000324")
#' revalidation_date(state = "FL", enrollment_type = 3, specialty = "General Practice")
#' @autoglobal
#' @noRd
revalidation_date <- function(npi = NULL,
enid = NULL,
first = NULL,
last = NULL,
organization = NULL,
state = NULL,
enrollment_type = NULL,
specialty = NULL,
tidy = TRUE,
na.rm = TRUE) {

if (!is.null(npi)) {npi <- npi_check(npi)}
if (!is.null(enid)) {enroll_check(enid)}

if (!is.null(enrollment_type)) {
enrollment_type <- as.character(enrollment_type)
rlang::arg_match(enrollment_type, as.character(1:3))}

args <- dplyr::tribble(
~param, ~arg,
"National Provider Identifier", npi,
"Enrollment ID", enid,
"First Name", first,
"Last Name", last,
"Organization Name", organization,
"Enrollment State Code", state,
"Enrollment Type", enrollment_type,
"Enrollment Specialty", specialty)

response <- httr2::request(build_url("rdt", args)) |>
httr2::req_perform()

if (isTRUE(vctrs::vec_is_empty(response$body))) {

cli_args <- dplyr::tribble(
~x, ~y,
"npi", npi,
"enid", enid,
"first", first,
"last", last,
"organization", organization,
"state", state,
"enrollment_type", enrollment_type,
"specialty", specialty) |>
tidyr::unnest(cols = c(y))

format_cli(cli_args)

return(invisible(NULL))
}

results <- httr2::resp_body_json(response, simplifyVector = TRUE)

if (tidy) {
results <- tidyup(results) |>
dplyr::mutate(dplyr::across(dplyr::contains("eligible"), yn_logical),
dplyr::across(dplyr::contains("date"), anytime::anydate),
dplyr::across(dplyr::contains("name"), toupper)) |>
rdate_cols()

if (na.rm) {
results <- janitor::remove_empty(results, which = c("rows", "cols"))}
}
return(results)
}

#' @param df data frame
#' @autoglobal
#' @noRd
rdate_cols <- function(df) {

cols <- c('npi' = 'national_provider_identifier',
'enid' = 'enrollment_id',
'first' = 'first_name',
'last' = 'last_name',
'organization' = 'organization_name',
'state' = 'enrollment_state_code',
'enrollment_type' = 'provider_type_text',
# 'specialty' = 'enrollment_specialty',
# 'due_date' = 'revalidation_due_date',
# 'due_date_adj' = 'adjusted_due_date',
'reassignments' = 'individual_total_reassign_to',
'associations' = 'receiving_benefits_reassignment')

df |> dplyr::select(dplyr::all_of(cols))

}

#' Search the Medicare Revalidation Clinic Group Practice Reassignment API
#'
#' @description Information on clinic group practice revalidation for Medicare
Expand Down
45 changes: 0 additions & 45 deletions R/individuals.R
View file

This file was deleted.

Loading

0 comments on commit 6b9c09d

Please sign in to comment.