* quality_payment rewriting

* formatting_api_params rewrite

* added helpers

* removed lifecycle svgs from man directory

NAMESPACE

@@ -66,8 +66,10 @@ import(rlang)
 importFrom(collapse,"%=%")
 importFrom(collapse,"%==%")
 importFrom(collapse,.c)
+importFrom(collapse,fmutate)
 importFrom(collapse,fselect)
 importFrom(collapse,get_elem)
+importFrom(data.table,as.data.table)
 importFrom(httr2,req_perform)
 importFrom(httr2,req_perform_parallel)
 importFrom(httr2,request)

R/arg_formatting.R

@@ -0,0 +1,35 @@
+#' Encode API parameters as a URL
+#'
+#' "%22" url encoding for double quote (")
+#'
+#' @param x tibble with two columns: `param` and `args`
+#'
+#' @param fmt format type, `filter`, `sql`, default is `filter`
+#'
+#' @returns formatted URL string
+#'
+#' @autoglobal
+#'
+#' @noRd
+format_api_params <- function(x, fmt = "filter") {
+
+  x <- purrr::discard(params, is_null)
+
+  fmt <- match.arg(fmt, c("filter", "sql"))
+
+  x <- switch(
+    fmt,
+    filter = paste0(
+      paste0("filter[", names(x), "]=", x), collapse = "&"),
+    sql = paste0(
+      paste0("[WHERE ", names(x), " = %22", x, "%22]" ), collapse = ""))
+
+  x <- gsub(" ", "%20", x)
+  x <- gsub("[", "%5B", x, fixed = TRUE)
+  x <- gsub("*", "%2A", x, fixed = TRUE)
+  x <- gsub("]", "%5D", x, fixed = TRUE)
+  x <- gsub("<", "%3C", x, fixed = TRUE)
+  x <- gsub("+", "%2B", x, fixed = TRUE)
+
+  return(x)
+}

R/cms.R

@@ -88,11 +88,18 @@ cms_dataset_search <- function(search = NULL) {
   return(ids)
 }
 
+#' "%22" url encoding for double quote (")
+#'
 #' @param param API parameter
+#'
 #' @param arg API function arg
+#'
 #' @param type format type, `filter`, `sql`, default is `filter`
-#' @return formatted API filters
+#'
+#' @returns formatted API filters
+#'
 #' @autoglobal
