foo <- function(x) {
x_name <- deparse(substitute(x))
glue::glue("{x_name}[{seq_along(x)}]={x}") |>
glue::glue_collapse(sep = "&")
}
ID <- 5:7
foo(ID)ID[1]=5&ID[2]=6&ID[3]=7
5 Query
Params with length > 1
multi_value <- function(x) {
glue::glue("[{seq_along(x)}]={x}") |>
glue::glue_collapse(sep = "&")
}
multi_value(state.abb)[1]=AL&[2]=AK&[3]=AZ&[4]=AR&[5]=CA&[6]=CO&[7]=CT&[8]=DE&[9]=FL&[10]=GA&[11]=HI&[12]=ID&[13]=IL&[14]=IN&[15]=IA&[16]=KS&[17]=KY&[18]=LA&[19]=ME&[20]=MD&[21]=MA&[22]=MI&[23]=MN&[24]=MS&[25]=MO&[26]=MT&[27]=NE&[28]=NV&[29]=NH&[30]=NJ&[31]=NM&[32]=NY&[33]=NC&[34]=ND&[35]=OH&[36]=OK&[37]=OR&[38]=PA&[39]=RI&[40]=SC&[41]=SD&[42]=TN&[43]=TX&[44]=UT&[45]=VT&[46]=VA&[47]=WA&[48]=WV&[49]=WI&[50]=WY
new_query <- function(
args = list(state = c("GA", "MD"),
last_name = "AMITH",
npi = 1234567890),
operator = c("IN", "STARTS_WITH", "=")) {
len <- cheapr::lengths_(args, names = TRUE)
single <- args[cheapr::which_(len == 1)]
multi <- args[cheapr::which_(len > 1)]
x <- list(s = if (vctrs::vec_is_empty(single)) NULL else single,
m = if (vctrs::vec_is_empty(multi)) NULL else multi)
idx <- rlang::set_names(seq_along(args), names(args))
opr <- rlang::set_names(operator, names(args))
g_single <- glue::glue(
"filter[{idx[names(x$s)]}][condition][path]={names(x$s)}\n",
"filter[{idx[names(x$s)]}][condition][operator]={opr[names(x$s)]}\n",
"filter[{idx[names(x$s)]}][condition][value]={providertwo:::delist(x$s)}")
g_mult <- glue::as_glue(
c(
glue::glue(
"filter[{idx[names(x$m)]}][condition][path]={names(x$m)}\n",
"filter[{idx[names(x$m)]}][condition][operator]={opr[names(x$m)]}"),
glue::glue(
"filter[{idx[names(x$m)]}][condition][value]",
"[{seq_along(providertwo:::delist(x$m))}]={providertwo:::delist(x$m)}"))
)
glue::glue_collapse(c(g_single, g_mult), sep = "\n")
}
new_query()filter[2][condition][path]=last_name
filter[2][condition][operator]=STARTS_WITH
filter[2][condition][value]=AMITH
filter[3][condition][path]=npi
filter[3][condition][operator]==
filter[3][condition][value]=1234567890
filter[1][condition][path]=state
filter[1][condition][operator]=IN
filter[1][condition][value][1]=GA
filter[1][condition][value][2]=MD
Query Generation
- Select Dataset/Method
- Build JSON Query
- Build Request
- Retrieve Number of Results
- Build Offset Sequence
Allowed Operators
= : equals(x)
<> : equals(x, negate = TRUE)
> : greater_than(x)
>= : greater_than(x, equals = TRUE)
< : less_than(x)
<= : less_than(x, equals = TRUE)
STARTS_WITH : starts_with(x)
CONTAINS : contains(x)
ENDS_WITH : ends_with(x)
IN : is_in(x)
NOT IN : is_in(x, negate = TRUE)
BETWEEN : between(x)
NOT BETWEEN : between(x, negate = TRUE)
IS NULL : blank(x)
IS NOT NULL : blank(x, negate = TRUE)
class_query
query Formatters
query_comparison
query_comparison <- function(args,
operator = c("=", ">", ">=", "<", "<=", "<>")) {
operator <- match.arg(operator)
args <- args[
cheapr::which_(
cheapr::lengths_(
args,
names = TRUE) == 1
)]
glue::glue(
"
filter[{seq_along(args)}][condition][path]={names(args)}
filter[{seq_along(args)}][condition][operator]={operator}
filter[{seq_along(args)}][condition][value]={providertwo:::delist(args)}
"
)
}
query_comparison(ex)filter[1][condition][path]=name
filter[1][condition][operator]==
filter[1][condition][value]=Jerry
filter[2][condition][path]=number
filter[2][condition][operator]==
filter[2][condition][value]=300.12
query_comparison(ex, ">=")filter[1][condition][path]=name
filter[1][condition][operator]=>=
filter[1][condition][value]=Jerry
filter[2][condition][path]=number
filter[2][condition][operator]=>=
filter[2][condition][value]=300.12
query_equals_simple
query_in_notin
query_in_notin <- function(args,
operator = c("IN", "NOT IN")) {
operator <- match.arg(operator)
args <- args[cheapr::which_(cheapr::lengths_(args, names = TRUE) > 1)]
glue::as_glue(
c(
glue::glue(
"filter[f{seq_along(args)}][condition][path]={names(args)}
filter[f{seq_along(args)}][condition][operator]={operator}"
),
glue::glue(
"filter[f{seq_along(args)}]",
"[condition][value]",
"[{seq_along(providertwo:::delist(args))}]={providertwo:::delist(args)}"
)
)
)
}
query_in_notin(ex)filter[f1][condition][path]=state
filter[f1][condition][operator]=IN
filter[f1][condition][value][1]=GA
filter[f1][condition][value][2]=MD
query_in_notin(ex, "NOT IN")filter[f1][condition][path]=state
filter[f1][condition][operator]=NOT IN
filter[f1][condition][value][1]=GA
filter[f1][condition][value][2]=MD
Finalizing query Components
filter[f1][condition][path]=state
filter[f1][condition][operator]=IN
filter[f1][condition][value][1]=GA
filter[f1][condition][value][2]=MD
filter[1][condition][path]=name
filter[1][condition][operator]==
filter[1][condition][value]=Jerry
filter[2][condition][path]=number
filter[2][condition][operator]==
filter[2][condition][value]=300.12
New Function
fields <- c(
"year",
"covered_recipient_npi",
"covered_recipient_type",
"covered_recipient_first_name",
"covered_recipient_last_name",
"recipient_city",
"recipient_state",
"recipient_zip_code",
"teaching_hospital_name",
"form_of_payment_or_transfer_of_value",
"nature_of_payment_or_transfer_of_value",
"applicable_manufacturer_or_applicable_gpo_making_payment_name",
"applicable_manufacturer_or_applicable_gpo_making_payment_id")
process_params <- \(arg_names, field_names) {
nms <- set_names(arg_names, field_names)
parse_expr(
paste0(
"list2(",
glue_collapse(
glue('{names(nms)} = {unname(nms)}'),
sep = ", "), ")"))
}
has_operator <- \(args) {
map_lgl(args, function(x) inherits(x, "query_operator"))
}
name_path <- \(args) {
map(args, \(x) x[[names(x)]][["path"]] <- names(x))
}open_pay <- function(year,
npi = NULL,
covered_type = NULL,
first = NULL,
last = NULL,
city = NULL,
state = NULL,
zip = NULL,
teaching_hospital = NULL,
payment_form = NULL,
payment_nature = NULL,
payer = NULL,
payer_id = NULL) {
fn_args <- process_params(fn_fmls_names(), fields) |>
eval_bare() |>
compact()
# if (any(has_operator(fn_args)))
# fn_args[has_operator(fn_args)] <- name_path(fn_args[has_operator(fn_args)])
fn_args
}open_pay(year = 2021, npi = "1043218118")$year
[1] 2021
$covered_recipient_npi
[1] "1043218118"
open_pay(year = 2021, payment_nature = "Royalty or License")$year
[1] 2021
$nature_of_payment_or_transfer_of_value
[1] "Royalty or License"
open_pay(year = 2021, payment_form = "Stock option")$year
[1] 2021
$form_of_payment_or_transfer_of_value
[1] "Stock option"
open_pay(year = 2021, payer = "Adaptive Biotechnologies Corporation")$year
[1] 2021
$applicable_manufacturer_or_applicable_gpo_making_payment_name
[1] "Adaptive Biotechnologies Corporation"
open_pay(year = 2021, teaching_hospital = "Nyu Langone Hospitals")$year
[1] 2021
$teaching_hospital_name
[1] "Nyu Langone Hospitals"
open_pay(year = 2017:2023, npi = "1043477615")$year
[1] 2017 2018 2019 2020 2021 2022 2023
$covered_recipient_npi
[1] "1043477615"
starts_with <- \(x) {
structure(
c(path = NA_character_,
operator = "STARTS_WITH",
value = x),
class = "query_operator")
}
starts_with("Royalty or License") path operator value
NA "STARTS_WITH" "Royalty or License"
attr(,"class")
[1] "query_operator"
x <- open_pay(
year = 2021,
payment_nature = starts_with("Royalty or License"),
teaching_hospital = starts_with("NYU"))
x$year
[1] 2021
$teaching_hospital_name
path operator value
NA "STARTS_WITH" "NYU"
attr(,"class")
[1] "query_operator"
$nature_of_payment_or_transfer_of_value
path operator value
NA "STARTS_WITH" "Royalty or License"
attr(,"class")
[1] "query_operator"
names(x[has_operator(x)])[1] "teaching_hospital_name"
[2] "nature_of_payment_or_transfer_of_value"
x[has_operator(x)][[1]][["path"]] <- names(x[has_operator(x)])[[1]]
x$year
[1] 2021
$teaching_hospital_name
path operator value
"teaching_hospital_name" "STARTS_WITH" "NYU"
attr(,"class")
[1] "query_operator"
$nature_of_payment_or_transfer_of_value
path operator value
NA "STARTS_WITH" "Royalty or License"
attr(,"class")
[1] "query_operator"
# map(args, \(x) x[[names(x)]][["path"]] <- names(x))
#
# x[has_operator(x)] <- providertwo:::map2(
# x[has_operator(x)],
# names(x[has_operator(x)]),
# function(x, y) x[["path"]] <- y)
#
# xQuery Format
url_parse(
base_url = "https://openpaymentsdata.cms.gov/api/1/datastore/",
url = "query/fdc3c773-018a-412c-8a81-d7b8a13a037b/0") |>
url_modify_query(
`conditions[0][property]` = "covered_recipient_last_name",
`conditions[0][value]` = "SMITH",
`conditions[0][operator]` = "=",
schema = "false",
keys = "false",
results = "false",
offset = 0,
limit = 500) |>
url_build() |>
request() |>
providertwo:::perform_simple() |>
_[["count"]][1] 77
url_parse(
base_url = "https://openpaymentsdata.cms.gov/api/1/datastore/",
url = "query/fdc3c773-018a-412c-8a81-d7b8a13a037b/0") |>
url_modify_query(
`conditions[0][property]` = "covered_recipient_first_name",
`conditions[0][value]` = "PATRICK",
`conditions[0][operator]` = "=",
`conditions[1][property]` = "covered_recipient_last_name",
`conditions[1][value]` = "WARD",
`conditions[1][operator]` = "=",
schema = "false",
keys = "false",
results = "false",
offset = 0) |>
url_build() |>
request() |>
providertwo:::perform_simple() |>
_[["count"]][1] 48
Other Examples
exquery <- glue::glue(
'
"filter[{i}][path]" = "{PATH}",
"filter[{i}][operator]" = "{OPERATOR}",
"filter[{i}][value]" = "{VALUE}"
',
i = 1:2,
PATH = c("STATE_CD", "LAST_NAME"),
OPERATOR = "=",
VALUE = c("GA", "SMITH")
) |>
glue::glue_collapse(sep = ",\n")
exquery"filter[1][path]" = "STATE_CD",
"filter[1][operator]" = "=",
"filter[1][value]" = "GA",
"filter[2][path]" = "LAST_NAME",
"filter[2][operator]" = "=",
"filter[2][value]" = "SMITH"
glue::glue('c({exquery})') |>
rlang::parse_expr() |>
rlang::eval_bare() filter[1][path] filter[1][operator] filter[1][value] filter[2][path]
"STATE_CD" "=" "GA" "LAST_NAME"
filter[2][operator] filter[2][value]
"=" "SMITH"
glue::glue(
'
filter[{PATH}][operator]={OPERATOR}
filter[{PATH}][value]={VALUE}
',
PATH = c("STATE_CD", "LAST_NAME"),
OPERATOR = "IN",
VALUE = c("GA", "SMITH")
)filter[STATE_CD][operator]=IN
filter[STATE_CD][value]=GA
filter[LAST_NAME][operator]=IN
filter[LAST_NAME][value]=SMITH
format_syntax <- \(name, value) {
setNames(
value,
paste0(
name,
"[id-",
seq_along(value),
"][condition][value]"))
}
format_syntax("filter", c("GA", "NY"))filter[id-1][condition][value] filter[id-2][condition][value]
"GA" "NY"
# query_syntax <- c(
# "filter[STATE_CD]" = "GA",
# "filter[LAST_NAME]" = "SMITH"
# )Pagination
base <- request("https://data.cms.gov/data-api/v1/dataset") |>
req_url_path_append("9887a515-7552-4693-bf58-735c77af46d7") |>
req_url_path_append("data")
base
stats <- base |>
req_url_path_append("stats")
stats
stats <- stats |>
req_perform() |>
resp_body_json(simplifyVector = TRUE)
stats |> purse()• $found_rows i1 50473
• $total_rows i1 50473
# Offset shouldn't go to 50000
providertwo:::offset_seq(stats$found_rows, 5000) [1] 0 5000 10000 15000 20000 25000 30000 35000 40000 45000 50000
urls <- glue::glue(
"{base$url}",
"?size=5000&",
"offset=",
"{providertwo:::offset_seq(stats$found_rows, 5000)}"
)
urlshttps://data.cms.gov/data-api/v1/dataset/9887a515-7552-4693-bf58-735c77af46d7/data?size=5000&offset=0
https://data.cms.gov/data-api/v1/dataset/9887a515-7552-4693-bf58-735c77af46d7/data?size=5000&offset=5000
https://data.cms.gov/data-api/v1/dataset/9887a515-7552-4693-bf58-735c77af46d7/data?size=5000&offset=10000
https://data.cms.gov/data-api/v1/dataset/9887a515-7552-4693-bf58-735c77af46d7/data?size=5000&offset=15000
https://data.cms.gov/data-api/v1/dataset/9887a515-7552-4693-bf58-735c77af46d7/data?size=5000&offset=20000
https://data.cms.gov/data-api/v1/dataset/9887a515-7552-4693-bf58-735c77af46d7/data?size=5000&offset=25000
https://data.cms.gov/data-api/v1/dataset/9887a515-7552-4693-bf58-735c77af46d7/data?size=5000&offset=30000
https://data.cms.gov/data-api/v1/dataset/9887a515-7552-4693-bf58-735c77af46d7/data?size=5000&offset=35000
https://data.cms.gov/data-api/v1/dataset/9887a515-7552-4693-bf58-735c77af46d7/data?size=5000&offset=40000
https://data.cms.gov/data-api/v1/dataset/9887a515-7552-4693-bf58-735c77af46d7/data?size=5000&offset=45000
https://data.cms.gov/data-api/v1/dataset/9887a515-7552-4693-bf58-735c77af46d7/data?size=5000&offset=50000
resp <- urls[1:3] |>
map(
function(x) {
request(x) |>
req_perform() |>
resp_body_json(simplifyVector = TRUE) |>
tibble()
}) |>
list_rbind(names_to = "reqID") |>
janitor::clean_names()
resp |>
janitor::get_dupes()# A tibble: 6 × 15
req_id first_name last_name npi specialty optout_effective_date
, first_line_street_address ,
# second_line_street_address , city_name , state_code ,
# zip_code , eligible_to_order_and_refer , last_updated ,
# dupe_count dupes <- resp |>
count(npi, sort = TRUE) |>
filter(n > 1) |>
pull(npi)
resp |>
filter(npi %in% dupes) |>
arrange(npi)# A tibble: 159 × 14
req_id first_name last_name npi specialty optout_effective_date
, first_line_street_address ,
# second_line_street_address , city_name , state_code ,
# zip_code , eligible_to_order_and_refer , last_updated
resp |>
filter(npi %in% c("1225232226", "1740295518", "1326103029")) |>
relocate(last_updated) |>
arrange(npi)# A tibble: 6 × 14
last_updated req_id first_name last_name npi specialty optout_effective_date
, first_line_street_address ,
# second_line_street_address , city_name , state_code ,
# zip_code , eligible_to_order_and_refer
Example 2
Select Dataset
distribution <- read_json_arrow(
file = "https://data.cms.gov/data.json",
col_select = c("dataset"),
as_data_frame = TRUE) |>
to_duckdb() |>
pull(dataset) |>
pluck(1) |>
select(distribution) |>
as_tibble() |>
unnest(distribution) |>
# rename_with(remove_at_symbol) |>
filter(format == "API",
description == "latest")Error: Invalid: straddling object straddles two block boundaries (try to increase block size?)
Error: object 'distribution' not found
Error: object 'distribution' not found
accessURLError: object 'accessURL' not found
Format Query
query <- glue::glue(
'c(
"filter[{i}][path]" = "{PATH}",
"filter[{i}][value]" = "{VALUE}"
)',
i = 1,
PATH = "State Code",
VALUE = "CA")
queryc(
"filter[1][path]" = "State Code",
"filter[1][value]" = "CA"
)
query <- query |>
parse_expr() |>
eval_bare()
query filter[1][path] filter[1][value]
"State Code" "CA"
Retrieve Number of Results
queryurl <- accessURL |>
request() |>
req_url_query(size = 5000, !!!query)Error: object 'accessURL' not found
nresults <- queryurl |>
req_url_path_append("stats") |>
req_perform() |>
resp_body_json() |>
fuimus::gelm("found")Error: object 'queryurl' not found
nresultsError: object 'nresults' not found
url_parse(queryurl$url)Error: object 'queryurl' not found
Generate and Send Requests
reqs <- map(
glue(
"{url}",
"&offset={off}",
url = queryurl$url,
off = providertwo:::offset_seq(nresults, 5000)),
httr2::request)Error:
! Failed to evaluate glue component {url}
Caused by error:
! object 'queryurl' not found
res <- req_perform_parallel(reqs) |>
resps_successes() |>
map(\(x) tibble(resp_body_json(x, simplifyVector = TRUE))) |>
bind_rows()Error: object 'reqs' not found
providertwo:::set_clean(res, names(res)) |>
providertwo:::map_na_if() |>
mtt(
optout_effective_date = providertwo:::as_date(optout_effective_date, fmt = "%m/%d/%Y"),
optout_end_date = providertwo:::as_date(optout_end_date, fmt = "%m/%d/%Y"),
last_updated = providertwo:::as_date(last_updated, fmt = "%m/%d/%Y")
)Error: object 'res' not found
Testing in a Function
protofunc <- function(id = NULL,
state = NULL,
name = NULL,
number = NULL) {
arg <- class_args(
id = id,
state = state,
name = name,
number = number)
query_comparison(compact(props(arg)))
}
protofunc(state = c("GA"),
name = "Jerry",
number = 300.12)Try Again
arg_list <- new_class(
"arg_list",
properties = list(params = class_list),
constructor = function(...) new_object(S7_object(), params = rlang::list2(...)),
validator = function(self) if (!rlang::is_named(self@params)) "all @params must all be named")
less_than <- function(x, equals = FALSE) {
`attr<-`(x, "operator", if (equals) "<=" else "<")
}
is_in <- function(x, negate = FALSE) {
`attr<-`(x, "operator", ifelse(negate, "NOT IN", "IN"))
}
a <- arg_list(
npi = less_than("1234567890"),
state = is_in(state.abb),
name = "Jerry")
# get_operator <- purrr::attr_getter("operator")
# attr(prop(a, "params")$npi, "operator")
has_operator <- \(x) names(attributes(x)) %in% "operator"
has_operator(a@params$npi)[1] TRUE
has_operator(a@params$name)logical(0)
map(a@params, has_operator) |>
compact() |>
names()[1] "npi" "state"
$npi
[1] "1234567890"
attr(,"operator")
[1] "<"
startswith <- \(x) {
list(
OPERATOR = "STARTS_WITH",
VALUE = as.character(x)
)
}
startswith("Royalty or License")
between <- \(x, negate = FALSE) {
list(
OPERATOR = ifelse(negate, "NOT BETWEEN", "BETWEEN"),
VALUE = as.character(x)
)
}
between(c(1, 10))
between(c(1, 10), negate = TRUE)
endswith <- \(x) {
list(
OPERATOR = "ENDS_WITH",
VALUE = as.character(x)
)
}
endswith("NYU")
is_in <- \(x, negate = FALSE) {
list(
OPERATOR = ifelse(negate, "NOT IN", "IN"),
VALUE = as.character(x)
)
}
is_in(c("GA", "NY"))
is_in(c("GA", "NY"), negate = TRUE)x <- list(npi = ~ providertwo:::starts_with("gdklfgj"))
x$npi
~providertwo:::starts_with("gdklfgj")
x$npi[1]`~`()
rlang::is_formula(x$npi, lhs = TRUE)[1] FALSE
foo <- function(npi = NULL,
entity = NULL,
first = NULL,
last = NULL,
organization = NULL,
name_type = NULL,
taxonomy_desc = NULL,
city = NULL,
state = NULL,
zip = NULL,
country = NULL) {
rlang::list2(
number = npi,
enumeration_type = entity,
first_name = first,
last_name = last,
name_purpose = name_type,
organization_name = organization,
taxonomy_description = taxonomy_desc,
city = city,
state = state,
postal_code = zip,
country_code = country,
skip = 0L
)
}
x <- foo(npi = ~ providertwo:::starts_with(1234567890))
rlang::f_lhs(x$number) <- rlang::expr(NPI)
x$numberNPI ~ providertwo:::starts_with(1234567890)
rlang::f_lhs(x$number)NPI
$field
character(0)
$operator
[1] "STARTS_WITH"
$input
[1] "1234567890"