open_payments(): bug fix in "pivot" parameter

andrewallenbruce · Oct 23, 2023 · f6658e2 · f6658e2
1 parent 65fbeef
commit f6658e2
Show file tree

Hide file tree

Showing 11 changed files with 141 additions and 171 deletions.
diff --git a/R/globals.R b/R/globals.R
@@ -161,8 +161,12 @@ utils::globalVariables(c(
   "covered_recipient_type", # <open_payments>
   "nature_of_payment_or_transfer_of_value", # <open_payments>
   "address", # <open_payments>
+  "name_1", # <open_payments>
   "val", # <open_payments>
   "covered", # <open_payments>
+  "name", # <open_payments>
+  "group", # <open_payments>
+  "pay_total", # <open_payments>
   "title", # <open_ids>
   "modified", # <open_ids>
   "distribution", # <open_ids>

diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
diff --git a/man/nppes.Rd b/man/nppes.Rd