Skip to content

Commit

Permalink
quality_eligibility scaffolding
Browse files Browse the repository at this point in the history
  • Loading branch information
andrewallenbruce committed Nov 15, 2023
1 parent 124a259 commit 78dbc3a
Show file tree
Hide file tree
Showing 4 changed files with 116 additions and 41 deletions.
14 changes: 14 additions & 0 deletions R/globals.R
Original file line number Diff line number Diff line change
Expand Up @@ -157,6 +157,20 @@ utils::globalVariables(c(
"y", # <pending>
"y", # <providers>
"y", # <quality_eligibility>
"org", # <quality_eligibility>
"org_individualScenario", # <quality_eligibility>
"org_groupScenario", # <quality_eligibility>
"ind", # <quality_eligibility>
"grp", # <quality_eligibility>
"ind.extremeHardshipReasons", # <quality_eligibility>
"ind.extremeHardshipSources", # <quality_eligibility>
"ind.lowVolumeStatusReasons", # <quality_eligibility>
"ind.specialty", # <quality_eligibility>
"ind.isEligible", # <quality_eligibility>
"grp.extremeHardshipReasons", # <quality_eligibility>
"grp.extremeHardshipSources", # <quality_eligibility>
"grp.lowVolumeStatusReasons", # <quality_eligibility>
"grp.isEligible", # <quality_eligibility>
"apms", # <quality_eligibility2>
"individual_scenario", # <quality_eligibility2>
"group_scenario", # <quality_eligibility2>
Expand Down
126 changes: 85 additions & 41 deletions R/quality_eligibility.R
Original file line number Diff line number Diff line change
Expand Up @@ -92,50 +92,62 @@ quality_eligibility <- function(year,

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

results <- list(
year = year,
npi = results$data$npi,
npi_type = results$data$nationalProviderIdentifierType,
first = results$data$firstName,
middle = results$data$middleName,
last = results$data$lastName,
first_approved_date = results$data$firstApprovedDate,
years_in_medicare = results$data$yearsInMedicare,
pecos_enroll_year = results$data$pecosEnrollmentDate,
newly_enrolled = results$data$newlyEnrolled,
specialty_description = results$data$specialty$specialtyDescription,
specialty_type = results$data$specialty$typeDescription,
specialty_category = results$data$specialty$categoryReference,
is_maqi = results$data$isMaqi,
organization = results$data$organizations$prvdrOrgName,
hosp_vbp_name = results$data$organizations$hospitalVbpName,
facility_based = results$data$organizations$isFacilityBased,
address_1 = results$data$organizations$addressLineOne,
address_2 = results$data$organizations$addressLineTwo,
city = results$data$organizations$city,
state = results$data$organizations$state,
zip = results$data$organizations$zip,
apms = results$data$organizations$apms,
virtual = results$data$organizations$virtualGroups,
ind = results$data$organizations$individualScenario,
group = results$data$organizations$groupScenario) |>
purrr::compact() |>
purrr::list_flatten() |>
purrr::list_flatten() |>
as.data.frame()

if (!tidy) results <- df2chr(results)

if (tidy) {
results <- results |>
dplyr::tibble()
# results <- tidyup(results,
# yn = 'telehlth',
# int = c('num_org_mem', 'grd_yr')) |>
# combine(address, c('adr_ln_1', 'adr_ln_2')) |>
# dplyr::mutate(gndr = fct_gen(gndr),
# state = fct_stabb(state)) |>
# cols_qelig()

res <- purrr::compact(results) |> purrr::list_flatten()

r <- dplyr::tibble(
year = as.integer(year),
npi = res$data_npi,
npi_type = fct_entype(res$data_nationalProviderIdentifierType),
first = res$data_firstName,
middle = res$data_middleName,
last = res$data_lastName,
first_approved_date = lubridate::ymd(res$data_firstApprovedDate),
years_in_medicare = as.integer(res$data_yearsInMedicare),
pecos_year = as.integer(res$data_pecosEnrollmentDate),
newly_enrolled = as.logical(res$data_newlyEnrolled),
specialty_description = res$data_specialty$specialtyDescription,
specialty_type = res$data_specialty$typeDescription,
specialty_category = res$data_specialty$categoryReference,
is_maqi = as.logical(res$data_isMaqi),
org = dplyr::tibble(res$data_organizations))

r <- r |>
tidyr::unpack(org, names_sep = "_") |>
tidyr::unite("org_address",
dplyr::any_of(c('org_addressLineOne',
'org_addressLineTwo')),
remove = TRUE, na.rm = TRUE, sep = " ") |>
tidyr::unnest_longer(dplyr::any_of(c('org_apms',
'org_virtualGroups')),
keep_empty = TRUE) |>
dplyr::rename(ind = org_individualScenario,
grp = org_groupScenario) |>
tidyr::unpack(ind, names_sep = ".") |>
tidyr::unpack(grp, names_sep = ".")

results <- r |>
tidyr::unnest_longer(ind.extremeHardshipReasons, keep_empty = TRUE) |>
tidyr::unpack(ind.extremeHardshipReasons, names_sep = ".") |>
tidyr::unnest_longer(ind.extremeHardshipSources, keep_empty = TRUE) |>
tidyr::unpack(ind.extremeHardshipSources, names_sep = ".") |>
tidyr::unnest_longer(ind.lowVolumeStatusReasons, keep_empty = TRUE) |>
tidyr::unpack(ind.lowVolumeStatusReasons, names_sep = ".") |>
tidyr::unnest_longer(ind.specialty, keep_empty = TRUE) |>
tidyr::unpack(ind.specialty, names_sep = ".") |>
tidyr::unnest_longer(ind.isEligible, keep_empty = TRUE) |>
tidyr::unpack(ind.isEligible, names_sep = ".") |>
tidyr::unnest_longer(grp.extremeHardshipReasons, keep_empty = TRUE) |>
tidyr::unpack(grp.extremeHardshipReasons, names_sep = ".") |>
tidyr::unnest_longer(grp.extremeHardshipSources, keep_empty = TRUE) |>
tidyr::unpack(grp.extremeHardshipSources, names_sep = ".") |>
tidyr::unnest_longer(grp.lowVolumeStatusReasons, keep_empty = TRUE) |>
tidyr::unpack(grp.lowVolumeStatusReasons, names_sep = ".") |>
tidyr::unnest_longer(grp.isEligible, keep_empty = TRUE) |>
tidyr::unpack(grp.isEligible, names_sep = ".")

if (na.rm) results <- narm(results)
}
Expand Down Expand Up @@ -234,6 +246,38 @@ quality_eligibility2 <- function(year,
npi,
tidy = TRUE) {

# results <- list(
# year = year,
# npi = results$data$npi,
# npi_type = results$data$nationalProviderIdentifierType,
# first = results$data$firstName,
# middle = results$data$middleName,
# last = results$data$lastName,
# first_approved_date = results$data$firstApprovedDate,
# years_in_medicare = results$data$yearsInMedicare,
# pecos_enroll_year = results$data$pecosEnrollmentDate,
# newly_enrolled = results$data$newlyEnrolled,
# specialty_description = results$data$specialty$specialtyDescription,
# specialty_type = results$data$specialty$typeDescription,
# specialty_category = results$data$specialty$categoryReference,
# is_maqi = results$data$isMaqi,
# organization = results$data$organizations$prvdrOrgName,
# hosp_vbp_name = results$data$organizations$hospitalVbpName,
# facility_based = results$data$organizations$isFacilityBased,
# address_1 = results$data$organizations$addressLineOne,
# address_2 = results$data$organizations$addressLineTwo,
# city = results$data$organizations$city,
# state = results$data$organizations$state,
# zip = results$data$organizations$zip,
# apms = results$data$organizations$apms,
# virtual = results$data$organizations$virtualGroups,
# ind = results$data$organizations$individualScenario,
# group = results$data$organizations$groupScenario) |>
# purrr::compact() |>
# purrr::list_flatten() |>
# purrr::list_flatten() |>
# as.data.frame()

rlang::check_required(year)
year <- as.character(year)
rlang::arg_match(year, values = as.character(qpp_years()))
Expand Down
11 changes: 11 additions & 0 deletions R/utils-fct.R
Original file line number Diff line number Diff line change
Expand Up @@ -85,6 +85,17 @@ fct_ent <- function(x) {
labels = c("Individual", "Organization"))
}


#' Convert npi types to labelled factor
#' @param x vector
#' @autoglobal
#' @noRd
fct_entype <- function(x) {
factor(x,
levels = c(1, 2),
labels = c("Individual", "Organization"))
}

#' Convert place of service types to labelled factor
#' @param x vector
#' @autoglobal
Expand Down
6 changes: 6 additions & 0 deletions tests/testthat/test-utils-fct.R
Original file line number Diff line number Diff line change
Expand Up @@ -44,6 +44,12 @@ test_that("fct_ent() works", {
expect_equal(fct_ent(x), y)
})

test_that("fct_entype() works", {
x <- c(1, 2)
y <- factor(c("Individual", "Organization"))
expect_equal(fct_entype(x), y)
})

test_that("fct_pos() works", {
x <- c("F", "O")
y <- factor(c("Facility", "Non-facility"))
Expand Down

0 comments on commit 78dbc3a

Please sign in to comment.