Skip to content

Commit

Permalink
commit
Browse files Browse the repository at this point in the history
  • Loading branch information
@andrewallenbruce
andrewallenbruce committed Oct 12, 2023
1 parent 168b361 commit f385cd1
Show file tree
Hide file tree
Showing 19 changed files with 183 additions and 186 deletions.
4 changes: 2 additions & 2 deletions R/affiliations.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -65,8 +65,8 @@ affiliations <- function(npi = NULL,
tidy = TRUE,
na.rm = TRUE) {

if (!is.null(npi)) {npi <- npi_check(npi)}
if (!is.null(pac)) {pac <- pac_check(pac)}
if (!is.null(npi)) {npi <- check_npi(npi)}
if (!is.null(pac)) {pac <- check_pac(pac)}
if (!is.null(facility_ccn)) {facility_ccn <- as.character(facility_ccn)}
if (!is.null(parent_ccn)) {parent_ccn <- as.character(parent_ccn)}

Expand Down
122 changes: 68 additions & 54 deletions R/utils-checks.R → R/checks.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,66 +2,72 @@
#'
#' @description checks validity of NPI input against CMS requirements.
#'
#' ## Links
#' * [The Luhn Algorithm](https://en.wikipedia.org/wiki/Luhn_algorithm)
#' * [CMS NPI Standard](https://www.cms.gov/Regulations-and-Guidance/Administrative-Simplification/NationalProvIdentStand/Downloads/NPIcheckdigit.pdf)
#' @section National Provider Identifier (NPI):
#' + [The Luhn Algorithm](https://en.wikipedia.org/wiki/Luhn_algorithm)
#' + [CMS NPI Standard](https://www.cms.gov/Regulations-and-Guidance/Administrative-Simplification/NationalProvIdentStand/Downloads/NPIcheckdigit.pdf)
#'
#' @param npi 10-digit National Provider Identifier (NPI).
#' @return boolean, `TRUE` or `FALSE`
#' @param x 10-digit National Provider Identifier (NPI)
#' @return character vector
#' @examplesIf interactive()
#' # Valid:
#' npi_check(1528060837)
#' npi_check("1528060837")
#' check_npi(1528060837)
#' check_npi("1528060837")
#'
#' # Invalid:
#' npi_check(1234567891)
#' npi_check(123456789)
#' npi_check("152806O837")
#' check_npi(1234567891)
#' check_npi(123456789)
#' check_npi("152806O837")
#' @autoglobal
#' @noRd
npi_check <- function(npi,
arg = rlang::caller_arg(npi),
check_npi <- function(x,
arg = rlang::caller_arg(x),
call = rlang::caller_env()) {

# Return FALSE if not a number
if (grepl("^[[:digit:]]+$", npi) == FALSE) {
#------------------------------------------Must be numeric
if (grepl("^[[:digit:]]+$", x) == FALSE) {
cli::cli_abort(c(
"An {.strong NPI} must be {.emph numeric}.",
"x" = "{.val {npi}} contains {.emph non-numeric} characters."), call = call)
"x" = "{.val {x}} contains {.emph non-numeric} characters."),
call = call)
}

# Must be 10 char length
if (nchar(npi) != 10L) {
#------------------------------------------Must be 10 char length
if (nchar(x) != 10L) {
cli::cli_abort(c(
"An {.strong NPI} must be {.emph 10 digits long}.",
"x" = "{.val {npi}} contains {.val {nchar(npi)}} digit{?s}."), call = call)
"x" = "{.val {x}} contains {.val {nchar(x)}} digit{?s}."),
call = call)
}

# Strip whitespace
npi_luhn <- gsub(pattern = " ", replacement = "", npi)
#------------------------------------------Must pass Luhn algorithm
# 1. Strip whitespace and convert to character vector
luhn <- gsub(pattern = " ", replacement = "", x)

# 2. Paste 80840 to each NPI number, per CMS documentation
luhn <- paste0("80840", luhn)

# Paste 80840 to each NPI number, per CMS documentation
npi_luhn <- paste0("80840", npi_luhn)
# 3. Split and unlist string
luhn <- unlist(strsplit(luhn, ""))

# Split string, Convert to list and reverse
npi_luhn <- unlist(strsplit(npi_luhn, ""))
npi_luhn <- npi_luhn[length(npi_luhn):1]
to_replace <- seq(2, length(npi_luhn), 2)
npi_luhn[to_replace] <- as.numeric(npi_luhn[to_replace]) * 2
# 4. Reverse order
luhn <- luhn[length(luhn):1]
replace <- seq(2, length(luhn), 2)
luhn[replace] <- as.numeric(luhn[replace]) * 2

# Convert to numeric
npi_luhn <- as.numeric(npi_luhn)
luhn <- as.numeric(luhn)

# Must be a single digit, any that are > 9, subtract 9
npi_luhn <- ifelse(npi_luhn > 9, npi_luhn - 9, npi_luhn)
luhn <- ifelse(luhn > 9, luhn - 9, luhn)

# Check if the sum divides by 10
if ((sum(npi_luhn) %% 10) != 0) {
if ((sum(luhn) %% 10) != 0) {
cli::cli_abort(c(
"An {.strong NPI} must pass {.emph Luhn algorithm}.",
"x" = "{.val {npi}} {.emph fails} Luhn check."), call = call)
"x" = "{.val {x}} {.emph fails} Luhn check."),
call = call)
}
return(as.character(npi))
return(as.character(x))
}