+#'
 #' @noRd
 format_param <- function(param, arg, type = "filter") {
 
@@ -123,8 +130,7 @@ format_param <- function(param, arg, type = "filter") {
 #' @noRd
 encode_param <- function(args, type = "filter") {
 
-  rlang::check_required(args)
-  rlang::arg_match(type, c("filter", "sql"))
+  type <- rlang::arg_match0(type, c("filter", "sql"))
 
   args <- tidyr::unnest(args, arg)
 
@@ -191,64 +197,73 @@ file_url <- function(fn = c("c", "a"), args, offset) {
 }
 
 #' Build url for http requests
-#' @param fn abbreviation for function name
+#' @param abb abbreviation for function name
 #' @param args tibble of parameter arguments
 #' @autoglobal
 #' @noRd
-build_url <- function(fn, args = NULL) {
-
-  api <- dplyr::case_match(fn,
-                           "ben" ~ "Medicare Monthly Enrollment",
-                           "hos" ~ "Hospital Enrollments",
-                           "lab" ~ "Provider of Services File - Clinical Laboratories",
-                           "end" ~ "Public Reporting of Missing Digital Contact Information",
-                           "pro" ~ "Medicare Fee-For-Service  Public Provider Enrollment",
-                           "rdt" ~ "Revalidation Due Date List",
-                           "ras" ~ "Revalidation Reassignment List",
-                           "ord" ~ "Order and Referring",
-                           "opt" ~ "Opt Out Affidavits",
-                           "ppe" ~ "Pending Initial Logging and Tracking Physicians",
-                           "npe" ~ "Pending Initial Logging and Tracking Non Physicians",
-                           "tax" ~ "Medicare Provider and Supplier Taxonomy Crosswalk",
-                           "bet" ~ "Restructured BETOS Classification System")
-
-  if (fn %in% "tax" && is.null(args)) {
-    url <- paste0("https://data.cms.gov/data-api/v1/dataset/", cms_update(api)$distro[1], "/data?keyword=")
-  }
-
-  if (!is.null(args)) {
-    json <- dplyr::case_match(fn,
-                              c("end", "tax") ~ "/data?",
-                              .default = "/data.json?")
-
-    url <- paste0("https://data.cms.gov/data-api/v1/dataset/",
-                  cms_update(api)$distro[1],
-                  json,
-                  encode_param(args))
-  }
-  return(url)
+build_url <- function(abb, args = NULL) {
+
+  api <- dplyr::case_match(
+    abb,
+    "ben" ~ "Medicare Monthly Enrollment",
+    "hos" ~ "Hospital Enrollments",
+    "lab" ~ "Provider of Services File - Clinical Laboratories",
+    "end" ~ "Public Reporting of Missing Digital Contact Information",
+    "pro" ~ "Medicare Fee-For-Service  Public Provider Enrollment",
+    "rdt" ~ "Revalidation Due Date List",
+    "ras" ~ "Revalidation Reassignment List",
+    "ord" ~ "Order and Referring",
+    "opt" ~ "Opt Out Affidavits",
+    "ppe" ~ "Pending Initial Logging and Tracking Physicians",
+    "npe" ~ "Pending Initial Logging and Tracking Non Physicians",
+    "tax" ~ "Medicare Provider and Supplier Taxonomy Crosswalk",
+    "bet" ~ "Restructured BETOS Classification System",
+    .default = NULL)
+
+  url <- "https://data.cms.gov/data-api/v1/dataset/"
+  url <- paste0(url, cms_update(api)$distro[1])
+
+  crosswalk <- (abb %in% "tax" & null(args))
+
+  if (crosswalk)
+    return(paste0(url, "/data?keyword="))
+
+  if (!crosswalk)
+    return(paste0(
+      url,
+      dplyr::if_else(
+        abb %in% c("end", "tax"),
+        "/data?",
+        "/data.json?"),
+      encode_param(args)))
 }
 
 #' Build url for http requests
-#' @param fn abbreviation for function name
-#' @param year tibble of parameter arguments
+#'
+#' @param abb abbreviation for function name
+#'
+#' @param year year of data distribution
+#'
 #' @autoglobal
+#'
 #' @noRd
-api_years <- function(fn) {
-
-  api <- dplyr::case_match(fn,
-                           "geo" ~ "Medicare Physician & Other Practitioners - by Geography and Service",
-                           "srv" ~ "Medicare Physician & Other Practitioners - by Provider and Service",
-                           "prv" ~ "Medicare Physician & Other Practitioners - by Provider",
-                           "rxg" ~ "Medicare Part D Prescribers - by Geography and Drug",
-                           "rxd" ~ "Medicare Part D Prescribers - by Provider and Drug",
-                           "rxp" ~ "Medicare Part D Prescribers - by Provider",
-                           "outps" ~ "Medicare Outpatient Hospitals - by Provider and Service",
-                           "outgs" ~ "Medicare Outpatient Hospitals - by Geography and Service",
-                           # "scc" ~ "Specific Chronic Conditions",
-                           # "mcc" ~ "Multiple Chronic Conditions",
-                           "qpp" ~ "Quality Payment Program Experience",
-                           .default = NULL)
-
-  cms_update(api)
+api_years <- function(abb, year) {
+
+  api <- dplyr::case_match(
+    abb,
+    "geo" ~ "Medicare Physician & Other Practitioners - by Geography and Service",
+    "srv" ~ "Medicare Physician & Other Practitioners - by Provider and Service",
+    "prv" ~ "Medicare Physician & Other Practitioners - by Provider",
+    "rxg" ~ "Medicare Part D Prescribers - by Geography and Drug",
+    "rxd" ~ "Medicare Part D Prescribers - by Provider and Drug",
+    "rxp" ~ "Medicare Part D Prescribers - by Provider",
+    "outps" ~ "Medicare Outpatient Hospitals - by Provider and Service",
+    "outgs" ~ "Medicare Outpatient Hospitals - by Geography and Service",
+    "qpp" ~ "Quality Payment Program Experience",
+    .default = NULL
+  )
+
+  api <- cms_update(api)
+
+  fuimus::search_in(api, api[["year"]], year)
 }

R/generated-globals.R

@@ -102,7 +102,6 @@ utils::globalVariables(c(
   # <laboratories>
   "cap",
   # <rbcs_util>
-  # <quality_pay2>
   # <quality_payment>
   "category",
   # <open_payments>
@@ -157,8 +156,6 @@ utils::globalVariables(c(
   # <distros_main>
   "distribution_accessURL",
   # <distros_open>
-  "distribution_data_describedBy",
-  # <distros_open>
   "distribution_data_downloadURL",
   # <distros_open>
   "distribution_data_title",
@@ -175,7 +172,6 @@ utils::globalVariables(c(
   "distribution_title",
   # <outpatient>
   # <prescribers>
-  # <quality_pay2>
   # <quality_payment>
   # <utilization>
   "distro",
@@ -289,15 +285,13 @@ utils::globalVariables(c(
   "npi_type",
   # <nppes>
   "on",
-  # <quality_pay2>
   # <quality_payment>
   "org_id",
   # <quality_eligibility>
   # <cols_qelig>
   "org_name",
   # <mips_2021>
   "org_pac_id",
-  # <quality_pay2>
   # <quality_payment>
   "org_size",
   # <quality_eligibility>
@@ -314,7 +308,8 @@ utils::globalVariables(c(
   "organizations_individualScenario",
   # <quality_eligibility>
   "organizations_virtualGroups",
-  # <quality_pay2>
+  # <format_api_params>
+  "params",
   # <quality_payment>
   "participation_type",
   # <mips_2021>
@@ -352,7 +347,6 @@ utils::globalVariables(c(
   "prvdr_ctgry_sbtyp_cd",
   # <nppes>
   "purpose",
-  # <quality_pay2>
   # <quality_payment>
   "qualified",
   # <betos>
@@ -367,11 +361,9 @@ utils::globalVariables(c(
   "rndrng_prvdr_geo_desc",
   # <tidyup_geography.util>
   "rndrng_prvdr_geo_lvl",
-  # <quality_pay2>
   # <quality_payment>
   "score",
   # <open_ids>
-  # <quality_pay2>
   # <quality_payment>
   "set",
   # <tidyup_provider.util>
@@ -404,7 +396,6 @@ utils::globalVariables(c(
   "state_of_travel",
   # <nppes>
   # <order_refer>
-  # <quality_pay2>
   # <quality_payment>
   "status",
   # <rbcs_util>
@@ -449,7 +440,6 @@ utils::globalVariables(c(
   "type_1",
   # <laboratories>
   "type_of_action",
-  # <quality_pay2>
   # <quality_payment>
   "val",
   # <open_payments>
@@ -489,6 +479,7 @@ utils::globalVariables(c(
   # <open_ids>
   # <cols_qelig>
   # <distros_main>
+  # <distros_open>
   "year",
   # <add_counties>
   "zip",