[WIP] Implement ValueSet References

Closes: #110

.clj-kondo/root/config.edn

@@ -77,6 +77,7 @@
     blaze.middleware.fhir.db db
     blaze.rest-api.header header
     blaze.scheduler sched
+    blaze.terminology-service ts
     blaze.test-util tu
     blaze.util u
     buddy.auth auth

docs/conformance/cql.md

@@ -32,8 +32,8 @@ The section numbers refer to the documentation of the [ELM Specification](https:
 | 3.8.  | ConceptRef    | ✓          |                          |       |
 | 3.9.  | Quantity      | ✓          |                          |       |
 | 3.10. | Ratio         | ✓          |                          |       |
-| 3.11. | ValueSetDef   | ✗          |                          |       |
-| 3.12. | ValueSetRef   | ✗          |                          |       |
+| 3.11. | ValueSetDef   | ✓          |                          |       |
+| 3.12. | ValueSetRef   | ✓          |                          |       |
 
 ### 4. Type Specifiers
 
@@ -373,7 +373,7 @@ The section numbers refer to the documentation of the [ELM Specification](https:
 | 23.5.  | Equal           | ✓          |
 | 23.6.  | Equivalent      | ✓          |
 | 23.7.  | InCodeSystem    | ✗          |
-| 23.8.  | InValueSet      | ✗          |
+| 23.8.  | InValueSet      | ✓          |
 | 23.9.  | ExpandValueSet  | ✗          |
 | 23.10. | Not Equal       | ✓          |
 | 23.11. | SubsumedBy      | ✗          |

modules/cql/deps.edn

@@ -4,6 +4,9 @@
  {blaze/db
   {:local/root "../db"}
 
+  blaze/terminology-service
+  {:local/root "../terminology-service"}
+
   com.fasterxml.jackson.module/jackson-module-jaxb-annotations
   {:mvn/version "2.18.1"
    :exclusions [javax.xml.bind/jaxb-api]}

modules/cql/src/blaze/elm/compiler/clinical_operators.clj

@@ -4,9 +4,12 @@
   Section numbers are according to
   https://cql.hl7.org/04-logicalspecification.html."
   (:require
+   [blaze.elm.compiler.clinical-operators.impl :as impl]
    [blaze.elm.compiler.core :as core]
    [blaze.elm.compiler.macros :refer [reify-expr]]
-   [blaze.elm.protocols :as p]))
+   [blaze.elm.concept :as concept]
+   [blaze.elm.protocols :as p]
+   [blaze.elm.value-set :as value-set]))
 
 ;; 23.3. CalculateAge
 ;;
@@ -42,3 +45,30 @@
     (when-let [date (core/compile* context date)]
       (let [chrono-precision (some-> precision core/to-chrono-unit)]
         (calculate-age-at-op birth-date date chrono-precision precision)))))