#' PAC ID Validation Check
Expand Down Expand Up @@ -89,24 +95,24 @@ npi_check <- function(npi,
#' pac_check("152806O837")
#' @autoglobal
#' @noRd
pac_check <- function(pac_id,
arg = rlang::caller_arg(pac_id),
check_pac <- function(x,
arg = rlang::caller_arg(x),
call = rlang::caller_env()) {

# Return FALSE if not a number
if (grepl("^[[:digit:]]+$", pac_id) == FALSE) {
if (grepl("^[[:digit:]]+$", x) == FALSE) {
cli::cli_abort(c(
"A {.strong PAC ID} must be {.emph numeric}.",
"x" = "{.val {pac_id}} contains {.emph non-numeric} characters."), call = call)
"x" = "{.val {x}} contains {.emph non-numeric} characters."), call = call)
}

# Must be 10 char length
if (nchar(pac_id) != 10L) {
if (nchar(x) != 10L) {
cli::cli_abort(c(
"A {.strong PAC ID} must be {.emph 10 digits long}.",
"x" = "{.val {pac_id}} contains {.val {nchar(pac_id)}} digit{?s}."), call = call)
"x" = "{.val {x}} contains {.val {nchar(x)}} digit{?s}."), call = call)
}
return(as.character(pac_id))
return(as.character(x))
}

