[WIP] Add Operation evaluate-measure

Dockerfile

@@ -7,11 +7,11 @@ RUN lein uberjar
 
 FROM openjdk:8u212-jre-alpine3.9
 
-COPY --from=build /build/target/blaze-0.6-alpha52-standalone.jar /app/
+COPY --from=build /build/target/blaze-0.6-alpha58-standalone.jar /app/
 COPY fhir /app/fhir/
 
 WORKDIR /app
 
 EXPOSE 80
 
-CMD ["/bin/sh", "-c", "java $JVM_OPTS -jar blaze-0.6-alpha52-standalone.jar"]
+CMD ["/bin/sh", "-c", "java $JVM_OPTS -jar blaze-0.6-alpha58-standalone.jar"]

dev/user.clj

@@ -19,7 +19,6 @@
     [blaze.elm.type-infer :as type-infer]
     [blaze.datomic.cql :as datomic-cql]
     [blaze.datomic.pull]
-    [blaze.datomic.schema :as schema]
     [blaze.datomic.util :as datomic-util]
     [blaze.spec]
     [blaze.structure-definition :refer [read-structure-definitions read-other]]
@@ -91,7 +90,9 @@
   (def db (d/db conn))
   (def now (OffsetDateTime/now))
 
-  (def library (cql/translate (slurp "queries/time-based-2.cql")))
+  (def library (cql/translate (slurp "queries/q1-gender.cql")))
+  (def library (cql/translate (slurp "queries/q2-bmi.cql")))
+  (def library (cql/translate (slurp "queries/q3-storage-temperature.cql")))
 
   (-> library
       normalizer/normalize-library
@@ -123,3 +124,13 @@
   (println (:body (prom/dump-metrics)))
 
   )