+
+;; 23.8. InValueSet
+(defn- in-value-set [code value-set]
+  (reify-expr core/Expression
+    (-attach-cache [_ cache]
+      (core/attach-cache-helper in-value-set cache code value-set))
+    (-resolve-refs [_ expression-defs]
+      (core/resolve-refs-helper in-value-set expression-defs code value-set))
+    (-resolve-params [_ parameters]
+      (core/resolve-params-helper in-value-set parameters code value-set))
+    (-optimize [_ db]
+      (core/optimize-helper in-value-set db code value-set))
+    (-eval [_ context resource scope]
+      (let [value-set (core/-eval value-set context resource scope)
+            code (core/-eval code context resource scope)]
+        (cond
+          (string? code) (contains? (into #{} (map :code) value-set) code)
+          (concept/concept? code) (impl/contains-any? value-set (:codes code))
+          :else (contains? value-set (value-set/from-code code)))))
+    (-form [_]
+      (list 'in-value-set (core/-form code) (core/-form value-set)))))
+
+(defmethod core/compile* :elm.compiler.type/in-value-set
+  [context {:keys [code] value-set :valueset}]
+  (let [code (core/compile* context code)]
+    (when-let [value-set (core/compile* context value-set)]
+      (in-value-set code value-set))))

modules/cql/src/blaze/elm/compiler/clinical_operators/impl.clj

@@ -0,0 +1,9 @@
+(ns blaze.elm.compiler.clinical-operators.impl
+  (:require
+   [blaze.elm.value-set :as value-set]))
+
+(defn contains-any? [value-set [code & codes]]
+  (cond
+    (nil? code) false
+    (contains? value-set (value-set/from-code code)) true
+    :else (recur value-set codes)))

modules/cql/src/blaze/elm/compiler/clinical_values.clj

@@ -7,10 +7,14 @@
    [blaze.anomaly :as ba :refer [throw-anom]]
    [blaze.elm.code :as code]
    [blaze.elm.compiler.core :as core]
+   [blaze.elm.compiler.macros :refer [reify-expr]]
    [blaze.elm.concept :refer [concept]]
    [blaze.elm.date-time :as date-time]
    [blaze.elm.quantity :refer [quantity]]
-   [blaze.elm.ratio :refer [ratio]]))
+   [blaze.elm.ratio :refer [ratio]]
+   [blaze.elm.value-set :as value-set]
+   [blaze.fhir.spec.type :as type]
+   [blaze.terminology-service :as ts]))
 
 (defn- find-code-system-def
   "Returns the code-system-def with `name` from `library` or nil if not found."
@@ -113,5 +117,31 @@
 ;; Not needed because it's not an expression.
 
 ;; 3.12. ValueSetRef
-;;
-;; TODO
+(defn- find-value-set-def
+  "Returns the value-set-def with `name` from `library` or nil if not found."
+  {:arglists '([library name])}
+  [{{value-set-defs :def} :valueSets} name]
+  (some #(when (= name (:name %)) %) value-set-defs))
+
+(defn- to-code [{:keys [system code]}]
+  (value-set/->Code (type/value system) (type/value code)))
+
+(defn- value-set [{{:keys [contains]} :expansion}]
+  (into #{} (map to-code) contains))
+
+(defn- expand-value-set [terminology-service request]
+  (try
+    @(ts/expand-value-set terminology-service request)
+    (catch Exception e
+      (throw (ex-cause e)))))
+
+(defmethod core/compile* :elm.compiler.type/value-set-ref
+  [{:keys [library terminology-service]} {:keys [name]}]
+  (when-let [{:keys [id]} (find-value-set-def library name)]
+    (reify-expr core/Expression
+      (-optimize [_ db]
+        (value-set (expand-value-set terminology-service {:db db :url id})))
+      (-eval [_ _ _ _]
+        (throw-anom (ba/fault "Can't eval value-set expression without optimization.")))
+      (-form [_]
+        (list 'value-set id)))))

modules/cql/src/blaze/elm/compiler/core.clj

@@ -5,7 +5,7 @@
    [blaze.fhir.spec.type.system :as system]
    [clojure.string :as str])
   (:import
-   [clojure.lang IReduceInit]
+   [clojure.lang IPersistentSet IReduceInit]
    [java.time.temporal ChronoUnit]))
 
 (set! *warn-on-reflection* true)
@@ -200,7 +200,25 @@
   (-eval [expr _ _ _]
     expr)
   (-form [expr]
-    (mapv -form expr)))
+    (mapv -form expr))
+
+  IPersistentSet
+  (-static [_]
+    true)
+  (-attach-cache [expr _]
+    [(fn [] [expr])])
+  (-patient-count [_]
+    nil)
+  (-resolve-refs [expr _]
+    expr)
+  (-resolve-params [expr _]
+    expr)
+  (-optimize [expr _]
+    expr)
+  (-eval [expr _ _ _]
+    expr)
+  (-form [expr]
+    `(~'set ~@(mapv -form expr))))
 
 (defmulti compile*
   "Compiles `expression` in `context`.

modules/cql/src/blaze/elm/compiler/external_data.clj

@@ -44,6 +44,8 @@
                                                            data-type clauses)]
       (reify-expr core/Expression
         (-optimize [expr db]
+         ;; if there is no resource, regardless of the individual patient,
+         ;; available, just return an empty list for further optimizations
           (if (coll/empty? (d/execute-query db type-query))
             []
             expr))

modules/cql/src/blaze/elm/compiler/library.clj

@@ -97,9 +97,9 @@
   :function-defs and :parameter-default-values.
 
   There are currently no options."
-  [node library opts]
+  [context library opts]
   (let [library (normalizer/normalize-library library)
-        context (assoc opts :node node :library library)]
+        context (merge opts context {:library library})]
     (when-ok [{:keys [function-defs] :as context} (compile-function-defs context library)
               expression-defs (expression-defs context library)
               expression-defs (resolve-refs (unfiltered-expr-names expression-defs) expression-defs)

modules/cql/src/blaze/elm/compiler/library/spec.clj

@@ -5,6 +5,7 @@
    [blaze.elm.compiler.function-def :as-alias function-def]
    [blaze.elm.compiler.spec]
    [blaze.fhir.spec.spec]
+   [blaze.terminology-service.spec]
    [clojure.spec.alpha :as s]))
 
 (s/def ::expression-def/name
@@ -40,5 +41,8 @@
 (s/def ::c/library
   (s/keys :req-un [::c/expression-defs ::c/function-defs ::c/parameter-default-values]))
 
+(s/def ::c/context
+  (s/keys :req-un [:blaze.db/node :blaze/terminology-service]))
+
 (s/def ::c/options
   map?)

modules/cql/src/blaze/elm/compiler/library_spec.clj

@@ -11,7 +11,7 @@
    [cognitect.anomalies :as-alias anom]))
 
 (s/fdef library/compile-library
-  :args (s/cat :node :blaze.db/node :library :elm/library :opts ::c/options)
+  :args (s/cat :context ::c/context :library :elm/library :opts ::c/options)
   :ret (s/or :library ::c/library :anomaly ::anom/anomaly))
 
 (s/fdef library/resolve-all-refs

modules/cql/src/blaze/elm/concept.clj

@@ -33,6 +33,9 @@
   (-form [_]
     `(~'concept ~@(map core/-form codes))))
 
+(defn concept? [x]
+  (instance? Concept x))
+
 (defn concept
   "Returns a CQL concept"
   [codes]

modules/cql/src/blaze/elm/spec.clj

@@ -208,7 +208,7 @@
 ;; 3. Clinical Values
 
 (s/def :elm/code-system-ref
-  (s/keys :opt-un [:elm/name :elm/libraryName]))
+  (s/keys :req-un [:elm/name] :opt-un [:elm/libraryName]))
 
 ;; 3.1. Code
 (s/def :elm.code/system
@@ -237,7 +237,7 @@
 
 ;; 3.3. CodeRef
 (s/def :elm/code-ref
-  (s/keys :opt-un [:elm/name :elm/libraryName]))
+  (s/keys :req-un [:elm/name] :opt-un [:elm/libraryName]))
 
 (defmethod expression :elm.spec.type/code-ref [_]
   :elm/code-ref)
@@ -271,7 +271,7 @@
 
 ;; 3.8. ConceptRef
 (s/def :elm/concept-ref
-  (s/keys :opt-un [:elm/name :elm/libraryName]))
+  (s/keys :req-un [:elm/name] :opt-un [:elm/libraryName]))
 
 (defmethod expression :elm.spec.type/concept-ref [_]
   :elm/concept-ref)
@@ -362,6 +362,25 @@
 (defmethod expression :elm.spec.type/ratio [_]
   :elm/ratio)
 
+;; 3.11. ValueSetDef
+(s/def :elm.value-set-def/codeSystem
+  (s/coll-of :elm/code-system-ref))
+
+(s/def :elm/value-set-def
+  (s/keys :req-un [:elm/name :elm/id]
+          :opt-un [:elm/version :elm.value-set-def/codeSystem]))
+
+;; 3.12. ValueSetRef
+(s/def :elm.value-set-ref/preserve
+  boolean?)
+
+(s/def :elm/value-set-ref
+  (s/keys :req-un [:elm/name]
+          :opt-un [:elm/libraryName :elm.value-set-ref/preserve]))
+
+(defmethod expression :elm.spec.type/value-set-ref [_]
+  :elm/value-set-ref)
+
 ;; 4. Type Specifiers
 
 ;; 4.1. TypeSpecifier
@@ -392,7 +411,8 @@
   :elm/type-specifier)
 
 (s/def :elm/tuple-element-definition
-  (s/keys :req-un [:elm/name] :opt-un [:elm.tuple-element-definition/type :elm/elementType]))
+  (s/keys :req-un [:elm/name]
+          :opt-un [:elm.tuple-element-definition/type :elm/elementType]))
 
 (s/def :elm.tuple-type-specifier/element
   (s/coll-of :elm/tuple-element-definition))
@@ -474,7 +494,7 @@
 
 ;; 7.2. ParameterRef
 (defmethod expression :elm.spec.type/parameter-ref [_]
-  (s/keys :opt-un [:elm/name :elm/libraryName]))
+  (s/keys :req-un [:elm/name] :opt-un [:elm/libraryName]))
 
 ;; 8. Expressions
 
@@ -1479,3 +1499,18 @@
 (defmethod expression :elm.spec.type/calculate-age-at [_]
   (s/keys :req-un [:elm.binary-expression/operand]
           :opt-un [:elm.date/precision]))
+
+;; 23.8. InValueSet
+(s/def :elm.in-value-set/code
+  :elm/expression)
+
+(s/def :elm.in-value-set/valueset
+  :elm/value-set-ref)
+
+(s/def :elm.in-value-set/valuesetExpression
+  :elm/expression)
+
+(defmethod expression :elm.spec.type/in-value-set [_]
+  (s/keys :req-un [:elm.in-value-set/code]
+          :opt-un [:elm.in-value-set/valueset
+                   :elm.in-value-set/valuesetExpression]))

modules/cql/src/blaze/elm/value_set.clj

@@ -0,0 +1,27 @@
+(ns blaze.elm.value-set
+  (:require
+   [blaze.elm.compiler.core :as core]))
+
+;; A code without it's version and display so that it's Clojure equal operation
+;; will be the CQL equivalence operation.
+(defrecord Code [system code]
+  core/Expression
+  (-static [_]
+    true)
+  (-attach-cache [expr _]
+    [(fn [] [expr])])
+  (-patient-count [_]
+    nil)
+  (-resolve-refs [expr _]
+    expr)
+  (-resolve-params [expr _]
+    expr)
+  (-optimize [expr _]
+    expr)
+  (-eval [this _ _ _]
+    this)
+  (-form [_]
+    `(~'code ~system ~code)))
+
+(defn from-code [{:keys [system code]}]
+  (->Code system code))

modules/cql/test/blaze/cql/translator_test.clj

@@ -85,6 +85,30 @@
       [1 :expression :operand 0 :operand :source :name] := "Patient"
       [1 :expression :operand 1 :type] := "Literal"))
 
+  (testing "Valueset"
+    (given-translation
+      "library Test
+      using FHIR version '4.0.0'
+      include FHIRHelpers version '4.0.0'
+      valueset \"Female Administrative Sex\": 'urn:oid:2.16.840.1.113883.3.560.100.2'
+      context Patient
+      define \"PatientIsFemale\": Patient.gender in \"Female Administrative Sex\""
+      [0 :name] := "Patient"
+      [0 :context] := "Patient"
+      [0 :expression :type] := "SingletonFrom"
+      [0 :expression :operand :type] := "Retrieve"
+      [0 :expression :operand :dataType] := "{http://hl7.org/fhir}Patient"
+      [1 :name] := "PatientIsFemale"
+      [1 :context] := "Patient"
+      [1 :expression :type] := "InValueSet"
+      [1 :expression :resultTypeName] := "{urn:hl7-org:elm-types:r1}Boolean"
+      [1 :expression :valueset :name] := "Female Administrative Sex"
+      [1 :expression :code :type] := "FunctionRef"
+      [1 :expression :code :name] := "ToString"
+      [1 :expression :code :operand 0 :type] := "Property"
+      [1 :expression :code :operand 0 :source :type] := "ExpressionRef"
+      [1 :expression :code :operand 0 :source :name] := "Patient"))
+
   (testing "Returns a valid :elm/library"
     (are [cql] (s/valid? :elm/library (translate cql))
       "library Test