Replaced anytime with lubridate, closes #35

andrewallenbruce · Nov 5, 2023 · 1235222 · 1235222
1 parent bb96515
commit 1235222
Show file tree

Hide file tree

Showing 14 changed files with 70 additions and 41 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -16,7 +16,6 @@ BugReports: https://github.com/andrewallenbruce/provider/issues
 Depends: 
     R (>= 4.1.0)
 Imports: 
-    anytime,
     cli,
     dplyr,
     furrr,

diff --git a/R/betos.R b/R/betos.R
@@ -100,7 +100,9 @@ betos <- function(hcpcs = NULL,
   results <- httr2::resp_body_json(response, simplifyVector = TRUE)
 
   if (tidy) {
-    results <- tidyup(results, dt = c("dt")) |> # nolint
+    results <- tidyup(results,
+                      dtype = 'mdy',
+                      dt = 'dt') |>
       dplyr::mutate(
         rbcs_major_ind = dplyr::case_match(rbcs_major_ind,
                                            "N" ~ "Non-procedure",
@@ -149,7 +151,6 @@ rbcs_util <- function(df) {
     return(df)
 
   } else {
-
     rbcs <- dplyr::select(rbcs, hcpcs, category, subcategory, family, procedure)
     cols_util(dplyr::full_join(df, rbcs, by = dplyr::join_by(hcpcs)), "rbcs")
   }

diff --git a/R/hospitals.R b/R/hospitals.R
@@ -275,8 +275,9 @@ hospitals <- function(npi = NULL,
 
   if (tidy) {
     results <- tidyup(results,
-                      yn = c("flag", "subgroup"),
-                      chr = "zip_code") |>
+                      dtype = 'ymd',
+                      yn = c('flag', 'subgroup'),
+                      chr = 'zip_code') |>
       combine(address, c('address_line_1',
                          'address_line_2')) |>
       combine(structure, c('organization_type_structure',

diff --git a/R/laboratories.R b/R/laboratories.R
@@ -148,7 +148,7 @@ laboratories <- function(name = NULL,
   results <- httr2::resp_body_json(response, simplifyVector = TRUE)
 
   if (tidy) {
-    results <- tidyup(results, dt = c("_dt"), yn = c("_sw")) |> # nolint
+    results <- tidyup(results, dtype = 'ymd', dt = '_dt', yn = '_sw') |>
       combine(address, c('st_adr', 'addtnl_st_adr')) |>
       combine(provider_name, c('fac_name', 'addtnl_fac_name')) |>
       dplyr::mutate(pgm_trmntn_cd               = termcd(pgm_trmntn_cd),

diff --git a/R/nppes.R b/R/nppes.R
@@ -194,9 +194,10 @@ nppes <- function(npi = NULL,
                                tidyr::unpack(ep, names_sep = ".")
     if (tidy) {
       results <- tidyup(results,
-                        yn = c("sole_prop", "org_part"),
-                        cred = "credential",
-                        ent = "entity_type") |>
+                        dtype = 'ymd',
+                        yn = c('sole_prop', 'org_part'),
+                        cred = 'credential',
+                        ent = 'entity_type') |>
         dplyr::mutate(purpose = dplyr::if_else(purpose == "LOCATION", "PRACTICE", purpose)) |>
         cols_nppes(2)
 

diff --git a/R/open_payments.R b/R/open_payments.R
@@ -238,9 +238,10 @@ open_payments <- function(year,
                 'related_product_indicator')
 
     results <- tidyup(results,
+                      dtype = 'mdy',
                       # yn = c(yncols),
-                      dbl = "dollars",
-                      int = "program_year") |>
+                      dbl = 'dollars',
+                      int = 'program_year') |>
       dplyr::mutate(change_type                            = changed_logical(change_type),
                     covered_recipient_type                 = covered_recipient(covered_recipient_type),
                     nature_of_payment_or_transfer_of_value = nature(nature_of_payment_or_transfer_of_value)) |>

diff --git a/R/opt_out.R b/R/opt_out.R
@@ -140,7 +140,10 @@ opt_out <- function(npi = NULL,
   results <- httr2::resp_body_json(response, simplifyVector = TRUE)
 
   if (tidy) {
-    results <- tidyup(results, yn = "eligible", chr = "npi") |>
+    results <- tidyup(results,
+                      dtype = 'mdy',
+                      yn = 'eligible',
+                      chr = 'npi') |>
       combine(address, c('first_line_street_address',
                          'second_line_street_address')) |>
       cols_opt()

diff --git a/R/providers.R b/R/providers.R
@@ -41,8 +41,6 @@
 #' |`state`                 |Enrollment state                       |
 #' |`gender`                |Individual provider's gender           |
 #'
-#' @seealso [order_refer()], [opt_out()], [pending()]
-#'
 #' @examplesIf interactive()
 #' providers(npi = 1417918293, specialty_code = "14-41")
 #' providers(pac = 2860305554, gender = "9")

diff --git a/R/taxonomy.R b/R/taxonomy.R
@@ -153,6 +153,6 @@ download_nucc_csv <- function() {
                   taxonomy_display_name = display_name,
                   taxonomy_definition = definition) |>
     dplyr::mutate(version = 231,
-                  release_date = anytime::anydate("2023-07-01"))
+                  release_date = lubridate::ymd("2023-07-01"))
   return(x)
 }
diff --git a/R/utils.R b/R/utils.R
@@ -145,13 +145,16 @@ display_long <- function(df, cols = dplyr::everything()) {
 #' @export
 #' @keywords internal
 df2chr <- function(df) {
-
-  df |> dplyr::mutate(dplyr::across(dplyr::where(is.numeric), as.character))
+  df |>
+    dplyr::mutate(
+      dplyr::across(
+        dplyr::where(is.numeric), as.character))
 }
 
 #' Tidy a Data Frame
 #' @param df data frame
-#' @param dt cols to convert to date with [anytime::anydate()]
+#' @param dt cols to convert to date
+#' @param dtype mdy or ymd
 #' @param yn cols to convert to logical
 #' @param int cols to convert to integer
 #' @param dbl cols to convert to double
@@ -164,6 +167,7 @@ df2chr <- function(df) {
 #' @export
 #' @keywords internal
 tidyup <- function(df,
+                   dtype = c('mdy', 'ymd'),
                    dt = "date",
                    yn = NULL,
                    int = NULL,
@@ -176,19 +180,18 @@ tidyup <- function(df,
   x <- janitor::clean_names(df) |>
     dplyr::tibble() |>
     dplyr::mutate(dplyr::across(dplyr::everything(), stringr::str_squish),
-                  dplyr::across(dplyr::where(is.character), na_blank),
-                  dplyr::across(dplyr::contains(dt), anytime::anydate))
-
-  # `%nn%` <- function(x, y) if (!is.null(x)) y else x
-  # x <- yn %nn% dplyr::mutate(x, dplyr::across(dplyr::contains(yn), yn_logical))
-
-  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))}
+                  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(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)
 }
 

diff --git a/R/years.R b/R/years.R
@@ -66,7 +66,7 @@ qpp_years <- function() as.integer(cms_update("Quality Payment Program Experienc
 #' @export
 #' @keywords internal
 bene_years <- function(period = c("year", "month")) {
-  if (period == "year")  {out <- beneficiaries(period = "Year", level = "National")$year}
-  if (period == "month") {out <- beneficiaries(period = "January", level = "National")$year}
+  if (period == "year")  out <- beneficiaries(period = "Year", level = "National", tidy = FALSE)$YEAR
+  if (period == "month") out <- beneficiaries(period = "January", level = "National", tidy = FALSE)$YEAR
   return(as.integer(out))
 }
diff --git a/man/providers.Rd b/man/providers.Rd
diff --git a/man/tidyup.Rd b/man/tidyup.Rd
diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R
@@ -65,9 +65,12 @@ test_that("tidyup() works", {
     star = "*",
     dash = "--")
 
+  df2 <- df
+  df2$date <- "03/07/1981"
+
   tidy <- dplyr::tibble(
     name = "JOHN DOE",
-    date = anytime::anydate("1981/03/07"),
+    date = lubridate::ymd("1981/03/07"),
     int = 123456789,
     dbl = 12.34,
     yn = TRUE,
@@ -79,9 +82,28 @@ test_that("tidyup() works", {
     star = NA_character_,
     dash = NA_character_)
 
-  expect_equal(tidyup(df, yn = "yn", int = c("int", "year"),
-                      dbl = "dbl", up = "name", cred = "cred",
-                      ent = c("ind", "org")), tidy)
+  tidy2 <- tidy
+  tidy2$date <- lubridate::mdy("03/07/1981")
+
+  expect_equal(tidyup(df,
+                      yn = "yn",
+                      dtype = 'ymd',
+                      int = c("int", "year"),
+                      dbl = "dbl",
+                      up = "name",
+                      cred = "cred",
+                      ent = c("ind", "org")),
+               tidy)
+
+  expect_equal(tidyup(df2,
+                      yn = "yn",
+                      dtype = 'mdy',
+                      int = c("int", "year"),
+                      dbl = "dbl",
+                      up = "name",
+                      cred = "cred",
+                      ent = c("ind", "org")),
+               tidy2)
 })
 
 test_that("combine() works", {