+
+;; Extract Codes from Code System
+(comment
+  (mapcat
+    (fn [{:strs [code concept]}]
+      (if concept
+        (cons code (map #(get % "code") concept))
+        [code]))
+    (cheshire.core/parse-string ""))
+  )

evaluate-measure.sh

@@ -0,0 +1,113 @@
+#!/usr/bin/env bash
+
+# Usage: ./evaluate-measure.sh -f <query>.cql <server-base>
+
+# Takes a CQL file, creates a Library resource from it, references that from a
+# Measure resource and calls $evaluate-measure on it.
+
+library() {
+cat <<END
+{
+  "resourceType": "Library",
+  "content": [
+    {
+      "contentType": "text/cql"
+    }
+  ]
+}
+END
+}
+
+measure() {
+cat <<END
+{
+  "resourceType": "Measure",
+  "status": "active",
+  "subjectCodeableConcept": {
+    "coding": [
+      {
+        "system": "http://hl7.org/fhir/resource-types",
+        "code": "Patient"
+      }
+    ]
+  },
+  "scoring": {
+    "coding": [
+      {
+        "system": "http://terminology.hl7.org/CodeSystem/measure-scoring",
+        "code": "cohort"
+      }
+    ]
+  },
+  "group": [
+    {
+      "population": [
+        {
+          "code": {
+            "coding": [
+              {
+                "system": "http://terminology.hl7.org/CodeSystem/measure-population",
+                "code": "initial-population"
+              }
+            ]
+          },
+          "criteria": {
+            "language": "text/cql",
+            "expression": "InInitialPopulation"
+          }
+        }
+      ]
+    }
+  ]
+}
+END
+}
+
+create-library() {
+  library | jq -cM ".url = \"urn:uuid:$1\" | .content[0].data = \"$2\""
+}
+
+create-measure() {
+  measure | jq -cM ".url = \"urn:uuid:$1\" | .library[0] = \"urn:uuid:$2\""
+}
+
+post() {
+  curl -sH "Content-Type: application/fhir+json" -d @- "${BASE}/$1"
+}
+
+evaluate-measure() {
+  time curl -s "${BASE}/Measure/$1/\$evaluate-measure?periodStart=2000&periodEnd=2019"
+}
+
+usage()
+{
+  echo "Usage: $0 [ -f QUERY_FILE ] BASE"
+  exit 2
+}
+
+unset FILE BASE
+
+while getopts 'f:' c
+do
+  case ${c} in
+    f) FILE=$OPTARG ;;
+  esac
+done
+
+shift $((OPTIND-1))
+BASE=$1
+
+[[ -z "$FILE" ]] && usage
+[[ -z "$BASE" ]] && usage
+
+DATA=$(cat ${FILE} | base64 | tr -d '\n')
+LIBRARY_URI=$(uuidgen | tr '[:upper:]' '[:lower:]')
+MEASURE_URI=$(uuidgen | tr '[:upper:]' '[:lower:]')
+
+create-library ${LIBRARY_URI} ${DATA} | post "Library" > /dev/null
+
+MEASURE_ID=$(create-measure ${MEASURE_URI} ${LIBRARY_URI} | post "Measure" | jq -r .id)
+
+COUNT=$(evaluate-measure ${MEASURE_ID} | jq ".group[0].population[0].count")
+
+echo "Count: ${COUNT}"

integration-test/query-3/query.cql

@@ -10,7 +10,7 @@ code "Seronegative chronische Polyarthritis": 'M06.9' from "ICD-10-GM:2019"
 context Patient
 
 define Qualifies:
-  Exists([Condition: "Seronegative chronische Polyarthritis"] C
+  exists([Condition: "Seronegative chronische Polyarthritis"] C
           where AgeInYearsAt(C.onset) >= 18)
 
 context Population

integration-test/query-5/query.cql

@@ -10,9 +10,9 @@ code "Thrombotische Mikroangiopathie": 'M31.1' from "ICD-10-GM:2019"
 context Patient
 
 define Qualifies:
-  Exists([Condition: "Weichteilsarkom"]) or
-  Exists([Condition: "Speicheldrüsenkrebs"]) or
-  Exists([Condition: "Thrombotische Mikroangiopathie"])
+  exists([Condition: "Weichteilsarkom"]) or
+  exists([Condition: "Speicheldrüsenkrebs"]) or
+  exists([Condition: "Thrombotische Mikroangiopathie"])
 
 context Population
 

integration-test/query-6/query.cql

@@ -10,7 +10,7 @@ code "tissue frozen": 'tissue frozen' from "Sample type tissue"
 context Patient
 
 define Qualifies:
-  Exists([Condition: "Brustkrebs"]) and Exists([Specimen: "tissue frozen"])
+  exists([Condition: "Brustkrebs"]) and exists([Specimen: "tissue frozen"])
 
 context Population
 

integration-test/query-7/query.cql

@@ -15,10 +15,10 @@ code "Vollblut-EDTA": 'whole_blood-EDTA' from "Sample type liquid"
 context Patient
 
 define Qualifies:
-  (Exists([Condition: "Morbus Crohn"]) or Exists([Condition: "Colitis ulcerosa"])) and
-  Exists([Specimen: "Tumorgewebe"]) and
-  Exists([Specimen: "Gesundes Gewebe"]) and
-  (Exists([Specimen: "Serum"]) or Exists([Specimen: "Vollblut-EDTA"]))
+  (exists([Condition: "Morbus Crohn"]) or exists([Condition: "Colitis ulcerosa"])) and
+  exists([Specimen: "Tumorgewebe"]) and
+  exists([Specimen: "Gesundes Gewebe"]) and
+  (exists([Specimen: "Serum"]) or exists([Specimen: "Vollblut-EDTA"]))
 
 context Population
 

project.clj

@@ -1,4 +1,4 @@
-(defproject blaze "0.6-alpha52"
+(defproject blaze "0.6-alpha58"
   :description "A FHIR Store with internal, fast CQL Evaluation Engine"
   :url "https://github.com/life-research/blaze"
 

src/blaze/bundle.clj

@@ -3,8 +3,11 @@
   (:require
     [blaze.datomic.transaction :as tx]
     [blaze.datomic.util :as util]
+    [blaze.deferred :as bd]
+    [blaze.terminology-service :refer [term-service?]]
     [clojure.spec.alpha :as s]
     [datomic-spec.core :as ds]
+    [manifold.deferred :as md :refer [deferred?]]
     [prometheus.alpha :as prom :refer [defhistogram]]
     [reitit.core :as reitit]))
 
@@ -117,6 +120,23 @@
     entries))
 
 
+(s/fdef annotate-codes
+  :args (s/cat :term-service term-service? :db ::ds/db :entries coll?)
+  :ret deferred?)
+
+(defn annotate-codes
+  [term-service db entries]
+  (transduce
+    (bd/map
+      (fn [{:strs [resource] :as entry}]
+        (if resource
+          (-> (tx/annotate-codes term-service db resource)
+              (md/chain' #(assoc entry "resource" %)))
+          entry)))
+    conj
+    entries))
+
+
 (defmulti entry-tx-data (fn [_ _ {{:strs [method]} "request"}] method))
 
 

src/blaze/cql_translator.clj

@@ -7,21 +7,26 @@
     [org.cqframework.cql.cql2elm CqlTranslator CqlTranslator$Options
                                  FhirLibrarySourceProvider LibraryManager ModelManager]))
 
+
+(set! *warn-on-reflection* true)
+
+
 (defn- options [locators?]
   (->> (cond-> [CqlTranslator$Options/EnableResultTypes]
          locators?
          (conj CqlTranslator$Options/EnableLocators))
        (into-array CqlTranslator$Options)))
 
+
 (defn translate [cql & {:keys [locators?]}]
   (let [model-manager (ModelManager.)
         library-manager (LibraryManager. model-manager)
         _ (.registerProvider (.getLibrarySourceLoader library-manager) (FhirLibrarySourceProvider.))
-        translator (CqlTranslator/fromText cql model-manager library-manager
-                                           (options locators?))]
+        translator (CqlTranslator/fromText cql model-manager library-manager (options locators?))]
     (if-let [errors (seq (.getErrors translator))]
-      {::anom/category ::anom/fault
+      {::anom/category ::anom/invalid
        ::anom/message (apply str (map ex-message errors))
+       :cql cql
        :errors errors}
       (:library
         (binding [*use-bigdecimals?* true]

src/blaze/datomic/cql.clj

@@ -1,25 +1,11 @@
 (ns blaze.datomic.cql
   (:require
-    [blaze.datomic.util :as util]
     [clojure.spec.alpha :as s]
     [datomic.api :as d]
     [datomic-spec.core :as ds]
     [prometheus.alpha :as prom :refer [defhistogram]]))
 
 
-(defhistogram call-seconds
-  "Call times in seconds."
-  {:namespace "datomic_cql"}
-  [0.0000001 0.0000002 0.0000005
-   0.000001 0.000002 0.000005
-   0.00001 0.00002 0.00005
-   0.0001 0.0002 0.0005
-   0.001 0.002 0.005
-   0.01 0.02 0.05
-   0.1 0.2 0.5]
-  "function")
-
-
 (s/fdef list-resource-by-code
   :args (s/cat :db ::ds/db
                :data-type-name string?
@@ -39,46 +25,41 @@
 
 (s/fdef find-code
   :args (s/cat :db ::ds/db :system string? :code string?)
-  :ret ::ds/entity-id)
+  :ret ::ds/entity)
 
 (defn find-code [db system code]
-  (d/q
-    '[:find ?c .
-      :in $ ?code ?system
-      :where
-      [?c :code/code ?code]
-      [?c :code/system ?system]]
-    db code system))
+  (some->>
+    (d/q
+      '[:find ?c .
+        :in $ ?code ?system
+        :where
+        [?c :code/code ?code]
+        [?c :code/system ?system]]
+      db code system)
+    (d/entity db)))
 
 
-(defn- get-codes [db attr eid]
-  (into #{} (map :v) (d/datoms db :eavt eid attr)))
+(defn- contains-codes? [db attr eid codes]
+  (some #(seq (d/datoms db :eavt eid attr %)) codes))
 
 
 (s/fdef list-patient-resource-by-code
   :args (s/cat :patient ::ds/entity
-               :data-type-name string?
-               :code-property-name string?
+               :subject-attr keyword?
+               :code-index-attr keyword?
                :codes (s/coll-of ::ds/entity-id))
   :ret (s/coll-of ::ds/entity))
 
 (defn list-patient-resource-by-code
   "Lists resources of `patient` and of a type specified by `data-type-name`
    which refer to one of the `codes` through a property called
    `code-property-name`."
-  [patient data-type-name code-property-name codes]
-  (with-open [_ (prom/timer call-seconds "list-patient-resource-by-code")]
-    (let [db (d/entity-db patient)
-          code-index-attr (keyword (str data-type-name ".index")
-                                   code-property-name)
-          subject-attr (keyword data-type-name "subject")]
-      (into
-        []
-        (comp
-          (map :e)
-          (filter
-            (fn [e]
-              (let [cs (get-codes db code-index-attr e)]
-                (some #(contains? cs %) codes))))
-          (map (partial d/entity db)))
-        (d/datoms db :vaet (:db/id patient) subject-attr)))))
+  [patient subject-attr code-index-attr codes]
+  (let [db (d/entity-db patient)]
+    (into
+      []
+      (comp
+        (map :e)
+        (filter #(contains-codes? db code-index-attr % codes))
+        (map #(d/entity db %)))
+      (d/datoms db :vaet (:db/id patient) subject-attr))))