R on FHIR
Mon Nov 25 10:40:15 2019
1 Modifications
I ran and little bit modified code from Grahame Grieve Orignal code starts below (with some notes and modifications)
2 Preliminaries
This session was solicited by Doug Fridsma.
Taught by Grahame Grieve.
The workshop uses POSTMan (https://www.getpostman.com/downloads/)
The actual R exercises have been preceded with examples of querying mimic data using FHIR.
See hapifhir.io for a Hapi server.
Load all the libraries.
#install.packages('httpuv')
library(httpuv)
library(devtools)
# install_github("FirelyTeam/RonFHIR")
library(RonFHIR)
library(stringr)
library(ggplot2)
library(DT);library(dplyr);library(purrr)
#version in sessioninfo at the bottomOpen client connection
client <- fhirClient$new("http://mimic.fhir.org/r3")## Warning: The endpoint requires authorization.Simple search
bundle <- client$search("Patient", c("gender=female", "birthdate=gt2082-06-27"))What did we get back?
class(bundle)## [1] "list"names(bundle)## [1] "resourceType" "id" "meta" "type"
## [5] "total" "link" "entry"summary(bundle)## Length Class Mode
## resourceType 1 -none- character
## id 1 -none- character
## meta 1 -none- list
## type 1 -none- character
## total 1 -none- numeric
## link 2 data.frame list
## entry 3 data.frame list#bundle$entry
nice<-bundle$entry %>% select_if(purrr::negate(is.list))
DT::datatable(nice)#knitr::kable()
# Don't do this; you'll flood your screen
#str(bundle)Summary of the number of records and matches
paste("Number of matching patients =", bundle$total)## [1] "Number of matching patients = 19"paste("Number of records =", dim(bundle$entry)[1])## [1] "Number of records = 19"Print the records gender and date of birth (my solution)
paste(bundle$entry$resource$gender,
bundle$entry$resource$birthDate,
unlist(lapply(bundle$entry$resource$extension, "[", 1, 2)),
sep=",")## [1] "female,2110-04-02,PROTESTANT QUAKER"
## [2] "female,2097-11-14,UNOBTAINABLE"
## [3] "female,2112-01-20,PROTESTANT QUAKER"
## [4] "female,2097-05-16,CATHOLIC"
## [5] "female,2104-02-12,CATHOLIC"
## [6] "female,2112-10-22,NOT SPECIFIED"
## [7] "female,2094-03-05,CATHOLIC"
## [8] "female,2090-06-05,CATHOLIC"
## [9] "female,2108-01-15,CATHOLIC"
## [10] "female,2141-03-15,CATHOLIC"
## [11] "female,2111-07-18,CATHOLIC"
## [12] "female,2146-10-23,UNKNOWN/NOT SPECIFIED"
## [13] "female,2110-03-25,CATHOLIC"
## [14] "female,2150-12-07,UNOBTAINABLE"
## [15] "female,2097-01-16,CATHOLIC"
## [16] "female,2099-03-17,PROTESTANT QUAKER"
## [17] "female,2108-12-20,JEWISH"
## [18] "female,2127-06-04,UNOBTAINABLE"
## [19] "female,2181-04-19,NOT SPECIFIED"Logic behind my solution:
class(bundle$entry)## [1] "data.frame"names(bundle$entry)## [1] "fullUrl" "resource" "search"class(bundle$entry$resource)## [1] "data.frame"names(bundle$entry$resource)## [1] "resourceType" "id" "meta"
## [4] "text" "extension" "identifier"
## [7] "gender" "birthDate" "deceasedDateTime"
## [10] "maritalStatus" "communication"class(bundle$entry$resource$gender)## [1] "character"class(bundle$entry$resource$birthDate)## [1] "character"We’ll need a function to extract religion.
getReligion <- function(extl) {
for (io in extl) {
for (i in 1:nrow(io)) {
if (io[i, "url"] == "http://hl7.org/fhir/StructureDefinition/patient-religion") {
v <- io[i, "valueCodeableConcept"];
return (v$text);
}
}
}
return ("??")
}Print the records gender and date of birth (Grahame’s solution)
for(row in 1:nrow(bundle$entry)) {
res <-bundle$entry[row, "resource"]
print(paste(res$gender, res$birthDate,
getReligion(res$extension), sep = ","))
}## [1] "female,2110-04-02,PROTESTANT QUAKER"
## [1] "female,2097-11-14,UNOBTAINABLE"
## [1] "female,2112-01-20,PROTESTANT QUAKER"
## [1] "female,2097-05-16,CATHOLIC"
## [1] "female,2104-02-12,CATHOLIC"
## [1] "female,2112-10-22,NOT SPECIFIED"
## [1] "female,2094-03-05,CATHOLIC"
## [1] "female,2090-06-05,CATHOLIC"
## [1] "female,2108-01-15,CATHOLIC"
## [1] "female,2141-03-15,CATHOLIC"
## [1] "female,2111-07-18,CATHOLIC"
## [1] "female,2146-10-23,??"
## [1] "female,2110-03-25,CATHOLIC"
## [1] "female,2150-12-07,UNOBTAINABLE"
## [1] "female,2097-01-16,CATHOLIC"
## [1] "female,2099-03-17,PROTESTANT QUAKER"
## [1] "female,2108-12-20,JEWISH"
## [1] "female,2127-06-04,UNOBTAINABLE"
## [1] "female,2181-04-19,NOT SPECIFIED"3 Example iterating through pages of results
Specify a search with 30 records per page
bundle <- client$search("Patient", c("_count=30"))class(bundle)## [1] "list"names(bundle)## [1] "resourceType" "id" "meta" "type"
## [5] "total" "link" "entry"class(client)## [1] "fhirClient" "R6"names(client)## [1] ".__enclos_env__" "registerUrl" "authUrl"
## [4] "tokenUrl" "token" "endpoint"
## [7] "clone" "setToken" "print"
## [10] "update" "operation" "continue"
## [13] "qraphQL" "searchByQuery" "wholeSystemSearch"
## [16] "searchById" "search" "read"
## [19] "initialize"class(client$continue)## [1] "function"while(!is.null(bundle)) {
print(c("================================= Number of records=",
dim(bundle$entry)[1]))
print(
paste(bundle$entry$resource$gender,
bundle$entry$resource$birthDate,
unlist(lapply(bundle$entry$resource$extension, "[", 1, 2)),
sep=","))
# Go to the next page of the bundle using FHIRs paging mechanism
bundle <- client$continue(bundle)
}## [1] "================================= Number of records="
## [2] "30"
## [1] "female,2063-07-05,CATHOLIC"
## [2] "male,2082-06-27,CATHOLIC"
## [3] "male,2079-08-17,CHRISTIAN SCIENTIST"
## [4] "female,2070-10-11,NOT SPECIFIED"
## [5] "female,2110-04-02,PROTESTANT QUAKER"
## [6] "male,2086-12-16,PROTESTANT QUAKER"
## [7] "male,2103-12-05,CATHOLIC"
## [8] "female,2031-08-12,CATHOLIC"
## [9] "female,2097-11-14,UNOBTAINABLE"
## [10] "female,2068-03-04,JEWISH"
## [11] "female,2112-01-20,PROTESTANT QUAKER"
## [12] "female,2073-08-13,NOT SPECIFIED"
## [13] "female,1844-07-18,JEWISH"
## [14] "female,2073-06-05,NOT SPECIFIED"
## [15] "male,2096-07-25,NOT SPECIFIED"
## [16] "male,2090-11-16,CATHOLIC"
## [17] "male,2136-07-28,CATHOLIC"
## [18] "female,1851-09-12,UNOBTAINABLE"
## [19] "female,2045-10-07,ROMANIAN EAST. ORTH"
## [20] "male,2061-06-13,CATHOLIC"
## [21] "male,2086-02-04,UNOBTAINABLE"
## [22] "male,2083-09-20,MUSLIM"
## [23] "female,2044-06-27,PROTESTANT QUAKER"
## [24] "female,2016-12-05,CATHOLIC"
## [25] "male,2058-08-04,CATHOLIC"
## [26] "female,2051-03-23,NOT SPECIFIED"
## [27] "male,2098-04-29,CATHOLIC"
## [28] "female,2074-09-29,NOT SPECIFIED"
## [29] "female,2041-05-16,OTHER"
## [30] "female,2072-12-03,NOT SPECIFIED"
## [1] "================================= Number of records="
## [2] "30"
## [1] "female,2060-02-12,JEWISH"
## [2] "male,2079-01-29,JEWISH"
## [3] "male,2061-12-10,CHRISTIAN SCIENTIST"
## [4] "male,1846-07-21,JEWISH"
## [5] "male,2046-07-05,CATHOLIC"
## [6] "female,2029-12-07,JEWISH"
## [7] "male,2099-09-02,JEWISH"
## [8] "male,2097-01-07,CATHOLIC"
## [9] "male,2136-07-29,CATHOLIC"
## [10] "female,1876-07-14,CATHOLIC"
## [11] "female,2097-05-16,CATHOLIC"
## [12] "female,2051-07-25,PROTESTANT QUAKER"
## [13] "male,2051-03-24,NOT SPECIFIED"
## [14] "female,2073-11-22,UNOBTAINABLE"
## [15] "female,2104-02-12,CATHOLIC"
## [16] "male,2057-11-15,CATHOLIC"
## [17] "male,1878-05-14,PROTESTANT QUAKER"
## [18] "female,2078-06-16,UNOBTAINABLE"
## [19] "male,2107-06-27,CATHOLIC"
## [20] "female,2112-10-22,NOT SPECIFIED"
## [21] "female,2094-03-05,CATHOLIC"
## [22] "female,2090-06-05,CATHOLIC"
## [23] "female,2038-09-03,CATHOLIC"
## [24] "female,2075-09-21,CATHOLIC"
## [25] "male,2114-06-20,CATHOLIC"
## [26] "female,1895-05-17,OTHER"
## [27] "female,2108-01-15,CATHOLIC"
## [28] "male,2061-04-10,PROTESTANT QUAKER"
## [29] "male,2050-03-29,CATHOLIC"
## [30] "female,2051-04-21,CATHOLIC"
## [1] "================================= Number of records="
## [2] "30"
## [1] "male,2053-04-13,NOT SPECIFIED"
## [2] "female,1885-03-24,JEWISH"
## [3] "female,2056-01-27,CATHOLIC"
## [4] "female,2061-10-23,UNOBTAINABLE"
## [5] "male,2076-05-06,UNOBTAINABLE"
## [6] "male,2109-04-07,CATHOLIC"
## [7] "female,2071-02-11,UNOBTAINABLE"
## [8] "female,2061-03-25,PROTESTANT QUAKER"
## [9] "female,2141-03-15,CATHOLIC"
## [10] "female,2046-02-27,CHRISTIAN SCIENTIST"
## [11] "male,2081-01-03,CATHOLIC"
## [12] "female,2031-05-19,CATHOLIC"
## [13] "male,2058-04-23,UNOBTAINABLE"
## [14] "female,2111-07-18,CATHOLIC"
## [15] "male,2101-06-10,UNOBTAINABLE"
## [16] "female,2146-10-23,UNKNOWN/NOT SPECIFIED"
## [17] "male,2081-12-26,OTHER"
## [18] "male,2038-05-10,NOT SPECIFIED"
## [19] "female,2110-03-25,CATHOLIC"
## [20] "male,2029-07-09,UNOBTAINABLE"
## [21] "male,2046-04-18,UNOBTAINABLE"
## [22] "male,2096-02-27,NOT SPECIFIED"
## [23] "male,2053-09-08,UNOBTAINABLE"
## [24] "male,1880-02-29,UNOBTAINABLE"
## [25] "female,2150-12-07,UNOBTAINABLE"
## [26] "male,2055-07-18,NOT SPECIFIED"
## [27] "male,2035-04-13,CATHOLIC"
## [28] "female,2050-02-16,BUDDHIST"
## [29] "male,2097-12-16,CATHOLIC"
## [30] "female,2097-01-16,CATHOLIC"
## [1] "================================= Number of records="
## [2] "10"
## [1] "female,2069-05-05,PROTESTANT QUAKER"
## [2] "female,2099-03-17,PROTESTANT QUAKER"
## [3] "female,2072-05-05,CATHOLIC"
## [4] "male,2036-03-10,NOT SPECIFIED"
## [5] "male,2088-05-05,OTHER"
## [6] "female,2108-12-20,JEWISH"
## [7] "female,2127-06-04,UNOBTAINABLE"
## [8] "female,2181-04-19,NOT SPECIFIED"
## [9] "male,2109-07-08,CATHOLIC"
## [10] "female,2058-04-23,CATHOLIC"4 using graphQL example 1
What are we doing here?
res <- client$qraphQL('{PatientList(){
gender birthDate religion:
extension(url :
"http://hl7.org/fhir/StructureDefinition/patient-religion")
{value : valueCodeableConcept { text } } }}');
pl <- res$data$PatientListpl## gender birthDate religion
## 1 female 2112-10-22 NOT SPECIFIED
## 2 male 2107-06-27 CATHOLIC
## 3 female 2078-06-16 UNOBTAINABLE
## 4 male 1878-05-14 PROTESTANT QUAKER
## 5 male 2057-11-15 CATHOLIC
## 6 female 2104-02-12 CATHOLIC
## 7 female 2073-11-22 UNOBTAINABLE
## 8 male 2051-03-24 NOT SPECIFIED
## 9 female 2051-07-25 PROTESTANT QUAKER
## 10 female 2097-05-16 CATHOLIC
## 11 female 1876-07-14 CATHOLIC
## 12 male 2136-07-29 CATHOLIC
## 13 male 2097-01-07 CATHOLIC
## 14 male 2099-09-02 JEWISH
## 15 female 2029-12-07 JEWISH
## 16 male 2046-07-05 CATHOLIC
## 17 male 1846-07-21 JEWISH
## 18 male 2061-12-10 CHRISTIAN SCIENTIST
## 19 male 2079-01-29 JEWISH
## 20 female 2060-02-12 JEWISH
## 21 female 2072-12-03 NOT SPECIFIED
## 22 female 2041-05-16 OTHER
## 23 female 2074-09-29 NOT SPECIFIED
## 24 male 2098-04-29 CATHOLIC
## 25 female 2051-03-23 NOT SPECIFIED
## 26 male 2058-08-04 CATHOLIC
## 27 female 2016-12-05 CATHOLIC
## 28 female 2044-06-27 PROTESTANT QUAKER
## 29 male 2083-09-20 MUSLIM
## 30 male 2086-02-04 UNOBTAINABLE
## 31 male 2061-06-13 CATHOLIC
## 32 female 2045-10-07 ROMANIAN EAST. ORTH
## 33 female 1851-09-12 UNOBTAINABLE
## 34 male 2136-07-28 CATHOLIC
## 35 male 2090-11-16 CATHOLIC
## 36 male 2096-07-25 NOT SPECIFIED
## 37 female 2073-06-05 NOT SPECIFIED
## 38 female 1844-07-18 JEWISH
## 39 female 2073-08-13 NOT SPECIFIED
## 40 female 2112-01-20 PROTESTANT QUAKER
## 41 female 2068-03-04 JEWISH
## 42 female 2097-11-14 UNOBTAINABLE
## 43 female 2031-08-12 CATHOLIC
## 44 male 2103-12-05 CATHOLIC
## 45 male 2086-12-16 PROTESTANT QUAKER
## 46 female 2110-04-02 PROTESTANT QUAKER
## 47 female 2070-10-11 NOT SPECIFIED
## 48 male 2079-08-17 CHRISTIAN SCIENTIST
## 49 male 2082-06-27 CATHOLIC
## 50 female 2063-07-05 CATHOLIC
## 51 female 2058-04-23 CATHOLIC
## 52 male 2109-07-08 CATHOLIC
## 53 female 2181-04-19 NOT SPECIFIED
## 54 female 2127-06-04 UNOBTAINABLE
## 55 female 2108-12-20 JEWISH
## 56 male 2088-05-05 OTHER
## 57 male 2036-03-10 NOT SPECIFIED
## 58 female 2072-05-05 CATHOLIC
## 59 female 2099-03-17 PROTESTANT QUAKER
## 60 female 2069-05-05 PROTESTANT QUAKER
## 61 female 2097-01-16 CATHOLIC
## 62 male 2097-12-16 CATHOLIC
## 63 female 2050-02-16 BUDDHIST
## 64 male 2035-04-13 CATHOLIC
## 65 male 2055-07-18 NOT SPECIFIED
## 66 female 2150-12-07 UNOBTAINABLE
## 67 male 1880-02-29 UNOBTAINABLE
## 68 male 2053-09-08 UNOBTAINABLE
## 69 male 2096-02-27 NOT SPECIFIED
## 70 male 2046-04-18 UNOBTAINABLE
## 71 male 2029-07-09 UNOBTAINABLE
## 72 female 2110-03-25 CATHOLIC
## 73 male 2038-05-10 NOT SPECIFIED
## 74 male 2081-12-26 OTHER
## 75 female 2146-10-23 NULL
## 76 male 2101-06-10 UNOBTAINABLE
## 77 female 2111-07-18 CATHOLIC
## 78 male 2058-04-23 UNOBTAINABLE
## 79 female 2031-05-19 CATHOLIC
## 80 male 2081-01-03 CATHOLIC
## 81 female 2046-02-27 CHRISTIAN SCIENTIST
## 82 female 2141-03-15 CATHOLIC
## 83 female 2061-03-25 PROTESTANT QUAKER
## 84 female 2071-02-11 UNOBTAINABLE
## 85 male 2109-04-07 CATHOLIC
## 86 male 2076-05-06 UNOBTAINABLE
## 87 female 2061-10-23 UNOBTAINABLE
## 88 female 2056-01-27 CATHOLIC
## 89 female 1885-03-24 JEWISH
## 90 male 2053-04-13 NOT SPECIFIED
## 91 female 2051-04-21 CATHOLIC
## 92 male 2050-03-29 CATHOLIC
## 93 male 2061-04-10 PROTESTANT QUAKER
## 94 female 2108-01-15 CATHOLIC
## 95 female 1895-05-17 OTHER
## 96 male 2114-06-20 CATHOLIC
## 97 female 2075-09-21 CATHOLIC
## 98 female 2038-09-03 CATHOLIC
## 99 female 2090-06-05 CATHOLIC
## 100 female 2094-03-05 CATHOLICNote that religion did not print. See the magic below to make it work.
5 using graphQL Example 2
res <- client$qraphQL('{PatientList(){
gender birthDate religion:
extension(url :
"http://hl7.org/fhir/StructureDefinition/patient-religion")
@flatten {value : valueCodeableConcept
@flatten { religion: text } } }}');
pl <- res$data$PatientListeasy now…
pl## gender birthDate religion
## 1 female 2112-10-22 NOT SPECIFIED
## 2 male 2107-06-27 CATHOLIC
## 3 female 2078-06-16 UNOBTAINABLE
## 4 male 1878-05-14 PROTESTANT QUAKER
## 5 male 2057-11-15 CATHOLIC
## 6 female 2104-02-12 CATHOLIC
## 7 female 2073-11-22 UNOBTAINABLE
## 8 male 2051-03-24 NOT SPECIFIED
## 9 female 2051-07-25 PROTESTANT QUAKER
## 10 female 2097-05-16 CATHOLIC
## 11 female 1876-07-14 CATHOLIC
## 12 male 2136-07-29 CATHOLIC
## 13 male 2097-01-07 CATHOLIC
## 14 male 2099-09-02 JEWISH
## 15 female 2029-12-07 JEWISH
## 16 male 2046-07-05 CATHOLIC
## 17 male 1846-07-21 JEWISH
## 18 male 2061-12-10 CHRISTIAN SCIENTIST
## 19 male 2079-01-29 JEWISH
## 20 female 2060-02-12 JEWISH
## 21 female 2072-12-03 NOT SPECIFIED
## 22 female 2041-05-16 OTHER
## 23 female 2074-09-29 NOT SPECIFIED
## 24 male 2098-04-29 CATHOLIC
## 25 female 2051-03-23 NOT SPECIFIED
## 26 male 2058-08-04 CATHOLIC
## 27 female 2016-12-05 CATHOLIC
## 28 female 2044-06-27 PROTESTANT QUAKER
## 29 male 2083-09-20 MUSLIM
## 30 male 2086-02-04 UNOBTAINABLE
## 31 male 2061-06-13 CATHOLIC
## 32 female 2045-10-07 ROMANIAN EAST. ORTH
## 33 female 1851-09-12 UNOBTAINABLE
## 34 male 2136-07-28 CATHOLIC
## 35 male 2090-11-16 CATHOLIC
## 36 male 2096-07-25 NOT SPECIFIED
## 37 female 2073-06-05 NOT SPECIFIED
## 38 female 1844-07-18 JEWISH
## 39 female 2073-08-13 NOT SPECIFIED
## 40 female 2112-01-20 PROTESTANT QUAKER
## 41 female 2068-03-04 JEWISH
## 42 female 2097-11-14 UNOBTAINABLE
## 43 female 2031-08-12 CATHOLIC
## 44 male 2103-12-05 CATHOLIC
## 45 male 2086-12-16 PROTESTANT QUAKER
## 46 female 2110-04-02 PROTESTANT QUAKER
## 47 female 2070-10-11 NOT SPECIFIED
## 48 male 2079-08-17 CHRISTIAN SCIENTIST
## 49 male 2082-06-27 CATHOLIC
## 50 female 2063-07-05 CATHOLIC
## 51 female 2058-04-23 CATHOLIC
## 52 male 2109-07-08 CATHOLIC
## 53 female 2181-04-19 NOT SPECIFIED
## 54 female 2127-06-04 UNOBTAINABLE
## 55 female 2108-12-20 JEWISH
## 56 male 2088-05-05 OTHER
## 57 male 2036-03-10 NOT SPECIFIED
## 58 female 2072-05-05 CATHOLIC
## 59 female 2099-03-17 PROTESTANT QUAKER
## 60 female 2069-05-05 PROTESTANT QUAKER
## 61 female 2097-01-16 CATHOLIC
## 62 male 2097-12-16 CATHOLIC
## 63 female 2050-02-16 BUDDHIST
## 64 male 2035-04-13 CATHOLIC
## 65 male 2055-07-18 NOT SPECIFIED
## 66 female 2150-12-07 UNOBTAINABLE
## 67 male 1880-02-29 UNOBTAINABLE
## 68 male 2053-09-08 UNOBTAINABLE
## 69 male 2096-02-27 NOT SPECIFIED
## 70 male 2046-04-18 UNOBTAINABLE
## 71 male 2029-07-09 UNOBTAINABLE
## 72 female 2110-03-25 CATHOLIC
## 73 male 2038-05-10 NOT SPECIFIED
## 74 male 2081-12-26 OTHER
## 75 female 2146-10-23 <NA>
## 76 male 2101-06-10 UNOBTAINABLE
## 77 female 2111-07-18 CATHOLIC
## 78 male 2058-04-23 UNOBTAINABLE
## 79 female 2031-05-19 CATHOLIC
## 80 male 2081-01-03 CATHOLIC
## 81 female 2046-02-27 CHRISTIAN SCIENTIST
## 82 female 2141-03-15 CATHOLIC
## 83 female 2061-03-25 PROTESTANT QUAKER
## 84 female 2071-02-11 UNOBTAINABLE
## 85 male 2109-04-07 CATHOLIC
## 86 male 2076-05-06 UNOBTAINABLE
## 87 female 2061-10-23 UNOBTAINABLE
## 88 female 2056-01-27 CATHOLIC
## 89 female 1885-03-24 JEWISH
## 90 male 2053-04-13 NOT SPECIFIED
## 91 female 2051-04-21 CATHOLIC
## 92 male 2050-03-29 CATHOLIC
## 93 male 2061-04-10 PROTESTANT QUAKER
## 94 female 2108-01-15 CATHOLIC
## 95 female 1895-05-17 OTHER
## 96 male 2114-06-20 CATHOLIC
## 97 female 2075-09-21 CATHOLIC
## 98 female 2038-09-03 CATHOLIC
## 99 female 2090-06-05 CATHOLIC
## 100 female 2094-03-05 CATHOLIC6 Using OAuth
Need lots of information from the server:
* App-Name: (“Mimic” for Mimic Server)
* Client-Id: (c.5 for Mimic server)
* Client-Secret: (cfe2cc3e-d4ca-49f4-8366-10064f4eda5c for Mimic server)
* Auth-Endpoint: https://mimic.fhir.org/r3/auth/auth
* Token-Endpoint: https://mimic.fhir.org/r3/auth/token
* Username / Password: REDACTED
VH: This does work when run outside R Markdown. It opens a browser. Not sure if picking a patient is important.
client <- fhirClient$new("https://mimic.fhir.org/r3");
app <- httr::oauth_app(appname = "Mimic",
"c.5",
"cfe2cc3e-d4ca-49f4-8366-10064f4eda5c")
scopes <- c("patient/*.read")
oauth_endpoint <-
httr::oauth_endpoint(authorize =
paste("https://mimic.fhir.org/r3/auth/auth",
"?aud=", "https://mimic.fhir.org/r3",
"&state=", runif(1), sep=""),
access = "https://mimic.fhir.org/r3/auth/token")
#VH: I set cache to false (to avoid the question, not sure here)
token <- httr::oauth2.0_token(endpoint = oauth_endpoint,
app = app, scope = scopes,cache = FALSE)
client$setToken(token$credentials$access_token)7 O2 Saturation example
Here we will build historic \(O_2\) saturation dataset for a patient.
7.1 Utility functions
We’ll need a couple of functions to do date format conversion.
fixDateTime <- function (s) {
if(nchar(s) == 10) {
return (paste(s, "00:00:00"));
} else {
return (str_replace(s,"T", " "));
}
}
fixDateTime2 <- function (s) {
ifelse(nchar(s) == 10, paste(s, "00:00:00"), sub("T", " ", s))
}client <- fhirClient$new("http://mimic.fhir.org/r3")## Warning: The endpoint requires authorization.bundle <- client$search("Observation",
c("code=2708-6",
"subject=Patient/30831",
"date=lt2130-08-01"))dateList <- list();
valueList <- list();
index <- 1
while(!is.null(bundle)) {
for(row in 1:nrow(bundle$entry)) {
res <-bundle$entry[row, "resource"]
dateList[index] = fixDateTime(res$effectiveDateTime);
valueList[index] = res$valueQuantity$value;
index = index+1;
}
bundle <- client$continue(bundle)
}
df <- do.call(rbind,
Map(data.frame,
DATE=dateList,
SAT=valueList))
df## DATE SAT
## 1 2130-02-04 04:42:00 100
## 2 2130-02-04 05:03:00 99
## 3 2130-02-04 06:00:00 100
## 4 2130-02-04 07:14:00 100
## 5 2130-02-04 08:00:00 98
## 6 2130-02-04 08:17:00 85
## 7 2130-02-04 09:00:00 100
## 8 2130-02-04 09:52:00 96
## 9 2130-02-04 10:00:00 100
## 10 2130-02-04 10:50:00 98
## 11 2130-02-04 11:00:00 98
## 12 2130-02-04 12:00:00 100
## 13 2130-02-04 13:03:00 95
## 14 2130-02-04 14:00:00 100
## 15 2130-02-04 15:00:00 99
## 16 2130-02-04 16:00:00 100
## 17 2130-02-04 17:34:00 99
## 18 2130-02-04 18:00:00 98
## 19 2130-02-04 19:00:00 98
## 20 2130-02-04 20:00:00 92
## 21 2130-02-04 21:00:00 93
## 22 2130-02-04 22:00:00 91
## 23 2130-02-04 23:00:00 91
## 24 2130-02-05 00:00:00 93
## 25 2130-02-05 01:00:00 93
## 26 2130-02-05 02:00:00 99
## 27 2130-02-05 03:00:00 98
## 28 2130-02-05 04:00:00 97
## 29 2130-02-05 05:00:00 98
## 30 2130-02-05 06:07:00 97
## 31 2130-02-05 07:00:00 99
## 32 2130-02-05 08:00:00 96
## 33 2130-02-05 09:31:00 98
## 34 2130-02-05 10:00:00 93
## 35 2130-02-05 11:00:00 98
## 36 2130-02-05 12:00:00 98
## 37 2130-02-05 13:00:00 100
## 38 2130-02-05 14:00:00 100
## 39 2130-02-05 15:00:00 100
## 40 2130-02-05 16:00:00 98
## 41 2130-02-05 17:44:00 95
## 42 2130-02-05 18:00:00 97
## 43 2130-02-05 19:00:00 97
## 44 2130-02-05 20:00:00 97
## 45 2130-02-05 21:00:00 98
## 46 2130-02-05 22:00:00 98
## 47 2130-02-05 23:36:00 100
## 48 2130-02-06 00:00:00 100
## 49 2130-02-06 01:00:00 100
## 50 2130-02-06 02:00:00 100
## 51 2130-02-06 03:00:00 97
## 52 2130-02-06 04:00:00 97
## 53 2130-02-06 05:00:00 98
## 54 2130-02-06 06:00:00 100
## 55 2130-02-06 07:00:00 100
## 56 2130-02-06 08:00:00 99
## 57 2130-02-06 09:00:00 100
## 58 2130-02-06 10:00:00 100
## 59 2130-02-06 11:01:00 99df$DATET <- as.POSIXct(df$DATE,tz=Sys.timezone())
df## DATE SAT DATET
## 1 2130-02-04 04:42:00 100 2130-02-04 04:42:00
## 2 2130-02-04 05:03:00 99 2130-02-04 05:03:00
## 3 2130-02-04 06:00:00 100 2130-02-04 06:00:00
## 4 2130-02-04 07:14:00 100 2130-02-04 07:14:00
## 5 2130-02-04 08:00:00 98 2130-02-04 08:00:00
## 6 2130-02-04 08:17:00 85 2130-02-04 08:17:00
## 7 2130-02-04 09:00:00 100 2130-02-04 09:00:00
## 8 2130-02-04 09:52:00 96 2130-02-04 09:52:00
## 9 2130-02-04 10:00:00 100 2130-02-04 10:00:00
## 10 2130-02-04 10:50:00 98 2130-02-04 10:50:00
## 11 2130-02-04 11:00:00 98 2130-02-04 11:00:00
## 12 2130-02-04 12:00:00 100 2130-02-04 12:00:00
## 13 2130-02-04 13:03:00 95 2130-02-04 13:03:00
## 14 2130-02-04 14:00:00 100 2130-02-04 14:00:00
## 15 2130-02-04 15:00:00 99 2130-02-04 15:00:00
## 16 2130-02-04 16:00:00 100 2130-02-04 16:00:00
## 17 2130-02-04 17:34:00 99 2130-02-04 17:34:00
## 18 2130-02-04 18:00:00 98 2130-02-04 18:00:00
## 19 2130-02-04 19:00:00 98 2130-02-04 19:00:00
## 20 2130-02-04 20:00:00 92 2130-02-04 20:00:00
## 21 2130-02-04 21:00:00 93 2130-02-04 21:00:00
## 22 2130-02-04 22:00:00 91 2130-02-04 22:00:00
## 23 2130-02-04 23:00:00 91 2130-02-04 23:00:00
## 24 2130-02-05 00:00:00 93 2130-02-05 00:00:00
## 25 2130-02-05 01:00:00 93 2130-02-05 01:00:00
## 26 2130-02-05 02:00:00 99 2130-02-05 02:00:00
## 27 2130-02-05 03:00:00 98 2130-02-05 03:00:00
## 28 2130-02-05 04:00:00 97 2130-02-05 04:00:00
## 29 2130-02-05 05:00:00 98 2130-02-05 05:00:00
## 30 2130-02-05 06:07:00 97 2130-02-05 06:07:00
## 31 2130-02-05 07:00:00 99 2130-02-05 07:00:00
## 32 2130-02-05 08:00:00 96 2130-02-05 08:00:00
## 33 2130-02-05 09:31:00 98 2130-02-05 09:31:00
## 34 2130-02-05 10:00:00 93 2130-02-05 10:00:00
## 35 2130-02-05 11:00:00 98 2130-02-05 11:00:00
## 36 2130-02-05 12:00:00 98 2130-02-05 12:00:00
## 37 2130-02-05 13:00:00 100 2130-02-05 13:00:00
## 38 2130-02-05 14:00:00 100 2130-02-05 14:00:00
## 39 2130-02-05 15:00:00 100 2130-02-05 15:00:00
## 40 2130-02-05 16:00:00 98 2130-02-05 16:00:00
## 41 2130-02-05 17:44:00 95 2130-02-05 17:44:00
## 42 2130-02-05 18:00:00 97 2130-02-05 18:00:00
## 43 2130-02-05 19:00:00 97 2130-02-05 19:00:00
## 44 2130-02-05 20:00:00 97 2130-02-05 20:00:00
## 45 2130-02-05 21:00:00 98 2130-02-05 21:00:00
## 46 2130-02-05 22:00:00 98 2130-02-05 22:00:00
## 47 2130-02-05 23:36:00 100 2130-02-05 23:36:00
## 48 2130-02-06 00:00:00 100 2130-02-06 00:00:00
## 49 2130-02-06 01:00:00 100 2130-02-06 01:00:00
## 50 2130-02-06 02:00:00 100 2130-02-06 02:00:00
## 51 2130-02-06 03:00:00 97 2130-02-06 03:00:00
## 52 2130-02-06 04:00:00 97 2130-02-06 04:00:00
## 53 2130-02-06 05:00:00 98 2130-02-06 05:00:00
## 54 2130-02-06 06:00:00 100 2130-02-06 06:00:00
## 55 2130-02-06 07:00:00 100 2130-02-06 07:00:00
## 56 2130-02-06 08:00:00 99 2130-02-06 08:00:00
## 57 2130-02-06 09:00:00 100 2130-02-06 09:00:00
## 58 2130-02-06 10:00:00 100 2130-02-06 10:00:00
## 59 2130-02-06 11:01:00 99 2130-02-06 11:01:00Now let’s actually plot this
ggplot(data = df, aes(x = DATET, y = SAT)) +
geom_point() + geom_line() +
labs(x = "Date",
y = "O2 Sat",
title = "Oxygen Saturation")+
theme_minimal()+
theme(axis.text.x = element_text(angle = 90, hjust = 1)) 
7.2 The same using graphQL
res <- client$qraphQL('{ObservationList(code: "2708-6",
subject: "Patient/30831",
date: "lt2130-08-01")
{date : effectiveDateTime
valueQuantity @flatten { value } }}');
df <- res$data$ObservationList
df$DATET <- as.POSIXct(fixDateTime2(df$date),
tz=Sys.timezone())
df## date value DATET
## 1 2130-02-06T11:01:00 99 2130-02-06 11:01:00
## 2 2130-02-06T10:00:00 100 2130-02-06 10:00:00
## 3 2130-02-06T09:00:00 100 2130-02-06 09:00:00
## 4 2130-02-06T08:00:00 99 2130-02-06 08:00:00
## 5 2130-02-06T07:00:00 100 2130-02-06 07:00:00
## 6 2130-02-06T06:00:00 100 2130-02-06 06:00:00
## 7 2130-02-06T05:00:00 98 2130-02-06 05:00:00
## 8 2130-02-06T04:00:00 97 2130-02-06 04:00:00
## 9 2130-02-06T03:00:00 97 2130-02-06 03:00:00
## 10 2130-02-06T02:00:00 100 2130-02-06 02:00:00
## 11 2130-02-06T01:00:00 100 2130-02-06 01:00:00
## 12 2130-02-06 100 2130-02-06 00:00:00
## 13 2130-02-05T23:36:00 100 2130-02-05 23:36:00
## 14 2130-02-05T22:00:00 98 2130-02-05 22:00:00
## 15 2130-02-05T21:00:00 98 2130-02-05 21:00:00
## 16 2130-02-05T20:00:00 97 2130-02-05 20:00:00
## 17 2130-02-05T19:00:00 97 2130-02-05 19:00:00
## 18 2130-02-05T18:00:00 97 2130-02-05 18:00:00
## 19 2130-02-05T17:44:00 95 2130-02-05 17:44:00
## 20 2130-02-05T16:00:00 98 2130-02-05 16:00:00
## 21 2130-02-05T15:00:00 100 2130-02-05 15:00:00
## 22 2130-02-05T14:00:00 100 2130-02-05 14:00:00
## 23 2130-02-05T13:00:00 100 2130-02-05 13:00:00
## 24 2130-02-05T12:00:00 98 2130-02-05 12:00:00
## 25 2130-02-05T11:00:00 98 2130-02-05 11:00:00
## 26 2130-02-05T10:00:00 93 2130-02-05 10:00:00
## 27 2130-02-05T09:31:00 98 2130-02-05 09:31:00
## 28 2130-02-05T08:00:00 96 2130-02-05 08:00:00
## 29 2130-02-05T07:00:00 99 2130-02-05 07:00:00
## 30 2130-02-05T06:07:00 97 2130-02-05 06:07:00
## 31 2130-02-05T05:00:00 98 2130-02-05 05:00:00
## 32 2130-02-05T04:00:00 97 2130-02-05 04:00:00
## 33 2130-02-05T03:00:00 98 2130-02-05 03:00:00
## 34 2130-02-05T02:00:00 99 2130-02-05 02:00:00
## 35 2130-02-05T01:00:00 93 2130-02-05 01:00:00
## 36 2130-02-05 93 2130-02-05 00:00:00
## 37 2130-02-04T23:00:00 91 2130-02-04 23:00:00
## 38 2130-02-04T22:00:00 91 2130-02-04 22:00:00
## 39 2130-02-04T21:00:00 93 2130-02-04 21:00:00
## 40 2130-02-04T20:00:00 92 2130-02-04 20:00:00
## 41 2130-02-04T19:00:00 98 2130-02-04 19:00:00
## 42 2130-02-04T18:00:00 98 2130-02-04 18:00:00
## 43 2130-02-04T17:34:00 99 2130-02-04 17:34:00
## 44 2130-02-04T16:00:00 100 2130-02-04 16:00:00
## 45 2130-02-04T15:00:00 99 2130-02-04 15:00:00
## 46 2130-02-04T14:00:00 100 2130-02-04 14:00:00
## 47 2130-02-04T13:03:00 95 2130-02-04 13:03:00
## 48 2130-02-04T12:00:00 100 2130-02-04 12:00:00
## 49 2130-02-04T11:00:00 98 2130-02-04 11:00:00
## 50 2130-02-04T10:50:00 98 2130-02-04 10:50:00
## 51 2130-02-04T10:00:00 100 2130-02-04 10:00:00
## 52 2130-02-04T09:52:00 96 2130-02-04 09:52:00
## 53 2130-02-04T09:00:00 100 2130-02-04 09:00:00
## 54 2130-02-04T08:17:00 85 2130-02-04 08:17:00
## 55 2130-02-04T08:00:00 98 2130-02-04 08:00:00
## 56 2130-02-04T07:14:00 100 2130-02-04 07:14:00
## 57 2130-02-04T06:00:00 100 2130-02-04 06:00:00
## 58 2130-02-04T05:03:00 99 2130-02-04 05:03:00
## 59 2130-02-04T04:42:00 100 2130-02-04 04:42:00Plotting
ggplot(data = df, aes(x = DATET, y = value)) +
geom_point() + geom_line() +
labs(x = "Date",
y = "O2 Sat",
title = "Oxygen Saturation")+
theme_minimal()+
theme(axis.text.x = element_text(angle = 90, hjust = 1))
8 More on graphQL
see [https://graphql.org]
9 Session info
session_info()## - Session info ----------------------------------------------------------
## setting value
## version R version 3.6.1 (2019-07-05)
## os Windows 10 x64
## system x86_64, mingw32
## ui RTerm
## language (EN)
## collate English_United States.1252
## ctype English_United States.1252
## tz America/New_York
## date 2019-11-25
##
## - Packages --------------------------------------------------------------
## package * version date lib source
## assertthat 0.2.1 2019-03-21 [1] CRAN (R 3.6.1)
## backports 1.1.4 2019-04-10 [1] CRAN (R 3.6.0)
## broom 0.5.2 2019-04-07 [1] CRAN (R 3.6.1)
## callr 3.3.2 2019-09-22 [1] CRAN (R 3.6.1)
## cellranger 1.1.0 2016-07-27 [1] CRAN (R 3.6.1)
## cli 1.1.0 2019-03-19 [1] CRAN (R 3.6.1)
## colorspace 1.4-1 2019-03-18 [1] CRAN (R 3.6.1)
## crayon 1.3.4 2017-09-16 [1] CRAN (R 3.6.1)
## crosstalk 1.0.0 2016-12-21 [1] CRAN (R 3.6.1)
## curl 4.2 2019-09-24 [1] CRAN (R 3.6.1)
## desc 1.2.0 2018-05-01 [1] CRAN (R 3.6.1)
## devtools * 2.2.1 2019-09-24 [1] CRAN (R 3.6.1)
## digest 0.6.21 2019-09-20 [1] CRAN (R 3.6.1)
## dplyr * 0.8.3 2019-07-04 [1] CRAN (R 3.6.1)
## DT * 0.9 2019-09-17 [1] CRAN (R 3.6.1)
## ellipsis 0.3.0 2019-09-20 [1] CRAN (R 3.6.1)
## evaluate 0.14 2019-05-28 [1] CRAN (R 3.6.1)
## forcats * 0.4.0 2019-02-17 [1] CRAN (R 3.6.1)
## fs 1.3.1 2019-05-06 [1] CRAN (R 3.6.1)
## generics 0.0.2 2018-11-29 [1] CRAN (R 3.6.1)
## ggplot2 * 3.2.0 2019-06-16 [1] CRAN (R 3.6.0)
## glue 1.3.1 2019-03-12 [1] CRAN (R 3.6.1)
## gtable 0.3.0 2019-03-25 [1] CRAN (R 3.6.1)
## haven 2.1.1 2019-07-04 [1] CRAN (R 3.6.1)
## hms 0.5.1 2019-08-23 [1] CRAN (R 3.6.1)
## htmltools 0.3.6 2017-04-28 [1] CRAN (R 3.6.1)
## htmlwidgets 1.3 2018-09-30 [1] CRAN (R 3.6.1)
## httpuv * 1.5.2 2019-09-11 [1] CRAN (R 3.6.1)
## httr 1.4.1 2019-08-05 [1] CRAN (R 3.6.1)
## jsonlite 1.6 2018-12-07 [1] CRAN (R 3.6.1)
## knitr 1.25 2019-09-18 [1] CRAN (R 3.6.1)
## labeling 0.3 2014-08-23 [1] CRAN (R 3.6.0)
## later 0.8.0 2019-02-11 [1] CRAN (R 3.6.1)
## lattice 0.20-38 2018-11-04 [1] CRAN (R 3.6.1)
## lazyeval 0.2.2 2019-03-15 [1] CRAN (R 3.6.1)
## lubridate 1.7.4 2018-04-11 [1] CRAN (R 3.6.1)
## magrittr * 1.5 2014-11-22 [1] CRAN (R 3.6.1)
## memoise 1.1.0 2017-04-21 [1] CRAN (R 3.6.1)
## mime 0.7 2019-06-11 [1] CRAN (R 3.6.0)
## modelr 0.1.5 2019-08-08 [1] CRAN (R 3.6.1)
## munsell 0.5.0 2018-06-12 [1] CRAN (R 3.6.1)
## nlme 3.1-140 2019-05-12 [1] CRAN (R 3.6.1)
## pillar 1.4.2 2019-06-29 [1] CRAN (R 3.6.1)
## pkgbuild 1.0.5 2019-08-26 [1] CRAN (R 3.6.1)
## pkgconfig 2.0.3 2019-09-22 [1] CRAN (R 3.6.1)
## pkgload 1.0.2 2018-10-29 [1] CRAN (R 3.6.1)
## prettyunits 1.0.2 2015-07-13 [1] CRAN (R 3.6.1)
## processx 3.4.1 2019-07-18 [1] CRAN (R 3.6.1)
## promises 1.0.1 2018-04-13 [1] CRAN (R 3.6.1)
## ps 1.3.0 2018-12-21 [1] CRAN (R 3.6.1)
## purrr * 0.3.2 2019-03-15 [1] CRAN (R 3.6.1)
## R6 2.4.1 2019-11-12 [1] CRAN (R 3.6.1)
## Rcpp 1.0.2 2019-07-25 [1] CRAN (R 3.6.1)
## readr * 1.3.1 2018-12-21 [1] CRAN (R 3.6.1)
## readxl 1.3.1 2019-03-13 [1] CRAN (R 3.6.1)
## remotes 2.1.0 2019-06-24 [1] CRAN (R 3.6.1)
## rlang 0.4.0 2019-06-25 [1] CRAN (R 3.6.1)
## rmarkdown 1.15 2019-08-21 [1] CRAN (R 3.6.1)
## RonFHIR * 0.3.0 2019-11-25 [1] Github (FirelyTeam/RonFHIR@d086672)
## rprojroot 1.3-2 2018-01-03 [1] CRAN (R 3.6.1)
## rstudioapi 0.10 2019-03-19 [1] CRAN (R 3.6.1)
## rvest 0.3.4 2019-05-15 [1] CRAN (R 3.6.1)
## scales 1.0.0 2018-08-09 [1] CRAN (R 3.6.1)
## sessioninfo 1.1.1 2018-11-05 [1] CRAN (R 3.6.1)
## shiny 1.3.2 2019-04-22 [1] CRAN (R 3.6.1)
## stringi 1.4.3 2019-03-12 [1] CRAN (R 3.6.0)
## stringr * 1.4.0 2019-02-10 [1] CRAN (R 3.6.1)
## testthat 2.2.1 2019-07-25 [1] CRAN (R 3.6.1)
## tibble * 2.1.3 2019-06-06 [1] CRAN (R 3.6.1)
## tidyr * 0.8.3 2019-03-01 [1] CRAN (R 3.6.1)
## tidyselect 0.2.5 2018-10-11 [1] CRAN (R 3.6.1)
## tidyverse * 1.2.1 2017-11-14 [1] CRAN (R 3.6.1)
## usethis * 1.5.1 2019-07-04 [1] CRAN (R 3.6.1)
## vctrs 0.2.0 2019-07-05 [1] CRAN (R 3.6.1)
## withr 2.1.2 2018-03-15 [1] CRAN (R 3.6.1)
## xfun 0.9 2019-08-21 [1] CRAN (R 3.6.1)
## xml2 1.2.2 2019-08-09 [1] CRAN (R 3.6.1)
## xtable 1.8-4 2019-04-21 [1] CRAN (R 3.6.1)
## yaml 2.2.0 2018-07-25 [1] CRAN (R 3.6.0)
## zeallot 0.1.0 2018-01-28 [1] CRAN (R 3.6.1)
##
## [1] C:/Users/huserv/R/R-3.6.1/library