#' Enrollment ID Validation Check
Expand All @@ -124,40 +130,48 @@ pac_check <- function(pac_id,
#' @return boolean, `TRUE` or `FALSE`
#' @examplesIf interactive()
#' # Valid:
#' enroll_check(1528060837)
#' enroll_check("1528060837")
#' enid_check(1528060837)
#' enid_check("1528060837")
#'
#' # Invalid:
#' enroll_check(1234567891)
#' enroll_check(123456789)
#' enroll_check("152806O837")
#' enid_check(0123456789123456)
#' enid_check("0123456789123456")
#' enid_check("I123456789123456")
#' enid_check("152806O837")
#' @autoglobal
#' @noRd
enroll_check <- function(enroll_id,
arg = rlang::caller_arg(enroll_id),
call = rlang::caller_env()) {
check_enid <- function(x,
arg = rlang::caller_arg(x),
call = rlang::caller_env()) {

# Abort if numeric
if (is.numeric(enroll_id) == TRUE) {
# Abort if not character vector
if (is.character(x) != TRUE) {
cli::cli_abort(c(
"An {.strong Enrollment ID} must be a {.cls character} vector.",
"x" = "{.val {enroll_id}} is a {.cls {class(enroll_id)}} vector."), call = call)
"x" = "{.val {x}} is a {.cls {class(x)}} vector."), call = call)
}

# Return TRUE if not a number
if (grepl("^[[:digit:]]+$", x) == TRUE) {
cli::cli_abort(c(
"An {.strong Enrollment ID} must be {.emph numeric}.",
"x" = "{.val {x}} contains {.emph non-numeric} characters."), call = call)
}

# Must be 15 char length
if (nchar(enroll_id) != 15L) {
if (nchar(x) != 15L) {
cli::cli_abort(c(
"An {.strong Enrollment ID} must be {.emph 15 characters long}.",
"x" = "{.val {enroll_id}} contains {.val {nchar(enroll_id)}} character{?s}."), call = call)
"x" = "{.val {x}} contains {.val {nchar(x)}} character{?s}."), call = call)
}

first <- unlist(strsplit(enroll_id, ""))[1]
first <- unlist(strsplit(x, ""))[1]

if ((first %in% c("I", "O")) != TRUE) {

cli::cli_abort(c(
"An {.strong Enrollment ID} must begin with a {.emph capital} {.strong `I`} or {.strong `O`}.",
"x" = "{.val {enroll_id}} begins with {.val {first}}."), call = call)
"x" = "{.val {x}} begins with {.val {first}}."), call = call)

}
}
Expand Down
16 changes: 6 additions & 10 deletions R/clinicians.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -87,18 +87,14 @@ clinicians <- function(npi = NULL,
tidy = TRUE,
na.rm = TRUE) {

if (!is.null(npi)) {npi <- npi_check(npi)}
if (!is.null(pac)) {pac <- pac_check(pac)}
if (!is.null(pac_org)) {pac_org <- pac_check(pac_org)}
if (!is.null(npi)) {npi <- check_npi(npi)}
if (!is.null(pac)) {pac <- check_pac(pac)}
if (!is.null(pac_org)) {pac_org <- check_pac(pac_org)}
if (!is.null(enid)) {check_enid(enid)}
if (!is.null(grad_year)) {grad_year <- as.character(grad_year)}
if (!is.null(zip)) {zip <- as.character(zip)}
if (!is.null(gender)) {rlang::arg_match(gender, c("F", "M"))}

if (!is.null(enid)) {
enroll_check(enid)
enroll_ind_check(enid)
}

args <- dplyr::tribble(
~param, ~arg,
"NPI", npi,
Expand Down Expand Up @@ -151,7 +147,8 @@ clinicians <- function(npi = NULL,
}

if (tidy) {
results <- tidyup(results, yn = c("telehlth"),
results <- tidyup(results,
yn = c("telehlth"),
int = c("num_org_mem", "grd_yr")) |>
address(c("adr_ln_1", "adr_ln_2")) |>
cols_clin()
Expand Down Expand Up @@ -193,5 +190,4 @@ cols_clin <- function(df) {
# 'assign_org' = 'grp_assgn'

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

}
18 changes: 9 additions & 9 deletions R/deprecated.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -53,8 +53,8 @@ revalidation_date <- function(npi = NULL,
tidy = TRUE,
na.rm = TRUE) {

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

if (!is.null(enrollment_type)) {
enrollment_type <- as.character(enrollment_type)
Expand Down Expand Up @@ -199,10 +199,10 @@ revalidation_group <- function(npi = NULL,
record_type = NULL,
tidy = TRUE) {

if (!is.null(npi)) {npi_check(npi)}
if (!is.null(enroll_id)) {enroll_check(enroll_id)}
if (!is.null(enroll_id_group)) {enroll_check(enroll_id_group)}
if (!is.null(pac_id_group)) {pac_check(pac_id_group)}
if (!is.null(npi)) {check_npi(npi)}
if (!is.null(enroll_id)) {check_enid(enroll_id)}
if (!is.null(enroll_id_group)) {check_enid(enroll_id_group)}
if (!is.null(pac_id_group)) {check_pac(pac_id_group)}

args <- dplyr::tribble(
~param, ~arg,
Expand Down Expand Up @@ -320,8 +320,8 @@ asc_ifed_enrollment <- function(npi = NULL,
zip = NULL,
tidy = TRUE) {

if (!is.null(npi)) {npi <- npi_check(npi)}
if (!is.null(enroll_id)) {enroll_id <- enroll_check(enroll_id)}
if (!is.null(npi)) {npi <- check_npi(npi)}
if (!is.null(enroll_id)) {enroll_id <- check_enid(enroll_id)}

args <- dplyr::tribble(
~param, ~arg,
Expand Down Expand Up @@ -449,7 +449,7 @@ missing_endpoints <- function(npi = NULL,
name = NULL,
tidy = TRUE) {

if (!is.null(npi)) {npi <- npi_check(npi)}
if (!is.null(npi)) {npi <- check_npi(npi)}
if (!is.null(name)) {name <- stringr::str_replace(name, " ", "")}

args <- dplyr::tribble(
Expand Down
9 changes: 5 additions & 4 deletions R/hospitals.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -134,12 +134,12 @@ hospitals <- function(npi = NULL,
pivot = TRUE,
na.rm = TRUE) {

if (!is.null(npi)) {npi <- npi_check(npi)}
if (!is.null(pac_org)) {pac_org <- pac_check(pac_org)}
if (!is.null(npi)) {npi <- check_npi(npi)}
if (!is.null(pac_org)) {pac_org <- check_pac(pac_org)}
if (!is.null(zip)) {zip <- as.character(zip)}
if (!is.null(facility_ccn)) {facility_ccn <- as.character(facility_ccn)}
if (!is.null(enid_org)) {
enroll_check(enid_org)
check_enid(enid_org)
enroll_org_check(enid_org)
}

Expand Down Expand Up @@ -191,7 +191,8 @@ hospitals <- function(npi = NULL,
"SUBGROUP %2D OTHER", other,
"REH CONVERSION FLAG", reh)

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

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

Expand Down
10 changes: 7 additions & 3 deletions R/laboratories.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -105,8 +105,11 @@ laboratories <- function(name = NULL,
}

if (!is.null(zip)) {zip <- as.character(zip)}
if (isTRUE(active)) {active <- "00"}
if (!isTRUE(active)) {active <- NULL}
if (isTRUE(active)) {
active <- "00"
} else {
active <- NULL
}

args <- dplyr::tribble(
~param, ~arg,
Expand All @@ -118,7 +121,8 @@ laboratories <- function(name = NULL,
"ZIP_CD", zip,
"PGM_TRMNTN_CD", active)

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

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

Expand Down
13 changes: 3 additions & 10 deletions R/nppes.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -127,7 +127,7 @@ nppes <- function(npi = NULL,
tidy = TRUE,
na.rm = TRUE) {

if (!is.null(npi)) {npi <- npi_check(npi)}
if (!is.null(npi)) {npi <- check_npi(npi)}
if (!is.null(name_type)) {rlang::arg_match(name_type, c("AO", "Provider"))}
if (!is.null(zip)) {zip <- as.character(zip)}

Expand Down Expand Up @@ -178,11 +178,7 @@ nppes <- function(npi = NULL,

if (unnest) {
results <- tidyr::unnest(results, c(basic, addresses)) |>
tidyr::unite("address",
dplyr::any_of(c("address_1", "address_2")),
remove = TRUE,
na.rm = TRUE,
sep = " ") |>
address(c("address_1", "address_2")) |>
cols_nppes() |>
dplyr::filter(purpose != "MAILING")

Expand All @@ -203,9 +199,7 @@ nppes <- function(npi = NULL,
purpose = dplyr::if_else(purpose == "LOCATION", "PRACTICE", purpose)) |>
cols_nppes2()

if (na.rm) {
results <- janitor::remove_empty(results, which = c("rows", "cols"))
}
if (na.rm) {results <- narm(results)}
}
}
return(results)
Expand Down Expand Up @@ -359,5 +353,4 @@ cols_nppes2 <- function(df) {
'on_organization_name')

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

}
Loading

0 comments on commit f385cd1

Please sign in to comment.