factors, closes #40, #41, #42, #44, #45

R/clinicians.R

@@ -151,10 +151,12 @@ clinicians <- function(npi = NULL,
   }
 
   if (tidy) {
-    results <- tidyup(results, yn = 'telehlth',
+    results <- tidyup(results,
+                      yn = 'telehlth',
                       int = c('num_org_mem', 'grd_yr')) |>
       combine(address, c('adr_ln_1', 'adr_ln_2')) |>
-      cols_clin()
+      cols_clin() |>
+      dplyr::mutate(gender = fct_gen(gender))
 
     if (na.rm) results <- narm(results)
     }

R/globals.R

@@ -112,6 +112,8 @@ utils::globalVariables(c(
   "pr", # <nppes>
   "on", # <nppes>
   "ep", # <nppes>
+  "gender", # <nppes>
+  "entity_type", # <nppes>
   "identifier", # <open_payments>
   "y", # <open_payments>
   "change_type", # <open_payments>

R/nppes.R

@@ -63,8 +63,8 @@
 #' statutes, regulations, and program instructions of the Medicare program.
 #'
 #' @section Links:
-#' - [NPPES NPI Registry API Documentation](https://npiregistry.cms.hhs.gov/api-page)
-#' - [NPPES NPI Registry API Demo](https://npiregistry.cms.hhs.gov/demo-api)
+#' + [NPPES NPI Registry API Documentation](https://npiregistry.cms.hhs.gov/api-page)
+#' + [NPPES NPI Registry API Demo](https://npiregistry.cms.hhs.gov/demo-api)
 #'
 #' @section Trailing Wildcard Entries:
 #' Arguments that allow trailing wildcard entries are denoted in the parameter
@@ -196,10 +196,11 @@ nppes <- function(npi = NULL,
       results <- tidyup(results,
                         dtype = 'ymd',
                         yn = c('sole_prop', 'org_part'),
-                        cred = 'credential',
-                        ent = 'entity_type') |>
+                        cred = 'credential') |>
         dplyr::mutate(purpose = dplyr::if_else(purpose == "LOCATION", "PRACTICE", purpose)) |>
-        cols_nppes(2)
+        cols_nppes(2) |>
+        dplyr::mutate(gender = fct_gen(gender),
+                      entity_type = fct_enum(entity_type))
 
       if (na.rm) results <- narm(results)
     }
@@ -331,3 +332,13 @@ cols_nppes <- function(df, step = c(1, 2)) {
   }
   df |> dplyr::select(dplyr::any_of(cols))
 }
+
+
+#' @param x vector
+#' @autoglobal
+#' @noRd
+fct_enum <- function(x) {
+  factor(x,
+         levels = c("NPI-1", "NPI-2"),
+         labels = c("Individual", "Organization"))
+}

R/providers.R

@@ -104,7 +104,7 @@ providers <- function(npi = NULL,
   }
   results <- httr2::resp_body_json(response, simplifyVector = TRUE)
 
-  if (tidy)  results <- cols_pros(tidyup(results))
+  if (tidy)  results <- cols_pros(tidyup(results)) |> dplyr::mutate(gender = fct_gen(gender))
   if (na.rm) results <- narm(results)
   return(results)
 }

R/utilization.R

