Implement CQL ValueSet Retrieve

docs/.vitepress/config.ts

@@ -114,7 +114,7 @@ export default defineConfig({
                 collapsed: true,
                 items: [
                   { text: "$compact", link: "/api/operation/compact" },
-                  { text: "$cql", link: "/api/operation/cql" }
+                  { text: "$cql", link: "/api/operation/cql" },
                 ],
               },
               {
@@ -166,6 +166,7 @@ export default defineConfig({
       {
         text: "CQL Queries",
         items: [
+          { text: "Overview", link: "/cql-queries" },
           { text: "via blazectl", link: "/cql-queries/blazectl" },
           { text: "via API", link: "/cql-queries/api" },
           { text: "Conformance", link: "/conformance/cql" },

docs/performance/cql/condition-sct-disease.cql

@@ -0,0 +1,10 @@
+library "condition-sct-disease"
+using FHIR version '4.0.0'
+include FHIRHelpers version '4.0.0'
+
+valueset sct_disease: 'http://fhir.org/VCL?v1=(http://snomed.info/sct)concept<<22253000'
+
+context Patient
+
+define InInitialPopulation:
+  exists [Condition: sct_disease]

docs/performance/cql/condition-sct-disease.yml

@@ -0,0 +1,5 @@
+library: cql/condition-sct-disease.cql
+group:
+- type: Patient
+  population:
+  - expression: InInitialPopulation

docs/terminology-service/vcl.md

@@ -2,9 +2,38 @@
 
 > [!CAUTION]
 > The VCL standard is curently in development. The implementation in currently **beta**.
- 
+
 The VCL documentation can be found [here](https://build.fhir.org/ig/FHIR/ig-guidance/vcl.html).
 
+## Operations
+
+The following operations support VCL:
+
+* [ValueSet \$expand](../api/operation/value-set-expand.md)
+* [ValueSet \$validate-code](../api/operation/value-set-validate-code.md)
+
+## Usage
+
+ValueSets can be created on-the-fly by using the ValueSet Compose Language (VCL) at any place where a ValueSet URL can be specified.
+
+A VCL implicit value set URL has two parts:
+
+* The base URL which is `http://fhir.org/VCL`
+* A query portion that specifies the VCL expression itself: `?v1=<expression>` where `<expression>` is the percent-encoded VCL expression.
+
+**Example:**
+
+To use the VCL expression `(http://loinc.org)COMPONENT=LP14449-0`, the full URL would be:
+
+`http://fhir.org/VCL?v1=(http://loinc.org)COMPONENT=LP14449-0` (properly encoded in actual usage).
+
+### Examples
+
+| Expression                                          | URL                                                                        |
+|-----------------------------------------------------|----------------------------------------------------------------------------|
+| `(http://loinc.org)(parent^{LP46821-2,LP259418-4})` | `http://fhir.org/VCL?v1=(http://loinc.org)(parent^{LP46821-2,LP259418-4})` |
+| `(http://snomed.info/sct)concept<<119297000`        | `http://fhir.org/VCL?v1=(http://snomed.info/sct)concept<<119297000`        |
+
 ## Tested VCL Expressions
 
 ```

modules/admin-api/test/blaze/admin_api_test.clj

@@ -31,6 +31,8 @@
    [blaze.module.test-util :refer [given-failed-system with-system]]
    [blaze.page-store-spec]
    [blaze.page-store.local]
+   [blaze.terminology-service :as-alias ts]
+   [blaze.terminology-service.local :as local]
    [blaze.test-util :as tu]
    [blaze.util-spec]
    [clojure.spec.alpha :as s]
@@ -189,7 +191,15 @@
      [:blaze.db.node.resource-indexer/executor :blaze.db.node.resource-indexer.admin/executor] {}
 
      :blaze.db/search-param-registry
-     {:structure-definition-repo structure-definition-repo}
+     {:structure-definition-repo structure-definition-repo
+      :terminology-service (ig/ref ::ts/local)}
+
+     ::ts/local
+     {:clock (ig/ref :blaze.test/fixed-clock)
+      :rng-fn (ig/ref :blaze.test/fixed-rng-fn)
+      :graph-cache (ig/ref ::local/graph-cache)}
+
+     ::local/graph-cache {}
 
      [:blaze.fhir/parsing-context :blaze.fhir.parsing-context/default]
      {:structure-definition-repo structure-definition-repo}

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

@@ -15,6 +15,7 @@
    [blaze.elm.resource :as cr]
    [blaze.elm.spec]
    [blaze.elm.util :as elm-util]
+   [blaze.elm.value-set :as value-set]
    [blaze.fhir.spec.references :as fsr]
    [blaze.util :refer [str]]
    [prometheus.alpha :as prom :refer [defcounter]]))
@@ -26,9 +27,6 @@
   {:namespace "blaze"
    :subsystem "cql"})
 
-(defn- code->clause-value [{:keys [system code]}]
-  (str system "|" code))
-
 (defn- code-expr
   "Returns an expression which, when evaluated, returns all resources of type
   `data-type` which have a code equivalent to `code` at `property` and are
@@ -37,26 +35,24 @@
   Example:
   * data-type - \"Observation\"
   * eval-context - \"Patient\"
-  * property - \"code\"
-  * codes - [(code \"http://loinc.org\" nil \"39156-5\")]"
-  [node eval-context data-type property codes]
-  (let [clauses [(into [property] (map code->clause-value) codes)]]
-    (if-ok [type-query (d/compile-type-query node data-type clauses)
-            compartment-query (d/compile-compartment-query node eval-context
-                                                           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))
-        (-eval [_ {:keys [db]} {:keys [id]} _]
-          (prom/inc! retrieve-total)
-          (coll/eduction (cr/resource-mapper db) (d/execute-query db compartment-query id)))
-        (-form [_]
-          `(~'retrieve ~data-type ~(d/query-clauses compartment-query))))
-      throw-anom)))
+  * codes-expr - [[\"code\" \"http://loinc.org|39156-5\"]]"
+  [node eval-context data-type clauses]
+  (if-ok [type-query (d/compile-type-query node data-type clauses)
+          compartment-query (d/compile-compartment-query node eval-context
+                                                         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))
+      (-eval [_ {:keys [db]} {:keys [id]} _]
+        (prom/inc! retrieve-total)
+        (coll/eduction (cr/resource-mapper db) (d/execute-query db compartment-query id)))
+      (-form [_]
+        `(~'retrieve ~data-type ~(d/query-clauses compartment-query))))
+    throw-anom))
 
 ;; TODO: find a better solution than hard coding this case
 (def ^:private specimen-patient-expr
@@ -135,56 +131,54 @@
       (list 'retrieve (core/-form related-context-expr) data-type (d/query-clauses query)))))
 
 (defn- related-context-expr
-  [node context-expr data-type code-property codes]
-  (if (seq codes)
+  [node context-expr data-type clauses]
+  (if (seq clauses)
     (if-let [result-type-name (:result-type-name (meta context-expr))]
       (let [[value-type-ns context-type] (elm-util/parse-qualified-name result-type-name)]
         (if (= "http://hl7.org/fhir" value-type-ns)
-          (let [clauses [(into [code-property] (map code->clause-value) codes)]]
-            (if-ok [query (d/compile-compartment-query node context-type data-type clauses)]
-              (related-context-expr-with-codes context-expr data-type query)
-              throw-anom))
+          (if-ok [query (d/compile-compartment-query node context-type data-type clauses)]
+            (related-context-expr-with-codes context-expr data-type query)
+            throw-anom)
           (throw-anom (unsupported-type-ns-anom value-type-ns))))
       (throw-anom unsupported-related-context-expr-without-type-anom))
     (related-context-expr-without-codes context-expr data-type)))
 
-(defn- unfiltered-context-expr [node data-type code-property codes]
-  (if (empty? codes)
+(defn- unfiltered-context-expr [node data-type clauses]
+  (if (empty? clauses)
     (reify-expr core/Expression
       (-eval [_ {:keys [db]} _ _]
         (prom/inc! retrieve-total)
         (coll/eduction (cr/resource-mapper db) (d/type-list db data-type)))
       (-form [_]
         `(~'retrieve ~data-type)))
-    (let [clauses [(into [code-property] (map code->clause-value) codes)]]
-      (if-ok [query (d/compile-type-query node data-type clauses)]
-        (reify-expr core/Expression
-          (-eval [_ {:keys [db]} _ _]
-            (prom/inc! retrieve-total)
-            (coll/eduction (cr/resource-mapper db) (d/execute-query db query)))
-          (-form [_]
-            `(~'retrieve ~data-type ~(d/query-clauses query))))
-        throw-anom))))
-
-(defn- expr* [node eval-context data-type code-property codes]
-  (if (empty? codes)
+    (if-ok [query (d/compile-type-query node data-type clauses)]
+      (reify-expr core/Expression
+        (-eval [_ {:keys [db]} _ _]
+          (prom/inc! retrieve-total)
+          (coll/eduction (cr/resource-mapper db) (d/execute-query db query)))
+        (-form [_]
+          `(~'retrieve ~data-type ~(d/query-clauses query))))
+      throw-anom)))
+
+(defn- expr* [node eval-context data-type clauses]
+  (if (empty? clauses)
     (if (= data-type eval-context)
       resource-expr
       (context-expr eval-context data-type))
-    (code-expr node eval-context data-type code-property codes)))
+    (code-expr node eval-context data-type clauses)))
 
 ;; 11.1. Retrieve
 (defn- expr
-  [{:keys [node eval-context]} context-expr data-type code-property codes]
+  [{:keys [node eval-context]} context-expr data-type clauses]
   (cond
     context-expr
-    (related-context-expr node context-expr data-type code-property codes)
+    (related-context-expr node context-expr data-type clauses)
 
     (= "Unfiltered" eval-context)
-    (unfiltered-context-expr node data-type code-property codes)
+    (unfiltered-context-expr node data-type clauses)
 
     :else
-    (expr* node eval-context data-type code-property codes)))
+    (expr* node eval-context data-type clauses)))
 
 (defn- unsupported-dynamic-codes-expr-anom [codes-expr]
   (ba/unsupported
@@ -196,10 +190,17 @@
    (format "Unsupported type namespace `%s` in Retrieve expression." type-ns)
    :type-ns type-ns))
 
-(defn- compile-codes-expr [context codes-expr]
+(defn- code->clause-value [{:keys [system code]}]
+  (str system "|" code))
+
+(defn- compile-codes-expr [context code-property codes-expr]
   (let [codes-expr (core/compile* context codes-expr)]
-    (if (and (sequential? codes-expr) (every? code? codes-expr))
-      codes-expr
+    (cond
+      (and (sequential? codes-expr) (every? code? codes-expr))
+      [(into [code-property] (map code->clause-value) codes-expr)]
+      (value-set/value-set? codes-expr)
+      [[(str code-property ":in") (value-set/url codes-expr)]]
+      :else
       (throw-anom (unsupported-dynamic-codes-expr-anom codes-expr)))))
 
 (defmethod core/compile* :elm.compiler.type/retrieve
@@ -215,6 +216,5 @@
        context
        (some->> context-expr (core/compile* context))
        data-type
-       code-property
-       (some->> codes-expr (compile-codes-expr context)))
+       (some->> codes-expr (compile-codes-expr context code-property)))
       (throw-anom (unsupported-type-namespace-anom type-ns)))))

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

@@ -1,6 +1,7 @@
 (ns blaze.elm.ts-util
   (:require
    [blaze.anomaly :as ba :refer [throw-anom]]
+   [blaze.elm.code :as code]
    [blaze.fhir.spec.type :as type]))
 
 (def ^:private result-pred
@@ -12,6 +13,15 @@
     (catch Exception e
       (throw-anom (ba/fault (msg-fn (ex-message (ex-cause e))))))))
 
+(defn- to-code [{:keys [system version code]}]
+  (code/code (:value system) (:value version) (:value code)))
+
+(defn extract-codes [response msg-fn]
+  (try
+    (mapv to-code (:contains (:expansion @response)))
+    (catch Exception e
+      (throw-anom (ba/fault (msg-fn (ex-message (ex-cause e))))))))
+
 (defn code-param [code]
   {:fhir/type :fhir.Parameters/parameter
    :name #fhir/string "code"

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

@@ -6,6 +6,12 @@
    [blaze.fhir.spec.type :as type]
    [blaze.terminology-service :as ts]))
 
+(defn value-set? [x]
+  (satisfies? p/ValueSet x))
+
+(defn url [value-set]
+  (p/-url value-set))
+
 (defn contains-string? [value-set code]
   (p/-contains-string value-set code))
 
@@ -15,6 +21,9 @@
 (defn contains-concept? [value-set concept]
   (p/-contains-concept value-set concept))
 
+(defn expand [value-set]
+  (p/-expand value-set))
+
 (defn- system-param [system]
   {:fhir/type :fhir.Parameters/parameter
    :name #fhir/string "system"
@@ -47,6 +56,8 @@
         (list 'value-set url))
 
       p/ValueSet
+      (-url [_]
+        url)
       (-contains-string [_ code]
         (tu/extract-result
          (ts/value-set-validate-code
@@ -77,4 +88,14 @@
          (fn [cause-msg]
            (format
             "Error while testing that the %s is in ValueSet `%s`. Cause: %s"
-            concept url cause-msg)))))))
+            concept url cause-msg))))
+      (-expand [_]
+        (tu/extract-codes
+         (ts/expand-value-set
+          terminology-service
+           {:fhir/type :fhir/Parameters
+            :parameter [url-param]})
+         (fn [cause-msg]
+           (format
+            "Error while expanding the ValueSet `%s`. Cause: %s"
+            url cause-msg)))))))

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

@@ -1,6 +1,8 @@
 (ns blaze.elm.value-set.protocol)
 
 (defprotocol ValueSet
-  (-contains-string [_ code])
-  (-contains-code [_ code])
-  (-contains-concept [_ concept]))
+  (-url [_])
+  (-contains-string [value-set code])
+  (-contains-code [value-set code])
+  (-contains-concept [value-set concept])
+  (-expand [value-set]))