diff --git a/R/globals.R b/R/globals.R index b37255ed..3f7c9ff4 100644 --- a/R/globals.R +++ b/R/globals.R @@ -161,8 +161,12 @@ utils::globalVariables(c( "covered_recipient_type", # "nature_of_payment_or_transfer_of_value", # "address", # + "name_1", # "val", # "covered", # + "name", # + "group", # + "pay_total", # "title", # "modified", # "distribution", # diff --git a/R/hospitals.R b/R/hospitals.R index 4745d5ef..129c8283 100644 --- a/R/hospitals.R +++ b/R/hospitals.R @@ -97,7 +97,11 @@ #' @seealso [clinicians()], [providers()], [affiliations()] #' @family api #' -#' @examples +#' @examplesIf interactive() +#' hospitals(pac_org = 6103733050) +#' +#' hospitals(state = "GA", reh = TRUE) +#' #' hospitals(city = "Savannah", state = "GA") |> #' dplyr::select(organization, subgroup) #' @@ -108,10 +112,6 @@ #' hospitals(city = "Savannah", state = "GA", #' subgroup = list(gen = TRUE, rehab = FALSE)) |> #' dplyr::select(organization, subgroup) -#' @examplesIf interactive() -#' hospitals(pac_org = 6103733050) -#' -#' hospitals(state = "GA", reh = TRUE) #' #' @autoglobal #' @export diff --git a/R/nppes.R b/R/nppes.R index 528923fb..f33f77a1 100644 --- a/R/nppes.R +++ b/R/nppes.R @@ -107,7 +107,7 @@ #' @examplesIf interactive() #' nppes(npi = 1528060837) #' -#' nppes(city = "CARROLLTON", state = "GA", zip = 301173889) +#' nppes(city = "CARROLLTON", state = "GA", zip = 301173889, entype = "I") #' @autoglobal #' @export nppes <- function(npi = NULL, @@ -133,7 +133,8 @@ nppes <- function(npi = NULL, if (!is.null(entype)) { entype <- rlang::arg_match(entype, c("I", "O")) - entype <- entype_arg(entype)} + entype <- dplyr::case_when(entype == "I" ~ "NPI-1", entype == "O" ~ "NPI-2") + } request <- httr2::request("https://npiregistry.cms.hhs.gov/api/?version=2.1") |> httr2::req_url_query(number = npi, diff --git a/R/open_payments.R b/R/open_payments.R index 974dd98a..053e98df 100644 --- a/R/open_payments.R +++ b/R/open_payments.R @@ -1,23 +1,26 @@ -#' Provider Financial Relationships +#' Provider Financial Relationships with Drug & Medical Device Companies #' #' @description #' `r lifecycle::badge("experimental")` #' #' [open_payments()] allows the user access to CMS' Open Payments Program API #' -#' The Open Payments program is a national disclosure program that collects and +#' The __Open Payments__ program is a national disclosure program that collects and #' publishes information about financial relationships between drug and medical #' device companies (referred to as "reporting entities") and certain health #' care providers (referred to as "covered recipients"). These relationships may #' involve payments to providers for things including but not limited to #' research, meals, travel, gifts or speaking fees. #' -#' **Applicable Group Purchasing Organizations** (GPOs): Entities that operate +#' @section Terminology: +#' __Reporting Entities__: Applicable manufacturers or GPOs. +#' +#' __Applicable Group Purchasing Organizations__ (GPOs) are entities that operate #' in the United States and purchase, arrange for or negotiate the purchase of #' covered drugs, devices, biologicals, or medical supplies for a group of #' individuals or entities, but not solely for use by the entity itself. #' -#' **Applicable Manufacturers**: Entities that operate in the United States and +#' __Applicable Manufacturers__ are entities that operate in the United States and #' are (1) engaged in the production, preparation, propagation, compounding, or #' conversion of a covered drug, device, biological, or medical supply, but not #' if such covered drug, device, biological or medical supply is solely for use @@ -31,65 +34,62 @@ #' marketing, promotion, sale, or distribution of a covered drug, device, #' biological or medical supply. #' -#' **Reporting Entities**: Applicable manufacturers or GPOs. -#' -#' **Covered Recipients**: Any physician, physician assistant, nurse +#' __Covered Recipients__ are any physician, physician assistant, nurse #' practitioner, clinical nurse specialist, certified registered nurse #' anesthetist, or certified nurse-midwife who is not a bona fide employee of #' the applicable manufacturer that is reporting the payment; or a teaching #' hospital, which is any institution that received a payment. #' -#' **Teaching Hospitals**: Hospitals that receive payment for Medicare direct +#' __Teaching Hospitals__ are hospitals that receive payment for Medicare direct #' graduate medical education (GME), IPPS indirect medical education (IME), or #' psychiatric hospital IME programs. #' -#' **Natures of Payment**: Categories that must be used to describe why a +#' __Natures of Payment__ are categories that must be used to describe why a #' payment or other transfer of value was made. They are only applicable to #' the “general” payment type, not research or ownership. The categories are: #' -#' * Acquisitions (2021 - current) -#' * Charitable contributions -#' * Compensation for services other than consulting -#' * Compensation for serving as faculty or speaker for: -#' * An accredited or certified continuing education program (2013 - 2020) -#' * An unaccredited and non-certified continuing education program (2013 - 2020) -#' * A medical education program (2021 - current) -#' * Consulting fees -#' * Current or prospective ownership or investment interest (prior to 2023) -#' * Debt Forgiveness (2021 - current) -#' * Education -#' * Entertainment -#' * Food and beverage -#' * Gift -#' * Grant -#' * Honoraria -#' * Long-term medical supply or device loan (2021 - current) -#' * Royalty or license -#' * Space rental or facility fees (Teaching Hospitals only) -#' * Travel and lodging +#' + Acquisitions (2021 - current) +#' + Charitable contributions: +#' + Compensation for services other than consulting +#' + Compensation for serving as faculty or speaker for: +#' + An accredited or certified continuing education program (2013 - 2020) +#' + An unaccredited and non-certified continuing education program (2013 - 2020) +#' + A medical education program (2021 - current) +#' + Consulting fees +#' + Current or prospective ownership or investment interest (prior to 2023) +#' + Debt Forgiveness (2021 - current) +#' + Education +#' + Entertainment +#' + Food and beverage +#' + Gift +#' + Grant +#' + Honoraria +#' + Long-term medical supply or device loan (2021 - current) +#' + Royalty or license +#' + Space rental or facility fees (Teaching Hospitals only) +#' + Travel and lodging #' -#' **Transfers of Value**: Anything of value given by an applicable manufacturer +#' __Transfers of Value__ are anything of value given by an applicable manufacturer #' or applicable GPO to a covered recipient or physician owner/investor that #' does not fall within one of the excluded categories in the rule. #' -#' **Ownership and Investment Interests** include, but are not limited to: -#' -#' * Stock -#' * Stock option(s) (not received as compensation, until they are exercised) -#' * Partnership share(s) -#' * Limited liability company membership(s) -#' * Loans -#' * Bonds -#' * Financial instruments secured with an entity’s property or revenue +#' __Ownership and Investment Interests__ include, but are not limited to: +#' + Stock +#' + Stock option(s) (not received as compensation, until they are exercised) +#' + Partnership share(s) +#' + Limited liability company membership(s) +#' + Loans +#' + Bonds +#' + Financial instruments secured with an entity’s property or revenue #' #' This may be direct or indirect and through debt, equity or other means. #' -#' Links: +#' @section Links: +#' + [What is the Open Payments Program?](https://www.cms.gov/priorities/key-initiatives/open-payments) +#' + [Open Payments: General Resources](https://www.cms.gov/OpenPayments/Resources) #' -#' * [What is the Open Payments Program?](https://www.cms.gov/priorities/key-initiatives/open-payments) -#' * [Open Payments: General Resources](https://www.cms.gov/OpenPayments/Resources) -#' -#' *Update Frequency:* **Yearly** +#' @section Update Frequency: +#' Yearly #' #' @param year < *integer* > // **required** Year data was reported, in `YYYY` #' format. Run [open_years()] to return a vector of the years currently available. @@ -132,6 +132,11 @@ #' open_payments(year = 2021, pay_form = "Stock option") #' open_payments(year = 2021, payer = "Adaptive Biotechnologies Corporation") #' open_payments(year = 2021, teaching_hospital = "Nyu Langone Hospitals") +#' +#' # Use the years helper function to retrieve results for all avaliable years: +#' open_years() |> +#' map(\(x) open_payments(year = x, npi = 1043477615)) |> +#' list_rbind() #' @autoglobal #' @export open_payments <- function(year, @@ -157,8 +162,8 @@ open_payments <- function(year, year <- as.character(year) rlang::arg_match(year, as.character(open_years())) - if (!is.null(npi)) {npi <- check_npi(npi)} - if (!is.null(zip)) {zip <- as.character(zip)} + npi <- npi %nn% check_npi(npi) + zip <- zip %nn% as.character(zip) if (!is.null(covered_type)) { rlang::arg_match(covered_type, c("Physician", @@ -197,7 +202,7 @@ open_payments <- function(year, results <- httr2::resp_body_json(response, simplifyVector = TRUE) - if (isTRUE(vctrs::vec_is_empty(results))) { + if (vctrs::vec_is_empty(results)) { cli_args <- dplyr::tribble( ~x, ~y, @@ -248,19 +253,24 @@ open_payments <- function(year, paste0('ndc_', 1:5), paste0('pdi_', 1:5)) - results <- tidyr::pivot_longer( - results, - cols = dplyr::any_of(pcol), - names_to = c("attr", "group"), - names_pattern = "(.*)_(.)", - values_to = "val") |> + results <- results |> + dplyr::mutate(id = dplyr::row_number(), .before = name_1) |> + tidyr::pivot_longer( + cols = dplyr::any_of(pcol), + names_to = c("attr", "group"), + names_pattern = "(.*)_(.)", + values_to = "val") |> + dplyr::arrange(id) |> tidyr::pivot_wider(names_from = attr, values_from = val, values_fn = list) |> tidyr::unnest(cols = dplyr::any_of(c('name', 'covered', 'type', 'category', 'ndc', 'pdi'))) |> - dplyr::mutate(covered = dplyr::case_match(covered, "Covered" ~ TRUE, "Non-Covered" ~ FALSE, .default = NA)) + dplyr::mutate(covered = dplyr::case_match(covered, "Covered" ~ TRUE, "Non-Covered" ~ FALSE, .default = NA)) |> + dplyr::filter(!is.na(name)) |> + dplyr::mutate(group = as.integer(group), + pay_total = dplyr::if_else(group > 1, NA, pay_total)) } - if (na.rm) {results <- narm(results)} + if (na.rm) results <- narm(results) } return(results) } diff --git a/R/reassignments.R b/R/reassignments.R index 93460f44..4dcc3a0a 100644 --- a/R/reassignments.R +++ b/R/reassignments.R @@ -56,11 +56,11 @@ reassignments <- function(npi = NULL, tidy = TRUE, na.rm = TRUE) { - 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(enid_org)) {check_enid(enid_org)} + npi <- npi %nn% check_npi(npi) + pac <- pac %nn% check_pac(pac) + pac_org <- pac_org %nn% check_pac(pac_org) + enid <- enid %nn% check_enid(enid) + enid_org <- enid_org %nn% check_enid(enid_org) if (!is.null(entry)) { rlang::arg_match(entry, c("E", "R")) diff --git a/R/utilization.R b/R/utilization.R index 83a23054..7738c391 100644 --- a/R/utilization.R +++ b/R/utilization.R @@ -238,12 +238,11 @@ by_provider <- function(year, rlang::check_required(year) year <- as.character(year) year <- rlang::arg_match(year, as.character(pop_years())) - - if (!is.null(npi)) {npi <- check_npi(npi)} - if (!is.null(zip)) {zip <- as.character(zip)} - if (!is.null(fips)) {fips <- as.character(fips)} - if (!is.null(ruca)) {ruca <- as.character(ruca)} - if (!is.null(par)) {par <- tf_2_yn(par)} + npi <- npi %nn% check_npi(npi) + zip <- zip %nn% as.character(zip) + fips <- fips %nn% as.character(fips) + ruca <- ruca %nn% as.character(ruca) + par <- par %nn% tf_2_yn(par) args <- dplyr::tribble( ~param, ~arg, @@ -476,14 +475,15 @@ by_service <- function(year, year <- as.character(year) rlang::arg_match(year, as.character(pop_years())) - if (!is.null(npi)) {npi <- check_npi(npi)} - if (!is.null(hcpcs_code)) {hcpcs_code <- as.character(hcpcs_code)} - if (!is.null(pos)) {pos <- pos_char(pos)} - if (!is.null(zip)) {zip <- as.character(zip)} - if (!is.null(fips)) {fips <- as.character(fips)} - if (!is.null(ruca)) {ruca <- as.character(ruca)} - if (!is.null(par)) {par <- tf_2_yn(par)} - if (!is.null(drug)) {drug <- tf_2_yn(drug)} + npi <- npi %nn% check_npi(npi) + zip <- zip %nn% as.character(zip) + fips <- fips %nn% as.character(fips) + ruca <- ruca %nn% as.character(ruca) + hcpcs_code <- hcpcs_code %nn% as.character(hcpcs_code) + par <- par %nn% tf_2_yn(par) + drug <- drug %nn% tf_2_yn(drug) + pos <- pos %nn% pos_char(pos) + args <- dplyr::tribble( ~param, ~arg, @@ -717,17 +717,17 @@ by_geography <- function(year, year <- as.character(year) rlang::arg_match(year, as.character(pop_years())) - if (!is.null(level)) {rlang::arg_match(level, c("National", "State"))} - if (!is.null(hcpcs_code)) {hcpcs_code <- as.character(hcpcs_code)} - if (!is.null(fips)) {fips <- as.character(fips)} - if (!is.null(drug)) {drug <- tf_2_yn(drug)} + level <- level %nn% rlang::arg_match(level, c("National", "State")) + fips <- fips %nn% as.character(fips) + hcpcs_code <- hcpcs_code %nn% as.character(hcpcs_code) + drug <- drug %nn% tf_2_yn(drug) if (!is.null(pos)) { pos <- pos_char(pos) rlang::arg_match(pos, c("F", "O")) } - if (!is.null(state) && (state %in% state.abb)) {state <- abb2full(state)} + if (!is.null(state) && (state %in% state.abb)) state <- abb2full(state) args <- dplyr::tribble( ~param, ~arg, diff --git a/man/hospitals.Rd b/man/hospitals.Rd index 6f283967..8427f430 100644 --- a/man/hospitals.Rd +++ b/man/hospitals.Rd @@ -148,6 +148,11 @@ type and address. } \examples{ +\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +hospitals(pac_org = 6103733050) + +hospitals(state = "GA", reh = TRUE) + hospitals(city = "Savannah", state = "GA") |> dplyr::select(organization, subgroup) @@ -158,10 +163,6 @@ hospitals(city = "Savannah", state = "GA", hospitals(city = "Savannah", state = "GA", subgroup = list(gen = TRUE, rehab = FALSE)) |> dplyr::select(organization, subgroup) -\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} -hospitals(pac_org = 6103733050) - -hospitals(state = "GA", reh = TRUE) \dontshow{\}) # examplesIf} } \seealso{ diff --git a/man/nppes.Rd b/man/nppes.Rd index 14707f7c..2399e94a 100644 --- a/man/nppes.Rd +++ b/man/nppes.Rd @@ -164,7 +164,7 @@ characters to be entered, e.g. \code{"jo*"} \dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} nppes(npi = 1528060837) -nppes(city = "CARROLLTON", state = "GA", zip = 301173889) +nppes(city = "CARROLLTON", state = "GA", zip = 301173889, entype = "I") \dontshow{\}) # examplesIf} } \seealso{ diff --git a/man/open_payments.Rd b/man/open_payments.Rd index cad2201c..8424f48b 100644 --- a/man/open_payments.Rd +++ b/man/open_payments.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/open_payments.R \name{open_payments} \alias{open_payments} -\title{Provider Financial Relationships} +\title{Provider Financial Relationships with Drug & Medical Device Companies} \usage{ open_payments( year, @@ -91,19 +91,23 @@ A \link[tibble:tibble-package]{tibble} containing the search results. \code{\link[=open_payments]{open_payments()}} allows the user access to CMS' Open Payments Program API -The Open Payments program is a national disclosure program that collects and +The \strong{Open Payments} program is a national disclosure program that collects and publishes information about financial relationships between drug and medical device companies (referred to as "reporting entities") and certain health care providers (referred to as "covered recipients"). These relationships may involve payments to providers for things including but not limited to research, meals, travel, gifts or speaking fees. +} +\section{Terminology}{ + +\strong{Reporting Entities}: Applicable manufacturers or GPOs. -\strong{Applicable Group Purchasing Organizations} (GPOs): Entities that operate +\strong{Applicable Group Purchasing Organizations} (GPOs) are entities that operate in the United States and purchase, arrange for or negotiate the purchase of covered drugs, devices, biologicals, or medical supplies for a group of individuals or entities, but not solely for use by the entity itself. -\strong{Applicable Manufacturers}: Entities that operate in the United States and +\strong{Applicable Manufacturers} are entities that operate in the United States and are (1) engaged in the production, preparation, propagation, compounding, or conversion of a covered drug, device, biological, or medical supply, but not if such covered drug, device, biological or medical supply is solely for use @@ -117,24 +121,23 @@ respect to the production, preparation, propagation, compounding, conversion, marketing, promotion, sale, or distribution of a covered drug, device, biological or medical supply. -\strong{Reporting Entities}: Applicable manufacturers or GPOs. - -\strong{Covered Recipients}: Any physician, physician assistant, nurse +\strong{Covered Recipients} are any physician, physician assistant, nurse practitioner, clinical nurse specialist, certified registered nurse anesthetist, or certified nurse-midwife who is not a bona fide employee of the applicable manufacturer that is reporting the payment; or a teaching hospital, which is any institution that received a payment. -\strong{Teaching Hospitals}: Hospitals that receive payment for Medicare direct +\strong{Teaching Hospitals} are hospitals that receive payment for Medicare direct graduate medical education (GME), IPPS indirect medical education (IME), or psychiatric hospital IME programs. -\strong{Natures of Payment}: Categories that must be used to describe why a +\strong{Natures of Payment} are categories that must be used to describe why a payment or other transfer of value was made. They are only applicable to the “general” payment type, not research or ownership. The categories are: \itemize{ \item Acquisitions (2021 - current) -\item Charitable contributions +\item Charitable contributions: +\itemize{ \item Compensation for services other than consulting \item Compensation for serving as faculty or speaker for: \itemize{ @@ -142,6 +145,7 @@ the “general” payment type, not research or ownership. The categories are: \item An unaccredited and non-certified continuing education program (2013 - 2020) \item A medical education program (2021 - current) } +} \item Consulting fees \item Current or prospective ownership or investment interest (prior to 2023) \item Debt Forgiveness (2021 - current) @@ -157,7 +161,7 @@ the “general” payment type, not research or ownership. The categories are: \item Travel and lodging } -\strong{Transfers of Value}: Anything of value given by an applicable manufacturer +\strong{Transfers of Value} are anything of value given by an applicable manufacturer or applicable GPO to a covered recipient or physician owner/investor that does not fall within one of the excluded categories in the rule. @@ -173,15 +177,21 @@ does not fall within one of the excluded categories in the rule. } This may be direct or indirect and through debt, equity or other means. +} + +\section{Links}{ -Links: \itemize{ \item \href{https://www.cms.gov/priorities/key-initiatives/open-payments}{What is the Open Payments Program?} \item \href{https://www.cms.gov/OpenPayments/Resources}{Open Payments: General Resources} } +} -\emph{Update Frequency:} \strong{Yearly} +\section{Update Frequency}{ + +Yearly } + \examples{ \dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} open_payments(year = 2021, npi = 1043218118) @@ -189,5 +199,10 @@ open_payments(year = 2021, pay_nature = "Royalty or License") open_payments(year = 2021, pay_form = "Stock option") open_payments(year = 2021, payer = "Adaptive Biotechnologies Corporation") open_payments(year = 2021, teaching_hospital = "Nyu Langone Hospitals") + +# Use the years helper function to retrieve results for all avaliable years: +open_years() |> +map(\(x) open_payments(year = x, npi = 1043477615)) |> +list_rbind() \dontshow{\}) # examplesIf} } diff --git a/tests/testthat/test-nppes.R b/tests/testthat/test-nppes.R index f92225f7..51d6079d 100644 --- a/tests/testthat/test-nppes.R +++ b/tests/testthat/test-nppes.R @@ -1,6 +1,11 @@ httptest2::without_internet({ test_that("nppes() returns correct request URL", { - httptest2::expect_GET(nppes(npi = 1528060837), + httptest2::expect_GET( + nppes(npi = 1528060837), 'https://npiregistry.cms.hhs.gov/api/?version=2.1&number=1528060837&limit=1200&skip=0') + + httptest2::expect_GET( + nppes(city = "CARROLLTON", state = "GA", zip = 301173889, entype = "I"), + 'https://npiregistry.cms.hhs.gov/api/?version=2.1&enumeration_type=NPI-1&city=CARROLLTON&state=GA&postal_code=301173889&limit=1200&skip=0') }) }) diff --git a/vignettes/articles/partb-stats.Rmd b/vignettes/articles/partb-stats.Rmd index ba7527d6..28215451 100644 --- a/vignettes/articles/partb-stats.Rmd +++ b/vignettes/articles/partb-stats.Rmd @@ -173,72 +173,6 @@ init ``` -
- - - - -
Beneficiary Demographics -

- - -```{r} -select(ind1, year, tot_benes, demographics) |> - unnest(demographics) |> - select(-contains("race")) |> - mutate(across(c(bene_age_lt65:bene_ndual), \(x) coalesce(x, 0))) |> - rowwise() |> - mutate(tot_bene_age = sum(c_across(bene_age_lt65:bene_age_gt84), na.rm = TRUE), - tot_bene_gen = sum(c_across(bene_gen_female:bene_gen_male), na.rm = TRUE), - tot_bene_dual = sum(c_across(bene_dual:bene_ndual), na.rm = TRUE), - tot_age_eq = if_else(tot_benes == tot_bene_age, TRUE, FALSE), - tot_gen_eq = if_else(tot_benes == tot_bene_gen, TRUE, FALSE), - tot_dual_eq = if_else(tot_benes == tot_bene_dual, TRUE, FALSE), - verdict = if_else(isTRUE(tot_age_eq) && isTRUE(tot_gen_eq) && isTRUE(tot_dual_eq), TRUE, FALSE), - .after = tot_benes) |> - select(year, - tot_benes, - tot_bene_age, - tot_age_eq, - tot_bene_gen, - tot_gen_eq, - tot_bene_dual, - tot_dual_eq, - verdict, - bene_age_avg:bene_ndual) |> - # filter(verdict ==TRUE) |> - gt(rowname_col = "year") |> - cols_label( - tot_benes = "Total", - tot_bene_age = "A", - tot_age_eq = "", - tot_bene_gen = "G", - tot_gen_eq = "", - tot_bene_dual = "D", - tot_dual_eq = "", - bene_age_avg = "Avg", - bene_age_lt65 = "<65", - bene_age_65_74 = "65-74", - bene_age_75_84 = "75-84", - bene_age_gt84 = ">84", - bene_gen_male = "M", - bene_gen_female = "F", - bene_dual = "1", - bene_ndual = "2") |> - tab_spanner(label = "Age", columns = c(bene_age_lt65, bene_age_65_74, bene_age_75_84, bene_age_gt84)) |> - tab_spanner(label = "Gender", columns = c(bene_gen_male, bene_gen_female)) |> - tab_spanner(label = "Dual Status", columns = c(bene_dual, bene_ndual)) |> - opt_table_font(font = google_font(name = "JetBrains Mono")) |> - sub_missing(missing_text = "") |> - sub_zero(zero_text = "") |> - opt_all_caps() |> - gt_check_xmark(cols = c(tot_age_eq, tot_gen_eq, tot_dual_eq, verdict)) |> - opt_stylize(color = "gray") -``` - -

-
-