open_payments fix (closes #55)

andrewallenbruce · Nov 14, 2023 · 058454a · 058454a
1 parent a79ae5c
commit 058454a
Show file tree

Hide file tree

Showing 11 changed files with 101 additions and 49 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -39,6 +39,7 @@ Suggests:
     fipio,
     fontawesome,
     forcats,
+    future,
     ggraph,
     ggplot2,
     ggthemes,

diff --git a/R/globals.R b/R/globals.R
@@ -129,11 +129,20 @@ utils::globalVariables(c(
   "nature_of_payment_or_transfer_of_value", # <open_payments>
   "address", # <open_payments>
   "name_1", # <open_payments>
-  "val", # <open_payments>
-  "covered", # <open_payments>
+  "covered_1", # <open_payments>
+  "type_1", # <open_payments>
+  "category_1", # <open_payments>
+  "ndc_1", # <open_payments>
+  "pdi_1", # <open_payments>
+  ".name_1", # <open_payments>
+  ".pdi_1", # <open_payments>
+  "total", # <open_payments>
+  "value", # <open_payments>
   "name", # <open_payments>
-  "group", # <open_payments>
+  "covered", # <open_payments>
+  "group_id", # <open_payments>
   "pay_total", # <open_payments>
+  "pay_count", # <open_payments>
   "title", # <open_ids>
   "modified", # <open_ids>
   "distribution", # <open_ids>

diff --git a/R/open_payments.R b/R/open_payments.R
@@ -138,7 +138,7 @@
 #' map(\(x) open_payments(year = x, npi = 1043477615)) |>
 #' list_rbind()
 #'
-#' # Parallelized
+#' # Or simply use the parallelized version
 #' open_payments_(npi = 1043218118)
 #'
 #' @autoglobal
@@ -243,7 +243,7 @@ open_payments <- function(year,
                       dtype = 'mdy',
                       yn = c(yncols),
                       dbl = 'dollars',
-                      int = c('program_year', 'pay_count')) |> #nolint
+                      int = c('program_year', 'number_of_payments_included_in_total_amount')) |> #nolint
       dplyr::mutate(covered_recipient_type                                         = fct_cov(covered_recipient_type),
                     recipient_state                                                = fct_stabb(recipient_state),
                     applicable_manufacturer_or_applicable_gpo_making_payment_state = fct_stabb(applicable_manufacturer_or_applicable_gpo_making_payment_state),
@@ -255,34 +255,49 @@ open_payments <- function(year,
                 'recipient_primary_business_street_address_line2')) |>
       cols_open()
 
-    ## ------------------------------------------------------------------------
     if (pivot) {
-      pcol <- c(paste0('name_', 1:5),
-                paste0('covered_', 1:5),
-                paste0('type_', 1:5),
-                paste0('category_', 1:5),
-                paste0('ndc_', 1:5),
-                paste0('pdi_', 1:5))
+      results <- results |>
+        dplyr::mutate(row_id  = dplyr::row_number(),
+                      .name_1 = dplyr::if_else(is.na(name_1), TRUE, FALSE),
+                      .cov_1  = dplyr::if_else(is.na(covered_1), TRUE, FALSE),
+                      .type_1 = dplyr::if_else(is.na(type_1), TRUE, FALSE),
+                      .cat_1  = dplyr::if_else(is.na(category_1), TRUE, FALSE),
+                      .ndc_1  = dplyr::if_else(is.na(ndc_1), TRUE, FALSE),
+                      .pdi_1  = dplyr::if_else(is.na(pdi_1), TRUE, FALSE),
+                      .before = name_1) |>
+        dplyr::rowwise() |>
+        dplyr::mutate(total  = sum(dplyr::c_across(.name_1:.pdi_1), na.rm = TRUE),
+                      name_1 = dplyr::if_else(total == 6, 'Blank', name_1),
+                      total  = NULL) |>
+        dplyr::ungroup()
+
+      results$.name_1 <- NULL
+      results$.cov_1  <- NULL
+      results$.type_1 <- NULL
+      results$.cat_1  <- NULL
+      results$.ndc_1  <- NULL
+      results$.pdi_1  <- NULL
+
+      pcol <- c('name_', 'covered_', 'type_',
+                'category_', 'ndc_', 'pdi_') %s+% rep(1:5, each = 6)
 
       results <- results |>
-        dplyr::mutate(top_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::filter(!is.na(name)) |>
-        dplyr::mutate(group = as.integer(group),
-                      pay_total = dplyr::if_else(group > 1, NA, pay_total))
+        tidyr::pivot_longer(dplyr::any_of(pcol)) |>
+        dplyr::filter(!is.na(value)) |>
+        tidyr::separate_wider_delim(name,
+                                    delim = "_",
+                                    names = c("attr", "group_id")) |>
+        tidyr::pivot_wider(names_from = "attr",
+                           values_from = "value") |>
+        dplyr::mutate(covered = dplyr::case_match(covered,
+                                                  "Covered" ~ TRUE,
+                                                  "Non-Covered" ~ FALSE,
+                                                  .default = NA),
+                      group_id = as.integer(group_id),
+                      pay_total = dplyr::if_else(group_id > 1, NA, pay_total),
+                      pay_count = dplyr::if_else(group_id > 1, NA, pay_count))
 
-      if (rlang::has_name(results, "pdi")) results$pdi <- dplyr::na_if(results$pdi, "N/A")
-      ## ------------------------------------------------------------------------
+      # if (rlang::has_name(results, "pdi")) results$pdi <- dplyr::na_if(results$pdi, "N/A")
     }
     if (na.rm) results <- narm(results)
   }

diff --git a/R/quality_payment.R b/R/quality_payment.R
@@ -39,14 +39,14 @@
 #' + Anesthesiology
 #' + Neurology
 #' + Cardiology
-#' @param type < *character* > Participation type; level at which the performance data
-#' was collected, submitted or reported for the final score attributed to the
-#' clinician; drives most of the data returned.
+#' @param type < *character* > Participation type; level at which the
+#' performance data was collected, submitted or reported for the final score
+#' attributed to the clinician; drives most of the data returned.
 #' + `"Group"`
 #' + `"Individual"`
 #' + `"MIPS APM"`
 #' @param tidy < *boolean* > // __default:__ `TRUE` Tidy output
-#' @param nest < *boolean* > // __default:__ `TRUE` Nest statuses & measures
+#' @param nest < *boolean* > // __default:__ `TRUE` Nest `statuses` & `measures`
 #' @param ... For future use.
 #' @return A [tibble][tibble::tibble-package] containing the search results.
 #'

diff --git a/README.Rmd b/README.Rmd
@@ -118,7 +118,7 @@ nppes(npi = 1720098791) |> glimpse()
 ### `open_payments()`
 
 ```{r}
-open_payments(year = 2021, npi = 1023630738) |> 
+open_payments(year = 2021, npi = 1023630738, na.rm = TRUE) |> 
   mutate(info = ndc_lookup(ndc), ndc = NULL) |> 
   unnest(info) |> glimpse()
 ```

diff --git a/README.md b/README.md
@@ -282,7 +282,7 @@ nppes(npi = 1720098791) |> glimpse()
 ### `open_payments()`
 
 ``` r
-open_payments(year = 2021, npi = 1023630738) |> 
+open_payments(year = 2021, npi = 1023630738, na.rm = TRUE) |> 
   mutate(info = ndc_lookup(ndc), ndc = NULL) |> 
   unnest(info) |> glimpse()
 ```
@@ -312,7 +312,7 @@ open_payments(year = 2021, npi = 1023630738) |>
     #> $ payer_country       <chr> "United States"
     #> $ pay_total           <dbl> 17.43
     #> $ pay_date            <date> 2021-08-25
-    #> $ pay_count           <chr> "1"
+    #> $ pay_count           <int> 1
     #> $ pay_form            <chr> "In-kind items and services"
     #> $ pay_nature          <chr> "Food and Beverage"
     #> $ physician_ownership <lgl> FALSE
@@ -321,8 +321,8 @@ open_payments(year = 2021, npi = 1023630738) |>
     #> $ publish_delay       <lgl> FALSE
     #> $ publish_dispute     <lgl> FALSE
     #> $ related_product     <lgl> TRUE
-    #> $ id                  <int> 1
-    #> $ group               <int> 1
+    #> $ row_id              <int> 1
+    #> $ group_id            <int> 1
     #> $ name                <chr> "NEXPLANON"
     #> $ covered             <lgl> TRUE
     #> $ type                <chr> "Drug"

diff --git a/man/open_payments.Rd b/man/open_payments.Rd
diff --git a/man/quality_payment.Rd b/man/quality_payment.Rd
diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml
@@ -104,6 +104,7 @@ reference:
   - conditions
   - open_payments
   - open_payments_
+  - quality_eligibility
   - quality_payment
   - quality_payment_
   - utilization

diff --git a/vignettes/articles/open.Rmd b/vignettes/articles/open.Rmd
@@ -22,6 +22,7 @@ options(scipen = 999)
 
 ```{r message=FALSE, warning=FALSE}
 library(provider)
+library(future)
 library(furrr)
 library(dplyr)
 ```
@@ -35,28 +36,52 @@ open
 ```
 
 
-
 ```{r}
 open |> 
   select(program_year, 
          payer_name, 
          pay_total, 
          pay_date, 
          pay_count, 
-         id, 
-         group, 
+         row_id, 
+         group_id, 
          name, 
-         type)
+         covered,
+         type, 
+         category, 
+         ndc,
+         pdi)
 ```
 
 
 ```{r}
-open |> count(payer_name, sort = TRUE)
+open |> 
+  count(payer_sub,
+        wt = pay_count,
+        sort = TRUE)
+```
+
+
+```{r}
+open |> 
+  count(payer_name,
+        wt = pay_count,
+        sort = TRUE)
 ```
 
 
 ```{r}
-open |> count(type, sort = TRUE)
+open |> 
+  count(payer_id,
+        wt = pay_count,
+        sort = TRUE)
+```
+
+
+```{r}
+open |> 
+  filter(!is.na(type)) |> 
+  count(type, sort = TRUE)
 ```
 
 

diff --git a/vignettes/articles/qpp.Rmd b/vignettes/articles/qpp.Rmd
@@ -22,6 +22,7 @@ options(scipen = 999)
 
 ```{r message=FALSE, warning=FALSE}
 library(provider)
+library(future)
 library(furrr)
 library(dplyr)
 library(tidyr)