@@ -277,8 +277,7 @@ tidyup_provider <- function(results, nest, detailed) {
     tidyup(yn   = "par",
            int  = c("year", "_hcpcs", "bene", "_srvcs"),
            dbl  = c("pay", "pymt", "charges", "allowed", "cc_", "hcc"),
-           cred = "credential",
-           ent  = "entity_type") |>
+           cred = "credential") |>
     combine(address, c('rndrng_prvdr_st1', 'rndrng_prvdr_st2')) |>
     dplyr::mutate(specialty       = correct_specialty(specialty),
                   .copay_deduct   = tot_allowed - tot_payment,

R/utils.R

@@ -138,6 +138,14 @@ display_long <- function(df, cols = dplyr::everything()) {
         tidyr::pivot_longer({{ cols }})
 }
 
+#' @param x vector
+#' @autoglobal
+#' @noRd
+fct_gen <- function(x) {
+  factor(x,
+         levels = c("M", "F", "9"),
+         labels = c("Male", "Female", "Unknown"))
+}
 
 #' Convert data.frame cols to character
 #' @param df data frame
@@ -161,37 +169,36 @@ df2chr <- function(df) {
 #' @param chr cols to convert to character
 #' @param up cols to convert to upper case
 #' @param cred cols to remove periods from
-#' @param ent cols to convert to NPI entity type
 #' @returns tidy data frame
 #' @autoglobal
 #' @export
 #' @keywords internal
 tidyup <- function(df,
-                   dtype = c('mdy', 'ymd'),
+                   dtype = NULL,
                    dt = "date",
                    yn = NULL,
                    int = NULL,
                    dbl = NULL,
                    chr = NULL,
                    up = NULL,
-                   cred = NULL,
-                   ent = NULL) {
+                   cred = NULL) {
 
   x <- janitor::clean_names(df) |>
     dplyr::tibble() |>
     dplyr::mutate(dplyr::across(dplyr::everything(), stringr::str_squish),
                   dplyr::across(dplyr::where(is.character), na_blank))
 
-  if (dtype == 'mdy') x <- dplyr::mutate(x, dplyr::across(dplyr::contains(dt), lubridate::mdy))
-  if (dtype == 'ymd') x <- dplyr::mutate(x, dplyr::across(dplyr::contains(dt), lubridate::ymd))
+  if (!is.null(dtype)) {
+    if (dtype == 'mdy') x <- dplyr::mutate(x, dplyr::across(dplyr::contains(dt), lubridate::mdy))
+    if (dtype == 'ymd') x <- dplyr::mutate(x, dplyr::across(dplyr::contains(dt), lubridate::ymd))
+  }
 
   if (!is.null(yn))   x <- dplyr::mutate(x, dplyr::across(dplyr::contains(yn),   yn_logical))
   if (!is.null(int))  x <- dplyr::mutate(x, dplyr::across(dplyr::contains(int),  as.integer))
   if (!is.null(dbl))  x <- dplyr::mutate(x, dplyr::across(dplyr::contains(dbl),  as.double))
   if (!is.null(chr))  x <- dplyr::mutate(x, dplyr::across(dplyr::contains(chr),  as.character))
   if (!is.null(up))   x <- dplyr::mutate(x, dplyr::across(dplyr::contains(up),   toupper))
   if (!is.null(cred)) x <- dplyr::mutate(x, dplyr::across(dplyr::contains(cred), clean_credentials))
-  if (!is.null(ent))  x <- dplyr::mutate(x, dplyr::across(dplyr::contains(ent),  entype_char))
   return(x)
 }
 

tests/testthat/test-utils.R

@@ -52,57 +52,51 @@ test_that("display_long() works", {
 
 test_that("tidyup() works", {
   df <- dplyr::tibble(
-    name = "John Doe ",
-    date = "1981/03/07",
-    int = "123456789",
-    dbl = "12.34",
-    yn = "Y",
-    cred = "M.D.",
-    ind = "NPI-1",
-    org = "NPI-2",
+    name  = "John Doe ",
+    date  = "1981/03/07",
+    int   = "123456789",
+    dbl   = "12.34",
+    yn    = "Y",
+    cred  = "M.D.",
     blank = "",
     space = " ",
-    star = "*",
-    dash = "--")
+    star  = "*",
+    dash  = "--")
 
-  df2 <- df
+  df2      <- df
   df2$date <- "03/07/1981"
 
   tidy <- dplyr::tibble(
-    name = "JOHN DOE",
-    date = lubridate::ymd("1981/03/07"),
-    int = 123456789,
-    dbl = 12.34,
-    yn = TRUE,
-    cred = "MD",
-    ind = "Individual",
-    org = "Organization",
+    name  = "JOHN DOE",
+    date  = lubridate::ymd("1981/03/07"),
+    int   = 123456789,
+    dbl   = 12.34,
+    yn    = TRUE,
+    cred  = "MD",
     blank = NA_character_,
     space = NA_character_,
-    star = NA_character_,
-    dash = NA_character_)
+    star  = NA_character_,
+    dash  = NA_character_)
 
-  tidy2 <- tidy
+  tidy2      <- tidy
   tidy2$date <- lubridate::mdy("03/07/1981")
 
   expect_equal(tidyup(df,
-                      yn = "yn",
+                      yn    = "yn",
                       dtype = 'ymd',
-                      int = c("int", "year"),
-                      dbl = "dbl",
-                      up = "name",
-                      cred = "cred",
-                      ent = c("ind", "org")),
+                      int   = c("int", "year"),
+                      dbl   = "dbl",
+                      up    = "name",
+                      cred  = "cred"),
                tidy)
 
   expect_equal(tidyup(df2,
-                      yn = "yn",
+                      yn    = "yn",
                       dtype = 'mdy',
-                      int = c("int", "year"),
-                      dbl = "dbl",
-                      up = "name",
-                      cred = "cred",
-                      ent = c("ind", "org")),
+                      int   = c("int", "year"),
+                      dbl   = "dbl",
+                      up    = "name",
+                      cred  = "cred"),
                tidy2)
 })