## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#"
)
hook_output = knitr::knit_hooks$get('output')
knitr::knit_hooks$set(output = function(x, options) {
if (!is.null(n <- options$out.lines)){
if (any(nchar(x) > n)){
index <- seq(1,nchar(x),n)
x = substring(x, index, c(index[2:length(index)]-1, nchar(x)))
}
x = paste(x, collapse = '\n# ')
}
hook_output(x, options)
})
# hook_warning = knitr::knit_hooks$get('warning')
# knitr::knit_hooks$set(warning = function(x, options) {
# n <- 90
# x = knitr:::split_lines(x)
# # any lines wider than n should be wrapped
# if (any(nchar(x) > n)) x = strwrap(x, width = n)
# x = paste(x, collapse = '\n ')
# hook_warning(x, options)
# })
## -----------------------------------------------------------------------------
library(fhircrackr)
## -----------------------------------------------------------------------------
fhir_url(url = "http://hapi.fhir.org/baseR4", resource = "Patient")
## ----warning=FALSE------------------------------------------------------------
fhir_resource_type(string = "Patient") #correct
fhir_resource_type(string = "medicationstatement") #fixed
fhir_resource_type(string = "medicationstatement", fix_capitalization = FALSE) #not fixed
fhir_resource_type(string = "Hospital") #an unknown resource type, a warning is issued
# Warning:
# In fhir_resource_type("Hospital") :
# You gave "Hospital" as the resource type.
# This doesn't match any of the resource types defined under
# https://hl7.org/FHIR/resourcelist.html.
# If you are sure the resource type is correct anyway, you can ignore this warning.
## ----out.lines=110------------------------------------------------------------
request <- fhir_url(
url = "http://hapi.fhir.org/baseR4",
resource = "Patient",
parameters = list(
"birthdate" = "lt2000-01-01",
"code" = "http://loinc.org|1751-1"))
request
## ----eval=F-------------------------------------------------------------------
# request <- fhir_url(url = "https://hapi.fhir.org/baseR4", resource = "Patient")
#
# patient_bundles <- fhir_search(request = request, max_bundles = 2, verbose = 0)
## ----include=F----------------------------------------------------------------
patient_bundles <- fhir_unserialize(bundles = patient_bundles)
## ----results='hide'-----------------------------------------------------------
patient_bundles
# An object of class "fhir_bundle_list"
# [[1]]
# A fhir_bundle_xml object
# No. of entries : 20
# Self Link: http://hapi.fhir.org/baseR4/Patient
# Next Link: http://hapi.fhir.org/baseR4?_getpages=ce958386-53d0-4042-888c-cad53bf5d5a1 ...
#
# {xml_node}
#
# [1]
# [2] \n \n
# [3]
# [4] \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
# [1]
# [2] \n \n
# [3]
# [4] \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
# [1]
# [2] \n \n
# [3]
# [4] \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
# [1]
# [2] \n \n
# [3]
# [4] \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
",
"
"
)
#convert to FHIR bundle list
bundles <- as_fhir(bundle_strings)
## ----eval=FALSE---------------------------------------------------------------
# request <- fhir_url(url = "http://hapi.fhir.org/baseR4",
# resource = "Patient",
# parameters = c("_elements" = "name,gender,birthDate",
# "_count"= "2"))
#
#
# bundles <- fhir_search(request, max_bundles = 1)
#
# cat(toString(bundles[[1]]))
## -----------------------------------------------------------------------------
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
## ----eval=F-------------------------------------------------------------------
# request <- fhir_url(url = "http://hapi.fhir.org/baseR4", resource = "Patient")
#
# fhir_search(
# request = request,
# max_bundles = 10,
# save_to_disc = "MyProject/downloadedBundles"
# )
#
# bundles<- fhir_load(directory = "MyProject/downloadedBundles")
## ----include=F----------------------------------------------------------------
assign(x = "last_next_link", value = fhir_url( "http://hapi.fhir.org/baseR4?_getpages=0be4d713-a4db-4c27-b384-b772deabcbc4&_getpagesoffset=200&_count=20&_pretty=true&_bundletype=searchset"), envir = fhircrackr:::fhircrackr_env)
## -----------------------------------------------------------------------------
strsplit(fhir_next_bundle_url(), "&")
## ----eval=F-------------------------------------------------------------------
# #Starting fhir search request
# url <- fhir_url(
# url = "http://hapi.fhir.org/baseR4",
# resource = "Observation",
# parameters = list("_count" = "500"))
#
# count <- 0
#
# table_description <- fhir_table_description(resource = "Observation")
#
# while(!is.null(url)){
#
# #load 10 bundles
# bundles <- fhir_search(request = url, max_bundles = 10)
#
# #crack bundles
# dfs <- fhir_crack(bundles = bundles, design = table_description)
#
# #save cracked bundle to RData-file (can be exchanged by other data type)
# save(tables, file = paste0(tempdir(), "/table_", count, ".RData"))
#
# #retrieve starting point for next 10 bundles
# url <- fhir_next_bundle_url()
#
# count <- count + 1
# # if(count >= 20) {break}
# }
#
## ----eval = FALSE-------------------------------------------------------------
# # define list of Patient resource ids
# ids <- c("4b7736c3-c005-4383-bf7c-99710811efd9", "bef39d3a-62bb-48c0-83ff-3bb70b51d831",
# "f371ed2f-5cb0-4093-a491-9df6e6bfcdf2", "277c4631-955e-4b52-bd40-78ddcde333b1",
# "72173a13-d32f-4489-a7b4-dfc301df087f", "4a97acec-028e-4b45-a72f-2b7e08cf80ba")
#
# #split into smaller chunks of 2
# id_list <- split(ids, ceiling(seq_along(ids)/2))
#
# #Define function that downloads one chunk of patients and serializes the result
# extract_and_serialize <- function(x){
# b <- fhir_get_resources_by_ids(base_url = "http://hapi.fhir.org/baseR4",
# resource = "Patient",
# ids = x)
# fhir_serialize(b)
# }
#
# #Download using 2 cores on linux:
# bundles_serialized <- parallel::mclapply(
# X = pat_list,
# FUN = extract_and_serialize,
# mc.cores = 2
# )
#
# #Unserialize the resulting list and create one fhir_bundle_list object from it
# bundles_unserialized <- lapply(bundles_serialized, fhir_unserialize)
# result <- fhir_bundle_list(unlist(bundles_unserialized, recursive = FALSE))
#
## ----eval=FALSE---------------------------------------------------------------
# #Download all Encounters
# encounter_bundles <- fhir_search(request = "http://hapi.fhir.org/baseR4/Encounter")
#
# #Flatten
# encounter_table <- fhir_crack(
# bundles = encounter_bundles,
# design = fhir_table_description(resource = "Encounter")
# )
#
# #Extract Patient ids
# pat_ids <- sub("Patient/", "", encounter_table$subject.reference)
#
# #Split into chunks of 20
# pat_id_list <- split(pat_ids, ceiling(seq_along(pat_ids)/20))
#
# #Define function that downloads one chunk and serializes the result
# extract_and_serialize <- function(x){
# b <- fhir_get_resources_by_ids(base_url = "http://hapi.fhir.org/baseR4",
# resource = "Patient",
# ids = x)
# fhir_serialize(b)
# }
#
# #Download using 4 cores on linux:
# bundles_serialized <- parallel::mclapply(
# X = pat_id_list,
# FUN = extract_and_serialize,
# mc.cores = 4
# )
#
# #Unserialize the resulting list and create one fhir_bundle_list object from it
# bundles_unserialized <- lapply(bundles_serialized, fhir_unserialize)
# result <- fhir_bundle_list(unlist(bundles_unserialized, recursive = FALSE))
#
## ----eval=F-------------------------------------------------------------------
# bundle <- fhir_sample_resources(
# base_url = "http://hapi.fhir.org/baseR4",
# resource = "Patient",
# parameters = c(gender = "female", birthdate = "lt1960-01-01"),
# sample_size = 10
# )
## ----include=F----------------------------------------------------------------
bundle <- fhir_unserialize(fhircrackr:::female_pat_bundle)
## -----------------------------------------------------------------------------
pat <- fhir_table_description(resource = "Patient",
cols = c("id", "gender", "birthDate"))
fhir_crack(bundles = bundle, design = pat)
## ----eval=F-------------------------------------------------------------------
# cap <- fhir_capability_statement(url = "http://hapi.fhir.org/baseR4")