diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 4618778..9e3fc66 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -2,7 +2,9 @@ name: CI on: push: - branches: [main] + branches: + - main + - 'wip/**' pull_request: concurrency: @@ -211,8 +213,8 @@ jobs: - uses: actions/cache/restore@v5 id: cache with: - path: .hades/loinc-2.81.db - key: loinc-2.81-v3 + path: .hades/loinc-2.82.db + key: loinc-2.82-native-v1 - name: Provision pinned LOINC DB id: provision @@ -226,28 +228,28 @@ jobs: fi mkdir -p .hades extract_dir=$(mktemp -d) - gh release download 2.81 \ + gh release download 2.82 \ --repo wardle/loinc-releases \ - --pattern 'Loinc_2.81.zip' \ + --pattern 'Loinc_2.82.zip' \ --output "$extract_dir/loinc.zip" # Extract into a directory whose name encodes the version so - # the LOINC loader's infer-version regex (Loinc[_-]?\d+...) - # matches whether the zip unpacks to LoincTableCore/... at the - # top level or nests inside its own Loinc_2.81/ folder. - unzip -q "$extract_dir/loinc.zip" -d "$extract_dir/Loinc_2.81" - release_dir=$(dirname "$(find "$extract_dir/Loinc_2.81" -maxdepth 3 -type d -name LoincTableCore | head -n 1)") - if [ -z "$release_dir" ] || [ ! -f "$release_dir/LoincTableCore/LoincTableCore.csv" ]; then - echo "::error::Could not locate LoincTableCore/LoincTableCore.csv inside the LOINC zip." + # local path is clear in logs whether the zip unpacks files at + # the top level or nests inside its own Loinc_2.82/ folder. + unzip -q "$extract_dir/loinc.zip" -d "$extract_dir/Loinc_2.82" + loinc_table_dir=$(find "$extract_dir/Loinc_2.82" -maxdepth 4 -type d -name LoincTable | head -n 1) + release_dir=$(dirname "$loinc_table_dir") + if [ -z "$loinc_table_dir" ] || [ ! -f "$release_dir/LoincTable/Loinc.csv" ]; then + echo "::error::Could not locate LoincTable/Loinc.csv inside the LOINC zip." exit 1 fi - clojure -M:run import compact .hades/loinc-2.81.db "$release_dir" + clojure -M:run import compact .hades/loinc-2.82.db "$release_dir" rm -rf "$extract_dir" - uses: actions/cache/save@v5 if: always() && steps.provision.outcome == 'success' with: - path: .hades/loinc-2.81.db - key: loinc-2.81-v3 + path: .hades/loinc-2.82.db + key: loinc-2.82-native-v1 # The install CLI downloads + extracts + imports in one shot: # --cache-dir lands extracted JSON at /-/package/ @@ -362,8 +364,8 @@ jobs: - uses: actions/cache/restore@v5 with: - path: .hades/loinc-2.81.db - key: loinc-2.81-v3 + path: .hades/loinc-2.82.db + key: loinc-2.82-native-v1 fail-on-cache-miss: true - uses: actions/cache/restore@v5 @@ -426,8 +428,8 @@ jobs: - uses: actions/cache/restore@v5 with: - path: .hades/loinc-2.81.db - key: loinc-2.81-v3 + path: .hades/loinc-2.82.db + key: loinc-2.82-native-v1 fail-on-cache-miss: true # Cache the tx-ecosystem clone keyed on the pinned commit. Bump @@ -498,8 +500,8 @@ jobs: - uses: actions/cache/restore@v5 with: - path: .hades/loinc-2.81.db - key: loinc-2.81-v3 + path: .hades/loinc-2.82.db + key: loinc-2.82-native-v1 fail-on-cache-miss: true - uses: actions/cache/restore@v5 @@ -526,7 +528,7 @@ jobs: run: | clojure -M:run serve \ .hades/snomed-intl-20250201.db \ - .hades/loinc-2.81.db \ + .hades/loinc-2.82.db \ .hades/fhir-smoke.db \ --port 8080 & echo $! > hades.pid diff --git a/CLAUDE.md b/CLAUDE.md index 7bb054a..b72f981 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -127,42 +127,47 @@ Source layout: - `src/com/eldrix/hades/core.clj` — public library API: service lifecycle and the FHIR terminology operations as plain Clojure functions. Read the ns docstring for the current surface. -- `src/com/eldrix/hades/impl/**` — library internals. Subject to breaking - changes; nothing outside the project should depend on these namespaces. -- `src/com/eldrix/hades/cmd.clj` + `impl/cli.clj` — CLI application - (entry point + option parsing). Not part of the library surface. - -The internal layering under `impl/` (read each file for the current -public surface — names drift, the layering doesn't): +- `src/com/eldrix/hades/composite.clj` — TerminologyService that dispatches + across registered providers; what `core` returns. +- `src/com/eldrix/hades/protocols/**` — `CodeSystem`, `ValueSet`, + `ConceptMap` interfaces plus result/input specs. The contract between + composite and providers. +- `src/com/eldrix/hades/providers/**` — one subdirectory per provider; + `providers/common/` holds shared provider helpers. +- `src/com/eldrix/hades/impl/**` — transport / wire layer (HTTP, MCP, + CLI parsing, wire shaping, source walking). Subject to breaking change. +- `src/com/eldrix/hades/cmd.clj` + `impl/cli.clj` — CLI application. + +Layering (read each file for the current public surface — names drift, +the layering doesn't): ``` -impl/http.clj Pedestal HTTP layer — routes, interceptors, - Parameters parsing, content negotiation +impl/http.clj Pedestal HTTP — routes, interceptors, + Parameters parsing, content negotiation +impl/mcp/{server,tools}.clj MCP stdio transport + tool definitions + │ +impl/wire.clj, impl/metadata.clj Pure FHIR JSON map builders (string-keyed) │ -impl/wire.clj Pure FHIR JSON map builders (string-keyed) -impl/metadata.clj +composite.clj TerminologyService — dispatch by URL/version, + cross-provider concerns (status warnings, + supplements check, CodeableConcept aggregation) │ -impl/composite.clj TerminologyService — dispatch by URL/version, - cross-provider concerns (status warnings, - supplements check, CodeableConcept aggregation) +protocols.clj, protocols/{input,result} Abstract interfaces + result/input specs │ -impl/protocols/ Abstract interfaces and result/input specs - (CodeSystem, ValueSet, ConceptMap) +providers/snomed/{provider,batch, SNOMED CT via Hermes + expansion}.clj +providers/in_memory/{provider,index}.clj In-memory providers + indexer +providers/ftrm/{provider,db,index}.clj FTRM (SQLite-backed) provider + container + indexer +providers/loinc/{loader,store,index, Native LOINC provider + container + indexer + import,provider,model} +providers/common/ Shared provider helpers: compose, vs-validate, + display, canonical, issues, property-filter, + fhir-extract, supplement, fhir-loader │ -impl/snomed.clj SNOMED CT via Hermes -impl/in_memory.clj In-memory providers -impl/sqlite/provider.clj SQLite-backed catalogue providers -impl/compose.clj ValueSet compose engine (include/exclude, filter, etc.) - -impl/loaders/fhir.clj FHIR JSON → fhir-data -impl/loaders/loinc.clj LOINC release dir → fhir-data -impl/index/memory.clj fhir-data → in-memory providers -impl/index/sqlite.clj fhir-data → SQLite container -impl/load.clj Convenience constructors over the load pipeline -impl/sqlite/db.clj SQLite open/create/schema/pragmas - -cmd.clj CLI entry point (-main) -impl/cli.clj CLI option parsing +impl/sources.clj, impl/paths.clj Walk a path, recognise terminology files, +impl/load.clj, impl/fhir_package.clj open them as provider bundles + +cmd.clj, impl/cli.clj CLI entry point + option parsing ``` ### Layering rules (strict) @@ -179,11 +184,12 @@ impl/cli.clj CLI option parsing ### Layer responsibilities (strict) -- **Protocol impls** (snomed.clj, in_memory.clj, sqlite/provider.clj) know - their domain. They return **complete, self-describing results** that match - the result specs under `impl/protocols/` — read those for the current - contract. No downstream layer should need to patch, enrich, or re-derive - fields. +- **Provider impls** (`providers/snomed/provider.clj`, + `providers/in_memory/provider.clj`, `providers/ftrm/provider.clj`, …) + know their domain. They return **complete, self-describing results** + that match the result specs under `protocols/` — read those for the + current contract. No downstream layer should need to patch, enrich, + or re-derive fields. - **Composite** dispatches to the right impl by URL/version and handles version resolution (the version-resolution flags carried in the operation params). It does **not** patch results, add issues retroactively, look up @@ -262,7 +268,7 @@ handler's params; grep `impl/http.clj` for the current names. - Use `clojure.spec.alpha` for all public API boundaries: protocol parameters, operation inputs, constructor arguments, **and protocol return values**. - The canonical data shapes for protocol parameters and return values live - under `impl/protocols/` — read those files; they are the contracts between + under `protocols/` — read those files; they are the contracts between layers, and every protocol impl must return data conforming to them. - Namespace specs under the relevant module. - Write `s/fdef` for public functions with non-trivial parameter contracts. @@ -366,7 +372,7 @@ place and flows data correctly. them and what shape do they expect? Draw the path: http → composite → impl → composite → http → wire. If data needs to flow backwards (handler reaching back into impl metadata), the return value is incomplete. -4. **Check the spec.** Does a spec exist under `impl/protocols/` for the +4. **Check the spec.** Does a spec exist under `protocols/` for the return value this change produces? If not, define it before writing the implementation. The spec is the contract — write the contract first. 5. **Check for secret channels.** Does this change require smuggling data through @@ -417,7 +423,7 @@ Run after every task. All items must pass. methods to recover data that should be in the result, no ad-hoc keys smuggled through the request context. 7. **Protocol impls return complete results.** If you changed a protocol impl, - its return value must conform to the result spec under `impl/protocols/`. + its return value must conform to the result spec under `protocols/`. No downstream patching needed. 8. **Composite is not patching domain results.** If you added logic to the composite that modifies a result after the protocol call (adding issues, diff --git a/deps.edn b/deps.edn index 0e80b8b..02073f9 100644 --- a/deps.edn +++ b/deps.edn @@ -101,5 +101,9 @@ :lint/kondo {:extra-deps {clj-kondo/clj-kondo {:mvn/version "RELEASE"}} - :main-opts ["-m" "clj-kondo.main" "--lint" "src"]}}} + :main-opts ["-m" "clj-kondo.main" "--lint" "src"]} + + :lint/splint + {:extra-deps {io.github.noahtheduke/splint {:mvn/version "1.24.0"}} + :main-opts ["-m" "noahtheduke.splint" "src"]}}} diff --git a/doc/development.md b/doc/development.md index cea45b5..5e1674c 100644 --- a/doc/development.md +++ b/doc/development.md @@ -24,7 +24,7 @@ exist locally. Fixture paths are declared in |----------------------------------|-----------------------------------|------------------------------------------|------------------------------------------| | SNOMED CT International | `.hades/snomed-intl-20250201.db` | `ihtsdo.mlds/167@2025-02-01` | MLDS | | SNOMED CT UK monolith | `.hades/snomed-uk-monolith.db` | `uk.nhs/sct-monolith` (latest) | TRUD | -| LOINC | `.hades/loinc-2.81.db` | LOINC release `2.81` | loinc.org (free account) | +| LOINC | `.hades/loinc-2.82.db` | LOINC release `2.82` | loinc.org (free account) | | FHIR packages (SQLite container) | `.hades/fhir-smoke.db` | `hl7.fhir.r4.core@4.0.1` + 5 others | packages.fhir.org | | FHIR packages (unpacked cache) | `.hades/fhir-packages/` | same as above | packages.fhir.org | | tx-ecosystem (conformance) | `.hades/tx-ecosystem/` | rev pinned in `conformance_test.clj` | `HL7/fhir-tx-ecosystem-ig` (auto-cloned) | @@ -65,16 +65,16 @@ rm -f .hades/trud-api-key.txt LOINC is licensed and not redistributable, so you download it yourself: sign in at [loinc.org/downloads](https://loinc.org/downloads/) (free -account), grab the **LOINC Table File (CSV)** archive for release 2.81, -and unzip it. Then point `import` at the unzipped directory: +account), grab the **LOINC Table File (CSV)** archive for release 2.82, +and unzip it: ```bash -unzip /path/to/Loinc_2.81.zip -d /tmp/Loinc_2.81 -clj -M:run import compact .hades/loinc-2.81.db /tmp/Loinc_2.81 +unzip /path/to/Loinc_2.82.zip -d /tmp/Loinc_2.82 ``` -`import` auto-detects the LOINC release layout (it looks for -`LoincTableCore/LoincTableCore.csv`). +LOINC release detection is based on the native loader's required +`LoincTable/Loinc.csv`. Native LOINC import writes a LOINC-specific +SQLite store from the release CSVs. ### FHIR packages @@ -122,7 +122,7 @@ asserts the in-memory and SQLite/FTRM providers produce **the same** result for the same fhir-data — including human-readable text. Both `:message` and issue `:text` are part of the comparison contract: divergence means the provider must converge on a shared helper in -`impl/issues.clj`, not that the test's normaliser should look the +`providers/common/issues.clj`, not that the test's normaliser should look the other way. The synthetic fixture is small (a handful of toy CodeSystems / ValueSets / a ConceptMap), so failures are fast to triage. @@ -232,7 +232,7 @@ cd ~/Dev/hades RUN_ID="$(date -u +%Y-%m-%dT%H%M)-2.0.$(git rev-list --count HEAD)-$(git rev-parse --short HEAD)$(git diff-index --quiet HEAD -- src test deps.edn build.clj || echo -dirty)" clj -M:run serve \ .hades/snomed-uk-monolith.db \ - .hades/loinc-2.81.db \ + .hades/loinc-2.82.db \ .hades/fhir-smoke.db \ --port 8080 > /tmp/hades.log 2>&1 & HADES_PID=$! @@ -267,7 +267,7 @@ cd ~/Dev/hades RUN_ID="$(date -u +%Y-%m-%dT%H%M)-2.0.$(git rev-list --count HEAD)-$(git rev-parse --short HEAD)$(git diff-index --quiet HEAD -- src test deps.edn build.clj || echo -dirty)" clj -M:run serve \ .hades/snomed-uk-monolith.db \ - .hades/loinc-2.81.db \ + .hades/loinc-2.82.db \ .hades/fhir-smoke.db \ --port 8080 > /tmp/hades.log 2>&1 & HADES_PID=$! @@ -341,7 +341,7 @@ RUN_ID="$(date -u +%Y-%m-%dT%H%M)-2.0.$(git rev-list --count HEAD)-$(git rev-par clj -T:build uber java -Xmx6g -jar target/hades.jar serve \ .hades/snomed-uk-monolith.db \ - .hades/loinc-2.81.db \ + .hades/loinc-2.82.db \ .hades/fhir-smoke.db \ --port 8080 > /tmp/hades.log 2>&1 & HADES_PID=$! diff --git a/doc/ftrm.md b/doc/ftrm.md index 8b2a2d7..b79d5e0 100644 --- a/doc/ftrm.md +++ b/doc/ftrm.md @@ -23,7 +23,7 @@ This document is the contract. | First published | 2026-05 | | Stability | Stable. Breaking changes will bump the schema version and ship migration tooling. | | Reference implementation | Hades — | -| Reference DDL | [`resources/com/eldrix/hades/sqlite/schema-v1.sql`](../resources/com/eldrix/hades/sqlite/schema-v1.sql) | +| Reference DDL | [`resources/com/eldrix/hades/providers/ftrm/schema-v1.sql`](../resources/com/eldrix/hades/providers/ftrm/schema-v1.sql) | | Licence | The schema, identifiers and prose of this specification are licensed under CC0. Implementations may use any licence. | The key words **MUST**, **MUST NOT**, **REQUIRED**, **SHALL**, diff --git a/doc/mcp.md b/doc/mcp.md index e4ac663..e2a6d85 100644 --- a/doc/mcp.md +++ b/doc/mcp.md @@ -16,6 +16,41 @@ Build them once with the steps in [Installation](installation.md) — SNOMED CT (international or UK editions), LOINC, and any HL7 FHIR package — then point the MCP server at the resulting paths. +For the worked examples below, use this pinned fixture set. It matches +the live test configuration and keeps examples reproducible: + +```shell +# SNOMED CT International, via MLDS credentials. +clojure -M:run install compact .hades/snomed-intl-20250201.db \ + --dist ihtsdo.mlds/167@2025-02-01 \ + --username "$MLDS_USERNAME" \ + --password .hades/mlds-password.txt + +# LOINC 2.82, from the unzipped LOINC Table File CSV archive. +clojure -M:run import .hades/loinc-2.82.db /path/to/Loinc_2.82/ + +# FHIR R4 core terminology, HL7 terminology, US Core, IPS 1.1 + 2.0, +# and tx support resources. IPS 1.1 carries useful LOINC-answer +# ConceptMaps; IPS 2.0 carries the SNOMED-based IPS ValueSets. +clojure -M:run install compact .hades/fhir-smoke.db \ + --dist hl7.fhir.r4.core@4.0.1 \ + --dist hl7.terminology.r4@7.0.1 \ + --dist hl7.fhir.us.core@6.1.0 \ + --dist hl7.fhir.uv.ips@2.0.0 \ + --dist hl7.fhir.uv.ips@1.1.0 \ + --dist fhir.tx.support.r4@0.34.0 \ + --cache-dir .hades/fhir-packages +``` + +Then run MCP against those three stores: + +```shell +clojure -M:run mcp \ + .hades/snomed-intl-20250201.db \ + .hades/loinc-2.82.db \ + .hades/fhir-smoke.db +``` + ## Setup The recommended setup runs Hades from a source checkout via the @@ -35,9 +70,9 @@ Add to your `claude_desktop_config.json`: "command": "clojure", "args": [ "-M:run", "mcp", - "/path/to/snomed.db", - "/path/to/fhir.db", - "/path/to/loinc.db" + "/path/to/.hades/snomed-intl-20250201.db", + "/path/to/.hades/loinc-2.82.db", + "/path/to/.hades/fhir-smoke.db" ], "cwd": "/path/to/hades-source" } @@ -55,7 +90,12 @@ Same shape. `claude mcp add-json` accepts the JSON object directly: ```shell claude mcp add-json --scope user hades '{ "command": "clojure", - "args": ["-M:run", "mcp", "/path/to/snomed.db", "/path/to/loinc.db"], + "args": [ + "-M:run", "mcp", + "/path/to/.hades/snomed-intl-20250201.db", + "/path/to/.hades/loinc-2.82.db", + "/path/to/.hades/fhir-smoke.db" + ], "cwd": "/path/to/hades-source" }' ``` @@ -83,8 +123,9 @@ local use you'll typically reference the versioned filename directly: "command": "java", "args": [ "-jar", "/path/to/hades-2.0.207.jar", "mcp", - "/path/to/snomed.db", - "/path/to/loinc.db" + "/path/to/.hades/snomed-intl-20250201.db", + "/path/to/.hades/loinc-2.82.db", + "/path/to/.hades/fhir-smoke.db" ] } } @@ -158,8 +199,8 @@ instruction the LLM follows using the available tools: ## Example session -With SNOMED CT International + FHIR R4 packages + LOINC 2.81 loaded -into one Hades process: +With the pinned SNOMED CT International + FHIR package + LOINC 2.82 +fixture set above loaded into one Hades process: > "I have a free-text problem `'type 1 diabetes mellitus'`. Code it, and > tell me whether it can be bound to the FHIR base condition-code value @@ -167,9 +208,9 @@ into one Hades process: The assistant calls: -1. `expand` against `http://snomed.info/sct` with `filter="type 1 - diabetes"` — gets candidates including `46635009` (Type 1 diabetes - mellitus). +1. `expand` against `http://snomed.info/sct?fhir_vs` with + `filter="type 1 diabetes"` — gets candidates including `46635009` + (Type 1 diabetes mellitus). 2. `lookup` for `46635009` — confirms display "Type 1 diabetes mellitus" and the SNOMED parent hierarchy (Diabetes mellitus → Disorder of glucose metabolism). @@ -177,21 +218,45 @@ The assistant calls: `http://hl7.org/fhir/ValueSet/condition-code` with the SNOMED code — returns `result: true`. -> "Now translate it to ICD-10." +> "Now translate it to ICD-10, if the loaded SNOMED edition includes a +> usable map for this code." 4. `translate` with `code=46635009` and - `target=http://hl7.org/fhir/sid/icd-10` — returns - `E10.9` ("Type 1 diabetes mellitus, without complications") via - SNOMED's built-in ICD-10 ConceptMap, with equivalence `relatedto`. + `target=http://hl7.org/fhir/sid/icd-10` — dispatches to SNOMED's + built-in ICD-10 map when that map is present in the loaded SNOMED + release. If the map or the requested source code is absent, Hades + returns a structured `result=false` response rather than inventing a + code. > "And give me a draft ValueSet for all clinical findings about diabetes." 5. `expand` against `http://hl7.org/fhir/ValueSet/clinical-findings` (a FHIR R4 base ValueSet that filters SNOMED clinical findings) with - `filter="diabetes"` — returns 631 SNOMED concepts, all clinical - findings, all matching "diabetes". The assistant proposes a tighter - compose block based on `is-a 73211009 |Diabetes mellitus|` and uses - `expand` again to preview. + `filter="diabetes"` — returns a version-dependent set of SNOMED + clinical findings matching "diabetes". The assistant proposes a + tighter compose block based on `is-a 73211009 |Diabetes mellitus|` + and uses `expand` again to preview. + +## LOINC and ConceptMap examples + +The same pinned fixture set also demonstrates multi-terminology +translation: + +| Tool call | Expected result | Why it matters | +|---|---|---| +| `translate` with `url=http://hl7.org/fhir/uv/ips/ConceptMap/loinc-pregnancy-status-to-snomed-ct-uv-ips`, `system=http://loinc.org`, `code=LA15173-0` | `SNOMED#77386006 Pregnant` | Canonical ConceptMap URL lookup. | +| `translate` with `system=http://loinc.org`, `target=http://snomed.info/sct`, `code=LA18976-3` | `SNOMED#449868002 Smokes tobacco daily` | Code-disambiguated lookup across LOINC-answer ConceptMaps. | +| `validate_code` with `url=http://hl7.org/fhir/uv/ips/ValueSet/current-smoking-status-uv-ips`, `value_set_version=2.0.0`, `system=http://snomed.info/sct`, `code=449868002` | `result=true` | Validates the translated SNOMED code against the SNOMED-based IPS ValueSet. | +| `translate` with `url=http://loinc.org/cm/map-to`, `system=http://loinc.org`, `target=http://loinc.org`, `code=1009-0` | `LOINC#1007-4` | LOINC `MapTo` replacement mapping for deprecated/discouraged source terms. | +| `translate` with `url=http://loinc.org/cm/map-to`, `system=http://loinc.org`, `target=http://loinc.org`, `code=4548-4` | `result=false` | `MapTo` is not general analyte equivalence for active lab codes. | +| `translate` with `url=http://loinc.org/cm/part-related-code-mapping/http%3A%2F%2Fsnomed.info%2Fsct`, `system=http://loinc.org`, `code=LP14635-4` | `SNOMED#67079006 Glucose (substance)`, equivalence `narrower` | LOINC part-to-SNOMED mapping while preserving relationship semantics. | + +When several ConceptMaps share the same source and target systems, +Hades uses the source code as an additional discriminator. It translates +only when one candidate contains the code, or when all matching +candidates produce the same target set. If candidates disagree, Hades +preserves the ambiguity and returns a structured failure instead of +guessing clinically. The same `lookup` and `validate_code` tools work against LOINC, the UK SNOMED dm+d drug extension, or any HL7 FHIR package — the LLM doesn't diff --git a/resources/com/eldrix/hades/sqlite/schema-v1.sql b/resources/com/eldrix/hades/providers/ftrm/schema-v1.sql similarity index 100% rename from resources/com/eldrix/hades/sqlite/schema-v1.sql rename to resources/com/eldrix/hades/providers/ftrm/schema-v1.sql diff --git a/resources/com/eldrix/hades/providers/loinc/add-indexes-v1.sql b/resources/com/eldrix/hades/providers/loinc/add-indexes-v1.sql new file mode 100644 index 0000000..b505220 --- /dev/null +++ b/resources/com/eldrix/hades/providers/loinc/add-indexes-v1.sql @@ -0,0 +1,66 @@ +CREATE INDEX IF NOT EXISTS loinc_status ON loinc(status); +CREATE INDEX IF NOT EXISTS loinc_class ON loinc(class); +CREATE INDEX IF NOT EXISTS loinc_order_obs ON loinc(order_obs); +CREATE INDEX IF NOT EXISTS loinc_external_copyright_link ON loinc(external_copyright_link); + +CREATE INDEX IF NOT EXISTS loinc_group_parent_group ON loinc_group(parent_group_id); +CREATE INDEX IF NOT EXISTS group_attribute_group ON group_attribute(group_id); +CREATE INDEX IF NOT EXISTS group_loinc_term_loinc ON group_loinc_term(loinc_number); +CREATE INDEX IF NOT EXISTS parent_group_attribute_parent ON parent_group_attribute(parent_group_id); + +CREATE INDEX IF NOT EXISTS part_type ON part(part_type_name); +CREATE INDEX IF NOT EXISTS part_link_primary_part ON part_link_primary(part_number); +CREATE INDEX IF NOT EXISTS part_link_supplementary_part ON part_link_supplementary(part_number); +CREATE INDEX IF NOT EXISTS part_related_ext_code ON part_related_code_mapping(ext_code_system, ext_code_id); + +CREATE INDEX IF NOT EXISTS component_hierarchy_parent ON component_hierarchy_by_system(immediate_parent); +CREATE INDEX IF NOT EXISTS component_hierarchy_code ON component_hierarchy_by_system(code); + +CREATE INDEX IF NOT EXISTS answer_list_id ON answer_list(answer_list_id); +CREATE INDEX IF NOT EXISTS answer_list_answer_string ON answer_list(answer_string_id); +CREATE INDEX IF NOT EXISTS answer_list_link_list ON answer_list_link(answer_list_id); +CREATE INDEX IF NOT EXISTS answer_list_link_loinc ON answer_list_link(loinc_number); + +CREATE INDEX IF NOT EXISTS panels_parent_loinc ON panels_and_forms(parent_loinc); +CREATE INDEX IF NOT EXISTS panels_member_loinc ON panels_and_forms(loinc); +CREATE INDEX IF NOT EXISTS panels_answer_list_id ON panels_answer_list(answer_list_id); +CREATE INDEX IF NOT EXISTS panels_answer_string ON panels_answer_list(answer_string_id); +CREATE INDEX IF NOT EXISTS panels_answer_link_loinc ON panels_answer_list_link(loinc_number); + +CREATE INDEX IF NOT EXISTS document_ontology_loinc ON document_ontology(loinc_number); +CREATE INDEX IF NOT EXISTS rsna_playbook_loinc ON loinc_rsna_radiology_playbook(loinc_number); +CREATE INDEX IF NOT EXISTS rsna_playbook_part ON loinc_rsna_radiology_playbook(part_number); +CREATE INDEX IF NOT EXISTS ieee_mapping_loinc ON loinc_ieee_medical_device_mapping(loinc_num); + +CREATE INDEX IF NOT EXISTS linguistic_variant_loinc ON linguistic_variant_row(loinc_num); +CREATE INDEX IF NOT EXISTS linguistic_variant_id ON linguistic_variant_row(variant_id); + +CREATE INDEX IF NOT EXISTS loinc_change_snapshot_code ON loinc_change_snapshot(loinc_num); +CREATE INDEX IF NOT EXISTS part_change_snapshot_code ON part_change_snapshot(part_number); +CREATE INDEX IF NOT EXISTS updates_code ON updates(loinc_num); +CREATE INDEX IF NOT EXISTS updates_additional_code ON updates_additional_fields(loinc_num); + +CREATE VIRTUAL TABLE IF NOT EXISTS loinc_fts USING fts5( + long_common_name, + component, + system, + related_names_2, + shortname, + display_name, + content='loinc', + content_rowid='rowid', + tokenize='unicode61 remove_diacritics 2' +); + +CREATE VIRTUAL TABLE IF NOT EXISTS loinc_variant_fts USING fts5( + loinc_num UNINDEXED, + variant_id UNINDEXED, + iso_language UNINDEXED, + iso_country UNINDEXED, + long_common_name, + linguistic_variant_display_name, + shortname, + component, + related_names_2, + tokenize='unicode61 remove_diacritics 2' +); diff --git a/resources/com/eldrix/hades/providers/loinc/drop-indexes-v1.sql b/resources/com/eldrix/hades/providers/loinc/drop-indexes-v1.sql new file mode 100644 index 0000000..a18f446 --- /dev/null +++ b/resources/com/eldrix/hades/providers/loinc/drop-indexes-v1.sql @@ -0,0 +1,35 @@ +DROP INDEX IF EXISTS loinc_status; +DROP INDEX IF EXISTS loinc_class; +DROP INDEX IF EXISTS loinc_order_obs; +DROP INDEX IF EXISTS loinc_external_copyright_link; +DROP INDEX IF EXISTS loinc_group_parent_group; +DROP INDEX IF EXISTS group_attribute_group; +DROP INDEX IF EXISTS group_loinc_term_loinc; +DROP INDEX IF EXISTS parent_group_attribute_parent; +DROP INDEX IF EXISTS part_type; +DROP INDEX IF EXISTS part_link_primary_part; +DROP INDEX IF EXISTS part_link_supplementary_part; +DROP INDEX IF EXISTS part_related_ext_code; +DROP INDEX IF EXISTS component_hierarchy_parent; +DROP INDEX IF EXISTS component_hierarchy_code; +DROP INDEX IF EXISTS answer_list_id; +DROP INDEX IF EXISTS answer_list_answer_string; +DROP INDEX IF EXISTS answer_list_link_list; +DROP INDEX IF EXISTS answer_list_link_loinc; +DROP INDEX IF EXISTS panels_parent_loinc; +DROP INDEX IF EXISTS panels_member_loinc; +DROP INDEX IF EXISTS panels_answer_list_id; +DROP INDEX IF EXISTS panels_answer_string; +DROP INDEX IF EXISTS panels_answer_link_loinc; +DROP INDEX IF EXISTS document_ontology_loinc; +DROP INDEX IF EXISTS rsna_playbook_loinc; +DROP INDEX IF EXISTS rsna_playbook_part; +DROP INDEX IF EXISTS ieee_mapping_loinc; +DROP INDEX IF EXISTS linguistic_variant_loinc; +DROP INDEX IF EXISTS linguistic_variant_id; +DROP INDEX IF EXISTS loinc_change_snapshot_code; +DROP INDEX IF EXISTS part_change_snapshot_code; +DROP INDEX IF EXISTS updates_code; +DROP INDEX IF EXISTS updates_additional_code; +DROP TABLE IF EXISTS loinc_fts; +DROP TABLE IF EXISTS loinc_variant_fts; diff --git a/resources/com/eldrix/hades/providers/loinc/schema-v1.sql b/resources/com/eldrix/hades/providers/loinc/schema-v1.sql new file mode 100644 index 0000000..3459c44 --- /dev/null +++ b/resources/com/eldrix/hades/providers/loinc/schema-v1.sql @@ -0,0 +1,517 @@ +-- LOINC SQLite store, schema v1. +-- +-- Source tables mirror the known LOINC CSV families streamed by +-- com.eldrix.hades.providers.loinc.loader. LoincTableCore/* is not +-- stored because it is duplicate packaging of LoincTable/* and is used +-- only as a version fallback when present. + +CREATE TABLE IF NOT EXISTS meta ( + key TEXT PRIMARY KEY, + value TEXT +); + +-- LoincTable/Loinc.csv +CREATE TABLE IF NOT EXISTS loinc ( + loinc_num TEXT NOT NULL PRIMARY KEY, + component TEXT, + property TEXT, + time_aspct TEXT, + system TEXT, + scale_typ TEXT, + method_typ TEXT, + class TEXT, + version_last_changed TEXT, + chng_type TEXT, + definition_description TEXT, + status TEXT, + consumer_name TEXT, + classtype TEXT, + formula TEXT, + exmpl_answers TEXT, + survey_quest_text TEXT, + survey_quest_src TEXT, + units_required TEXT, + related_names_2 TEXT, + shortname TEXT, + order_obs TEXT, + hl7_field_subfield_id TEXT, + external_copyright_notice TEXT, + example_units TEXT, + long_common_name TEXT, + example_ucum_units TEXT, + status_reason TEXT, + status_text TEXT, + change_reason_public TEXT, + common_test_rank INTEGER, + common_order_rank INTEGER, + hl7_attachment_structure TEXT, + external_copyright_link TEXT, + panel_type TEXT, + ask_at_order_entry TEXT, + associated_observations TEXT, + version_first_released TEXT, + valid_hl7_attachment_request TEXT, + display_name TEXT +); + +-- LoincTable/MapTo.csv +CREATE TABLE IF NOT EXISTS map_to ( + loinc TEXT NOT NULL, + map_to TEXT NOT NULL, + comment TEXT, + PRIMARY KEY (loinc, map_to) +) WITHOUT ROWID; + +-- LoincTable/SourceOrganization.csv +CREATE TABLE IF NOT EXISTS source_organization ( + id TEXT NOT NULL PRIMARY KEY, + copyright_id TEXT, + name TEXT, + copyright TEXT, + terms_of_use TEXT, + url TEXT +) WITHOUT ROWID; + +-- AccessoryFiles/ConsumerName/ConsumerName.csv +CREATE TABLE IF NOT EXISTS consumer_name ( + loinc_number TEXT NOT NULL PRIMARY KEY, + consumer_name TEXT +) WITHOUT ROWID; + +-- AccessoryFiles/GroupFile/Group.csv +CREATE TABLE IF NOT EXISTS loinc_group ( + parent_group_id TEXT, + group_id TEXT NOT NULL PRIMARY KEY, + group_name TEXT, + archetype TEXT, + status TEXT, + version_first_released TEXT +) WITHOUT ROWID; + +-- AccessoryFiles/GroupFile/GroupAttributes.csv +CREATE TABLE IF NOT EXISTS group_attribute ( + parent_group_id TEXT, + group_id TEXT, + type TEXT, + value TEXT, + PRIMARY KEY (parent_group_id, group_id, type, value) +) WITHOUT ROWID; + +-- AccessoryFiles/GroupFile/GroupLoincTerms.csv +CREATE TABLE IF NOT EXISTS group_loinc_term ( + category TEXT, + group_id TEXT NOT NULL, + archetype TEXT, + loinc_number TEXT NOT NULL, + long_common_name TEXT, + PRIMARY KEY (group_id, loinc_number) +) WITHOUT ROWID; + +-- AccessoryFiles/GroupFile/ParentGroup.csv +CREATE TABLE IF NOT EXISTS parent_group ( + parent_group_id TEXT NOT NULL PRIMARY KEY, + parent_group_name TEXT, + status TEXT +) WITHOUT ROWID; + +-- AccessoryFiles/GroupFile/ParentGroupAttributes.csv +CREATE TABLE IF NOT EXISTS parent_group_attribute ( + parent_group_id TEXT, + type TEXT, + value TEXT, + PRIMARY KEY (parent_group_id, type, value) +) WITHOUT ROWID; + +-- AccessoryFiles/PartFile/Part.csv +CREATE TABLE IF NOT EXISTS part ( + part_number TEXT NOT NULL PRIMARY KEY, + part_type_name TEXT, + part_name TEXT, + part_display_name TEXT, + status TEXT +); + +-- AccessoryFiles/PartFile/LoincPartLink_Primary.csv +CREATE TABLE IF NOT EXISTS part_link_primary ( + loinc_number TEXT NOT NULL, + long_common_name TEXT, + part_number TEXT NOT NULL, + part_name TEXT, + part_code_system TEXT, + part_type_name TEXT NOT NULL, + link_type_name TEXT NOT NULL, + property TEXT, + PRIMARY KEY (loinc_number, part_number, part_type_name, link_type_name) +) WITHOUT ROWID; + +-- AccessoryFiles/PartFile/LoincPartLink_Supplementary.csv +CREATE TABLE IF NOT EXISTS part_link_supplementary ( + loinc_number TEXT NOT NULL, + long_common_name TEXT, + part_number TEXT NOT NULL, + part_name TEXT, + part_code_system TEXT, + part_type_name TEXT NOT NULL, + link_type_name TEXT NOT NULL, + property TEXT, + PRIMARY KEY (loinc_number, part_number, part_type_name, link_type_name) +) WITHOUT ROWID; + +-- AccessoryFiles/PartFile/PartRelatedCodeMapping.csv +CREATE TABLE IF NOT EXISTS part_related_code_mapping ( + part_number TEXT NOT NULL, + part_name TEXT, + part_type_name TEXT, + ext_code_id TEXT NOT NULL, + ext_code_display_name TEXT, + ext_code_system TEXT NOT NULL, + equivalence TEXT, + content_origin TEXT, + ext_code_system_version TEXT, + ext_code_system_copyright_notice TEXT, + PRIMARY KEY (part_number, ext_code_system, ext_code_id) +) WITHOUT ROWID; + +-- AccessoryFiles/ComponentHierarchyBySystem/ComponentHierarchyBySystem.csv +CREATE TABLE IF NOT EXISTS component_hierarchy_by_system ( + path_to_root TEXT NOT NULL DEFAULT '', + sequence INTEGER, + immediate_parent TEXT NOT NULL, + code TEXT NOT NULL, + code_text TEXT, + PRIMARY KEY (code, immediate_parent, path_to_root) +) WITHOUT ROWID; + +-- AccessoryFiles/AnswerFile/AnswerList.csv +CREATE TABLE IF NOT EXISTS answer_list ( + answer_list_id TEXT, + answer_list_name TEXT, + answer_list_oid TEXT, + ext_defined_yn TEXT, + ext_defined_answer_list_code_system TEXT, + ext_defined_answer_list_link TEXT, + answer_string_id TEXT, + local_answer_code TEXT, + local_answer_code_system TEXT, + sequence_number INTEGER, + display_text TEXT, + ext_code_id TEXT, + ext_code_display_name TEXT, + ext_code_system TEXT, + ext_code_system_version TEXT, + ext_code_system_copyright_notice TEXT, + subsequent_text_prompt TEXT, + description TEXT, + score TEXT, + PRIMARY KEY (answer_list_id, answer_string_id) +) WITHOUT ROWID; + +-- AccessoryFiles/AnswerFile/LoincAnswerListLink.csv +CREATE TABLE IF NOT EXISTS answer_list_link ( + loinc_number TEXT, + long_common_name TEXT, + answer_list_id TEXT, + answer_list_name TEXT, + answer_list_link_type TEXT, + applicable_context TEXT, + PRIMARY KEY (loinc_number, answer_list_id, answer_list_link_type, applicable_context) +) WITHOUT ROWID; + +-- AccessoryFiles/PanelsAndForms/PanelsAndForms.csv +CREATE TABLE IF NOT EXISTS panels_and_forms ( + parent_id TEXT, + parent_loinc TEXT, + parent_name TEXT, + id TEXT, + sequence INTEGER, + loinc TEXT, + loinc_name TEXT, + display_name_for_form TEXT, + observation_required_in_panel TEXT, + observation_id_in_form TEXT, + skip_logic_help_text TEXT, + default_value TEXT, + entry_type TEXT, + data_type_in_form TEXT, + data_type_source TEXT, + answer_sequence_override INTEGER, + condition_for_inclusion TEXT, + allowable_alternative TEXT, + observation_category TEXT, + context TEXT, + consistency_checks TEXT, + relevance_equation TEXT, + coding_instructions TEXT, + question_cardinality TEXT, + answer_cardinality TEXT, + answer_list_id_override TEXT, + answer_list_type_override TEXT, + external_copyright_notice TEXT, + additional_copyright TEXT, + PRIMARY KEY (parent_id, id) +) WITHOUT ROWID; + +-- AccessoryFiles/PanelsAndForms/Loinc.csv +CREATE TABLE IF NOT EXISTS panels_loinc ( + loinc_num TEXT, + component TEXT, + property TEXT, + time_aspct TEXT, + system TEXT, + scale_typ TEXT, + method_typ TEXT, + class TEXT, + version_last_changed TEXT, + chng_type TEXT, + definition_description TEXT, + status TEXT, + consumer_name TEXT, + classtype TEXT, + formula TEXT, + exmpl_answers TEXT, + survey_quest_text TEXT, + survey_quest_src TEXT, + units_required TEXT, + related_names_2 TEXT, + shortname TEXT, + order_obs TEXT, + hl7_field_subfield_id TEXT, + external_copyright_notice TEXT, + example_units TEXT, + long_common_name TEXT, + example_ucum_units TEXT, + status_reason TEXT, + status_text TEXT, + change_reason_public TEXT, + common_test_rank INTEGER, + common_order_rank INTEGER, + hl7_attachment_structure TEXT, + external_copyright_link TEXT, + panel_type TEXT, + ask_at_order_entry TEXT, + associated_observations TEXT, + version_first_released TEXT, + valid_hl7_attachment_request TEXT, + display_name TEXT, + PRIMARY KEY (loinc_num) +) WITHOUT ROWID; + +-- AccessoryFiles/PanelsAndForms/AnswerList.csv +CREATE TABLE IF NOT EXISTS panels_answer_list ( + answer_list_id TEXT, + answer_list_name TEXT, + answer_list_oid TEXT, + ext_defined_yn TEXT, + ext_defined_answer_list_code_system TEXT, + ext_defined_answer_list_link TEXT, + answer_string_id TEXT, + local_answer_code TEXT, + local_answer_code_system TEXT, + sequence_number INTEGER, + display_text TEXT, + ext_code_id TEXT, + ext_code_display_name TEXT, + ext_code_system TEXT, + ext_code_system_version TEXT, + ext_code_system_copyright_notice TEXT, + subsequent_text_prompt TEXT, + description TEXT, + score TEXT, + PRIMARY KEY (answer_list_id, answer_string_id) +) WITHOUT ROWID; + +-- AccessoryFiles/PanelsAndForms/LoincAnswerListLink.csv +CREATE TABLE IF NOT EXISTS panels_answer_list_link ( + loinc_number TEXT, + long_common_name TEXT, + answer_list_id TEXT, + answer_list_name TEXT, + answer_list_link_type TEXT, + applicable_context TEXT, + PRIMARY KEY (loinc_number, answer_list_id, answer_list_link_type, applicable_context) +) WITHOUT ROWID; + +-- AccessoryFiles/DocumentOntology/DocumentOntology.csv +CREATE TABLE IF NOT EXISTS document_ontology ( + loinc_number TEXT, + part_number TEXT, + part_type_name TEXT, + part_sequence_order INTEGER, + part_name TEXT, + PRIMARY KEY (loinc_number, part_number, part_type_name) +) WITHOUT ROWID; + +-- AccessoryFiles/ImagingDocuments/ImagingDocumentCodes.csv +CREATE TABLE IF NOT EXISTS imaging_document_code ( + loinc_num TEXT NOT NULL PRIMARY KEY, + long_common_name TEXT +) WITHOUT ROWID; + +-- AccessoryFiles/LoincRsnaRadiologyPlaybook/LoincRsnaRadiologyPlaybook.csv +CREATE TABLE IF NOT EXISTS loinc_rsna_radiology_playbook ( + loinc_number TEXT, + long_common_name TEXT, + part_number TEXT, + part_type_name TEXT, + part_name TEXT, + part_sequence_order INTEGER, + rid TEXT, + preferred_name TEXT, + rpid TEXT, + long_name TEXT, + PRIMARY KEY (loinc_number, part_number, part_type_name) +) WITHOUT ROWID; + +-- AccessoryFiles/LoincIeeeMedicalDeviceCodeMappingTable/LoincIeeeMedicalDeviceCodeMappingTable.csv +CREATE TABLE IF NOT EXISTS loinc_ieee_medical_device_mapping ( + loinc_num TEXT, + loinc_long_common_name TEXT, + ieee_cf_code10 TEXT, + ieee_refid TEXT, + equivalence TEXT, + PRIMARY KEY (loinc_num, ieee_refid) +) WITHOUT ROWID; + +-- AccessoryFiles/LoincUniversalLabOrdersValueSet/LoincUniversalLabOrdersValueSet.csv +CREATE TABLE IF NOT EXISTS loinc_universal_lab_orders_value_set ( + loinc_num TEXT NOT NULL PRIMARY KEY, + long_common_name TEXT, + order_obs TEXT +) WITHOUT ROWID; + +-- AccessoryFiles/LinguisticVariants/LinguisticVariants.csv +CREATE TABLE IF NOT EXISTS linguistic_variant_catalog ( + id TEXT NOT NULL PRIMARY KEY, + iso_language TEXT, + iso_country TEXT, + language_name TEXT, + producer TEXT +) WITHOUT ROWID; + +-- AccessoryFiles/LinguisticVariants/LinguisticVariant.csv +CREATE TABLE IF NOT EXISTS linguistic_variant_row ( + variant_id TEXT, + loinc_num TEXT, + component TEXT, + property TEXT, + time_aspct TEXT, + system TEXT, + scale_typ TEXT, + method_typ TEXT, + class TEXT, + shortname TEXT, + long_common_name TEXT, + related_names_2 TEXT, + linguistic_variant_display_name TEXT, + PRIMARY KEY (variant_id, loinc_num) +) WITHOUT ROWID; + +-- AccessoryFiles/ChangeSnapshot/LoincChangeSnapshot.csv +CREATE TABLE IF NOT EXISTS loinc_change_snapshot ( + version_effective TEXT, + loinc_num TEXT, + property TEXT, + value_prior TEXT, + value_current TEXT, + change_reason TEXT, + PRIMARY KEY (version_effective, loinc_num, property) +) WITHOUT ROWID; + +-- AccessoryFiles/ChangeSnapshot/PartChangeSnapshot.csv +CREATE TABLE IF NOT EXISTS part_change_snapshot ( + version_effective TEXT, + part_number TEXT, + property TEXT, + value_prior TEXT, + value_current TEXT, + change_reason TEXT, + PRIMARY KEY (version_effective, part_number, property) +) WITHOUT ROWID; + +-- AccessoryFiles/Updates/Updates.csv +CREATE TABLE IF NOT EXISTS updates ( + rec_type TEXT, + loinc_num TEXT, + component TEXT, + property TEXT, + time_aspct TEXT, + system TEXT, + scale_typ TEXT, + method_typ TEXT, + class TEXT, + PRIMARY KEY (rec_type, loinc_num) +) WITHOUT ROWID; + +-- AccessoryFiles/Updates/UpdatesAdditionalFields.csv +CREATE TABLE IF NOT EXISTS updates_additional_fields ( + rec_type TEXT, + loinc_num TEXT, + component TEXT, + property TEXT, + time_aspct TEXT, + system TEXT, + scale_typ TEXT, + method_typ TEXT, + class TEXT, + version_last_changed TEXT, + chng_type TEXT, + definition_description TEXT, + status TEXT, + consumer_name TEXT, + classtype TEXT, + formula TEXT, + exmpl_answers TEXT, + survey_quest_text TEXT, + survey_quest_src TEXT, + units_required TEXT, + related_names_2 TEXT, + shortname TEXT, + order_obs TEXT, + hl7_field_subfield_id TEXT, + external_copyright_notice TEXT, + example_units TEXT, + long_common_name TEXT, + example_ucum_units TEXT, + status_reason TEXT, + status_text TEXT, + change_reason_public TEXT, + common_test_rank INTEGER, + common_order_rank INTEGER, + hl7_attachment_structure TEXT, + external_copyright_link TEXT, + panel_type TEXT, + ask_at_order_entry TEXT, + associated_observations TEXT, + version_first_released TEXT, + valid_hl7_attachment_request TEXT, + display_name TEXT, + PRIMARY KEY (rec_type, loinc_num) +) WITHOUT ROWID; + +-- Full-text search over LOINC terms. External-content FTS5 references +-- `loinc.rowid`; the native LOINC index step rebuilds it after source +-- rows have been imported. +CREATE VIRTUAL TABLE IF NOT EXISTS loinc_fts USING fts5( + long_common_name, + component, + system, + related_names_2, + shortname, + display_name, + content='loinc', + content_rowid='rowid', + tokenize='unicode61 remove_diacritics 2' +); + +CREATE VIRTUAL TABLE IF NOT EXISTS loinc_variant_fts USING fts5( + loinc_num UNINDEXED, + variant_id UNINDEXED, + iso_language UNINDEXED, + iso_country UNINDEXED, + long_common_name, + linguistic_variant_display_name, + shortname, + component, + related_names_2, + tokenize='unicode61 remove_diacritics 2' +); diff --git a/src/com/eldrix/hades/cmd.clj b/src/com/eldrix/hades/cmd.clj index 3d3776f..18e36d8 100644 --- a/src/com/eldrix/hades/cmd.clj +++ b/src/com/eldrix/hades/cmd.clj @@ -2,7 +2,6 @@ "Command-line entry point for the Hades FHIR terminology server." (:gen-class) (:require [clojure.data.json :as json] - [clojure.core.async :as async] [clojure.pprint :as pp] [clojure.spec.alpha :as s] [clojure.string :as str] @@ -12,12 +11,14 @@ [com.eldrix.hades.impl.http :as http] [com.eldrix.hades.impl.mcp.server :as mcp-server] [com.eldrix.hades.impl.fhir-package :as fhir-package] - [com.eldrix.hades.impl.index.sqlite :as sqlite-index] - [com.eldrix.hades.impl.loaders.fhir :as fhir-loader] - [com.eldrix.hades.impl.loaders.loinc :as loinc-loader] - [com.eldrix.hades.impl.protocols :as protos] + [com.eldrix.hades.providers.ftrm.index :as ftrm-index] + [com.eldrix.hades.providers.common.fhir-loader :as fhir-loader] + [com.eldrix.hades.providers.loinc.import :as loinc-import] + [com.eldrix.hades.providers.loinc.index :as loinc-index] + [com.eldrix.hades.providers.loinc.loader :as loinc-loader] + [com.eldrix.hades.protocols :as protos] [com.eldrix.hades.impl.sources :as sources] - [com.eldrix.hades.impl.sqlite.db :as sqlite-db] + [com.eldrix.hades.providers.ftrm.db :as ftrm-db] [com.eldrix.hermes.core :as hermes] [com.eldrix.hermes.download :as download] [com.eldrix.hermes.importer :as importer]) @@ -74,15 +75,12 @@ (hermes/import-snomed file dirs :exclude importer/default-exclude)) (defn- import-loinc! [file roots] - (let [ch (loinc-loader/stream-releases roots) - result (sqlite-index/import-fhir-data file ch {:loader-type "loinc-csv"})] - (log/info "loinc import complete" - (merge {:file file :sources (count roots)} - (summarise-resources (:resources result)))) - result)) + (log/info "loinc import" {:file file :sources (count roots) :paths (vec roots)}) + (doseq [root roots] + (loinc-import/import-release! file root))) (defn- import-fhir-json! [file files] - (let [result (sqlite-index/build! file #(fhir-loader/load-files files) + (let [result (ftrm-index/build! file #(fhir-loader/load-files files) {:loader-type "fhir-json"})] (log/info "fhir-json import complete" (merge {:file file :files (count files)} @@ -103,7 +101,11 @@ :fhir-tx-db (let [path (.getPath file)] (println (str " → index: " path)) - (sqlite-index/index! path)) + (ftrm-index/index! path)) + :loinc-db + (let [path (.getPath file)] + (println (str " → index: " path)) + (loinc-index/index! path)) ;; Release-only entries (rf2, loinc) — silently skipped so a chained ;; pipeline that mixes release sources with built artefacts doesn't ;; fail spuriously. fhir-json gets here too but indexing it is a no-op. @@ -115,7 +117,7 @@ (defn- compact-one [{:keys [kind ^File file ^File dir]}] (case kind :hermes-db (let [path (.getPath dir)] (println (str " → compact: " path)) (hermes/compact path)) - :fhir-tx-db (let [path (.getPath file)] (println (str " → vacuum: " path)) (sqlite-db/vacuum! path)) + :fhir-tx-db (let [path (.getPath file)] (println (str " → vacuum: " path)) (ftrm-db/vacuum! path)) nil)) (defn- files-or-throw [paths] @@ -160,6 +162,12 @@ "import — they target different database formats.") {:rf2 rf2-dirs :loinc loinc-dirs :fhir-json (mapv #(.getPath ^File %) fhir-json-files)})) + (when (and (seq loinc-dirs) (seq fhir-json-files)) + (cli-error ::mixed-sources + (str "Cannot mix LOINC releases with FHIR JSON in one import " + "— they target different database formats.") + {:loinc loinc-dirs + :fhir-json (mapv #(.getPath ^File %) fhir-json-files)})) (when (seq rf2-dirs) (import-rf2! file rf2-dirs)) (when (seq loinc-dirs) (import-loinc! file loinc-dirs)) (when (seq fhir-json-files) (import-fhir-json! file fhir-json-files)))) @@ -181,24 +189,17 @@ files)))) (defn- list-loinc [dir] - (let [ch (loinc-loader/stream-release dir) - counts (loop [counts {}] - (if-let [batch (async/> by-type + (map (fn [[type rows]] + {:type (name type) :rows rows})) + (sort-by :type))))) (defn- list-fhir-json [files] (let [data (fhir-loader/load-files files) @@ -220,14 +221,14 @@ (when (seq cm) (println "\nConceptMaps:") (pp/print-table cm)))) (defn- list-fhir-tx-db [path] - (let [ds (sqlite-db/open path)] + (let [ds (ftrm-db/open path)] (try - (let [resources (sqlite-db/list-resources ds)] + (let [resources (ftrm-db/list-resources ds)] (println (str "\n=== FHIR terminology container " path " ===")) (println (str " Resources: " (count resources))) (pp/print-table (map #(select-keys % [:resource-type :url :version :concept-count]) resources))) - (finally (sqlite-db/close! ds))))) + (finally (ftrm-db/close! ds))))) (defn- list-hermes-db [path] (let [st (hermes/status path {:counts? true :log? false})] @@ -273,7 +274,7 @@ (try (some-> (download/download id (cond-> (dissoc opts :dist) version (assoc :release-date version))) - .toString) + str) (catch IllegalArgumentException _ (cli-error ::unknown-distribution (str "Unrecognised SNOMED distribution: " id ". " diff --git a/src/com/eldrix/hades/impl/composite.clj b/src/com/eldrix/hades/composite.clj similarity index 87% rename from src/com/eldrix/hades/impl/composite.clj rename to src/com/eldrix/hades/composite.clj index a66572c..0d3dc07 100644 --- a/src/com/eldrix/hades/impl/composite.clj +++ b/src/com/eldrix/hades/composite.clj @@ -1,4 +1,4 @@ -(ns com.eldrix.hades.impl.composite +(ns com.eldrix.hades.composite "Composite TerminologyService. Holds the catalogues built by the boot driver (or supplied directly to @@ -24,11 +24,11 @@ (:require [clojure.spec.alpha :as s] [clojure.string :as str] [clojure.tools.logging.readable :as log] - [com.eldrix.hades.impl.canonical :as canonical] - [com.eldrix.hades.impl.issues :as issues] - [com.eldrix.hades.impl.protocols :as protos] - [com.eldrix.hades.impl.protocols.result :as result] - [com.eldrix.hades.impl.supplement :as supplement])) + [com.eldrix.hades.providers.common.canonical :as canonical] + [com.eldrix.hades.providers.common.issues :as issues] + [com.eldrix.hades.protocols :as protos] + [com.eldrix.hades.protocols.result :as result] + [com.eldrix.hades.providers.common.supplement :as supplement])) (set! *warn-on-reflection* true) @@ -72,12 +72,22 @@ (when (and resolved (not= resolved key)) (lookup-impl nil codesystems resolved))))) +(defn- dynamic-valueset + [valuesets key] + (let [[url version] (canonical/parse-versioned-uri key)] + (some (fn [vs] + (when (seq (protos/vs-metadata vs {:url url :version version})) + vs)) + (distinct (vals valuesets))))) + (defn find-valueset [{:keys [valuesets naming-systems]} key] (or (lookup-impl nil valuesets key) + (dynamic-valueset valuesets key) (let [resolved (resolve-canonical naming-systems key)] (when (and resolved (not= resolved key)) - (lookup-impl nil valuesets resolved))))) + (or (lookup-impl nil valuesets resolved) + (dynamic-valueset valuesets resolved)))))) (defn available-versions "List all registered versions for a system URL." @@ -85,8 +95,8 @@ (let [prefix (str system "|")] (distinct (keep (fn [k] - (when (and (string? k) (.startsWith ^String k prefix)) - (.substring ^String k (count prefix)))) + (when (and (string? k) (str/starts-with? k prefix)) + (subs k (count prefix)))) (keys codesystems))))) (defn find-matching-version @@ -108,20 +118,65 @@ ;; --------------------------------------------------------------------------- (defn- matches-cm-request? - [{desc-url :url desc-sys :system desc-tgt :target} + [{desc-url :url desc-sys :system desc-tgt :target pairs :pairs} {req-url :url req-sys :system req-tgt :target}] (cond req-url (or (= req-url desc-url) (and desc-url (= (canonical/uri-without-query req-url) desc-url))) - (and req-sys req-tgt) (and (= req-sys desc-sys) (= req-tgt desc-tgt)) + (and req-sys req-tgt) (and (or (= req-sys desc-sys) + (some #(= req-sys (:system %)) pairs)) + (or (= req-tgt desc-tgt) + (some #(= req-tgt (:target %)) pairs))) :else false)) -(defn- candidate-cm-impls +(defn- candidate-cm-entries [conceptmaps request] (vec (distinct (for [{:keys [impl description]} conceptmaps :when (matches-cm-request? description request)] - impl)))) + {:impl impl :description description})))) + +(defn- candidate-cm-impls + [conceptmaps request] + (mapv :impl (candidate-cm-entries conceptmaps request))) + +(defn- translate-not-found + [{:keys [url system target]}] + (let [msg (if url + (str "A definition for ConceptMap '" url "' could not be found") + (str "No ConceptMap matched system='" system "' target='" target "'"))] + {:result false + :message msg + :not-found true + :issues [{:severity "error" + :type "not-found" + :details-code "not-found" + :text msg}]})) + +(defn- match-signature + [result] + (->> (:matches result) + (map #(select-keys % [:system :code :version])) + set)) + +(defn- ambiguous-cm-result + [system target] + (let [msg (str "Multiple ConceptMaps match the request — " + "supply `:url` to disambiguate. " + "system='" system "' target='" target "'")] + {:result false + :message msg + :issues [{:severity "error" + :type "invalid" + :details-code "ambiguous-target" + :text msg}]})) + +(defn- params-for-cm-entry + [params {:keys [description]}] + (cond-> params + (nil? (:url params)) (assoc :url (:url description)) + (and (nil? (:version params)) (:version description)) + (assoc :version (:version description)))) ;; --------------------------------------------------------------------------- ;; Cross-provider concerns @@ -319,16 +374,7 @@ (if-let [cs (find-codesystem this lookup-key)] (-> (protos/cs-validate-code cs (assoc params :system canonical)) (issues/add-inactive-warning)) - (let [msg (str "A definition for CodeSystem '" system - "' could not be found, so the code cannot be validated")] - {:result false - :code (when code (keyword code)) - :system system - :message msg - :x-unknown-system system - :issues [{:severity "error" :type "not-found" - :details-code "not-found" :text msg - :expression ["system"]}]})))) + (issues/unknown-system-validate system code)))) (cs-subsumes [this {:keys [systemA systemB] :as params}] (cond @@ -341,13 +387,7 @@ :else (if-let [cs (find-codesystem this systemA)] (protos/cs-subsumes cs params) - (let [msg (str "A definition for the code system '" systemA - "' could not be found, so subsumption cannot be tested")] - {:not-found true - :x-unknown-system systemA - :issues [{:severity "error" :type "not-found" - :details-code "not-found" :text msg - :expression ["system"]}]})))) + (issues/unknown-system-subsumes systemA)))) (cs-expand* [this {:keys [system version] :as query}] (let [lookup-key (canonical/versioned-uri system version)] @@ -397,26 +437,31 @@ (protos/cm-resource cm params))) (cm-translate [_ {:keys [url system target] :as params}] - (let [hits (candidate-cm-impls conceptmaps {:url url :system system :target target})] + (let [hits (candidate-cm-entries conceptmaps {:url url :system system :target target})] (cond - (empty? hits) nil + (empty? hits) (translate-not-found params) (= 1 (count hits)) - (protos/cm-translate (first hits) params) - - ;; Multiple ConceptMaps match a system+target pair (different - ;; canonicals, different versions). Force the caller to disambiguate - ;; with `:url` rather than guessing which map they want. + (let [{:keys [impl] :as hit} (first hits)] + (protos/cm-translate impl (params-for-cm-entry params hit))) + + ;; Multiple ConceptMaps can share a broad system/target pair (for + ;; example, LOINC answer maps and LOINC part maps both target SNOMED). + ;; Use the requested source code as an additional discriminator. If + ;; only one map knows the code, dispatch to it; if several return the + ;; same target set, return that set; if several return different target + ;; sets, preserve the ambiguity instead of guessing clinically. :else - (let [msg (str "Multiple ConceptMaps match the request — " - "supply `:url` to disambiguate. " - "system='" system "' target='" target "'")] - {:result false - :message msg - :issues [{:severity "error" - :type "invalid" - :details-code "ambiguous-target" - :text msg}]}))))) + (let [results (keep (fn [hit] + (let [r (protos/cm-translate (:impl hit) + (params-for-cm-entry params hit))] + (when (seq (:matches r)) r))) + hits) + signatures (set (map match-signature results))] + (cond + (empty? results) {:result false :message "No matches found"} + (= 1 (count signatures)) (first results) + :else (ambiguous-cm-result system target))))))) ;; --------------------------------------------------------------------------- ;; Search — FHIR REST search for CodeSystem / ValueSet @@ -606,42 +651,40 @@ issues)))))) codings) first-not-found (first (filter :not-found per-coding))] - (if first-not-found - first-not-found - (let [valid (last (filter :result per-coding)) - invalid (remove :result per-coding) - all-issues (into [] (mapcat :issues) invalid) - cs-error-msgs (into [] (comp (keep #(when (= "invalid-code" (:details-code %)) (:text %))) - (distinct)) - all-issues) - error-msg (first cs-error-msgs)] - (if valid - (cond-> valid - (seq invalid) (assoc :result false) - (seq all-issues) (update :issues (fnil into []) all-issues) - error-msg (assoc :message error-msg)) - (let [version-issue-codes #{"vs-invalid" "version-error" "version-mismatch"} - best-invalid (last (filter (fn [r] - (and (:display r) (:system r) - (some #(contains? version-issue-codes (:details-code %)) - (:issues r)) - (not (some #(= "not-in-vs" (:details-code %)) - (:issues r))))) - per-coding))] - (if best-invalid - (assoc best-invalid :result false) - (let [url (:url base-params) - vs-ver (:version (vs-meta svc url)) - vs-url-ver (if vs-ver (str url "|" vs-ver) url) - no-valid-msg (str "No valid coding was found for the value set '" vs-url-ver "'") - combined-msg (if (seq cs-error-msgs) - (str no-valid-msg "; " (str/join "; " cs-error-msgs)) - no-valid-msg) - no-valid-issue {:severity "error" :type "code-invalid" - :details-code "not-in-vs" :text no-valid-msg}] - {:result false - :message combined-msg - :issues (into [no-valid-issue] all-issues)})))))))) + (or first-not-found + (let [valid (last (filter :result per-coding)) + invalid (remove :result per-coding) + all-issues (into [] (mapcat :issues) invalid) + cs-error-msgs (into [] (comp (keep #(when (= "invalid-code" (:details-code %)) (:text %))) + (distinct)) + all-issues)] + (if valid + (cond-> valid + (seq invalid) (assoc :result false) + (seq all-issues) (update :issues (fnil into []) all-issues) + (seq cs-error-msgs) (assoc :message (first cs-error-msgs))) + (let [version-issue-codes #{"vs-invalid" "version-error" "version-mismatch"} + best-invalid (last (filter (fn [r] + (and (:display r) (:system r) + (some #(contains? version-issue-codes (:details-code %)) + (:issues r)) + (not-any? #(= "not-in-vs" (:details-code %)) + (:issues r)))) + per-coding))] + (if best-invalid + (assoc best-invalid :result false) + (let [url (:url base-params) + vs-ver (:version (vs-meta svc url)) + vs-url-ver (if vs-ver (str url "|" vs-ver) url) + no-valid-msg (str "No valid coding was found for the value set '" vs-url-ver "'") + combined-msg (if (seq cs-error-msgs) + (str no-valid-msg "; " (str/join "; " cs-error-msgs)) + no-valid-msg) + no-valid-issue {:severity "error" :type "code-invalid" + :details-code "not-in-vs" :text no-valid-msg}] + {:result false + :message combined-msg + :issues (into [no-valid-issue] all-issues)})))))))) ;; --------------------------------------------------------------------------- ;; Construction from provider impls diff --git a/src/com/eldrix/hades/core.clj b/src/com/eldrix/hades/core.clj index 7654327..b2d87ef 100644 --- a/src/com/eldrix/hades/core.clj +++ b/src/com/eldrix/hades/core.clj @@ -33,9 +33,9 @@ relevant `impl` namespaces directly." (:require [clojure.spec.alpha :as s] [com.eldrix.hades.impl.paths :as paths] - [com.eldrix.hades.impl.composite :as composite] - [com.eldrix.hades.impl.protocols :as protos] - [com.eldrix.hades.impl.protocols.result :as result])) + [com.eldrix.hades.composite :as composite] + [com.eldrix.hades.protocols :as protos] + [com.eldrix.hades.protocols.result :as result])) (set! *warn-on-reflection* true) @@ -66,7 +66,7 @@ container, or a file/tree of FHIR JSON resources: (hades/open [\".hades/snomed-intl-20250201.db\" - \".hades/loinc-2.81.db\"]) + \".hades/loinc-2.82.db\"]) RF2 and LOINC release sources must be imported first. Provider-level construction lives in `impl` namespaces. @@ -164,12 +164,12 @@ (s/fdef translate :args (s/cat :svc some? :params map?) - :ret (s/nilable ::translate-result)) + :ret ::translate-result) (defn translate "ConceptMap $translate. `params` may carry `:url` (canonical lookup), or `:system :target` (system-pair lookup), plus `:code`. Returns a - `::translate-result` or nil if no provider matches the request." + `::translate-result`." [svc params] (protos/cm-translate svc params)) diff --git a/src/com/eldrix/hades/impl/fhir_package.clj b/src/com/eldrix/hades/impl/fhir_package.clj index 2e6defc..26569e3 100644 --- a/src/com/eldrix/hades/impl/fhir_package.clj +++ b/src/com/eldrix/hades/impl/fhir_package.clj @@ -10,7 +10,7 @@ [clojure.pprint :as pp] [clojure.string :as str] [clojure.tools.logging.readable :as log] - [com.eldrix.hades.impl.canonical :as canonical]) + [com.eldrix.hades.providers.common.canonical :as canonical]) (:import (java.net URI) (java.net.http HttpClient HttpRequest HttpResponse$BodyHandlers) (java.nio.file Files StandardCopyOption) diff --git a/src/com/eldrix/hades/impl/http.clj b/src/com/eldrix/hades/impl/http.clj index 018ad59..ef691a2 100644 --- a/src/com/eldrix/hades/impl/http.clj +++ b/src/com/eldrix/hades/impl/http.clj @@ -5,12 +5,12 @@ [clojure.string :as str] [clojure.tools.logging.readable :as log] [com.eldrix.hades.core :as hades] - [com.eldrix.hades.impl.canonical :as canonical] - [com.eldrix.hades.impl.composite :as composite] + [com.eldrix.hades.providers.common.canonical :as canonical] + [com.eldrix.hades.composite :as composite] [com.eldrix.hades.impl.load :as load-fhir] - [com.eldrix.hades.impl.loaders.fhir :as loaders] + [com.eldrix.hades.providers.common.fhir-loader :as loaders] [com.eldrix.hades.impl.metadata :as metadata] - [com.eldrix.hades.impl.protocols :as protos] + [com.eldrix.hades.protocols :as protos] [com.eldrix.hades.impl.wire :as wire] [io.pedestal.connector :as conn] [io.pedestal.http.jetty :as jetty] @@ -33,7 +33,7 @@ ^String [data] (let [sw (java.io.StringWriter. 1024)] (write-json-fn sw data) - (.toString sw))) + (str sw))) (defn- payload-too-large [size limit] (ex-info (str "Request body exceeds the configured limit of " limit " bytes (got " size ")") @@ -619,7 +619,7 @@ used-cs (:used-codesystems result) compose-pinned (into #{} (keep :system) (:compose-pins result)) vs-meta (when-let [vs (composite/find-valueset svc url)] - (protos/vs-resource vs {})) + (protos/vs-resource vs {:url url})) vs-version-uri (let [v (:version vs-meta)] (if v (str url "|" v) url)) version-error (when check-system-version @@ -713,8 +713,8 @@ (-> (or requested default-count) (max 0) (min max-count))) (defn- split-modifier [^String k] - (let [idx (.indexOf k ":")] - (if (neg? idx) [k ""] [(subs k 0 idx) (subs k (inc idx))]))) + (let [idx (str/index-of k ":")] + (if idx [(subs k 0 idx) (subs k (inc idx))] [k ""]))) (defn- modifier-error [field mod] {:severity "error" :type "invalid" diff --git a/src/com/eldrix/hades/impl/load.clj b/src/com/eldrix/hades/impl/load.clj index 0990f45..f209a3c 100644 --- a/src/com/eldrix/hades/impl/load.clj +++ b/src/com/eldrix/hades/impl/load.clj @@ -11,8 +11,8 @@ impl/load (this ns) wires them up for callers." (:require [clojure.spec.alpha :as s] - [com.eldrix.hades.impl.index.memory :as index] - [com.eldrix.hades.impl.loaders.fhir :as loaders])) + [com.eldrix.hades.providers.in-memory.index :as index] + [com.eldrix.hades.providers.common.fhir-loader :as loaders])) (declare from-fhir from-fhir-resources build-from-fhir-data) diff --git a/src/com/eldrix/hades/impl/loaders/loinc.clj b/src/com/eldrix/hades/impl/loaders/loinc.clj deleted file mode 100644 index 884dbac..0000000 --- a/src/com/eldrix/hades/impl/loaders/loinc.clj +++ /dev/null @@ -1,614 +0,0 @@ -(ns com.eldrix.hades.impl.loaders.loinc - "LOINC release directory → fhir-data. - - Inputs (Core CSV release + AccessoryFiles): - - LoincTableCore/LoincTableCore.csv → :codesystem-meta + one :concept - per LOINC code. Axis columns (COMPONENT, PROPERTY, TIME_ASPCT, - SYSTEM, SCALE_TYP, METHOD_TYP) are emitted as raw FHIR string - properties. - - LoincTable/MapTo.csv → one :conceptmap (LOINC → LOINC). - - AccessoryFiles/AnswerFile/AnswerList.csv → one :valueset per LL-id - plus one :concept per unique LA-id (so answer-list expansions - resolve into the same http://loinc.org code system, matching the - published FHIR LOINC convention). - - AccessoryFiles/PartFile/Part.csv → one :concept per LP-* part - (PartName as display, STATUS + PartTypeName as properties). - - AccessoryFiles/PartFile/LoincPartLink_Primary.csv → one - `:concept-property` fhir-data entry per (LOINC-num, axis), each - carrying a Coding property pointing at the LP-part. Surfaces e.g. - `property=COMPONENT` to recover the canonical analyte concept. - - AccessoryFiles/ComponentHierarchyBySystem/ComponentHierarchyBySystem.csv - → one `:concept-parent` fhir-data entry per row (for both LP- and - LOINC-num children), so $subsumes and `descendant-of` $expand - work over LOINC's hierarchy. - - AccessoryFiles/LinguisticVariants/LinguisticVariants.csv + - LinguisticVariant.csv → multi-lingual `:designations` - (display + COMPONENT/PROPERTY/SYSTEM…) on each LOINC-num concept. - - Not loaded: full Loinc.csv extra columns (ORDER_OBS, - EXAMPLE_UCUM_UNITS, …), supplementary part-link properties - (`LoincPartLink_Supplementary.csv`), Group/PanelsAndForms, - ImagingDocuments, Updates, ChangeSnapshot, ConsumerName. - - Large imports should use `stream-release`, which emits rows through a - bounded channel." - (:require [charred.api :as charred] - [clojure.core.async :as async] - [clojure.java.io :as io] - [clojure.string :as str] - [com.eldrix.hades.impl.canonical :as canonical]) - (:import (java.io Closeable File))) - -(set! *warn-on-reflection* true) - -(def system-uri "http://loinc.org") - -;; --------------------------------------------------------------------------- -;; CSV row maps -;; --------------------------------------------------------------------------- - -(defn- reduce-csv-rows - "Open `f` and reduce over `{header -> cell}` row maps. - Returns `init` when absent. Row maps are short-lived and the channel - carries bounded fhir-data batches, matching the Hermes importer shape." - [rf init ^File f] - (if-not (.exists f) - init - (let [^java.util.function.Supplier supplier - (charred/read-csv-supplier f {:async? false}) - header (vec (.get supplier))] - (try - (loop [acc init] - (if-let [row (.get supplier)] - (recur (rf acc (zipmap header row))) - acc)) - (finally - (when (instance? Closeable supplier) - (.close ^Closeable supplier))))))) - -(defn- read-csv! - "Open `f` and call `row-fn` with each row map. - Returns nil when the file is absent." - [^File f row-fn] - (reduce-csv-rows (fn [_ row] (row-fn row) nil) nil f)) - -(defn- put-fhir-data! [ch fd] - (when-not (async/>!! ch fd) - (throw (ex-info "LOINC stream closed by consumer" - {:reason :stream-closed})))) - -;; --------------------------------------------------------------------------- -;; CodeSystem meta -;; --------------------------------------------------------------------------- - -(def ^:private property-defs - "CodeSystem.property[] declarations for every Core column surfaced as - `:properties`, so the in-memory provider can echo them in $lookup. - Axis columns are typed `string` (not `Coding`)." - [{"code" "STATUS" "type" "code" - "uri" "http://loinc.org/property/STATUS" - "description" "Status of the term (ACTIVE, TRIAL, DISCOURAGED, DEPRECATED)."} - {"code" "CLASS" "type" "string" - "uri" "http://loinc.org/property/CLASS" - "description" "An arbitrary classification of the terms for grouping related observations."} - {"code" "CLASSTYPE" "type" "string" - "uri" "http://loinc.org/property/CLASSTYPE" - "description" "Class type — 1=Laboratory, 2=Clinical, 3=Claims attachments, 4=Surveys."} - {"code" "COMPONENT" "type" "string" - "uri" "http://loinc.org/property/COMPONENT" - "description" "First major axis: the analyte/component."} - {"code" "PROPERTY" "type" "string" - "uri" "http://loinc.org/property/PROPERTY" - "description" "Second major axis: the kind of property."} - {"code" "TIME_ASPCT" "type" "string" - "uri" "http://loinc.org/property/TIME_ASPCT" - "description" "Third major axis: the time aspect."} - {"code" "SYSTEM" "type" "string" - "uri" "http://loinc.org/property/SYSTEM" - "description" "Fourth major axis: the system/sample type."} - {"code" "SCALE_TYP" "type" "string" - "uri" "http://loinc.org/property/SCALE_TYP" - "description" "Fifth major axis: the scale of measurement."} - {"code" "METHOD_TYP" "type" "string" - "uri" "http://loinc.org/property/METHOD_TYP" - "description" "Sixth major axis: the method (when applicable)."} - {"code" "SHORTNAME" "type" "string" - "uri" "http://loinc.org/property/SHORTNAME" - "description" "Short name for the LOINC term."} - {"code" "EXTERNAL_COPYRIGHT_NOTICE" "type" "string" - "uri" "http://loinc.org/property/EXTERNAL_COPYRIGHT_NOTICE" - "description" "Copyright notice for terms sourced from external organisations."} - {"code" "VersionFirstReleased" "type" "string" - "uri" "http://loinc.org/property/VersionFirstReleased" - "description" "LOINC release in which this term was first published."} - {"code" "VersionLastChanged" "type" "string" - "uri" "http://loinc.org/property/VersionLastChanged" - "description" "Most recent LOINC release in which this term changed."}]) - -(defn- codesystem-meta [version source-path] - {:type :codesystem-meta - :url system-uri - :version version - :case-sensitive true - :hierarchy-meaning nil - :content "complete" - :supplements-target nil - :status "active" - :experimental false - :name "LOINC" - :title "Logical Observation Identifiers, Names and Codes (LOINC)" - :description "LOINC is a freely available terminology for identifying medical laboratory observations and other clinical observations." - :standards-status nil - :property-defs property-defs - :filter-defs [] - :metadata nil - :source-path source-path}) - -;; --------------------------------------------------------------------------- -;; LOINC core concepts -;; --------------------------------------------------------------------------- - -(def ^:private core-property-cols - "CSV columns we surface as concept :properties, in declaration order. - Empty cells are dropped so $lookup doesn't echo blank values." - ["STATUS" "CLASS" "CLASSTYPE" - "COMPONENT" "PROPERTY" "TIME_ASPCT" "SYSTEM" "SCALE_TYP" "METHOD_TYP" - "SHORTNAME" "EXTERNAL_COPYRIGHT_NOTICE" - "VersionFirstReleased" "VersionLastChanged"]) - -(defn- core-row->properties - "Build the FHIR-shaped (string-keyed) :properties vector for one LOINC - Core row. STATUS is emitted as `valueCode`; everything else as - `valueString`." - [row] - (into [] - (keep (fn [col] - (let [v (get row col)] - (when (and v (not (str/blank? v))) - (cond-> {"code" col} - (= col "STATUS") (assoc "valueCode" v) - (not= col "STATUS") (assoc "valueString" v)))))) - core-property-cols)) - -(defn- core-row->concept - [version source-path {:strs [LOINC_NUM LONG_COMMON_NAME SHORTNAME] :as row}] - (let [designations (cond-> [] - (and SHORTNAME (not (str/blank? SHORTNAME))) - (conj {:value SHORTNAME - :use {:system "http://loinc.org" - :code "SHORTNAME" - :display "SHORTNAME"}}))] - {:type :concept - :system system-uri - :version version - :code LOINC_NUM - :display LONG_COMMON_NAME - :definition nil - :designations designations - :properties (core-row->properties row) - :source-path source-path})) - -;; --------------------------------------------------------------------------- -;; MapTo → ConceptMap -;; --------------------------------------------------------------------------- - -(defn- map-to-row->element - [{:strs [LOINC MAP_TO COMMENT]}] - (when (and LOINC MAP_TO (not (str/blank? LOINC)) (not (str/blank? MAP_TO))) - {:code LOINC - :display nil - :target [(cond-> {:code MAP_TO - :display nil - :equivalence "equivalent"} - (and COMMENT (not (str/blank? COMMENT))) - (assoc :comment COMMENT))]})) - -(defn- stream-map-to! - [ch ^File root version] - (let [^File f (io/file root "LoincTable" "MapTo.csv") - path (.getPath f)] - (when (.exists f) - (let [elements (reduce-csv-rows - (fn [elements row] - (if-let [el (map-to-row->element row)] - (conj elements el) - elements)) - [] - f)] - (when (seq elements) - (put-fhir-data! ch {:type :conceptmap - :url (str system-uri "/maps/MapTo") - :version version - :source-uri system-uri - :source-version version - :target-uri system-uri - :target-version version - :metadata nil - :groups [{:source system-uri - :source-version version - :target system-uri - :target-version version - :elements elements}] - :source-path path})))))) - -;; --------------------------------------------------------------------------- -;; AnswerList → ValueSets + LA-concepts -;; --------------------------------------------------------------------------- - -(defn- answer-row->contains - [{:strs [AnswerStringId DisplayText]}] - (when (and AnswerStringId (not (str/blank? AnswerStringId))) - (cond-> {:code AnswerStringId :system system-uri} - (and DisplayText (not (str/blank? DisplayText))) (assoc :display DisplayText)))) - -(defn- la-concept [version source-path code display] - {:type :concept - :system system-uri - :version version - :code code - :display display - :definition nil - :designations [] - :properties [] - :parent-code nil - :source-path source-path}) - -(defn- stream-answer-lists! - [ch ^File root version] - (let [^File f (io/file root "AccessoryFiles" "AnswerFile" "AnswerList.csv") - path (.getPath f)] - (when (.exists f) - (let [{:keys [lists la]} - (reduce-csv-rows - (fn [{:keys [la] :as acc} - {:strs [AnswerListId AnswerListName AnswerStringId DisplayText] :as row}] - (let [acc (cond-> acc - (and AnswerStringId - (not (str/blank? AnswerStringId)) - (not (contains? la AnswerStringId))) - (assoc-in [:la AnswerStringId] DisplayText))] - (if-let [contains (answer-row->contains row)] - (update-in acc [:lists AnswerListId] - (fn [{:keys [name rows]}] - {:name (or name AnswerListName AnswerListId) - :rows (conj (or rows []) contains)})) - acc))) - {:lists {} :la {}} - f)] - (doseq [[code display] la] - (put-fhir-data! ch (la-concept version path code display))) - (doseq [[list-id {:keys [name rows]}] lists] - (let [include-concepts (mapv (fn [c] - (cond-> {"code" (:code c)} - (:display c) (assoc "display" (:display c)))) - rows) - compose {"include" [{"system" system-uri - "concept" include-concepts}]}] - (put-fhir-data! ch {:type :valueset - :url (str system-uri "/vs/" list-id) - :version version - :metadata {"resourceType" "ValueSet" - "url" (str system-uri "/vs/" list-id) - "name" (or name list-id) - "status" "active" - "compose" compose} - :compose compose - :source-path path}))))))) - -;; --------------------------------------------------------------------------- -;; Part.csv → LP-* concepts -;; --------------------------------------------------------------------------- - -(defn- part-row->concept - [version source-path {:strs [PartNumber PartDisplayName PartName PartTypeName Status]}] - (let [display (or (some-> PartDisplayName str/trim not-empty) PartName)] - (when (and PartNumber (not (str/blank? PartNumber))) - {:type :concept - :system system-uri - :version version - :code PartNumber - :display display - :definition nil - :designations [] - :properties (cond-> [] - (and Status (not (str/blank? Status))) - (conj {"code" "STATUS" "valueCode" Status}) - (and PartTypeName (not (str/blank? PartTypeName))) - (conj {"code" "PartTypeName" "valueString" PartTypeName})) - :source-path source-path}))) - -;; --------------------------------------------------------------------------- -;; LoincPartLink_Primary.csv → standalone :concept-property entries -;; -;; Each row carries (LOINC-num, axis, LP-part). The SQLite indexer routes -;; standalone `:concept-property` entries straight into `concept_property` -;; so we emit one per row instead of building a `{code → [link…]}` map up -;; front (~100–200 MB on modern releases). -;; --------------------------------------------------------------------------- - -(defn- part-link-row->property - [version source-path {:strs [LoincNumber PartNumber PartTypeName PartName]}] - (when (and LoincNumber PartNumber PartTypeName - (not (str/blank? LoincNumber)) - (not (str/blank? PartNumber)) - (not (str/blank? PartTypeName))) - {:type :concept-property - :system system-uri - :version version - :code LoincNumber - :property {"code" PartTypeName - "valueCoding" - (cond-> {"system" system-uri - "code" PartNumber} - (and PartName (not (str/blank? PartName))) - (assoc "display" PartName))} - :source-path source-path})) - -(defn- stream-part-links! - [ch ^File root version] - (let [^File f (io/file root "AccessoryFiles" "PartFile" "LoincPartLink_Primary.csv") - path (.getPath f)] - (when (.exists f) - (read-csv! f - (fn [row] - (when-let [fd (part-link-row->property version path row)] - (put-fhir-data! ch fd))))))) - -;; --------------------------------------------------------------------------- -;; ComponentHierarchyBySystem.csv → standalone :concept-parent entries -;; -;; Same pattern as part-links: one fhir-data entry per row. Both LOINC-num -;; and LP-* parents flow through the same emission path; the SQLite -;; indexer doesn't care which is which. -;; --------------------------------------------------------------------------- - -(defn- hierarchy-row->parent - [version source-path {:strs [CODE IMMEDIATE_PARENT]}] - (when (and CODE IMMEDIATE_PARENT - (not (str/blank? CODE)) - (not (str/blank? IMMEDIATE_PARENT)) - (not= CODE IMMEDIATE_PARENT)) - {:type :concept-parent - :system system-uri - :version version - :code CODE - :parent IMMEDIATE_PARENT - :source-path source-path})) - -(defn- stream-hierarchy! - [ch ^File root version] - (let [^File f (io/file root "AccessoryFiles" "ComponentHierarchyBySystem" - "ComponentHierarchyBySystem.csv") - path (.getPath f)] - (when (.exists f) - (read-csv! f - (fn [row] - (when-let [fd (hierarchy-row->parent version path row)] - (put-fhir-data! ch fd))))))) - -;; --------------------------------------------------------------------------- -;; LinguisticVariants/LinguisticVariant.csv → multi-lingual designations -;; --------------------------------------------------------------------------- - -(def ^:private linguistic-cols - ;; Columns in a per-language file we surface as a designation. - ;; `LONG_COMMON_NAME` is treated as the localised display; the others - ;; become typed designations whose `use.code` carries the column name. - ["LONG_COMMON_NAME" "COMPONENT" "PROPERTY" "TIME_ASPCT" "SYSTEM" - "SCALE_TYP" "METHOD_TYP" "CLASS" "SHORTNAME" - "RELATEDNAMES2" "LinguisticVariantDisplayName"]) - -(defn- ling-row->designation-entries - "Yield zero or more `:concept-designation` fhir-data entries for one - per-language row. Each entry stands alone — the SQLite indexer routes - them straight into `concept_designation` without per-code joining, - so the lingual stream never materialises into a giant - `{code → [designations]}` map." - [version source-path language {:strs [LOINC_NUM] :as row}] - (when (and LOINC_NUM (not (str/blank? LOINC_NUM))) - (keep (fn [col] - (let [v (get row col)] - (when (and v (not (str/blank? v))) - {:type :concept-designation - :system system-uri - :version version - :code LOINC_NUM - :value v - :language language - :use {:system "http://loinc.org" - :code col - :display col} - :source-path source-path}))) - linguistic-cols))) - -(defn- bcp47-tag - "Map an ISO 639 + ISO 3166 pair to a BCP 47 tag, e.g. (\"de\" \"DE\") → \"de-DE\"." - [lang country] - (cond - (and (not (str/blank? lang)) (not (str/blank? country))) - (str (str/lower-case lang) "-" (str/upper-case country)) - (not (str/blank? lang)) - (str/lower-case lang) - :else nil)) - -(defn- linguistic-variant-files - "Eager seq of `[language file]` tuples for every per-language file - referenced by `LinguisticVariants.csv`. The catalog itself is small - (~22 rows). Returns nil when the catalog is missing." - [^File root] - (let [^File catalog (io/file root "AccessoryFiles" "LinguisticVariants" - "LinguisticVariants.csv")] - (when (.exists catalog) - (reduce-csv-rows - (fn [files {:strs [ID ISO_LANGUAGE ISO_COUNTRY]}] - (let [tag (bcp47-tag ISO_LANGUAGE ISO_COUNTRY) - fname (when (and ID ISO_LANGUAGE ISO_COUNTRY) - (str ISO_LANGUAGE ISO_COUNTRY ID "LinguisticVariant.csv")) - ^File f (when fname - (io/file root "AccessoryFiles" "LinguisticVariants" fname))] - (if (and tag f (.exists f)) - (conj files [tag f]) - files))) - [] - catalog)))) - -(defn- stream-linguistic-designations! - [ch ^File root version] - (doseq [[language ^File f] (linguistic-variant-files root)] - (let [path (.getPath f)] - (read-csv! f - (fn [row] - (doseq [entry (ling-row->designation-entries version path language row)] - (put-fhir-data! ch entry))))))) - -;; --------------------------------------------------------------------------- -;; Public API -;; --------------------------------------------------------------------------- - -(defn- stream-core-table! - [ch ^File root version] - (let [^File f (io/file root "LoincTableCore" "LoincTableCore.csv") - path (.getPath f)] - (when-not (.exists f) - (throw (ex-info (str "LoincTableCore.csv not found: " path) - {:reason :missing-core-table :source-path path}))) - (put-fhir-data! ch (codesystem-meta version path)) - (read-csv! f - (fn [row] - (put-fhir-data! ch (core-row->concept version path row)))))) - -(defn- stream-parts! - [ch ^File root version] - (let [^File f (io/file root "AccessoryFiles" "PartFile" "Part.csv") - path (.getPath f)] - (when (.exists f) - (read-csv! f - (fn [row] - (when-let [concept (part-row->concept version path row)] - (put-fhir-data! ch concept))))))) - -(defn read-version - "Return the highest `VersionLastChanged` value across all rows of - `LoincTableCore.csv` under `canonical-root`. Every release bumps at - least one concept's last-changed marker, so `max(VersionLastChanged)` - is the release version itself — content-derived, immune to - operator-renamed unzip directories. Returns nil when the file is - absent or carries no recognisable version values." - [^File canonical-root] - (let [^File f (io/file canonical-root "LoincTableCore" "LoincTableCore.csv")] - (when (.exists f) - (->> (reduce-csv-rows - (fn [acc row] - (let [v (get row "VersionLastChanged")] - (cond-> acc (not (str/blank? v)) (conj v)))) - #{} f) - (sort canonical/semver-compare) - last)))) - -(defn- release-version [^File canonical-root version] - (let [v (or version (read-version canonical-root))] - (when (str/blank? v) - (throw (ex-info (str "LOINC version could not be derived from " - "LoincTableCore.csv under: " - (.getPath canonical-root)) - {:reason :missing-version - :source-path (.getPath canonical-root)}))) - v)) - -(defn- stream-release* [root {:keys [version]} ch] - (let [^File canonical-root (.getCanonicalFile (io/file root)) - v (release-version canonical-root version)] - (stream-core-table! ch canonical-root v) - (stream-parts! ch canonical-root v) - (stream-part-links! ch canonical-root v) - (stream-hierarchy! ch canonical-root v) - (stream-answer-lists! ch canonical-root v) - (stream-map-to! ch canonical-root v) - (stream-linguistic-designations! ch canonical-root v))) - -(defn stream-release - "Return a channel that streams bounded batches of fhir-data maps for one LOINC release. - The channel is closed when the release is fully streamed. On failure - the final item is `{:type :stream-error :ex e}`." - ([root] (stream-release root nil)) - ([root {:keys [buffer-size batch-size] :as opts}] - (let [ch (async/chan (or buffer-size 8) (partition-all (or batch-size 1000)))] - (async/thread - (try - (stream-release* root opts ch) - (catch Throwable t - (async/>!! ch {:type :stream-error :ex t})) - (finally - (async/close! ch)))) - ch))) - -(defn- stream-error? - "True when a fhir-data item (or batch of items) carries a stream - failure raised by a per-release producer." - [fd] - (cond - (and (map? fd) (= :stream-error (:type fd))) true - (sequential? fd) (some #(= :stream-error (:type %)) fd) - :else false)) - -(defn stream-releases - "Return a channel multiplexing batched fhir-data from every LOINC - release in `roots`. Each release is streamed via `stream-release`; - outputs are forwarded onto the returned channel in order. The - returned channel is closed when all releases finish, when a - release's `:stream-error` item is propagated and aborts streaming, - or when the consumer closes the channel. - - When a producer-side error closes the input channel mid-stream, the - source channel is also closed so the LOINC producer thread parked - on `>!!` to its bounded buffer unblocks rather than grinding through - the rest of the release into nothing." - ([roots] (stream-releases roots nil)) - ([roots opts] - (let [out-ch (async/chan 256)] - (async/thread - (try - (loop [[root & more] (seq roots)] - (when root - (let [src-ch (stream-release root opts) - outcome (loop [] - (if-let [fd (async/!! out-ch fd) :error) - - (async/>!! out-ch fd) (recur) - :else :closed) - :done))] - (case outcome - :done (recur more) - :closed (async/close! src-ch) - :error (async/close! src-ch))))) - (catch Throwable t - (async/>!! out-ch {:type :stream-error :ex t})) - (finally - (async/close! out-ch)))) - out-ch))) - -;; --------------------------------------------------------------------------- -;; Recogniser -;; --------------------------------------------------------------------------- - -(defn- loinc-recognise - "Anchor a LOINC release on `LoincTableCore.csv` — distinctive enough - to identify a release on its own. The release root is the parent - (flat layout) or grandparent (`/LoincTableCore/LoincTableCore.csv`). - Version resolution is the loader's concern; this stays cheap." - [^File f _probe?] - (when (and (.isFile f) (= "LoincTableCore.csv" (.getName f))) - (let [parent (.getParentFile f) - root (if (= "LoincTableCore" (.getName parent)) - (.getParentFile parent) - parent)] - {:dir root}))) - -(def loinc-recogniser - {:id :loinc - :importable? true - :database? false - :recognise loinc-recognise}) diff --git a/src/com/eldrix/hades/impl/mcp/server.clj b/src/com/eldrix/hades/impl/mcp/server.clj index 936b205..4cb67cd 100644 --- a/src/com/eldrix/hades/impl/mcp/server.clj +++ b/src/com/eldrix/hades/impl/mcp/server.clj @@ -1,7 +1,7 @@ (ns com.eldrix.hades.impl.mcp.server "Stdio JSON-RPC 2.0 transport for the Hades MCP server. Reads newline-delimited messages from stdin, dispatches to handlers in - `com.eldrix.hades.impl.mcp`, writes responses to stdout. Logs to + `com.eldrix.hades.impl.mcp.tools`, writes responses to stdout. Logs to stderr; `System/out` is redirected to stderr for the lifetime of the loop so stray prints from any downstream library can't corrupt the wire." @@ -10,7 +10,7 @@ [clojure.java.io :as io] [clojure.string :as str] [clojure.tools.logging.readable :as log] - [com.eldrix.hades.impl.mcp :as mcp]) + [com.eldrix.hades.impl.mcp.tools :as mcp]) (:import (java.io BufferedReader InputStreamReader OutputStreamWriter PrintStream))) (set! *warn-on-reflection* true) diff --git a/src/com/eldrix/hades/impl/mcp.clj b/src/com/eldrix/hades/impl/mcp/tools.clj similarity index 99% rename from src/com/eldrix/hades/impl/mcp.clj rename to src/com/eldrix/hades/impl/mcp/tools.clj index ea9f01c..7b3b259 100644 --- a/src/com/eldrix/hades/impl/mcp.clj +++ b/src/com/eldrix/hades/impl/mcp/tools.clj @@ -1,4 +1,4 @@ -(ns com.eldrix.hades.impl.mcp +(ns com.eldrix.hades.impl.mcp.tools "MCP (Model Context Protocol) tool definitions for Hades. Pure data and handler functions with no transport dependency — suitable for in-process use by any MCP host or LLM integration. The stdio JSON-RPC @@ -231,14 +231,14 @@ :description (str "FHIR ConceptMap $translate. Map a code from one CodeSystem to " "matching code(s) in another. Provide either `url` (canonical of " "a specific ConceptMap) OR both `system` and `target` (lookup a " - "ConceptMap by its source/target system pair).") + "ConceptMap by source CodeSystem and target ValueSet or CodeSystem).") :inputSchema {:type "object" :properties {:code code-schema :url {:type "string" :description "Canonical URL of a ConceptMap."} :system (assoc system-url-schema :description "Source CodeSystem URL (with `target`).") :target {:type "string" - :description "Target CodeSystem URL (with `system`)."} + :description "Target ValueSet or CodeSystem URL (with `system`)."} :version version-schema :display_language display-language-schema} :required ["code"]} diff --git a/src/com/eldrix/hades/impl/paths.clj b/src/com/eldrix/hades/impl/paths.clj index cc837c4..ab92138 100644 --- a/src/com/eldrix/hades/impl/paths.clj +++ b/src/com/eldrix/hades/impl/paths.clj @@ -2,13 +2,14 @@ "Open terminology artefact paths as Hades provider bundles." (:require [clojure.spec.alpha :as s] [clojure.tools.logging.readable :as log] - [com.eldrix.hades.impl.composite :as composite] + [com.eldrix.hades.composite :as composite] [com.eldrix.hades.impl.load :as load-fhir] - [com.eldrix.hades.impl.loaders.fhir :as fhir-loader] - [com.eldrix.hades.impl.snomed :as snomed] + [com.eldrix.hades.providers.common.fhir-loader :as fhir-loader] + [com.eldrix.hades.providers.snomed.provider :as snomed] [com.eldrix.hades.impl.sources :as sources] - [com.eldrix.hades.impl.sqlite.db :as sqlite-db] - [com.eldrix.hades.impl.sqlite.provider :as sqlite-provider] + [com.eldrix.hades.providers.ftrm.db :as ftrm-db] + [com.eldrix.hades.providers.ftrm.provider :as ftrm-provider] + [com.eldrix.hades.providers.loinc.provider :as loinc-provider] [com.eldrix.hermes.core :as hermes]) (:import (java.io Closeable File))) @@ -44,7 +45,7 @@ (defn open-database "Open one built-database entry as a provider bundle. Dispatches on `:kind`; uses `:dir` for Hermes (the DB is a directory) and `:file` - for FTRM (the DB is a file). + for FTRM / native LOINC (the DB is a file). `opts` may carry `:default-locale` (a BCP 47 / Accept-Language string) forwarded to `hermes/open` for Hermes entries." @@ -63,16 +64,25 @@ :fhir-tx-db (let [path (.getPath file) {:keys [datasource codesystem valueset conceptmap naming-system]} - (sqlite-provider/open-providers path) + (ftrm-provider/open-providers path) providers (filterv some? [codesystem valueset conceptmap])] (log/info "registered provider" (merge {:source path :kind :fhir-tx-db :naming-system? (some? naming-system)} - (summarise-resources (sqlite-db/list-resources datasource)))) + (summarise-resources (ftrm-db/list-resources datasource)))) {:providers providers :naming-systems (when naming-system [naming-system]) :closers (when (instance? Closeable datasource) - [#(.close ^Closeable datasource)])})))) + [#(.close ^Closeable datasource)])}) + + :loinc-db + (let [path (.getPath file) + {:keys [datasource codesystem valueset conceptmap naming-system]} (loinc-provider/open-providers path)] + (log/info "registered provider" {:source path :kind :loinc-db}) + {:providers (filterv some? [codesystem valueset conceptmap]) + :naming-systems (when naming-system [naming-system]) + :closers (when (instance? Closeable datasource) + [#(.close ^Closeable datasource)])})))) (defn- aggregate-fhir-json "Build one in-memory provider set from FHIR JSON files." @@ -102,7 +112,7 @@ ([path opts] (let [files (sources/tx-file-seq path) release (filter #(and (:importable? %) (not (:database? %))) files) - databases (filter #(#{:hermes-db :fhir-tx-db} (:kind %)) files) + databases (filter #(#{:hermes-db :fhir-tx-db :loinc-db} (:kind %)) files) json (filter #(= :fhir-json (:kind %)) files)] (when (empty? files) (throw (ex-info (str "Couldn't find any terminology sources under " path) diff --git a/src/com/eldrix/hades/impl/sources.clj b/src/com/eldrix/hades/impl/sources.clj index 2492745..12f0b74 100644 --- a/src/com/eldrix/hades/impl/sources.clj +++ b/src/com/eldrix/hades/impl/sources.clj @@ -2,9 +2,9 @@ "Walk a path and recognise terminology files. `tx-file-seq` returns a flat sequence of entries, one per recognised - file. Each entry has the shape: + source. Each entry has the shape: - {:file java.io.File ; the file that was recognised + {:file java.io.File ; the file or directory that was recognised :kind :rf2 | :loinc | :fhir-json | :hermes-db | :fhir-tx-db :importable? boolean ; can be fed to an importer :database? boolean ; can be opened as a provider @@ -17,17 +17,18 @@ is a directory (RF2 release, LOINC release, Hermes DB). Recognition is delegated to per-provider recognisers — see - `impl/snomed`, `impl/loaders/loinc`, `impl/loaders/fhir`, - `impl/sqlite/db`. Each one knows how to recognise its own files; the - walker is just glue." + `providers/snomed`, `providers/loinc`, `providers/common/fhir-loader`, + `providers/ftrm/db`. Each one knows how to recognise its own files or + directories; the walker is just glue." (:require [clojure.java.io :as io] [clojure.spec.alpha :as s] [clojure.string :as str] [clojure.tools.logging.readable :as log] - [com.eldrix.hades.impl.loaders.fhir :as fhir] - [com.eldrix.hades.impl.loaders.loinc :as loinc] - [com.eldrix.hades.impl.snomed :as snomed] - [com.eldrix.hades.impl.sqlite.db :as sqlite-db]) + [com.eldrix.hades.providers.common.fhir-loader :as fhir] + [com.eldrix.hades.providers.loinc.loader :as loinc] + [com.eldrix.hades.providers.loinc.store :as loinc-store] + [com.eldrix.hades.providers.snomed.provider :as snomed] + [com.eldrix.hades.providers.ftrm.db :as ftrm-db]) (:import (java.io File IOException))) (set! *warn-on-reflection* true) @@ -36,7 +37,7 @@ ;; Specs — the contracts between the walker, its registry, and consumers. ;; --------------------------------------------------------------------------- -(s/def ::kind #{:rf2 :loinc :fhir-json :hermes-db :fhir-tx-db}) +(s/def ::kind #{:rf2 :loinc :loinc-db :fhir-json :hermes-db :fhir-tx-db}) (s/def ::file #(instance? File %)) (s/def ::dir ::file) (s/def ::importable? boolean?) @@ -46,9 +47,11 @@ ;; either nil (not mine) or a map of kind-specific annotations. (s/def ::recognise ifn?) (s/def ::id ::kind) +(s/def ::scope #{:file :directory}) (s/def ::recogniser - (s/keys :req-un [::id ::importable? ::database? ::recognise])) + (s/keys :req-un [::id ::importable? ::database? ::recognise] + :opt-un [::scope])) ;; The walker's return entries: walker-supplied fields plus the ;; recogniser's annotations. `:dir` is opt-un because only kinds whose @@ -58,15 +61,19 @@ :opt-un [::dir])) (def ^:private recognisers - "Ordered registry. First match wins. Order matters when a file could + "Ordered registry. First match wins. Order matters when a path could plausibly satisfy more than one recogniser; today the kinds are distinctive enough that order is for clarity, not correctness." - [sqlite-db/fhir-tx-db-recogniser + [ftrm-db/fhir-tx-db-recogniser + loinc-store/loinc-db-recogniser snomed/hermes-db-recogniser snomed/rf2-recogniser loinc/loinc-recogniser fhir/fhir-json-recogniser]) +(defn- recogniser-scope [{:keys [scope]}] + (or scope :file)) + ;; Validate the registry at load time so a misshapen recogniser fails ;; here rather than during a walk. Cheap; runs once per ns load. (when-let [bad (seq (remove #(s/valid? ::recogniser %) recognisers))] @@ -101,8 +108,8 @@ (.getPath f)))) []))) -(defn- recognise-file - "Apply each recogniser to `f` in order; first to claim it wins. +(defn- recognise-path + "Apply recognisers of `scope` to `f` in order; first to claim it wins. Returns a complete entry, or nil when no recogniser claims the file. Centralises error handling: a recogniser may throw to indicate it @@ -115,20 +122,21 @@ The returned entry is asserted against `::entry` so a misbehaving recogniser is caught at the boundary (asserts are a no-op when `*compile-asserts*` is false)." - [^File f probe?] - (reduce (fn [_ {:keys [id importable? database? recognise]}] - (when-let [ann (try (recognise f probe?) - (catch Exception e - (log/warn e "recogniser threw" - {:recogniser id - :file (.getPath f)}) - nil))] - (reduced (s/assert ::entry - (assoc ann - :file f - :kind id - :importable? importable? - :database? database?))))) + [scope ^File f probe?] + (reduce (fn [_ {:keys [id importable? database? recognise] :as r}] + (when (= scope (recogniser-scope r)) + (when-let [ann (try (recognise f probe?) + (catch Exception e + (log/warn e "recogniser threw" + {:recogniser id + :file (.getPath f)}) + nil))] + (let [base (cond-> {:file f + :kind id + :importable? importable? + :database? database?} + (= scope :directory) (assoc :dir f))] + (reduced (s/assert ::entry (merge base ann))))))) nil recognisers)) @@ -144,10 +152,13 @@ ([path {:keys [probe?] :or {probe? false}}] (let [^File root (io/file path)] (if (.exists root) - (into [] - (comp (filter #(.isFile ^File %)) - (keep #(recognise-file % probe?))) - (tree-seq #(and (.isDirectory ^File %) (not (skip-dir? %))) - list-children - root)) + (let [paths (tree-seq #(and (.isDirectory ^File %) (not (skip-dir? %))) + list-children + root)] + (into [] + (keep (fn [^File f] + (cond + (.isDirectory f) (recognise-path :directory f probe?) + (.isFile f) (recognise-path :file f probe?)))) + paths)) [])))) diff --git a/src/com/eldrix/hades/impl/wire.clj b/src/com/eldrix/hades/impl/wire.clj index 835fc07..7a4af56 100644 --- a/src/com/eldrix/hades/impl/wire.clj +++ b/src/com/eldrix/hades/impl/wire.clj @@ -162,6 +162,8 @@ (keyword? value) {"name" "value" "valueCode" (name value)} (string? value) {"name" "value" "valueString" value} (number? value) {"name" "value" "valueString" (str value)} + (and (map? value) (:system value) (:code value)) + {"name" "value" "valueCoding" (coding-map value)} :else {"name" "value" "valueString" (str value)})] {"name" "property" "part" (cond-> [{"name" "code" "valueCode" code-str} @@ -215,7 +217,7 @@ version (conj (param-string "version" version)) display (conj (param-string "display" display)) system (conj (param-uri "system" system)) - code (conj (param-auto "code" code)) + code (conj (param-code "code" code)) definition (conj (param-string "definition" definition)) (some? abstract) (conj (param-boolean "abstract" abstract))) with-props (into base (map property-param) properties) @@ -225,7 +227,7 @@ (defn subsumes->parameters "Convert a subsumes result to a FHIR Parameters map." [{:keys [outcome]}] - (parameters [(param-auto "outcome" outcome)])) + (parameters [(param-code "outcome" outcome)])) (defn- translate-match-param "Build a single $translate match entry as a Parameters.parameter part." diff --git a/src/com/eldrix/hades/impl/protocols.clj b/src/com/eldrix/hades/protocols.clj similarity index 99% rename from src/com/eldrix/hades/impl/protocols.clj rename to src/com/eldrix/hades/protocols.clj index b96a0ff..05a1436 100644 --- a/src/com/eldrix/hades/impl/protocols.clj +++ b/src/com/eldrix/hades/protocols.clj @@ -1,4 +1,4 @@ -(ns com.eldrix.hades.impl.protocols +(ns com.eldrix.hades.protocols "Protocols defining a terminology service. Implementations participate in a Hades service by satisfying one or diff --git a/src/com/eldrix/hades/impl/protocols/input.clj b/src/com/eldrix/hades/protocols/input.clj similarity index 99% rename from src/com/eldrix/hades/impl/protocols/input.clj rename to src/com/eldrix/hades/protocols/input.clj index c7e4ac3..f0913a1 100644 --- a/src/com/eldrix/hades/impl/protocols/input.clj +++ b/src/com/eldrix/hades/protocols/input.clj @@ -1,4 +1,4 @@ -(ns com.eldrix.hades.impl.protocols.input +(ns com.eldrix.hades.protocols.input "Specs for operation parameters — what callers send into protocol methods and into the public `core` operation functions. diff --git a/src/com/eldrix/hades/impl/protocols/result.clj b/src/com/eldrix/hades/protocols/result.clj similarity index 97% rename from src/com/eldrix/hades/impl/protocols/result.clj rename to src/com/eldrix/hades/protocols/result.clj index bde1625..b13f957 100644 --- a/src/com/eldrix/hades/impl/protocols/result.clj +++ b/src/com/eldrix/hades/protocols/result.clj @@ -1,4 +1,4 @@ -(ns com.eldrix.hades.impl.protocols.result +(ns com.eldrix.hades.protocols.result "Specs for protocol return values — the data contracts between layers. Every keyword in this namespace describes an output field produced by a protocol method or a `core` operation. Sibling input @@ -71,7 +71,9 @@ (s/def ::property-code (s/or :keyword keyword? :string string?)) (s/def ::property-value (s/or :boolean boolean? :string string? - :keyword keyword? :number number?)) + :keyword keyword? :number number? + :coding (s/keys :req-un [::system ::code] + :opt-un [::display]))) (s/def ::property (s/and #(contains? % :code) #(s/valid? ::property-code (:code %)) diff --git a/src/com/eldrix/hades/impl/canonical.clj b/src/com/eldrix/hades/providers/common/canonical.clj similarity index 95% rename from src/com/eldrix/hades/impl/canonical.clj rename to src/com/eldrix/hades/providers/common/canonical.clj index 631b5a5..4c51240 100644 --- a/src/com/eldrix/hades/impl/canonical.clj +++ b/src/com/eldrix/hades/providers/common/canonical.clj @@ -1,4 +1,4 @@ -(ns com.eldrix.hades.impl.canonical +(ns com.eldrix.hades.providers.common.canonical "Pure utilities for FHIR canonical URLs and version handling. - parse `url|version` canonicals @@ -26,9 +26,9 @@ 'http://example.com/cs' => ['http://example.com/cs' nil]" [s] (when s - (let [idx (.lastIndexOf ^String s "|")] - (if (pos? idx) - [(.substring ^String s 0 idx) (.substring ^String s (inc idx))] + (let [idx (str/last-index-of s "|")] + (if (and idx (pos? idx)) + [(subs s 0 idx) (subs s (inc idx))] [s nil])))) (defn versioned-uri diff --git a/src/com/eldrix/hades/impl/compose.clj b/src/com/eldrix/hades/providers/common/compose.clj similarity index 65% rename from src/com/eldrix/hades/impl/compose.clj rename to src/com/eldrix/hades/providers/common/compose.clj index bb8d9c5..61d5f7a 100644 --- a/src/com/eldrix/hades/impl/compose.clj +++ b/src/com/eldrix/hades/providers/common/compose.clj @@ -1,17 +1,17 @@ -(ns com.eldrix.hades.impl.compose +(ns com.eldrix.hades.providers.common.compose "Pure compose expansion engine for FHIR ValueSet compose definitions. Evaluates include/exclude/filter/valueSet-import to produce an expanded set of concepts. Compose treats `svc` as an opaque provider satisfying - the protocols in `com.eldrix.hades.impl.protocols`; cross-CodeSystem + the protocols in `com.eldrix.hades.protocols`; cross-CodeSystem callbacks go through protocol methods on `svc`, which the composite dispatches to the right child provider." (:require [clojure.spec.alpha :as s] [clojure.string :as str] - [com.eldrix.hades.impl.canonical :as canonical] - [com.eldrix.hades.impl.composite :as composite] - [com.eldrix.hades.impl.display :as display] - [com.eldrix.hades.impl.protocols :as protos])) + [com.eldrix.hades.providers.common.canonical :as canonical] + [com.eldrix.hades.composite :as composite] + [com.eldrix.hades.providers.common.display :as display] + [com.eldrix.hades.protocols :as protos])) (set! *warn-on-reflection* true) @@ -56,46 +56,68 @@ (or property "?") ", op = " op " has no value")}))) filter-array)) +(defn- safe-lowercase-includes? + "Nil-safe case-insensitive substring containment: true when `substring` + appears in `s` after both are lower-cased. False when either is + nil — call sites can thread potentially-missing strings through + without their own nil guards." + [s substr] + (and s substr + (str/includes? (str/lower-case s) (str/lower-case substr)))) + +(defn- designations-match? + "True when any designation in `designations` has a `:value` that + matches search string `s` (via `safe-lowercase-includes?`)." + [designations s] + (some (fn [{:keys [value]}] (safe-lowercase-includes? value s)) designations)) + (defn- expand-include-concepts - [svc system version concepts params] - (let [active-only? (:activeOnly params)] - (keep (fn [c] - (let [code (get c "code") - provided-display (get c "display") - raw (when system - (protos/cs-lookup svc (cond-> {:system system :code code} - version (assoc :version version)))) - looked-up (when-not (:not-found raw) raw)] - ;; `include.concept` lists explicit codes that are by FHIR - ;; semantics part of the value set: emit them even when no - ;; provider serves the system, using the provided display. - (when (or looked-up (nil? system) provided-display) - (let [display-langs (display/parse-display-language (:displayLanguage params)) - lang-display (when (and (seq display-langs) looked-up) - (display/find-display-for-language (:designations looked-up) display-langs)) - display (or provided-display lang-display (:display looked-up)) - result-version (or (:version looked-up) version) - inactive? (when looked-up - (some (fn [p] (and (= :inactive (:code p)) (:value p))) - (:properties looked-up))) - abstract? (:abstract looked-up) - designations (:designations looked-up)] - (when-not (and active-only? inactive?) - (cond-> {:code code - :system system - :display display} - result-version (assoc :version result-version) - (seq designations) (assoc :designations designations) - abstract? (assoc :abstract true) - inactive? (assoc :inactive true) - (and (seq (:properties params)) looked-up) - (assoc :properties - (let [want (set (:properties params))] - (filterv (fn [p] - (let [k (:code p)] - (contains? want (if (keyword? k) (name k) (str k))))) - (:properties looked-up)))))))))) - concepts))) + "Expand a concept-driven include (`include.concept[]`) into the + expansion. Each candidate is looked up via `cs-lookup` to enrich + display / designations / inactive / abstract, then gated by + `:activeOnly` and (when present) the `$expand` `:text` filter. The + filter matches against the looked-up display AND every designation + value — the same surface a match-driven `cs-expand*` would consider — + so concept-driven includes honour `filter` without compose having to + post-filter the merged expansion." + [svc system version concepts {:keys [activeOnly displayLanguage text properties]}] + (keep (fn [{:strs [code] provided-display "display"}] + (let [raw (when system + (protos/cs-lookup svc (cond-> {:system system :code code} + version (assoc :version version)))) + looked-up (when-not (:not-found raw) raw)] + ;; `include.concept` lists explicit codes that are by FHIR + ;; semantics part of the value set: emit them even when no + ;; provider serves the system, using the provided display. + (when (or looked-up (nil? system) provided-display) + (let [display-langs (display/parse-display-language displayLanguage) + lang-display (when (and (seq display-langs) looked-up) + (display/find-display-for-language (:designations looked-up) display-langs)) + display (or provided-display lang-display (:display looked-up)) + result-version (or (:version looked-up) version) + inactive? (when looked-up + (some (fn [{:keys [code value]}] + (and (= :inactive code) value)) + (:properties looked-up))) + designations (:designations looked-up)] + (when (and (not (and activeOnly inactive?)) + (or (nil? text) + (safe-lowercase-includes? display text) + (designations-match? designations text))) + (cond-> {:code code + :system system + :display display} + result-version (assoc :version result-version) + (seq designations) (assoc :designations designations) + (:abstract looked-up) (assoc :abstract true) + inactive? (assoc :inactive true) + (and (seq properties) looked-up) + (assoc :properties + (let [want (set properties)] + (filterv (fn [{k :code}] + (contains? want (if (keyword? k) (name k) (str k)))) + (:properties looked-up)))))))))) + concepts)) (defn- build-query [system version filters params] @@ -115,14 +137,14 @@ (throw (ex-info (str "Circular ValueSet reference: " vs-url) {:type :processing :details-code "vs-invalid" :url vs-url}))) (if-let [result (protos/vs-expand svc svc - (-> params - (assoc :url vs-url :expanding expanding) - (dissoc :valueSetVersion)))] + (-> params + (assoc :url vs-url :expanding expanding) + (dissoc :valueSetVersion)))] (update acc :concepts into (or (:concepts result) [])) (let [msg (str "A definition for the value Set '" vs-url "' could not be found")] (update acc :issues conj - {:severity "error" :type "not-found" - :details-code "not-found" :text msg})))) + {:severity "error" :type "not-found" + :details-code "not-found" :text msg})))) {:concepts [] :issues []} valueset-urls)) @@ -130,7 +152,19 @@ [(:system c) (:version c) (:code c)]) (defn- expand-include - [svc include params] + "Expand one element of `compose.include[]` into a sub-result + `{:concepts :issues :total :fully-materialised?}`. The element may + specify a CodeSystem (`include.system` — match-driven when no + explicit `concept[]` is given; concept-driven when it is) and / or a + list of imported ValueSets (`include.valueSet[]`). When both system + and valueSet are present the results intersect; otherwise they + concatenate. Surfaces issues for unknown system, version-pin + mismatch, broken filter clauses, and propagates provider-emitted + issues from `cs-expand*` verbatim. `expanding` tracks in-flight VS + URLs so cycles raise rather than recurse." + [svc include {:keys [expanding purpose] + :or {expanding #{} purpose :validate} + :as params}] (let [system (get include "system") include-version (get include "version") raw-version (resolve-effective-version svc system include-version params) @@ -138,14 +172,13 @@ concepts (get include "concept") filters (get include "filter") vs-urls (get include "valueSet") - expanding (or (:expanding params) #{}) unknown-version-issue (when (and system include-version (composite/find-codesystem svc system) (not (composite/find-codesystem svc (canonical/versioned-uri system version)))) - (composite/unknown-version-issue svc system version (:purpose params :validate))) + (composite/unknown-version-issue svc system version purpose)) unknown-system-issue - (when (and system (= :expand (:purpose params)) + (when (and system (= :expand purpose) (not (composite/find-codesystem svc system)) (not (and version (composite/find-codesystem svc (canonical/versioned-uri system version))))) @@ -189,10 +222,10 @@ concept-systems (into #{} (map first) concept-pairs) include-pairs (into #{} (comp - (keep (fn [inc] - (when-let [sys (get inc "system")] - (when-not (contains? concept-systems sys) - [sys (get inc "version")]))))) + (keep (fn [inc] + (when-let [sys (get inc "system")] + (when-not (contains? concept-systems sys) + [sys (get inc "version")]))))) (get compose "include")) pairs (into concept-pairs include-pairs)] (mapv (fn [[sys ver]] @@ -240,7 +273,7 @@ (assoc params :displayLanguage compose-lang) params) params (if-let [text (:filter params)] - (-> params (dissoc :filter) (assoc :text text)) + (assoc params :text text) params) includes (get compose "include") excludes (get compose "exclude") @@ -252,27 +285,20 @@ include-results (mapv #(expand-include svc % include-params) includes) include-issues (mapcat :issues include-results) included (into {} (map (fn [c] [(concept-key c) c])) - (mapcat :concepts include-results)) + (mapcat :concepts include-results)) excluded (when (seq excludes) (let [exclude-results (mapv #(expand-include svc % params) excludes)] (set (map concept-key (mapcat :concepts exclude-results))))) after-exclude (if excluded (remove (fn [[k _]] (contains? excluded k)) included) included) - merged-concepts (map second after-exclude) - ;; `expand-include-concepts` returns explicit-concept lists - ;; verbatim (it has no FTS to consult). Apply the filter text - ;; here so concept-driven includes honour `$expand`'s `filter` - ;; param. Match-driven includes pre-filter via `cs-expand*`, - ;; so this post-filter is a no-op for them. - filter-text (:text params) - filtered (if filter-text - (let [needle (str/lower-case filter-text)] - (filter (fn [c] - (when-let [d (:display c)] - (str/includes? (str/lower-case d) needle))) - merged-concepts)) - merged-concepts) + ;; Text filtering is the provider's responsibility for + ;; match-driven includes (`cs-expand*` honours `:text`, + ;; matching display + designations via the per-terminology + ;; index) and `expand-include-concepts`' responsibility for + ;; concept-driven includes (it gates emission on display + + ;; designations). Compose neither re-filters nor materialises. + filtered (map second after-exclude) used-cs (collect-used-codesystems svc compose filtered) sys->versions (reduce (fn [acc c] (if-let [sys (:system c)] @@ -305,4 +331,3 @@ total (assoc :total total) (:displayLanguage params) (assoc :display-language (:displayLanguage params)) (seq include-issues) (assoc :issues include-issues)))) - diff --git a/src/com/eldrix/hades/impl/display.clj b/src/com/eldrix/hades/providers/common/display.clj similarity index 60% rename from src/com/eldrix/hades/impl/display.clj rename to src/com/eldrix/hades/providers/common/display.clj index f7cec92..c1de4de 100644 --- a/src/com/eldrix/hades/impl/display.clj +++ b/src/com/eldrix/hades/providers/common/display.clj @@ -1,4 +1,4 @@ -(ns com.eldrix.hades.impl.display +(ns com.eldrix.hades.providers.common.display "Shared display + language helpers for FHIR terminology operations. Used by CodeSystem and ValueSet implementations for language-aware display validation and selection." @@ -46,12 +46,38 @@ display-langs))))) (:designations concept)))))) +(def ^:private fhir-designation-usage + "FHIR's canonical CodeSystem of designation `use` semantics — + `http://terminology.hl7.org/CodeSystem/designation-usage`." + "http://terminology.hl7.org/CodeSystem/designation-usage") + +(defn- display-eligible? + "A designation participates in display-language selection when its + `use` carries FHIR-standard display semantics — either no `use` at + all (the writer did not classify) or a `use` drawn from + `http://terminology.hl7.org/CodeSystem/designation-usage` + (`display` or `synonym`). Terminology-specific use codes (LOINC + axes, SNOMED description-type ids, …) are ignored here; the + ingest layer that emitted them is responsible for surfacing a + FHIR-standard `use` if it wants the designation to be picked." + [{:keys [use]}] + (or (nil? use) + (and (= (:system use) fhir-designation-usage) + (contains? #{"display" "synonym"} (:code use))))) + (defn find-display-for-language - "Find the best display for a set of designations given language preferences." + "Pick a display for `designations` given a seq of priority-ordered + `display-languages` (`{:lang :q}` maps from `parse-display-language`). + Only display-eligible designations participate — see `display-eligible?`. + Walks the requested languages outer-first and returns the first + language-matched eligible designation's `:value`; returns nil when + no eligible designation matches any requested language, so callers + fall back to the concept's primary `:display`." [designations display-languages] (some (fn [{:keys [lang]}] (some (fn [d] - (when (language-matches? (:language d) lang) + (when (and (display-eligible? d) + (language-matches? (:language d) lang)) (:value d))) designations)) display-languages)) diff --git a/src/com/eldrix/hades/impl/fhir_extract.clj b/src/com/eldrix/hades/providers/common/fhir_extract.clj similarity index 99% rename from src/com/eldrix/hades/impl/fhir_extract.clj rename to src/com/eldrix/hades/providers/common/fhir_extract.clj index 0390a7e..a0cc7c7 100644 --- a/src/com/eldrix/hades/impl/fhir_extract.clj +++ b/src/com/eldrix/hades/providers/common/fhir_extract.clj @@ -1,4 +1,4 @@ -(ns com.eldrix.hades.impl.fhir-extract +(ns com.eldrix.hades.providers.common.fhir-extract "FHIR-resource extraction helpers shared between the FHIR loader and in-memory provider. All inputs are parsed FHIR JSON maps with string keys; outputs are keyword-keyed Clojure data, with one exception: diff --git a/src/com/eldrix/hades/impl/loaders/fhir.clj b/src/com/eldrix/hades/providers/common/fhir_loader.clj similarity index 99% rename from src/com/eldrix/hades/impl/loaders/fhir.clj rename to src/com/eldrix/hades/providers/common/fhir_loader.clj index d070d51..f30d75a 100644 --- a/src/com/eldrix/hades/impl/loaders/fhir.clj +++ b/src/com/eldrix/hades/providers/common/fhir_loader.clj @@ -1,4 +1,4 @@ -(ns com.eldrix.hades.impl.loaders.fhir +(ns com.eldrix.hades.providers.common.fhir-loader "FHIR JSON → seq of fhir-data. A pure data producer: parses FHIR JSON resources (from in-memory @@ -20,7 +20,7 @@ (:require [clojure.data.json :as json] [clojure.java.io :as io] [clojure.string :as str] - [com.eldrix.hades.impl.fhir-extract :as fhir-extract]) + [com.eldrix.hades.providers.common.fhir-extract :as fhir-extract]) (:import (java.io File))) (set! *warn-on-reflection* true) diff --git a/src/com/eldrix/hades/impl/issues.clj b/src/com/eldrix/hades/providers/common/issues.clj similarity index 75% rename from src/com/eldrix/hades/impl/issues.clj rename to src/com/eldrix/hades/providers/common/issues.clj index 45802f8..0c71b46 100644 --- a/src/com/eldrix/hades/impl/issues.clj +++ b/src/com/eldrix/hades/providers/common/issues.clj @@ -1,4 +1,4 @@ -(ns com.eldrix.hades.impl.issues +(ns com.eldrix.hades.providers.common.issues "Shared issue / message helpers used by both the composite layer and the validate-code engines. Kept narrow on purpose: each helper here is invoked from at least two places and is purely structural — no @@ -29,6 +29,50 @@ :message msg :issues [{:severity "error" :type "not-found" :text msg}]})) +(defn unknown-system-validate + "Build a `::result/validate` map for an unknown CodeSystem. Mirrors the + shape composite uses when no provider serves the URL." + [system code] + (let [msg (str "A definition for CodeSystem '" system + "' could not be found, so the code cannot be validated")] + {:result false + :code (when code (keyword code)) + :system system + :message msg + :x-unknown-system system + :issues [{:severity "error" + :type "not-found" + :details-code "not-found" + :text msg + :expression ["system"]}]})) + +(defn unknown-system-subsumes + "Build a subsumes result for an unknown CodeSystem — no `:outcome`; + the presence of `:not-found` + issues signals the error." + [system] + (let [msg (str "A definition for the code system '" system + "' could not be found, so subsumption cannot be tested")] + {:not-found true + :x-unknown-system system + :issues [{:severity "error" + :type "not-found" + :details-code "not-found" + :text msg + :expression ["system"]}]})) + +(defn unknown-code-subsumes + "Build a subsumes result for a code that isn't in the CodeSystem. + `expression` is the FHIRPath token identifying which input was bad + (`\"codeA\"` or `\"codeB\"`)." + [system code expression] + (let [msg (str "Unknown code '" code "' in code system '" system "'")] + {:not-found true + :issues [{:severity "error" + :type "not-found" + :details-code "not-found" + :text msg + :expression [expression]}]})) + (defn inactive-warning-issue "Build an OperationOutcome issue for an inactive concept." [code status] diff --git a/src/com/eldrix/hades/impl/property_filter.clj b/src/com/eldrix/hades/providers/common/property_filter.clj similarity index 96% rename from src/com/eldrix/hades/impl/property_filter.clj rename to src/com/eldrix/hades/providers/common/property_filter.clj index eec6c78..b214d12 100644 --- a/src/com/eldrix/hades/impl/property_filter.clj +++ b/src/com/eldrix/hades/providers/common/property_filter.clj @@ -1,4 +1,4 @@ -(ns com.eldrix.hades.impl.property-filter +(ns com.eldrix.hades.providers.common.property-filter "Parses the FHIR `_property=…` request filter into a tiny predicate bundle consumed by every `cs-lookup` provider. diff --git a/src/com/eldrix/hades/impl/supplement.clj b/src/com/eldrix/hades/providers/common/supplement.clj similarity index 95% rename from src/com/eldrix/hades/impl/supplement.clj rename to src/com/eldrix/hades/providers/common/supplement.clj index 9415a96..fa2988f 100644 --- a/src/com/eldrix/hades/impl/supplement.clj +++ b/src/com/eldrix/hades/providers/common/supplement.clj @@ -1,4 +1,4 @@ -(ns com.eldrix.hades.impl.supplement +(ns com.eldrix.hades.providers.common.supplement "Supplement composition: a thin wrapper deftype that augments any `CodeSystem` provider with extra designations and properties from a supplement lookup, plus a pure resolver that walks a supplement seq @@ -7,9 +7,10 @@ Talks to the base only via protocol methods, so it works against in-memory, Hermes, or any future provider." (:require [clojure.spec.alpha :as s] - [com.eldrix.hades.impl.display :as display] - [com.eldrix.hades.impl.fhir-extract :as fhir-extract] - [com.eldrix.hades.impl.protocols :as protos])) + [clojure.string :as str] + [com.eldrix.hades.providers.common.display :as display] + [com.eldrix.hades.providers.common.fhir-extract :as fhir-extract] + [com.eldrix.hades.protocols :as protos])) (set! *warn-on-reflection* true) @@ -148,8 +149,8 @@ "Split a `supplements` canonical (`url` or `url|version`) into [url version]." [target] (when target - (let [idx (.lastIndexOf ^String target "|")] - (if (pos? idx) + (let [idx (str/last-index-of target "|")] + (if (and idx (pos? idx)) [(subs target 0 idx) (subs target (inc idx))] [target nil])))) diff --git a/src/com/eldrix/hades/impl/vs_validate.clj b/src/com/eldrix/hades/providers/common/vs_validate.clj similarity index 88% rename from src/com/eldrix/hades/impl/vs_validate.clj rename to src/com/eldrix/hades/providers/common/vs_validate.clj index d2d8a15..fa27abf 100644 --- a/src/com/eldrix/hades/impl/vs_validate.clj +++ b/src/com/eldrix/hades/providers/common/vs_validate.clj @@ -1,4 +1,4 @@ -(ns com.eldrix.hades.impl.vs-validate +(ns com.eldrix.hades.providers.common.vs-validate "Pure compose-driven `vs-validate-code` implementation, shared by every ValueSet provider that's backed by a parsed compose definition. @@ -7,17 +7,17 @@ matching / display validation / inactive-status / fragment-CS / status-warning logic, and returns a `::result/validate`. - Provider impls (`MemoryValueSet`, `SqliteValueSetCatalogue`, …) call + Provider impls (`MemoryValueSet`, `FtrmValueSetCatalogue`, …) call this with their own `vs-data` `{:url :version :compose :metadata}` map. Behaviour is identical across backends because the function only depends on the svc and the compose def." (:require [clojure.string :as str] - [com.eldrix.hades.impl.canonical :as canonical] - [com.eldrix.hades.impl.compose :as compose] - [com.eldrix.hades.impl.composite :as composite] - [com.eldrix.hades.impl.display :as display] - [com.eldrix.hades.impl.issues :as issues] - [com.eldrix.hades.impl.protocols :as protos])) + [com.eldrix.hades.providers.common.canonical :as canonical] + [com.eldrix.hades.providers.common.compose :as compose] + [com.eldrix.hades.composite :as composite] + [com.eldrix.hades.providers.common.display :as display] + [com.eldrix.hades.providers.common.issues :as issues] + [com.eldrix.hades.protocols :as protos])) (set! *warn-on-reflection* true) @@ -31,6 +31,38 @@ (or (when preferred (some #{preferred} matches)) (first matches))))) +(defn- code-filter [code] + {"property" "code" "op" "=" "value" code}) + +(defn- match-driven-system-include? + [include system] + (and (= system (get include "system")) + (not (seq (get include "concept"))))) + +(defn- add-code-filter + [include code] + (update include "filter" (fnil conj []) (code-filter code))) + +(defn- narrow-match-driven-includes + "For ValueSet validation we only need to know whether one coding is in + the compose. Match-driven includes such as `{system: http://loinc.org}` + can be too large for provider-default expansion windows, so push the + exact code predicate into matching includes/excludes before expanding. + Explicit `concept[]` includes are already bounded and are left intact." + [compose-def system code] + (if (and system code + (some #(match-driven-system-include? % system) + (concat (get compose-def "include") + (get compose-def "exclude")))) + (let [narrow (fn [include] + (if (match-driven-system-include? include system) + (add-code-filter include code) + include))] + (cond-> compose-def + (contains? compose-def "include") (update "include" #(mapv narrow %)) + (contains? compose-def "exclude") (update "exclude" #(mapv narrow %)))) + compose-def)) + (defn- add-version-mismatch [result caller-version match-ver system override-pattern include-ver force? svc] (if (and caller-version match-ver (not= caller-version match-ver)) @@ -141,9 +173,13 @@ (defn- find-best-match "Walk the expanded concept list and pick the best match for the caller. Returns nil when no concept matches by code+system. Sets `:case-differs` - on the returned match when the only match is case-insensitive." - [expanded code system display caller-version multi-version-systems] - (let [all-exact (filterv (fn [c] + on the returned match when the only match is case-insensitive and the + matched CodeSystem declares caseSensitive=false." + [svc expanded code system display caller-version multi-version-systems] + (let [case-insensitive? (fn [c] + (false? (:case-sensitive + (composite/cs-meta svc (or (:system c) system))))) + all-exact (filterv (fn [c] (and (= code (:code c)) (or (nil? system) (= system (:system c))))) expanded) @@ -159,6 +195,7 @@ (and (not= code (:code c)) (= (str/lower-case code) (str/lower-case (:code c))) (or (nil? system) (= system (:system c))) + (case-insensitive? c) (assoc c :case-differs true))) parse-semver (fn [v] (mapv #(try (Integer/parseInt %) (catch Exception _ 0)) @@ -330,16 +367,17 @@ `result-no-match`." [svc {:keys [url version compose]} params] (let [expanding (conj (or (:expanding params) #{}) url) + {:keys [code system display]} params + validation-compose (narrow-match-driven-includes compose system code) ;; Forward request flags (force-/system-/check-system-version) to ;; compose so version overrides apply during the validation expand. compose-params (-> (select-keys params [:force-system-version :system-version :check-system-version :displayLanguage]) (assoc :expanding expanding)) - compose-result (compose/expand-compose svc compose compose-params) + compose-result (compose/expand-compose svc validation-compose compose-params) compose-issues (:issues compose-result) expanded (:concepts compose-result) multi-version-systems (or (:multi-version-systems compose-result) #{}) - {:keys [code system display]} params caller-version (:version params) vs-invalid-issue (first (filter #(= "vs-invalid" (:details-code %)) compose-issues)) not-found-issue (first (filter #(= "not-found" (:details-code %)) compose-issues))] @@ -351,7 +389,7 @@ (result-not-found svc compose not-found-issue compose-issues code system caller-version) :else - (let [match (-> (find-best-match expanded code system display caller-version multi-version-systems) + (let [match (-> (find-best-match svc expanded code system display caller-version multi-version-systems) (align-match-to-wildcard-version svc compose system code caller-version)) include-ver (compose-version-for-system compose system (or (:version match) caller-version)) diff --git a/src/com/eldrix/hades/impl/sqlite/db.clj b/src/com/eldrix/hades/providers/ftrm/db.clj similarity index 98% rename from src/com/eldrix/hades/impl/sqlite/db.clj rename to src/com/eldrix/hades/providers/ftrm/db.clj index ddeb986..cc2b497 100644 --- a/src/com/eldrix/hades/impl/sqlite/db.clj +++ b/src/com/eldrix/hades/providers/ftrm/db.clj @@ -1,4 +1,4 @@ -(ns com.eldrix.hades.impl.sqlite.db +(ns com.eldrix.hades.providers.ftrm.db "Open / create / verify a FHIR terminology SQLite container. File-level identity is encoded in the SQLite file header itself: @@ -40,7 +40,7 @@ (def ^:private schema-resource - "com/eldrix/hades/sqlite/schema-v1.sql") + "com/eldrix/hades/providers/ftrm/schema-v1.sql") (defn- jdbc-spec [^String path] {:dbtype "sqlite" :dbname path}) @@ -101,8 +101,8 @@ ;; comments are gone. (->> (str/split-lines sql) (map (fn [^String line] - (let [i (.indexOf line "--")] - (if (neg? i) line (subs line 0 i))))) + (let [i (str/index-of line "--")] + (if i (subs line 0 i) line)))) (str/join "\n"))) (defn- exec-script! [conn ^String sql] diff --git a/src/com/eldrix/hades/impl/index/sqlite.clj b/src/com/eldrix/hades/providers/ftrm/index.clj similarity index 99% rename from src/com/eldrix/hades/impl/index/sqlite.clj rename to src/com/eldrix/hades/providers/ftrm/index.clj index 7826829..b0732bc 100644 --- a/src/com/eldrix/hades/impl/index/sqlite.clj +++ b/src/com/eldrix/hades/providers/ftrm/index.clj @@ -1,6 +1,6 @@ -(ns com.eldrix.hades.impl.index.sqlite +(ns com.eldrix.hades.providers.ftrm.index "Persistent indexer: consume a `fhir-data` seq and write it into a - FHIR terminology SQLite container (built by `impl/sqlite/db`). + FHIR terminology SQLite container (built by `impl/ftrm/db`). Two-phase contract (mirrors Hermes `import` + `index`): @@ -37,7 +37,7 @@ retained in `concept_property` for round-trip lookup." (:require [clojure.data.json :as json] [clojure.core.async :as async] - [com.eldrix.hades.impl.sqlite.db :as db] + [com.eldrix.hades.providers.ftrm.db :as db] [next.jdbc :as jdbc] [next.jdbc.prepare :as prep]) (:import (java.sql Connection PreparedStatement) @@ -715,7 +715,7 @@ `build!` is a one-shot operation: it opens its own pooled datasource, runs the transaction, and closes the pool before returning. Callers - query the file by reopening via `sqlite-provider/open-providers` (or + query the file by reopening via `ftrm-provider/open-providers` (or `db/open`)." [^String db-path data-source opts] (let [data-fn (if (fn? data-source) data-source (fn [] data-source)) diff --git a/src/com/eldrix/hades/impl/sqlite/provider.clj b/src/com/eldrix/hades/providers/ftrm/provider.clj similarity index 84% rename from src/com/eldrix/hades/impl/sqlite/provider.clj rename to src/com/eldrix/hades/providers/ftrm/provider.clj index a4d34ed..c392552 100644 --- a/src/com/eldrix/hades/impl/sqlite/provider.clj +++ b/src/com/eldrix/hades/providers/ftrm/provider.clj @@ -1,6 +1,6 @@ -(ns com.eldrix.hades.impl.sqlite.provider +(ns com.eldrix.hades.providers.ftrm.provider "Persistent CodeSystem/ValueSet/ConceptMap providers backed by a - FHIR terminology SQLite container (built by `impl/index/sqlite`). + FHIR terminology SQLite container (built by `impl/index/ftrm`). One catalogue impl per resource type per `.db`, registered under every key it serves — same pattern Hermes uses for SNOMED. Each @@ -21,14 +21,14 @@ case-insensitive lookup, supplements, and fragment-CS warnings." (:require [charred.api :as charred] [clojure.string :as str] - [com.eldrix.hades.impl.canonical :as canonical] - [com.eldrix.hades.impl.compose :as compose] - [com.eldrix.hades.impl.display :as display] - [com.eldrix.hades.impl.issues :as issues] - [com.eldrix.hades.impl.property-filter :as property-filter] - [com.eldrix.hades.impl.protocols :as protos] - [com.eldrix.hades.impl.sqlite.db :as db] - [com.eldrix.hades.impl.vs-validate :as vs-validate] + [com.eldrix.hades.providers.common.canonical :as canonical] + [com.eldrix.hades.providers.common.compose :as compose] + [com.eldrix.hades.providers.common.display :as display] + [com.eldrix.hades.providers.common.issues :as issues] + [com.eldrix.hades.providers.common.property-filter :as property-filter] + [com.eldrix.hades.protocols :as protos] + [com.eldrix.hades.providers.ftrm.db :as db] + [com.eldrix.hades.providers.common.vs-validate :as vs-validate] [next.jdbc :as jdbc]) (:import (com.google.re2j Pattern PatternSyntaxException))) @@ -65,6 +65,7 @@ :case-sensitive (int->bool (:codesystem_meta/case_sensitive row)) :hierarchy-meaning (:codesystem_meta/hierarchy_meaning row) :content (:codesystem_meta/content row) + :supplements (:codesystem_meta/supplements row) :status (:codesystem_meta/status row) :experimental (int->bool (:codesystem_meta/experimental row)) :name (:codesystem_meta/name row) @@ -105,11 +106,26 @@ (jdbc/execute! ds ["SELECT url, version, metadata, compose FROM valueset"]))) (defn- load-conceptmap-cache [ds] - (into {} - (map (fn [row] - [(key-for (:conceptmap/url row) (:conceptmap/version row)) - (conceptmap-row->entry row)])) - (jdbc/execute! ds ["SELECT * FROM conceptmap"]))) + (let [pairs-by-key + (reduce + (fn [m row] + (let [k (key-for (:conceptmap_element/cm_url row) + (:conceptmap_element/cm_version row))] + (update m k (fnil conj []) + {:system (:conceptmap_element/source_system row) + :target (:conceptmap_element/target_system row)}))) + {} + (jdbc/execute! ds + ["SELECT DISTINCT cm_url, cm_version, source_system, target_system + FROM conceptmap_element + WHERE source_system IS NOT NULL AND target_system IS NOT NULL"]))] + (into {} + (map (fn [row] + (let [k (key-for (:conceptmap/url row) (:conceptmap/version row))] + [k (cond-> (conceptmap-row->entry row) + (seq (get pairs-by-key k)) + (assoc :pairs (vec (distinct (get pairs-by-key k)))))]))) + (jdbc/execute! ds ["SELECT * FROM conceptmap"])))) ;; --------------------------------------------------------------------------- ;; Concept fetch + render (per-request) @@ -329,40 +345,64 @@ (defn- in-list-placeholders [n] (str/join "," (repeat n "?"))) +(defn- code-sql + [expr case-sensitive?] + (if (false? case-sensitive?) + (str "LOWER(" expr ")") + expr)) + +(defn- code-param-sql + [case-sensitive?] + (if (false? case-sensitive?) "LOWER(?)" "?")) + +(defn- code-in-list-placeholders + [n case-sensitive?] + (str/join "," (repeat n (code-param-sql case-sensitive?)))) + (defn- filter->sql-clause "Translate one Query filter to {:sql ... :params [...] :post-filter ...}. `:post-filter` is a fn `concept-row -> boolean` applied after the SQL result lands; used for `regex` (SQLite has no portable REGEXP) and for any unsupported op (returns false to drop)." - [{:keys [property op value]}] + [{:keys [property op value]} case-sensitive?] (case op ("is-a") - {:sql (str "(c.code = ? OR EXISTS (SELECT 1 FROM concept_ancestor a " + {:sql (str "(" (code-sql "c.code" case-sensitive?) " = " (code-param-sql case-sensitive?) + " OR EXISTS (SELECT 1 FROM concept_ancestor a " "WHERE a.cs_url=c.cs_url AND a.cs_version=c.cs_version " - "AND a.ancestor_code=? AND a.descendent_code=c.code))") + "AND " (code-sql "a.ancestor_code" case-sensitive?) " = " (code-param-sql case-sensitive?) + " AND a.descendent_code=c.code))") :params [value value]} ("descendent-of" "descendant-of") {:sql (str "EXISTS (SELECT 1 FROM concept_ancestor a " "WHERE a.cs_url=c.cs_url AND a.cs_version=c.cs_version " - "AND a.ancestor_code=? AND a.descendent_code=c.code)") + "AND " (code-sql "a.ancestor_code" case-sensitive?) " = " (code-param-sql case-sensitive?) + " AND a.descendent_code=c.code)") :params [value]} ("is-not-a") - {:sql (str "(c.code <> ? AND NOT EXISTS (SELECT 1 FROM concept_ancestor a " + {:sql (str "(" (code-sql "c.code" case-sensitive?) " <> " (code-param-sql case-sensitive?) + " AND NOT EXISTS (SELECT 1 FROM concept_ancestor a " "WHERE a.cs_url=c.cs_url AND a.cs_version=c.cs_version " - "AND a.ancestor_code=? AND a.descendent_code=c.code))") + "AND " (code-sql "a.ancestor_code" case-sensitive?) " = " (code-param-sql case-sensitive?) + " AND a.descendent_code=c.code))") :params [value value]} ("generalizes") - {:sql (str "(c.code = ? OR EXISTS (SELECT 1 FROM concept_ancestor a " + {:sql (str "(" (code-sql "c.code" case-sensitive?) " = " (code-param-sql case-sensitive?) + " OR EXISTS (SELECT 1 FROM concept_ancestor a " "WHERE a.cs_url=c.cs_url AND a.cs_version=c.cs_version " - "AND a.ancestor_code=c.code AND a.descendent_code=?))") + "AND a.ancestor_code=c.code AND " + (code-sql "a.descendent_code" case-sensitive?) " = " (code-param-sql case-sensitive?) "))") :params [value value]} "=" (if-let [col (direct-column property)] - {:sql (str col " = ?") :params [value]} + {:sql (if (= "code" property) + (str (code-sql col case-sensitive?) " = " (code-param-sql case-sensitive?)) + (str col " = ?")) + :params [value]} {:sql (str "EXISTS (SELECT 1 FROM concept_property p " "WHERE p.cs_url=c.cs_url AND p.cs_version=c.cs_version " "AND p.code=c.code AND p.prop_code=? " @@ -372,7 +412,9 @@ "in" (let [parts (str/split value #",")] (if-let [col (direct-column property)] - {:sql (str col " IN (" (in-list-placeholders (count parts)) ")") + {:sql (if (= "code" property) + (str (code-sql col case-sensitive?) " IN (" (code-in-list-placeholders (count parts) case-sensitive?) ")") + (str col " IN (" (in-list-placeholders (count parts)) ")")) :params (vec parts)} {:sql (str "EXISTS (SELECT 1 FROM concept_property p " "WHERE p.cs_url=c.cs_url AND p.cs_version=c.cs_version " @@ -384,7 +426,9 @@ "not-in" (let [parts (str/split value #",")] (if-let [col (direct-column property)] - {:sql (str col " NOT IN (" (in-list-placeholders (count parts)) ")") + {:sql (if (= "code" property) + (str (code-sql col case-sensitive?) " NOT IN (" (code-in-list-placeholders (count parts) case-sensitive?) ")") + (str col " NOT IN (" (in-list-placeholders (count parts)) ")")) :params (vec parts)} {:sql (str "NOT EXISTS (SELECT 1 FROM concept_property p " "WHERE p.cs_url=c.cs_url AND p.cs_version=c.cs_version " @@ -451,7 +495,7 @@ (regex). With post-filters present, SQL would drop survivors after the limit was applied, returning fewer rows than the caller asked for; the caller slices in Clojure instead. See `cs-expand*`." - [url version filters text active-only? max-hits] + [url version filters text active-only? max-hits case-sensitive?] (let [base-where ["c.cs_url = ?" "c.cs_version = ?"] base-params [url (v version)] active-clause (when active-only? @@ -459,7 +503,7 @@ fts (fts-query text) fts-from (when fts (str " JOIN " fts-hits-subquery " hits ON hits.rowid = c.rowid ")) fts-params (when fts [fts fts]) - filter-clauses (map filter->sql-clause filters) + filter-clauses (map #(filter->sql-clause % case-sensitive?) filters) clause-sqls (map :sql filter-clauses) clause-params (mapcat :params filter-clauses) post-filters (filter some? (map :post-filter filter-clauses)) @@ -534,7 +578,7 @@ (:hierarchy-meaning meta) (assoc :hierarchy-meaning (:hierarchy-meaning meta)) (:standards-status meta) (assoc :standards-status (:standards-status meta)))) -(deftype SqliteCodeSystemCatalogue [ds cache] +(deftype FtrmCodeSystemCatalogue [ds cache] protos/CodeSystem (cs-metadata [_ {:keys [url version]}] ;; Cache is keyed by `[url version]`, so we filter the raw key @@ -547,7 +591,9 @@ (map (fn [[[k-url k-ver] entry]] (cond-> {:url k-url} (not (str/blank? k-ver)) (assoc :version k-ver) - (:content entry) (assoc :content (:content entry))))) + (:content entry) (assoc :content (:content entry)) + (some? (:case-sensitive entry)) (assoc :case-sensitive (:case-sensitive entry)) + (:supplements entry) (assoc :supplements (:supplements entry))))) cache)) (cs-resource [_ params] @@ -622,8 +668,7 @@ (let [meta (lookup-entry cache system (params-version params)) {:keys [url version case-sensitive]} meta] (if (nil? meta) - {:result false :code (keyword code) :system system - :message (str "No CodeSystem found for " system)} + (issues/unknown-system-validate system code) (with-open [conn (jdbc/get-connection ds)] (let [row (fetch-concept-row conn url version code case-sensitive)] (if (nil? row) @@ -687,25 +732,34 @@ ;; FHIR's $subsumes carries `systemA` / `systemB` (the composite has ;; already verified they're equal). Older callers may pass a single ;; `:system`; accept either spelling. - (let [system' (or systemA system) - meta (lookup-entry cache system' (params-version params)) - {:keys [url version]} meta] - {:outcome - (cond - (= codeA codeB) "equivalent" - (and meta - (jdbc/execute-one! ds - ["SELECT 1 FROM concept_ancestor - WHERE cs_url=? AND cs_version=? AND ancestor_code=? AND descendent_code=? LIMIT 1" - url (v version) codeA codeB])) - "subsumes" - (and meta - (jdbc/execute-one! ds - ["SELECT 1 FROM concept_ancestor - WHERE cs_url=? AND cs_version=? AND ancestor_code=? AND descendent_code=? LIMIT 1" - url (v version) codeB codeA])) - "subsumed-by" - :else "not-subsumed")})) + (let [system' (or systemA system) + meta (lookup-entry cache system' (params-version params)) + {:keys [url version case-sensitive]} meta] + (if (nil? meta) + (issues/unknown-system-subsumes system') + (with-open [conn (jdbc/get-connection ds)] + (let [rowA (fetch-concept-row conn url version codeA case-sensitive) + rowB (fetch-concept-row conn url version codeB case-sensitive)] + (cond + (nil? rowA) (issues/unknown-code-subsumes url codeA "codeA") + (nil? rowB) (issues/unknown-code-subsumes url codeB "codeB") + :else + {:outcome + (let [actualA (:concept/code rowA) + actualB (:concept/code rowB)] + (cond + (= actualA actualB) "equivalent" + (jdbc/execute-one! conn + ["SELECT 1 FROM concept_ancestor + WHERE cs_url=? AND cs_version=? AND ancestor_code=? AND descendent_code=? LIMIT 1" + url (v version) actualA actualB]) + "subsumes" + (jdbc/execute-one! conn + ["SELECT 1 FROM concept_ancestor + WHERE cs_url=? AND cs_version=? AND ancestor_code=? AND descendent_code=? LIMIT 1" + url (v version) actualB actualA]) + "subsumed-by" + :else "not-subsumed"))})))))) (cs-expand* [_ {:keys [system version filters text active-only max-hits displayLanguage] :as query}] @@ -715,7 +769,7 @@ (let [url (:url meta) ver (:version meta) {:keys [sql params post-filters issues]} - (search-concepts-sql url ver filters text active-only max-hits) + (search-concepts-sql url ver filters text active-only max-hits (:case-sensitive meta)) regex-on-property? (some (fn [{:keys [op property]}] (and (= "regex" op) (nil? (direct-column property)))) @@ -775,7 +829,7 @@ (some? experimental) (assoc :experimental (boolean experimental)) (map? compose) (assoc :compose compose)))) -(deftype SqliteValueSetCatalogue [_ds cache] +(deftype FtrmValueSetCatalogue [_ds cache] protos/ValueSet (vs-metadata [_ {:keys [url version]}] ;; Same key-filter trick as `cs-metadata` above. @@ -789,24 +843,27 @@ cache)) (vs-resource [_ params] - (some-> (lookup-entry cache (:url params) (params-version params)) + (some-> (lookup-entry cache (:url params) + (or (:valueSetVersion params) (params-version params))) vs-resource-from-entry)) (vs-expand [_ svc params] - (let [entry (lookup-entry cache (:url params) (params-version params)) + (let [entry (lookup-entry cache (:url params) + (or (:valueSetVersion params) (params-version params))) expanding (conj (or (:expanding params) #{}) (:url params))] (compose/expand-compose svc (:compose entry) (assoc params :expanding expanding :purpose :expand)))) (vs-validate-code [_ svc params] - (when-let [entry (lookup-entry cache (:url params) (params-version params))] + (when-let [entry (lookup-entry cache (:url params) + (or (:valueSetVersion params) (params-version params)))] (vs-validate/validate-code svc entry params)))) ;; --------------------------------------------------------------------------- ;; ConceptMap catalogue ;; --------------------------------------------------------------------------- -(deftype SqliteConceptMapCatalogue [ds cache] +(deftype FtrmConceptMapCatalogue [ds cache] protos/ConceptMap (cm-metadata [_ {:keys [url version]}] (eduction @@ -817,7 +874,8 @@ (cond-> {:url k-url :system (:source-uri entry) :target (:target-uri entry)} - (not (str/blank? k-ver)) (assoc :version k-ver)))) + (not (str/blank? k-ver)) (assoc :version k-ver) + (seq (:pairs entry)) (assoc :pairs (:pairs entry))))) cache)) (cm-resource [_ params] @@ -829,17 +887,22 @@ (cm-translate [_ {:keys [code system target] :as params}] (let [entry (lookup-entry cache (:url params) (params-version params)) - {:keys [url version source-uri target-uri]} entry - source-system (or system source-uri) - target-system (or target target-uri) + {:keys [url version]} entry + target-system (when (not= target (:target-uri entry)) target) rows (when entry - (jdbc/execute! ds - ;; Index `cme_fwd(cm_url, cm_version, source_system, source_code)` - ;; serves this lookup with all four columns covered. - ["SELECT target_system, target_code, target_display, equivalence, comment - FROM conceptmap_element - WHERE cm_url=? AND cm_version=? AND source_system=? AND source_code=?" - url (v version) source-system code])) + (if system + (jdbc/execute! ds + ;; Index `cme_fwd(cm_url, cm_version, source_system, source_code)` + ;; serves this lookup with all four columns covered. + ["SELECT target_system, target_code, target_display, equivalence, comment + FROM conceptmap_element + WHERE cm_url=? AND cm_version=? AND source_system=? AND source_code=?" + url (v version) system code]) + (jdbc/execute! ds + ["SELECT target_system, target_code, target_display, equivalence, comment + FROM conceptmap_element + WHERE cm_url=? AND cm_version=? AND source_code=?" + url (v version) code]))) matches (->> rows (filter (fn [r] (or (nil? target-system) @@ -877,7 +940,7 @@ vs-cache (load-valueset-cache ds) cm-cache (load-conceptmap-cache ds)] {:datasource ds - :codesystem (when (seq cs-cache) (->SqliteCodeSystemCatalogue ds cs-cache)) - :valueset (when (seq vs-cache) (->SqliteValueSetCatalogue ds vs-cache)) - :conceptmap (when (seq cm-cache) (->SqliteConceptMapCatalogue ds cm-cache)) + :codesystem (when (seq cs-cache) (->FtrmCodeSystemCatalogue ds cs-cache)) + :valueset (when (seq vs-cache) (->FtrmValueSetCatalogue ds vs-cache)) + :conceptmap (when (seq cm-cache) (->FtrmConceptMapCatalogue ds cm-cache)) :naming-system (fn [id] (db/resolve-system ds id))})) diff --git a/src/com/eldrix/hades/impl/index/memory.clj b/src/com/eldrix/hades/providers/in_memory/index.clj similarity index 98% rename from src/com/eldrix/hades/impl/index/memory.clj rename to src/com/eldrix/hades/providers/in_memory/index.clj index 698428e..081690a 100644 --- a/src/com/eldrix/hades/impl/index/memory.clj +++ b/src/com/eldrix/hades/providers/in_memory/index.clj @@ -1,4 +1,4 @@ -(ns com.eldrix.hades.impl.index.memory +(ns com.eldrix.hades.providers.in-memory.index "Single-phase indexer that turns accumulated `fhir-data` into provider values plus diagnostics. The pluggable seam is the provider protocol (impl/in_memory); intermediate indexed data stays private here. @@ -28,8 +28,8 @@ raw supplement data and metadata so the consumer can do this in one pass." (:require [clojure.string :as str] - [com.eldrix.hades.impl.fhir-extract :as fhir-extract] - [com.eldrix.hades.impl.in-memory :as in-memory])) + [com.eldrix.hades.providers.common.fhir-extract :as fhir-extract] + [com.eldrix.hades.providers.in-memory.provider :as in-memory])) (set! *warn-on-reflection* true) diff --git a/src/com/eldrix/hades/impl/in_memory.clj b/src/com/eldrix/hades/providers/in_memory/provider.clj similarity index 87% rename from src/com/eldrix/hades/impl/in_memory.clj rename to src/com/eldrix/hades/providers/in_memory/provider.clj index 66f020e..c9fc689 100644 --- a/src/com/eldrix/hades/impl/in_memory.clj +++ b/src/com/eldrix/hades/providers/in_memory/provider.clj @@ -1,4 +1,4 @@ -(ns com.eldrix.hades.impl.in-memory +(ns com.eldrix.hades.providers.in-memory.provider "In-memory provider deftypes that satisfy `CodeSystem`, `ValueSet`, and `ConceptMap` against indexed concept data. @@ -24,13 +24,13 @@ `loaders/fhir` + `index/memory`." (:require [clojure.spec.alpha :as s] [clojure.string :as str] - [com.eldrix.hades.impl.compose :as compose] - [com.eldrix.hades.impl.display :as display] - [com.eldrix.hades.impl.fhir-extract :as fhir-extract] - [com.eldrix.hades.impl.issues :as issues] - [com.eldrix.hades.impl.property-filter :as property-filter] - [com.eldrix.hades.impl.protocols :as protos] - [com.eldrix.hades.impl.vs-validate :as vs-validate]) + [com.eldrix.hades.providers.common.compose :as compose] + [com.eldrix.hades.providers.common.display :as display] + [com.eldrix.hades.providers.common.fhir-extract :as fhir-extract] + [com.eldrix.hades.providers.common.issues :as issues] + [com.eldrix.hades.providers.common.property-filter :as property-filter] + [com.eldrix.hades.protocols :as protos] + [com.eldrix.hades.providers.common.vs-validate :as vs-validate]) (:import (com.google.re2j Pattern))) (set! *warn-on-reflection* true) @@ -81,18 +81,46 @@ (conj result current)))) result))) +(defn- same-code? + [case-sensitive? a b] + (if case-sensitive? + (= a b) + (= (str/lower-case (str a)) (str/lower-case (str b))))) + +(defn- code-in? + [case-sensitive? values code] + (if case-sensitive? + (contains? values code) + (contains? (set (map str/lower-case values)) + (str/lower-case (str code))))) + +(defn- canonical-filter-code + [code-index case-sensitive? code] + (if case-sensitive? + code + (or (some (fn [actual] + (when (same-code? false actual code) actual)) + (keys code-index)) + code))) + (defn- concept-matches-filter? - [_code-index _children-map parents-map concept {:keys [property op value]}] + [code-index _children-map parents-map concept {:keys [property op value]} case-sensitive?] + (let [canonical-value (delay (canonical-filter-code code-index case-sensitive? value))] (case op - "is-a" (or (= (:code concept) value) - (ancestor? parents-map (:code concept) value)) - ("descendent-of" "descendant-of") (ancestor? parents-map (:code concept) value) - "is-not-a" (not (or (= (:code concept) value) - (ancestor? parents-map (:code concept) value))) - "generalizes" (or (= (:code concept) value) - (contains? (set (collect-ancestors parents-map value)) (:code concept))) + "is-a" (or (same-code? case-sensitive? (:code concept) value) + (some #(same-code? case-sensitive? % value) + (collect-ancestors parents-map (:code concept)))) + ("descendent-of" "descendant-of") + (some #(same-code? case-sensitive? % value) + (collect-ancestors parents-map (:code concept))) + "is-not-a" (not (or (same-code? case-sensitive? (:code concept) value) + (some #(same-code? case-sensitive? % value) + (collect-ancestors parents-map (:code concept))))) + "generalizes" (or (same-code? case-sensitive? (:code concept) value) + (some #(same-code? case-sensitive? % (:code concept)) + (collect-ancestors parents-map @canonical-value))) "=" (if (= property "code") - (= (:code concept) value) + (same-code? case-sensitive? (:code concept) value) (let [pv (get-concept-property concept property)] (and (not= pv ::not-found) (= (str pv) value)))) "regex" (let [^Pattern pat (Pattern/compile value) @@ -103,12 +131,12 @@ (boolean (when pv (.matches (.matcher pat ^CharSequence pv))))) "in" (let [vals (set (str/split value #","))] (if (= property "code") - (contains? vals (:code concept)) + (code-in? case-sensitive? vals (:code concept)) (let [pv (get-concept-property concept property)] (and (not= pv ::not-found) (contains? vals (str pv)))))) "not-in" (let [vals (set (str/split value #","))] (if (= property "code") - (not (contains? vals (:code concept))) + (not (code-in? case-sensitive? vals (:code concept))) (let [pv (get-concept-property concept property)] (or (= pv ::not-found) (not (contains? vals (str pv))))))) "exists" (let [exists? (= "true" value) @@ -122,7 +150,7 @@ :issues [{:severity "error" :type "not-supported" :details-code "not-supported" - :text (str "The filter operation '" op "' is not supported")}]})))) + :text (str "The filter operation '" op "' is not supported")}]}))))) ;; FHIR concept-property statuses that mean "no longer to be used". ;; "deprecated" is *not* in this set — per FHIR the deprecated state @@ -188,6 +216,7 @@ (some? (:experimental meta)) (assoc :experimental (boolean (:experimental meta))) (:description meta) (assoc :description (:description meta)) (:content meta) (assoc :content (:content meta)) + (some? (:case-sensitive meta)) (assoc :case-sensitive (:case-sensitive meta)) language (assoc :language language) (:standards-status meta) (assoc :standards-status (:standards-status meta))))) @@ -203,6 +232,7 @@ [(cond-> {:url my-url} my-ver (assoc :version my-ver) (:content meta) (assoc :content (:content meta)) + (some? (:case-sensitive meta)) (assoc :case-sensitive (:case-sensitive meta)) (:supplements-target meta) (assoc :supplements (:supplements-target meta)))]))) (cs-resource [_ _params] @@ -318,12 +348,19 @@ (not fragment?) (assoc :message msg)))))) (cs-subsumes [_ {:keys [codeA codeB]}] - {:outcome - (cond - (= codeA codeB) "equivalent" - (ancestor? (:parents hierarchy) codeA codeB) "subsumed-by" - (ancestor? (:parents hierarchy) codeB codeA) "subsumes" - :else "not-subsumed")}) + (let [url (:url meta)] + (cond + (not (contains? code-index codeA)) + (issues/unknown-code-subsumes url codeA "codeA") + (not (contains? code-index codeB)) + (issues/unknown-code-subsumes url codeB "codeB") + :else + {:outcome + (cond + (= codeA codeB) "equivalent" + (ancestor? (:parents hierarchy) codeA codeB) "subsumed-by" + (ancestor? (:parents hierarchy) codeB codeA) "subsumes" + :else "not-subsumed")}))) (cs-expand* [_ query] (let [{:keys [filters displayLanguage properties max-hits text active-only]} query @@ -337,7 +374,7 @@ matching (if (seq filters) (clojure.core/filter (fn [c] - (every? #(concept-matches-filter? code-index children-map parents-map c %) filters)) + (every? #(concept-matches-filter? code-index children-map parents-map c % case-sensitive?) filters)) all-concepts) all-concepts) matching (if active-only @@ -620,23 +657,43 @@ (deftype MemoryConceptMap [cm-data fwd-idx rev-idx] protos/ConceptMap (cm-metadata [_ {url-q :url ver-q :version}] - (let [{:keys [url source-uri target-uri version]} cm-data] + (let [{:keys [url source-uri target-uri version groups]} cm-data + pairs (->> groups + (keep (fn [{:keys [source target]}] + (when (and source target) + {:system source :target target}))) + distinct + vec)] (when (and (or (nil? url-q) (= url-q url)) (or (nil? ver-q) (= ver-q version))) [(cond-> {:url url :system (or source-uri "") :target (or target-uri "")} - version (assoc :version version))]))) + version (assoc :version version) + (seq pairs) (assoc :pairs pairs))]))) (cm-resource [_ _params] (:metadata cm-data)) (cm-translate [_ {:keys [code system target] :as _params}] - (let [src-sys (or system (:source-uri cm-data)) - fwd (when (and src-sys code) (get fwd-idx [src-sys code])) - rev-target-sys target - rev (when (and rev-target-sys code) - (get rev-idx [rev-target-sys code])) + (let [{:keys [target-uri]} cm-data + target-system? (not= target target-uri) + matches-for-code (fn [idx] + (into [] + (mapcat (fn [[[idx-system idx-code] matches]] + (when (and (= idx-code code) + (or (nil? system) + (= system idx-system))) + matches))) + idx)) + fwd (cond + (and system code) (get fwd-idx [system code]) + code (matches-for-code fwd-idx)) + fwd (cond->> fwd + (and target target-system?) (filter #(= target (:system %)))) + rev (when (and system code) + (cond->> (get rev-idx [system code]) + (and target target-system?) (filter #(= target (:system %))))) matches (cond (seq fwd) fwd (seq rev) rev diff --git a/src/com/eldrix/hades/providers/loinc/import.clj b/src/com/eldrix/hades/providers/loinc/import.clj new file mode 100644 index 0000000..4d80783 --- /dev/null +++ b/src/com/eldrix/hades/providers/loinc/import.clj @@ -0,0 +1,48 @@ +(ns com.eldrix.hades.providers.loinc.import + "Thin LOINC release import orchestration." + (:require [clojure.core.async :as async] + [com.eldrix.hades.providers.loinc.loader :as loader] + [com.eldrix.hades.providers.loinc.store :as store] + [next.jdbc :as jdbc]) + (:import (java.time Instant))) + +(defn- stream-blocks [dir opts] + (let [ch (async/chan 8)] + (async/thread (loader/stream-release ch dir opts)) + ch)) + +(defn import-release-into! + "Import a LOINC release directory into an existing connection. + Performs row-level upserts through `store/write-batch!` and returns + row counts by loader type." + ([conn dir] (import-release-into! conn dir nil)) + ([conn dir opts] + (let [{:keys [version]} (loader/metadata dir)] + (when-not version + (throw (ex-info (str "Invalid LOINC distribution: " dir) {:dir dir}))) + (jdbc/with-transaction [tx conn] + (loop [ch (stream-blocks dir opts) + counts {}] + (if-let [{:keys [type data ex] :as block} (async/ (.relativize (.toPath root) (.toPath file)) + str + (str/replace File/separatorChar \/))] + (some (fn [{:keys [path] :as lf}] + (when (if (string? path) (= path rel) (re-matches path rel)) + (assoc lf :path rel))) + release-files))) + +(defn loinc-file-seq* [dir] + (keep #(loinc-file dir %) (file-seq (io/file dir)))) + +(defn loinc-file-seq + "Returns a sequence of LOINC file definitions for the directory specified, + or nil if the directory is not a LOINC distribution." + [dir] + (let [required (->> release-files (filter :required?) (map :type) set) + files (loinc-file-seq* dir) + found (set (map :type files))] + (when (set/subset? required found) + (map (fn [{:keys [path] :as lf}] + (assoc lf :f (io/file dir path))) + files)))) + +(defn csv-rows + "Read CSV from `r`, returning a lazy seq of `{column -> cell}` row maps + keyed by the header row." + [r] + (let [[header & rows] (charred/read-csv r :async? false :close-reader? false)] + (map #(zipmap header %) rows))) + +(defn- read-version-from + [f] + (when (.exists ^File f) + (with-open [r (io/reader f :encoding "UTF-8")] + (reduce (fn [best {v "VersionLastChanged"}] + (if (pos? (canonical/semver-compare v best)) v best)) + nil + (csv-rows r))))) + +(defn read-version + "Return max VersionLastChanged from the release tables, or nil. + Every release bumps at least one concept's last-changed marker, so + `max(VersionLastChanged)` is the release version itself — + content-derived, immune to operator-renamed unzip directories. Prefer + `LoincTableCore/LoincTableCore.csv` when present because it is + narrower, but fall back to required `LoincTable/Loinc.csv` so optional + Core packaging is not required for import." + [root] + (or (read-version-from (io/file root "LoincTableCore" "LoincTableCore.csv")) + (read-version-from (io/file root "LoincTable" "Loinc.csv")))) + +(defn- block-extra + [{:keys [block-meta path]}] + (if block-meta + (block-meta path) + {})) + +(defn metadata + "Static information about the LOINC release at `dir`." + [dir] + (when-let [files (loinc-file-seq dir)] + {:version (read-version dir) + :files files})) + +(def loinc-recogniser + {:id :loinc + :scope :directory + :importable? true + :database? false + :recognise (fn [^File dir _probe?] + (when (loinc-file-seq dir) {}))}) + +(defn stream-file! + "Stream `f` to `ch` in `batch-size` row chunks. Throws when any column + declared in `cols` is absent from the file header — that's the failure + mode that matters, because downstream consumers reference cells by + header name. Trailing extra columns and reordering are forwarded + untouched: each block carries `:headings` so consumers can `zipmap` by + name." + [ch version batch-size {:keys [f type path cols] :as file-def}] + (let [[headings & rows] (charred/read-csv f) + missing (remove (set headings) cols)] + (when (seq missing) + (throw (ex-info (str "Missing columns in " path ": " missing) + {:path path :found headings :missing missing :expected cols}))) + (doseq [batch (partition-all batch-size rows)] + (async/>!! ch (merge {:type type :path path :version version + :headings headings :data batch} + (block-extra file-def)))))) + +(defn stream-release + "Blocking: stream raw LOINC CSV blocks from an unpacked release directory. + Run in a background thread. e.g. + ``` + (async/thread + (stream-release ch dir)) + ``` + Data blocks carry vectors of row vectors keyed by a semantic `:type` + from `release-files`. Failures are emitted as a final + `{:type ::error :ex t}` block before the channel closes; the + function does not throw." + ([ch dir] (stream-release ch dir nil)) + ([ch dir {:keys [batch-size close?] :or {batch-size 500 close? true}}] + (try + (if-let [{:keys [files version]} (metadata dir)] + (run! #(stream-file! ch version batch-size %) files) + (throw (ex-info (str "Invalid LOINC distribution: " dir) {}))) + (catch Throwable t + (async/>!! ch {:type ::error :ex t})) + (finally + (when close? (async/close! ch)))))) + +(defn row-counts + "Stream `dir` through `stream-release` and tally data-row counts — + the streaming-API equivalent of `wc -l` minus each file's header. + Returns `{:per-file {path -> rows} :by-type {type -> rows}}`." + [dir] + (let [ch (async/chan 8) + _ (async/thread (stream-release ch dir))] + (loop [per-file {} by-type {}] + (if-let [{:keys [type path data ex]} (async/> path + (re-matches #"AccessoryFiles/LinguisticVariants/([a-z]{2})([A-Z]{2})(\d+)LinguisticVariant\.csv") + last + (hash-map :variant-id)) + (throw (ex-info (str "Cannot derive linguistic variant identity from " path) + {:path path})))) + +(defn linguistic-variant-table + [{:keys [variant-id]} columns rows] + {:columns (into ["variant_id"] columns) + :rows (mapv #(into [variant-id] %) rows)}) + +(def column-overrides + {"Group" "group_name" + "ParentGroup" "parent_group_name" + "PROPERTY" "property" + "UNITSREQUIRED" "units_required" + "RELATEDNAMES2" "related_names_2"}) + +(defn column-name + [heading] + (or (column-overrides heading) + (-> heading + (str/replace #"([A-Z]+)([A-Z][a-z])" "$1_$2") + (str/replace #"([a-z0-9])([A-Z])" "$1_$2") + (str/replace #"[ -]+" "_") + str/lower-case))) + +(def release-files + "Known LOINC release files. `:type` is the streamed block type, + `:table-name` is the SQLite source table, optional + `:column-transforms` rewrite individual column values, and optional + `:table-transform` handles files whose row identity includes + per-file metadata. Store writers keep `:columns` and `:rows` as + ordered vectors." + [{:path "LoincTable/Loinc.csv" + :required? true + :type (loader-type "loinc") + :table-name "loinc" + :cols loinc-cols} + {:path "LoincTable/MapTo.csv" + :type (loader-type "map-to") + :table-name "map_to" + :cols ["LOINC" "MAP_TO" "COMMENT"]} + {:path "LoincTable/SourceOrganization.csv" + :type (loader-type "source-organization") + :table-name "source_organization" + :cols ["ID" "COPYRIGHT_ID" "NAME" "COPYRIGHT" "TERMS_OF_USE" "URL"]} + {:path "AccessoryFiles/ConsumerName/ConsumerName.csv" + :type (loader-type "consumer-name") + :table-name "consumer_name" + :cols ["LoincNumber" "ConsumerName"]} + {:path "AccessoryFiles/GroupFile/Group.csv" + :type (loader-type "group") + :table-name "loinc_group" + :cols ["ParentGroupId" "GroupId" "Group" "Archetype" "Status" "VersionFirstReleased"]} + {:path "AccessoryFiles/GroupFile/GroupAttributes.csv" + :type (loader-type "group-attribute") + :table-name "group_attribute" + :cols ["ParentGroupId" "GroupId" "Type" "Value"]} + {:path "AccessoryFiles/GroupFile/GroupLoincTerms.csv" + :type (loader-type "group-loinc-term") + :table-name "group_loinc_term" + :cols ["Category" "GroupId" "Archetype" "LoincNumber" "LongCommonName"]} + {:path "AccessoryFiles/GroupFile/ParentGroup.csv" + :type (loader-type "parent-group") + :table-name "parent_group" + :cols ["ParentGroupId" "ParentGroup" "Status"]} + {:path "AccessoryFiles/GroupFile/ParentGroupAttributes.csv" + :type (loader-type "parent-group-attribute") + :table-name "parent_group_attribute" + :cols ["ParentGroupId" "Type" "Value"]} + {:path "AccessoryFiles/PartFile/Part.csv" + :type (loader-type "part") + :table-name "part" + :cols ["PartNumber" "PartTypeName" "PartName" "PartDisplayName" "Status"]} + {:path "AccessoryFiles/PartFile/LoincPartLink_Primary.csv" + :type (loader-type "part-link-primary") + :table-name "part_link_primary" + :cols ["LoincNumber" "LongCommonName" "PartNumber" "PartName" + "PartCodeSystem" "PartTypeName" "LinkTypeName" "Property"]} + {:path "AccessoryFiles/PartFile/LoincPartLink_Supplementary.csv" + :type (loader-type "part-link-supplementary") + :table-name "part_link_supplementary" + :cols ["LoincNumber" "LongCommonName" "PartNumber" "PartName" + "PartCodeSystem" "PartTypeName" "LinkTypeName" "Property"]} + {:path "AccessoryFiles/PartFile/PartRelatedCodeMapping.csv" + :type (loader-type "part-related-code-mapping") + :table-name "part_related_code_mapping" + :cols ["PartNumber" "PartName" "PartTypeName" "ExtCodeId" + "ExtCodeDisplayName" "ExtCodeSystem" "Equivalence" "ContentOrigin" + "ExtCodeSystemVersion" "ExtCodeSystemCopyrightNotice"]} + {:path "AccessoryFiles/ComponentHierarchyBySystem/ComponentHierarchyBySystem.csv" + :type (loader-type "hierarchy") + :table-name "component_hierarchy_by_system" + :cols ["PATH_TO_ROOT" "SEQUENCE" "IMMEDIATE_PARENT" "CODE" "CODE_TEXT"]} + {:path "AccessoryFiles/AnswerFile/AnswerList.csv" + :type (loader-type "answer-list") + :table-name "answer_list" + :cols answer-list-cols} + {:path "AccessoryFiles/AnswerFile/LoincAnswerListLink.csv" + :type (loader-type "answer-list-link") + :table-name "answer_list_link" + :cols answer-list-link-cols} + {:path "AccessoryFiles/PanelsAndForms/PanelsAndForms.csv" + :type (loader-type "panel") + :table-name "panels_and_forms" + :cols ["ParentId" "ParentLoinc" "ParentName" "ID" "SEQUENCE" "Loinc" + "LoincName" "DisplayNameForForm" "ObservationRequiredInPanel" + "ObservationIdInForm" "SkipLogicHelpText" "DefaultValue" "EntryType" + "DataTypeInForm" "DataTypeSource" "AnswerSequenceOverride" + "ConditionForInclusion" "AllowableAlternative" "ObservationCategory" + "Context" "ConsistencyChecks" "RelevanceEquation" "CodingInstructions" + "QuestionCardinality" "AnswerCardinality" "AnswerListIdOverride" + "AnswerListTypeOverride" "EXTERNAL_COPYRIGHT_NOTICE" "AdditionalCopyright"]} + {:path "AccessoryFiles/PanelsAndForms/Loinc.csv" + :type (loader-type "panels-loinc") + :table-name "panels_loinc" + :cols loinc-cols} + {:path "AccessoryFiles/PanelsAndForms/AnswerList.csv" + :type (loader-type "panels-answer-list") + :table-name "panels_answer_list" + :cols answer-list-cols} + {:path "AccessoryFiles/PanelsAndForms/LoincAnswerListLink.csv" + :type (loader-type "panels-answer-list-link") + :table-name "panels_answer_list_link" + :cols answer-list-link-cols} + {:path "AccessoryFiles/DocumentOntology/DocumentOntology.csv" + :type (loader-type "document-ontology") + :table-name "document_ontology" + :cols ["LoincNumber" "PartNumber" "PartTypeName" "PartSequenceOrder" "PartName"]} + {:path "AccessoryFiles/ImagingDocuments/ImagingDocumentCodes.csv" + :type (loader-type "imaging-document") + :table-name "imaging_document_code" + :cols ["LOINC_NUM" "LONG_COMMON_NAME"]} + {:path "AccessoryFiles/LoincRsnaRadiologyPlaybook/LoincRsnaRadiologyPlaybook.csv" + :type (loader-type "rsna-playbook") + :table-name "loinc_rsna_radiology_playbook" + :cols ["LoincNumber" "LongCommonName" "PartNumber" "PartTypeName" "PartName" + "PartSequenceOrder" "RID" "PreferredName" "RPID" "LongName"]} + {:path "AccessoryFiles/LoincIeeeMedicalDeviceCodeMappingTable/LoincIeeeMedicalDeviceCodeMappingTable.csv" + :type (loader-type "ieee-medical-device-mapping") + :table-name "loinc_ieee_medical_device_mapping" + :cols ["LOINC_NUM" "LOINC_LONG_COMMON_NAME" "IEEE_CF_CODE10" "IEEE_REFID" "EQUIVALENCE"]} + {:path "AccessoryFiles/LoincUniversalLabOrdersValueSet/LoincUniversalLabOrdersValueSet.csv" + :type (loader-type "universal-lab-orders") + :table-name "loinc_universal_lab_orders_value_set" + :cols ["LOINC_NUM" "LONG_COMMON_NAME" "ORDER_OBS"]} + {:path "AccessoryFiles/LinguisticVariants/LinguisticVariants.csv" + :type (loader-type "linguistic-variant-catalog") + :table-name "linguistic_variant_catalog" + :cols ["ID" "ISO_LANGUAGE" "ISO_COUNTRY" "LANGUAGE_NAME" "PRODUCER"]} + {:path #"AccessoryFiles/LinguisticVariants/.+LinguisticVariant\.csv" + :type (loader-type "linguistic-variant") + :table-name "linguistic_variant_row" + :block-meta linguistic-variant-meta + :table-transform linguistic-variant-table + :cols ["LOINC_NUM" "COMPONENT" "PROPERTY" "TIME_ASPCT" "SYSTEM" "SCALE_TYP" + "METHOD_TYP" "CLASS" "SHORTNAME" "LONG_COMMON_NAME" "RELATEDNAMES2" + "LinguisticVariantDisplayName"]} + {:path "AccessoryFiles/ChangeSnapshot/LoincChangeSnapshot.csv" + :type (loader-type "loinc-change-snapshot") + :table-name "loinc_change_snapshot" + :cols ["VersionEffective" "LOINC_NUM" "Property" "ValuePrior" + "ValueCurrent" "ChangeReason"]} + {:path "AccessoryFiles/ChangeSnapshot/PartChangeSnapshot.csv" + :type (loader-type "part-change-snapshot") + :table-name "part_change_snapshot" + :cols ["VersionEffective" "PartNumber" "PROPERTY" "ValuePrior" + "ValueCurrent" "ChangeReason"]} + {:path "AccessoryFiles/Updates/Updates.csv" + :type (loader-type "updates") + :table-name "updates" + :cols ["RecType" "LOINC_NUM" "COMPONENT" "PROPERTY" "TIME_ASPCT" + "SYSTEM" "SCALE_TYP" "METHOD_TYP" "CLASS"]} + {:path "AccessoryFiles/Updates/UpdatesAdditionalFields.csv" + :type (loader-type "updates-additional-fields") + :table-name "updates_additional_fields" + :cols (into ["RecType"] loinc-cols)}]) + +(def release-files-by-type + (into {} (map (juxt :type identity)) release-files)) + +(defn release-file + [type] + (or (release-files-by-type type) + (throw (ex-info (str "Unknown LOINC release file type: " type) + {:type type})))) diff --git a/src/com/eldrix/hades/providers/loinc/provider.clj b/src/com/eldrix/hades/providers/loinc/provider.clj new file mode 100644 index 0000000..e33f617 --- /dev/null +++ b/src/com/eldrix/hades/providers/loinc/provider.clj @@ -0,0 +1,1563 @@ +(ns com.eldrix.hades.providers.loinc.provider + "Native LOINC SQLite provider." + (:require [clojure.string :as str] + [com.eldrix.hades.protocols :as protos] + [com.eldrix.hades.providers.common.display :as display] + [com.eldrix.hades.providers.common.issues :as issues] + [com.eldrix.hades.providers.common.property-filter :as property-filter] + [com.eldrix.hades.providers.loinc.model :as model] + [com.eldrix.hades.providers.loinc.store :as store] + [next.jdbc :as jdbc] + [next.jdbc.result-set :as rs]) + (:import (java.io Closeable))) + +(set! *warn-on-reflection* true) + +(def loinc-url "http://loinc.org") + +(def ^:private designation-use-system "http://loinc.org") + +(def ^:private loinc-oid "2.16.840.1.113883.6.1") + +(def ^:private loinc-vs-prefix "http://loinc.org/vs/") + +(def ^:private implicit-loinc-vs-url "http://loinc.org/vs") + +(defn- row-builder [] + {:builder-fn rs/as-unqualified-lower-maps}) + +(defn- sqlite-true? [v] + (or (true? v) + (and (number? v) (not (zero? v))))) + +(defn- meta-value [ds k] + (:value (jdbc/execute-one! ds + ["SELECT value FROM meta WHERE key = ?" (name k)] + (row-builder)))) + +(defn- code-row [conn code] + (jdbc/execute-one! conn + ["SELECT * + FROM loinc + WHERE loinc_num = ? COLLATE NOCASE" + code] + (row-builder))) + +(defn- answer-list-id->url [id] + (str loinc-vs-prefix id)) + +(defn- loinc-vs-id [url pattern] + (when (string? url) + (second (re-matches pattern url)))) + +(defn- answer-list-id [url] + (loinc-vs-id url #"http://loinc\.org/vs/(LL\d+-\d+)")) + +(defn- group-id->url [id] + (str loinc-vs-prefix id)) + +(defn- group-id [url] + (loinc-vs-id url #"http://loinc\.org/vs/(LG\d+-\d+)")) + +(defn- part-id [url] + (loinc-vs-id url #"http://loinc\.org/vs/(LP\d+-\d+)")) + +(defn- implicit-loinc-vs? [url] + (= implicit-loinc-vs-url url)) + +(defn- locale-tag [{:keys [iso_language iso_country]}] + (cond + (and (seq iso_language) (seq iso_country)) (str iso_language "-" iso_country) + (seq iso_language) iso_language)) + +(defn- variant-value [row column] + (let [v (get row column)] + (when-not (str/blank? v) v))) + +(def ^:private display-columns + [[:long_common_name "LONG_COMMON_NAME"] + [:linguistic_variant_display_name "LinguisticVariantDisplayName"] + [:shortname "SHORTNAME"] + [:component "COMPONENT"] + [:related_names_2 "RELATEDNAMES2"]]) + +(defn- variant-designations [rows] + (vec + (for [row rows + :let [language (locale-tag row)] + [column use-code] display-columns + :let [value (variant-value row column)] + :when value] + {:language language + :use {:system designation-use-system :code use-code} + :value value}))) + +(defn- fetch-variant-rows + ([conn code] (fetch-variant-rows conn code nil)) + ([conn code languages] + (let [language-set (some->> languages + (map #(subs % 0 (min 2 (count %)))) + (remove str/blank?) + set) + rows (jdbc/execute! conn + ["SELECT r.variant_id, c.iso_language, c.iso_country, + r.long_common_name, + r.linguistic_variant_display_name, + r.shortname, r.component, r.related_names_2 + FROM linguistic_variant_row r + LEFT JOIN linguistic_variant_catalog c ON c.id = r.variant_id + WHERE r.loinc_num = ?" + code] + (row-builder))] + (if (seq language-set) + (filterv #(contains? language-set (:iso_language %)) rows) + rows)))) + +(defn- preferred-designation + [designations display-langs] + (some (fn [{:keys [lang]}] + (some (fn [[_column use-code]] + (some (fn [{:keys [language use value]}] + (when (and value + (= use-code (:code use)) + (display/language-matches? language lang)) + value)) + designations)) + display-columns)) + display-langs)) + +(defn- fts-tokens + [text] + (when-not (str/blank? text) + (seq (->> (str/split text #"\s+") + (map #(str/replace % #"[\"]" "")) + (map #(str/replace % #"[^\p{L}\p{Nd}_-]" "")) + (remove str/blank?))))) + +(defn- fts-query + [tokens] + (when (seq tokens) + (str/join " " (map #(str \" % \") tokens)))) + +(defn- locale-where [display-langs] + (when (seq display-langs) + (let [langs (->> display-langs + (map :lang) + (map #(subs % 0 (min 2 (count %)))) + distinct + vec)] + {:sql (str " AND vf.iso_language IN (" (str/join "," (repeat (count langs) "?")) ")") + :params langs}))) + +(def ^:private filter-columns + {"code" "loinc_num" + "display" "long_common_name" + "COMPONENT" "component" + "PROPERTY" "property" + "TIME_ASPCT" "time_aspct" + "SYSTEM" "system" + "SCALE_TYP" "scale_typ" + "METHOD_TYP" "method_typ" + "CLASS" "class" + "STATUS" "status" + "CLASSTYPE" "classtype" + "ORDER_OBS" "order_obs" + "copyright" "external_copyright_notice"}) + +(defn- placeholders [n] + (str/join "," (repeat n "?"))) + +(defn- hierarchy-token-clause [column] + (str "(" column " = ? OR path_to_root = ?" + " OR path_to_root LIKE ?" + " OR path_to_root LIKE ?" + " OR path_to_root LIKE ?)")) + +(defn- hierarchy-token-params [value] + [value value (str value ".%") (str "%." value) (str "%." value ".%")]) + +(defn- filter-clause [{:keys [property op value]}] + (case op + "=" + (cond + (= "parent" property) + {:sql "EXISTS (SELECT 1 FROM component_hierarchy_by_system h WHERE h.code = loinc_num AND h.immediate_parent = ?)" + :params [value]} + + (= "child" property) + {:sql "EXISTS (SELECT 1 FROM component_hierarchy_by_system h WHERE h.code = ? AND h.immediate_parent = loinc_num)" + :params [value]} + + (filter-columns property) + {:sql (str (filter-columns property) " = ? COLLATE NOCASE") + :params [value]}) + + "in" + (when-let [column (filter-columns property)] + (let [parts (str/split value #",")] + {:sql (str column " COLLATE NOCASE IN (" (placeholders (count parts)) ")") + :params parts})) + + "not-in" + (when-let [column (filter-columns property)] + (let [parts (str/split value #",")] + {:sql (str column " COLLATE NOCASE NOT IN (" (placeholders (count parts)) ")") + :params parts})) + + "exists" + (when-let [column (filter-columns property)] + {:sql (if (= "true" value) + (str column " IS NOT NULL AND " column " <> ''") + (str "(" column " IS NULL OR " column " = '')")) + :params []}) + + "regex" + (when-let [column (filter-columns property)] + {:sql (str column " IS NOT NULL AND " column " <> ''") + :params [] + :post-filter (let [pattern (try (re-pattern value) (catch Exception _ nil))] + (if pattern + #(boolean (re-find pattern (str (get % (keyword column))))) + (constantly false)))}) + + "is-a" + (when (= "concept" property) + {:sql (str "(loinc_num = ? COLLATE NOCASE OR EXISTS" + " (SELECT 1 FROM component_hierarchy_by_system h" + " WHERE h.code = loinc_num AND " (hierarchy-token-clause "h.immediate_parent") "))") + :params (into [value] (hierarchy-token-params value))}) + + ("descendent-of" "descendant-of") + (when (= "concept" property) + {:sql (str "EXISTS (SELECT 1 FROM component_hierarchy_by_system h" + " WHERE h.code = loinc_num AND " (hierarchy-token-clause "h.immediate_parent") ")") + :params (hierarchy-token-params value)}) + + "is-not-a" + (when (= "concept" property) + {:sql (str "loinc_num <> ? COLLATE NOCASE AND NOT EXISTS" + " (SELECT 1 FROM component_hierarchy_by_system h" + " WHERE h.code = loinc_num AND " (hierarchy-token-clause "h.immediate_parent") ")") + :params (into [value] (hierarchy-token-params value))}) + + "generalizes" + (when (= "concept" property) + {:sql (str "EXISTS (SELECT 1 FROM component_hierarchy_by_system h" + " WHERE h.code = ? AND " (hierarchy-token-clause "loinc_num") ")") + :params (into [value] (hierarchy-token-params value))}) + + nil)) + +(defn- unsupported-filter-issue [{:keys [property op value]}] + {:severity "error" + :type "invalid" + :details-code "vs-invalid" + :text (str "Unsupported LOINC filter" + " property=" (pr-str property) + ", op=" (pr-str op) + ", value=" (pr-str value))}) + +(defn- filter-where [filters] + (let [filters (seq filters) + clauses (mapv filter-clause filters)] + (cond + (nil? filters) nil + + (some nil? clauses) + {:sql " WHERE 0" + :params [] + :post-filters [] + :issues (mapv unsupported-filter-issue + (keep-indexed (fn [idx f] + (when (nil? (nth clauses idx)) f)) + filters))} + + (seq clauses) + {:sql (str " WHERE " (str/join " AND " (map :sql clauses))) + :params (mapcat :params clauses) + :post-filters (keep :post-filter clauses)}))) + +(defn- search-sql [text display-langs filters active-only max-hits] + (let [tokens (fts-tokens text) + q (fts-query tokens) + text? (not (str/blank? text)) + locale (locale-where display-langs) + filters (filter-where (cond-> (vec filters) + active-only (conj {:property "STATUS" :op "not-in" :value "DEPRECATED"}))) + token-count (count tokens) + limit (or max-hits 50)] + (cond + q + {:sql (str "SELECT *, MIN(rank) AS rank FROM (" + " SELECT l.*, f.rank AS rank" + " FROM loinc_fts f JOIN loinc l ON l.rowid = f.rowid" + " WHERE loinc_fts MATCH ?" + " UNION ALL" + " SELECT l.*, vf.rank AS rank" + " FROM loinc_variant_fts vf JOIN loinc l ON l.loinc_num = vf.loinc_num" + " WHERE loinc_variant_fts MATCH ?" (or (:sql locale) "") + ")" (or (:sql filters) "") + " GROUP BY loinc_num" + (if (> token-count 2) + " ORDER BY rank, CASE WHEN common_test_rank > 0 THEN 0 ELSE 1 END, common_test_rank LIMIT ?" + " ORDER BY CASE WHEN common_test_rank > 0 THEN 0 ELSE 1 END, common_test_rank, CASE WHEN common_order_rank > 0 THEN 0 ELSE 1 END, common_order_rank, rank LIMIT ?")) + :params (concat [q q] (:params locale) (:params filters) [limit]) + :post-filters (:post-filters filters) + :issues (:issues filters)} + + text? + {:sql "SELECT *, 0.0 AS rank FROM loinc WHERE 0 LIMIT ?" + :params [limit] + :post-filters (:post-filters filters) + :issues (:issues filters)} + + :else + {:sql (str "SELECT *, 0.0 AS rank" + " FROM loinc" + (or (:sql filters) "") + " ORDER BY loinc_num LIMIT ?") + :params (concat (:params filters) [limit]) + :post-filters (:post-filters filters) + :issues (:issues filters)}))) + +(defn- concept-from-row [conn display-langs row] + (let [code (:loinc_num row) + variant-rows (when (seq display-langs) + (fetch-variant-rows conn code (mapv :lang display-langs))) + designations (when (seq variant-rows) (variant-designations variant-rows)) + lang-display (when (seq designations) + (preferred-designation designations display-langs))] + (cond-> {:system loinc-url + :code code + :display (or lang-display (:long_common_name row)) + :inactive (= "DEPRECATED" (:status row))} + (seq designations) (assoc :designations designations)))) + +(def ^:private coded-property-types + {:COMPONENT "COMPONENT" + :PROPERTY "PROPERTY" + :TIME_ASPCT "TIME" + :SYSTEM "SYSTEM" + :SCALE_TYP "SCALE" + :METHOD_TYP "METHOD" + :CLASS "CLASS"}) + +(def ^:private lookup-properties + [[:COMPONENT :component true] + [:PROPERTY :property true] + [:TIME_ASPCT :time_aspct true] + [:SYSTEM :system true] + [:SCALE_TYP :scale_typ true] + [:METHOD_TYP :method_typ true] + [:CLASS :class true] + [:STATUS :status false] + [:CLASSTYPE :classtype false] + [:ORDER_OBS :order_obs false] + [:copyright :external_copyright_notice false]]) + +(defn- property-entry [row part-by-type [code column coded?]] + (let [value (get row column)] + (when-not (str/blank? value) + {:code code + :value (if (and coded? (part-by-type (coded-property-types code))) + (let [{:keys [part_number part_name]} (part-by-type (coded-property-types code))] + {:system loinc-url :code part_number :display part_name}) + value)}))) + +(defn- fetch-primary-parts [conn {:keys [loinc_num class]}] + (let [part-rows (jdbc/execute! conn + ["SELECT part_number, part_name, part_type_name + FROM part_link_primary + WHERE loinc_number = ?" + loinc_num] + (row-builder)) + class-row (jdbc/execute-one! conn + ["SELECT part_number, part_name, part_type_name + FROM part + WHERE part_type_name = 'CLASS' + AND part_name = ? + LIMIT 1" + class] + (row-builder))] + (into {} + (map (juxt :part_type_name identity)) + (cond-> part-rows class-row (conj class-row))))) + +(defn- fetch-parents [conn code] + (jdbc/execute! conn + ["SELECT DISTINCT h.immediate_parent AS code, COALESCE(p.code_text, h.immediate_parent) AS display + FROM component_hierarchy_by_system h + LEFT JOIN component_hierarchy_by_system p ON p.code = h.immediate_parent + WHERE h.code = ? + ORDER BY h.sequence, h.immediate_parent" + code] + (row-builder))) + +(defn- fetch-children [conn code] + (jdbc/execute! conn + ["SELECT DISTINCT code, code_text AS display + FROM component_hierarchy_by_system + WHERE immediate_parent = ? + ORDER BY sequence, code" + code] + (row-builder))) + +(defn- code-exists? + "True when `code` resolves to a LOINC term or a part code. LOINC's + subsumption hierarchy spans both, so existence-checking subsumes + inputs must consider both tables." + [conn code] + (boolean + (or (jdbc/execute-one! conn + ["SELECT 1 FROM loinc WHERE loinc_num = ? COLLATE NOCASE" code]) + (jdbc/execute-one! conn + ["SELECT 1 FROM component_hierarchy_by_system + WHERE code = ? OR immediate_parent = ? LIMIT 1" code code])))) + +(defn- hierarchy-related? [conn ancestor descendant include-self?] + (or (and include-self? (= ancestor descendant)) + (boolean + (jdbc/execute-one! conn + [(str "SELECT 1 FROM component_hierarchy_by_system" + " WHERE code = ? AND " + (hierarchy-token-clause "immediate_parent") + " LIMIT 1") + descendant ancestor ancestor (str ancestor ".%") + (str "%." ancestor) (str "%." ancestor ".%")] + (row-builder))))) + +(defn- wanted-properties [row part-by-type {:keys [want? want-typed?]}] + (when want-typed? + (keep (fn [[code :as property]] + (when (want? (name code)) + (property-entry row part-by-type property))) + lookup-properties))) + +(defn- answer-code-row [conn code] + (jdbc/execute-one! conn + ["SELECT answer_string_id, display_text + FROM answer_list + WHERE answer_string_id = ? COLLATE NOCASE + LIMIT 1" + code] + (row-builder))) + +(defn- part-code-row [conn code] + (jdbc/execute-one! conn + ["SELECT part_number, part_name, part_display_name, status + FROM part + WHERE part_number = ? COLLATE NOCASE + LIMIT 1" + code] + (row-builder))) + +(defn- group-code-row [conn code] + (jdbc/execute-one! conn + ["SELECT group_id, group_name, status + FROM loinc_group + WHERE group_id = ? COLLATE NOCASE + LIMIT 1" + code] + (row-builder))) + +(defn- answer-lookup-result [{:keys [display_text answer_string_id]} version] + {:name "LOINC" + :version version + :display display_text + :system loinc-url + :code answer_string_id + :abstract false + :properties [] + :designations []}) + +(defn- part-lookup-result [{:keys [status part_display_name part_name part_number]} version] + (cond-> {:name "LOINC" + :version version + :display (or part_display_name part_name) + :system loinc-url + :code part_number + :abstract false + :properties [] + :designations []} + (= "DEPRECATED" status) (assoc :inactive true :inactive-status "inactive"))) + +(defn- group-lookup-result [{:keys [status group_name group_id]} version] + (cond-> {:name "LOINC" + :version version + :display group_name + :system loinc-url + :code group_id + :abstract false + :properties [] + :designations []} + (= "Deprecated" status) (assoc :inactive true :inactive-status "inactive"))) + +(defn- display-issue [system code concept {:keys [display displayLanguage]}] + (let [display-langs (display/parse-display-language displayLanguage)] + (when (and display + (not (display/display-matches? concept display display-langs))) + {:severity "error" + :type "invalid" + :details-code "invalid-display" + :text (issues/format-display-mismatch + display system code (:display concept) (:designations concept) + displayLanguage nil) + :expression ["Coding.display"]}))) + +(defrecord LoincCodeSystem [ds version] + Closeable + (close [_] (store/close! ds)) + + protos/CodeSystem + (cs-metadata [this {:keys [url version]}] + (when (and (or (nil? url) (= loinc-url url)) + (or (nil? version) (= (:version this) version))) + [(cond-> {:url loinc-url + :name "LOINC" + :title "Logical Observation Identifiers Names and Codes" + :content "complete" + :case-sensitive false} + (:version this) (assoc :version (:version this)))])) + + (cs-resource [this params] + (first (protos/cs-metadata this params))) + + (cs-lookup [_ {:keys [system code displayLanguage properties]}] + (if (not= loinc-url system) + (issues/unknown-system-lookup system code) + (with-open [conn (jdbc/get-connection ds)] + (if-let [row (code-row conn code)] + (let [{:keys [want?] :as property-filter} (property-filter/parse properties) + display-langs (display/parse-display-language displayLanguage) + variant-rows (when (or (want? "designation") + (seq display-langs)) + (fetch-variant-rows conn (:loinc_num row) + (when (seq display-langs) + (mapv :lang display-langs)))) + designations (variant-designations variant-rows) + lang-display (preferred-designation designations display-langs) + parents (when (want? "parent") + (fetch-parents conn (:loinc_num row))) + children (when (want? "child") + (fetch-children conn (:loinc_num row))) + part-by-type (when (:want-typed? property-filter) + (fetch-primary-parts conn row)) + inactive? (= "DEPRECATED" (:status row))] + (cond-> {:name "LOINC" + :version version + :display (or lang-display (:long_common_name row)) + :system loinc-url + :code (:loinc_num row) + :definition (variant-value row :definition_description) + :abstract false + :properties (vec + (concat + (wanted-properties row part-by-type property-filter) + (when (and inactive? (want? "inactive")) + [{:code :inactive :value true}]) + (map (fn [{:keys [code display]}] + {:code :parent + :value {:system loinc-url + :code code + :display display}}) + parents) + (map (fn [{:keys [code display]}] + {:code :child + :value {:system loinc-url + :code code + :display display}}) + children))) + :designations (if (want? "designation") + designations + [])} + inactive? (assoc :inactive true :inactive-status "inactive"))) + (if-let [row (answer-code-row conn code)] + (answer-lookup-result row version) + (if-let [row (part-code-row conn code)] + (part-lookup-result row version) + (if-let [row (group-code-row conn code)] + (group-lookup-result row version) + (issues/unknown-code-lookup loinc-url code)))) + )))) + + (cs-validate-code [this {:keys [system code display displayLanguage]}] + (if-let [r (protos/cs-lookup this {:system system :code code :displayLanguage displayLanguage + :properties (when display ["designation"])})] + (if (:not-found r) + (if (= :unknown-system (:not-found-reason r)) + (issues/unknown-system-validate system code) + {:result false + :system system + :code code + :message (:message r) + :issues (:issues r)}) + (let [display-issue (display-issue loinc-url code r + {:display display + :displayLanguage displayLanguage})] + (cond-> {:result (nil? display-issue) + :system loinc-url + :code (:code r) + :display (:display r) + :version version} + (:inactive r) (assoc :inactive true) + (:inactive-status r) (assoc :inactive-status (:inactive-status r)) + display-issue (assoc :message (:text display-issue) + :issues [display-issue])))) + {:result false :system system :code code})) + + (cs-subsumes [_ {:keys [codeA codeB]}] + (with-open [conn (jdbc/get-connection ds)] + (cond + (not (code-exists? conn codeA)) + (issues/unknown-code-subsumes loinc-url codeA "codeA") + (not (code-exists? conn codeB)) + (issues/unknown-code-subsumes loinc-url codeB "codeB") + :else + {:outcome + (cond + (= codeA codeB) "equivalent" + (hierarchy-related? conn codeA codeB false) "subsumes" + (hierarchy-related? conn codeB codeA false) "subsumed-by" + :else "not-subsumed")}))) + + (cs-expand* [_ {:keys [system text displayLanguage filters active-only max-hits] + requested-version :version}] + (if (or (and requested-version (not= version requested-version)) + (and system (not= loinc-url system))) + {:concepts []} + (let [display-langs (display/parse-display-language displayLanguage) + {:keys [sql params post-filters issues]} (search-sql text display-langs filters active-only max-hits)] + (with-open [conn (jdbc/get-connection ds)] + (let [rows (cond->> (jdbc/execute! conn (into [sql] params) (row-builder)) + (seq post-filters) (filter #(every? (fn [f] (f %)) post-filters)))] + (cond-> {:concepts (mapv #(concept-from-row conn display-langs %) rows)} + (seq issues) (assoc :issues issues)))))))) + +(defn- loinc-naming-system [id] + (let [id (some-> id str (str/replace #"^urn:oid:" ""))] + (when (= loinc-oid id) + loinc-url))) + +(defn- answer-list-meta-row [ds id] + (jdbc/execute-one! ds + ["SELECT answer_list_id, answer_list_name, answer_list_oid + FROM answer_list + WHERE answer_list_id = ? + LIMIT 1" + id] + (row-builder))) + +(defn- answer-list-metadata + ([ds] + (jdbc/execute! ds + ["SELECT answer_list_id, answer_list_name, answer_list_oid + FROM answer_list + GROUP BY answer_list_id + ORDER BY answer_list_id"] + (row-builder))) + ([ds id] + (when-let [row (answer-list-meta-row ds id)] + [row]))) + +(defn- answer-list-resource [version {:keys [answer_list_id answer_list_name answer_list_oid]}] + (cond-> {:url (answer-list-id->url answer_list_id) + :name answer_list_name + :title answer_list_name + :status "active"} + version (assoc :version version) + answer_list_oid (assoc :identifier [{:system "urn:ietf:rfc:3986" + :value (str "urn:oid:" answer_list_oid)}]))) + +(defn- implicit-loinc-resource [version] + (cond-> {:url implicit-loinc-vs-url + :name "LOINC" + :title "All LOINC codes" + :status "active"} + version (assoc :version version))) + +(defn- group-meta-row [ds id] + (jdbc/execute-one! ds + ["SELECT group_id, group_name, status + FROM loinc_group + WHERE group_id = ? + LIMIT 1" + id] + (row-builder))) + +(defn- group-metadata [ds] + (jdbc/execute! ds + ["SELECT group_id, group_name, status + FROM loinc_group + ORDER BY group_id"] + (row-builder))) + +(defn- hierarchy-root-metadata [ds] + (jdbc/execute! ds + ["SELECT code, COALESCE(MAX(code_text), code) AS code_text + FROM ( + SELECT code, code_text + FROM component_hierarchy_by_system + UNION + SELECT immediate_parent AS code, immediate_parent AS code_text + FROM component_hierarchy_by_system + ) + GROUP BY code + ORDER BY code"] + (row-builder))) + +(defn- group-resource [version {:keys [group_id group_name status]}] + (cond-> {:url (group-id->url group_id) + :name group_name + :title group_name + :status (if (#{"Deprecated" "DEPRECATED"} status) "retired" "active")} + version (assoc :version version))) + +(defn- hierarchy-root-row [ds id] + (jdbc/execute-one! ds + ["SELECT code, code_text + FROM component_hierarchy_by_system + WHERE code = ? OR immediate_parent = ? + ORDER BY CASE WHEN code = ? THEN 0 ELSE 1 END + LIMIT 1" + id id id] + (row-builder))) + +(defn- hierarchy-resource [version {:keys [code code_text]}] + (cond-> {:url (group-id->url code) + :name code_text + :title code_text + :status "active"} + version (assoc :version version))) + +(defn- answer-filter-where [filter-text] + (when-not (str/blank? filter-text) + {:sql " AND (answer_string_id LIKE ? COLLATE NOCASE + OR display_text LIKE ? COLLATE NOCASE + OR local_answer_code LIKE ? COLLATE NOCASE)" + :params (repeat 3 (str "%" filter-text "%"))})) + +(defn- answer-concept [{:keys [answer_string_id display_text ext_code_display_name local_answer_code]}] + {:system loinc-url + :code answer_string_id + :display (or display_text ext_code_display_name local_answer_code)}) + +(defn- answer-list-total [ds id filter-text] + (let [{:keys [sql params]} (answer-filter-where filter-text)] + (:total (jdbc/execute-one! ds + (into [(str "SELECT COUNT(*) AS total FROM answer_list" + " WHERE answer_list_id = ?" + (or sql ""))] + (concat [id] params)) + (row-builder))))) + +(defn- answer-list-concepts [ds id {:keys [filter offset count]}] + (let [{:keys [sql params]} (answer-filter-where filter) + offset (or offset 0) + limit (or count -1)] + (mapv answer-concept + (jdbc/execute! ds + (into [(str "SELECT answer_string_id, local_answer_code, display_text," + " ext_code_display_name" + " FROM answer_list" + " WHERE answer_list_id = ?" + (or sql "") + " ORDER BY sequence_number, answer_string_id" + " LIMIT ? OFFSET ?")] + (concat [id] params [limit offset])) + (row-builder))))) + +(defn- group-total + ([ds id] (group-total ds id false)) + ([ds id active-only?] + (:total (jdbc/execute-one! ds + [(str "SELECT COUNT(*) AS total" + " FROM group_loinc_term g" + " LEFT JOIN loinc l ON l.loinc_num = g.loinc_number" + " WHERE g.group_id = ?" + (when active-only? + " AND (l.status IS NULL OR l.status <> 'DEPRECATED')")) + id] + (row-builder))))) + +(defn- group-concepts [ds id {:keys [offset count activeOnly]}] + (let [offset (or offset 0) + limit (or count -1)] + (mapv (fn [{:keys [loinc_number long_common_name status]}] + (cond-> {:system loinc-url + :code loinc_number + :display long_common_name} + (= "DEPRECATED" status) (assoc :inactive true))) + (jdbc/execute! ds + [(str "SELECT g.loinc_number, g.long_common_name, l.status" + " FROM group_loinc_term g" + " LEFT JOIN loinc l ON l.loinc_num = g.loinc_number" + " WHERE g.group_id = ?" + (when activeOnly + " AND (l.status IS NULL OR l.status <> 'DEPRECATED')") + " ORDER BY g.loinc_number" + " LIMIT ? OFFSET ?") + id limit offset] + (row-builder))))) + +(defn- hierarchy-total + ([ds part] (hierarchy-total ds part false)) + ([ds part active-only?] + (:total (jdbc/execute-one! ds + [(str "SELECT COUNT(DISTINCT l.loinc_num) AS total" + " FROM component_hierarchy_by_system h" + " JOIN loinc l ON l.loinc_num = h.code" + " WHERE " (hierarchy-token-clause "h.immediate_parent") + (when active-only? " AND l.status <> 'DEPRECATED'")) + part part (str part ".%") (str "%." part) (str "%." part ".%")] + (row-builder))))) + +(defn- hierarchy-concepts [ds part {:keys [offset count displayLanguage activeOnly]}] + (let [display-langs (display/parse-display-language displayLanguage) + offset (or offset 0) + limit (or count -1)] + (with-open [conn (jdbc/get-connection ds)] + (mapv #(concept-from-row conn display-langs %) + (jdbc/execute! conn + [(str "SELECT DISTINCT l.*" + " FROM component_hierarchy_by_system h" + " JOIN loinc l ON l.loinc_num = h.code" + " WHERE " (hierarchy-token-clause "h.immediate_parent") + (when activeOnly " AND l.status <> 'DEPRECATED'") + " ORDER BY l.loinc_num" + " LIMIT ? OFFSET ?") + part part (str part ".%") (str "%." part) (str "%." part ".%") limit offset] + (row-builder)))))) + +(defn- loinc-count + ([ds] (loinc-count ds false)) + ([ds active-only?] + (:total (jdbc/execute-one! ds + [(str "SELECT COUNT(*) AS total FROM loinc" + (when active-only? " WHERE status <> 'DEPRECATED'"))] + (row-builder))))) + +(defn- answer-code-count [ds] + (:total (jdbc/execute-one! ds + ["SELECT COUNT(DISTINCT answer_string_id) AS total FROM answer_list"] + (row-builder)))) + +(defn- part-code-count + ([ds] (part-code-count ds false)) + ([ds active-only?] + (:total (jdbc/execute-one! ds + [(str "SELECT COUNT(*) AS total FROM part" + (when active-only? " WHERE status <> 'DEPRECATED'"))] + (row-builder))))) + +(defn- group-code-count + ([ds] (group-code-count ds false)) + ([ds active-only?] + (:total (jdbc/execute-one! ds + [(str "SELECT COUNT(*) AS total FROM loinc_group" + (when active-only? " WHERE status NOT IN ('Deprecated', 'DEPRECATED')"))] + (row-builder))))) + +(defn- implicit-loinc-count + ([ds] (implicit-loinc-count ds false)) + ([ds active-only?] + (+ (loinc-count ds active-only?) + (answer-code-count ds) + (part-code-count ds active-only?) + (group-code-count ds active-only?)))) + +(defn- validation-result [system code concept version params] + (let [issue (display-issue system code concept params)] + (cond-> {:result (nil? issue) + :system system + :code code + :display (:display concept) + :version version} + issue (assoc :message (:text issue) + :issues [issue])))) + +(defn- loinc-code-validation [ds version {:keys [system code] :as params}] + (if (not= loinc-url system) + {:result false + :system system + :code code + :message (str "CodeSystem '" system "' is not valid for LOINC")} + (protos/cs-validate-code (->LoincCodeSystem ds version) params))) + +(defn- code-like [filter-text] + (when-not (str/blank? filter-text) + (str "%" filter-text "%"))) + +(defn- non-loinc-filter-clause [filter-text columns] + (when-let [pattern (code-like filter-text)] + {:sql (str " WHERE (" (str/join " OR " (map #(str % " LIKE ? COLLATE NOCASE") columns)) ")") + :params (repeat (count columns) pattern)})) + +(defn- count-query [ds sql params] + (:total (jdbc/execute-one! ds (into [sql] params) (row-builder)))) + +(defn- non-loinc-code-count [ds filter-text table columns active-clause] + (let [pattern (code-like filter-text) + text-clause (when pattern + (str "(" (str/join " OR " (map #(str % " LIKE ? COLLATE NOCASE") columns)) ")")) + clauses (cond-> [] + text-clause (conj text-clause) + active-clause (conj active-clause))] + (count-query ds + (str "SELECT COUNT(*) AS total FROM (" + " SELECT 1 FROM " table + (when (seq clauses) + (str " WHERE " (str/join " AND " clauses))) + " GROUP BY " (first columns) + ")") + (if pattern (repeat (count columns) pattern) [])))) + +(defn- filtered-loinc-count [ds filter-text display-langs activeOnly] + (let [tokens (fts-tokens filter-text) + q (fts-query tokens) + locale (locale-where display-langs)] + (cond + (str/blank? filter-text) + (loinc-count ds activeOnly) + + (nil? q) + 0 + + :else + (count-query ds + (str "SELECT COUNT(DISTINCT loinc_num) AS total FROM (" + " SELECT l.loinc_num, l.status" + " FROM loinc_fts f JOIN loinc l ON l.rowid = f.rowid" + " WHERE loinc_fts MATCH ?" + " UNION ALL" + " SELECT l.loinc_num, l.status" + " FROM loinc_variant_fts vf JOIN loinc l ON l.loinc_num = vf.loinc_num" + " WHERE loinc_variant_fts MATCH ?" (or (:sql locale) "") + ")" + (when activeOnly + " WHERE status <> 'DEPRECATED'")) + (concat [q q] (:params locale)))))) + +(defn- filtered-implicit-loinc-count [ds {:keys [filter displayLanguage activeOnly]}] + (let [display-langs (display/parse-display-language displayLanguage)] + (+ (filtered-loinc-count ds filter display-langs activeOnly) + (non-loinc-code-count ds filter "answer_list" + ["answer_string_id" "display_text" "local_answer_code"] + nil) + (non-loinc-code-count ds filter "part" + ["part_number" "part_name" "part_display_name"] + (when activeOnly + "status <> 'DEPRECATED'")) + (non-loinc-code-count ds filter "loinc_group" + ["group_id" "group_name"] + (when activeOnly + "status NOT IN ('Deprecated', 'DEPRECATED')"))))) + +(defn- answer-code-concepts [ds {:keys [filter offset count]}] + (let [{:keys [sql params]} (non-loinc-filter-clause filter ["answer_string_id" "display_text" "local_answer_code"]) + offset (or offset 0) + limit (or count -1)] + (mapv (fn [{:keys [answer_string_id display_text local_answer_code]}] + {:system loinc-url + :code answer_string_id + :display (or display_text local_answer_code)}) + (jdbc/execute! ds + (into [(str "SELECT answer_string_id, display_text, local_answer_code" + " FROM answer_list" + (or sql "") + " GROUP BY answer_string_id" + " ORDER BY answer_string_id" + " LIMIT ? OFFSET ?")] + (concat params [limit offset])) + (row-builder))))) + +(defn- part-code-concepts [ds {:keys [filter offset count activeOnly]}] + (let [{:keys [sql params]} (non-loinc-filter-clause filter ["part_number" "part_name" "part_display_name"]) + active-sql (when activeOnly + (if sql " AND status <> 'DEPRECATED'" " WHERE status <> 'DEPRECATED'")) + offset (or offset 0) + limit (or count -1)] + (mapv (fn [{:keys [part_number part_name part_display_name status]}] + (cond-> {:system loinc-url + :code part_number + :display (or part_display_name part_name)} + (= "DEPRECATED" status) (assoc :inactive true))) + (jdbc/execute! ds + (into [(str "SELECT part_number, part_name, part_display_name, status" + " FROM part" + (or sql "") + (or active-sql "") + " ORDER BY part_number" + " LIMIT ? OFFSET ?")] + (concat params [limit offset])) + (row-builder))))) + +(defn- group-code-concepts [ds {:keys [filter offset count activeOnly]}] + (let [{:keys [sql params]} (non-loinc-filter-clause filter ["group_id" "group_name"]) + active-sql (when activeOnly + (if sql + " AND status NOT IN ('Deprecated', 'DEPRECATED')" + " WHERE status NOT IN ('Deprecated', 'DEPRECATED')")) + offset (or offset 0) + limit (or count -1)] + (mapv (fn [{:keys [group_id group_name status]}] + (cond-> {:system loinc-url + :code group_id + :display group_name} + (= "Deprecated" status) (assoc :inactive true))) + (jdbc/execute! ds + (into [(str "SELECT group_id, group_name, status" + " FROM loinc_group" + (or sql "") + (or active-sql "") + " ORDER BY group_id" + " LIMIT ? OFFSET ?")] + (concat params [limit offset])) + (row-builder))))) + +(defn- implicit-concept-from-row [conn display-langs {:keys [kind code display inactive]}] + (if (= "LNC" kind) + (let [variant-rows (when (seq display-langs) + (fetch-variant-rows conn code (mapv :lang display-langs))) + designations (when (seq variant-rows) (variant-designations variant-rows)) + lang-display (when (seq designations) + (preferred-designation designations display-langs))] + (cond-> {:system loinc-url + :code code + :display (or lang-display display) + :inactive (sqlite-true? inactive)} + (seq designations) (assoc :designations designations))) + (cond-> {:system loinc-url + :code code + :display display} + (sqlite-true? inactive) (assoc :inactive true)))) + +(def ^:private implicit-loinc-page-sql + ;; Canonical ordering for http://loinc.org/vs: primary LOINC terms, + ;; answer codes, parts, then groups. Keep paging in SQLite so + ;; activeOnly and LIMIT/OFFSET are applied to one logical stream. + "SELECT kind, code, display, inactive + FROM ( + SELECT 0 AS family, + 'LNC' AS kind, + loinc_num AS code, + long_common_name AS display, + status = 'DEPRECATED' AS inactive + FROM loinc + WHERE (? = 0 OR status <> 'DEPRECATED') + UNION ALL + SELECT 1 AS family, + 'LA' AS kind, + answer_string_id AS code, + COALESCE(MIN(display_text), MIN(local_answer_code)) AS display, + 0 AS inactive + FROM answer_list + GROUP BY answer_string_id + UNION ALL + SELECT 2 AS family, + 'LP' AS kind, + part_number AS code, + COALESCE(NULLIF(part_display_name, ''), part_name) AS display, + status = 'DEPRECATED' AS inactive + FROM part + WHERE (? = 0 OR status <> 'DEPRECATED') + UNION ALL + SELECT 3 AS family, + 'LG' AS kind, + group_id AS code, + group_name AS display, + status IN ('Deprecated', 'DEPRECATED') AS inactive + FROM loinc_group + WHERE (? = 0 OR status NOT IN ('Deprecated', 'DEPRECATED')) + ) + ORDER BY family, code + LIMIT ? OFFSET ?") + +(defn- active-only-flag [activeOnly] + (if activeOnly 1 0)) + +(defn- implicit-loinc-page-rows [conn {:keys [offset count activeOnly]}] + (let [offset (or offset 0) + limit (or count 50) + active-only? (active-only-flag activeOnly)] + (jdbc/execute! conn + [implicit-loinc-page-sql active-only? active-only? active-only? limit offset] + (row-builder)))) + +(defn- unfiltered-implicit-loinc-concepts [ds {:keys [offset count displayLanguage activeOnly]}] + (let [display-langs (display/parse-display-language displayLanguage)] + (with-open [conn (jdbc/get-connection ds)] + (mapv #(implicit-concept-from-row conn display-langs %) + (implicit-loinc-page-rows conn {:offset offset + :count count + :activeOnly activeOnly}))))) + +(defn- filtered-concept-rank [filter-text concept] + (let [needle (some-> filter-text str/lower-case str/trim) + display (some-> (:display concept) str/lower-case)] + (cond + (str/blank? needle) 0 + (= display needle) 0 + (and display (str/starts-with? display needle)) 1 + :else 2))) + +(defn- implicit-loinc-concepts [ds {:keys [filter offset count displayLanguage activeOnly] :as params}] + (if (str/blank? filter) + (unfiltered-implicit-loinc-concepts ds params) + (let [display-langs (display/parse-display-language displayLanguage) + lnc-limit (+ (or count 50) (or offset 0)) + {:keys [sql post-filters] + sql-params :params} (search-sql filter display-langs nil activeOnly lnc-limit)] + (with-open [conn (jdbc/get-connection ds)] + (let [rows (cond->> (jdbc/execute! conn (into [sql] sql-params) (row-builder)) + (seq post-filters) (filter #(every? (fn [f] (f %)) post-filters))) + lnc (mapv #(concept-from-row conn display-langs %) rows) + concepts (concat lnc + (answer-code-concepts ds {:filter filter}) + (part-code-concepts ds {:filter filter :activeOnly activeOnly}) + (group-code-concepts ds {:filter filter :activeOnly activeOnly}))] + (->> (sort-by (juxt #(filtered-concept-rank filter %) + #(str (:code %))) + concepts) + (drop (or offset 0)) + (take (or count 50)) + vec)))))) + +(defn- requested-version [{:keys [version valueSetVersion]}] + (or valueSetVersion version)) + +(defn- version-matches? [actual requested] + (or (nil? requested) (= actual requested))) + +(defrecord LoincValueSet [ds version] + protos/ValueSet + (vs-metadata [_ {url-q :url version-q :version}] + (when (version-matches? version version-q) + (cond + (implicit-loinc-vs? url-q) + [(cond-> {:url implicit-loinc-vs-url} version (assoc :version version))] + + url-q + (cond + (answer-list-id url-q) + (mapv (fn [row] + (cond-> {:url (answer-list-id->url (:answer_list_id row))} + version (assoc :version version))) + (answer-list-metadata ds (answer-list-id url-q))) + + (group-id url-q) + (mapv (fn [row] + (cond-> {:url (group-id->url (:group_id row))} + version (assoc :version version))) + (when-let [row (group-meta-row ds (group-id url-q))] + [row])) + + (part-id url-q) + (mapv (fn [row] + (cond-> {:url (group-id->url (:code row))} + version (assoc :version version))) + (when-let [row (hierarchy-root-row ds (part-id url-q))] + [row])) + + :else nil) + + :else + (into (into [(cond-> {:url implicit-loinc-vs-url} version (assoc :version version))] + (map (fn [row] + (cond-> {:url (answer-list-id->url (:answer_list_id row))} + version (assoc :version version)))) + (answer-list-metadata ds)) + (concat + (map (fn [row] + (cond-> {:url (group-id->url (:group_id row))} + version (assoc :version version))) + (group-metadata ds)) + (map (fn [row] + (cond-> {:url (group-id->url (:code row))} + version (assoc :version version))) + (hierarchy-root-metadata ds))))))) + + (vs-resource [_ {:keys [url] :as params}] + (when (version-matches? version (requested-version params)) + (cond + (implicit-loinc-vs? url) + (implicit-loinc-resource version) + + (answer-list-id url) + (some->> url answer-list-id (answer-list-meta-row ds) (answer-list-resource version)) + + (group-id url) + (some->> url group-id (group-meta-row ds) (group-resource version)) + + (part-id url) + (some->> url part-id (hierarchy-root-row ds) (hierarchy-resource version))))) + + (vs-expand [_ _svc {:keys [url filter activeOnly] :as params}] + (when (version-matches? version (requested-version params)) + (cond + (implicit-loinc-vs? url) + {:url url + :version version + :total (if (str/blank? filter) + (implicit-loinc-count ds activeOnly) + (filtered-implicit-loinc-count ds params)) + :concepts (implicit-loinc-concepts ds params)} + + (part-id url) + (let [id (part-id url)] + (when (hierarchy-root-row ds id) + {:url url + :version version + :total (hierarchy-total ds id activeOnly) + :concepts (hierarchy-concepts ds id params)})) + + (group-id url) + (let [id (group-id url)] + (when (group-meta-row ds id) + {:url url + :version version + :total (group-total ds id activeOnly) + :concepts (group-concepts ds id params)})) + + :else + (when-let [id (answer-list-id url)] + (when (answer-list-meta-row ds id) + {:url url + :version version + :total (answer-list-total ds id filter) + :concepts (answer-list-concepts ds id params)}))))) + + (vs-validate-code [_ _svc {:keys [url system code] :as params}] + (when (version-matches? version (requested-version params)) + (cond + (implicit-loinc-vs? url) + (loinc-code-validation ds version params) + + (part-id url) + (let [id (part-id url)] + (if (not= loinc-url system) + {:result false + :system system + :code code + :message (str "CodeSystem '" system "' is not valid for LOINC hierarchy " id)} + (let [result (hierarchy-related? ds id code false)] + (cond-> {:result result + :system loinc-url + :code code + :version version} + (not result) (assoc :message (str "Code '" code "' is not in LOINC hierarchy " id)))))) + + (group-id url) + (let [id (group-id url)] + (if (not= loinc-url system) + {:result false + :system system + :code code + :message (str "CodeSystem '" system "' is not valid for LOINC group " id)} + (let [row (jdbc/execute-one! ds + ["SELECT loinc_number, long_common_name + FROM group_loinc_term + WHERE group_id = ? + AND loinc_number = ? COLLATE NOCASE" + id code] + (row-builder))] + (if row + (validation-result loinc-url (:loinc_number row) {:display (:long_common_name row)} + version params) + {:result false + :system loinc-url + :code code + :message (str "Code '" code "' is not in LOINC group " id)})))) + + :else + (when-let [id (answer-list-id url)] + (if (not= loinc-url system) + {:result false + :system system + :code code + :message (str "CodeSystem '" system "' is not valid for LOINC answer list " id)} + (if-let [row (jdbc/execute-one! ds + ["SELECT answer_string_id, display_text + FROM answer_list + WHERE answer_list_id = ? + AND answer_string_id = ? COLLATE NOCASE" + id code] + (row-builder))] + (validation-result loinc-url (:answer_string_id row) {:display (:display_text row)} + version params) + {:result false + :system loinc-url + :code code + :message (str "Code '" code "' is not in LOINC answer list " id)}))))))) + +(def ^:private symmetric-equivalences + #{"equivalent" "equal" "relatedto" "related-to" "inexact" "unmatched" + "disjoint"}) + +(def ^:private inverted-equivalences + {"wider" "narrower" + "narrower" "wider" + "subsumes" "specializes" + "specializes" "subsumes" + "broader" "narrower"}) + +(defn- invert-equivalence [equivalence] + (or (when (contains? symmetric-equivalences equivalence) equivalence) + (get inverted-equivalences equivalence) + equivalence)) + +(defn- cm-meta + [{:keys [url system target title]} version] + (cond-> {:url url + :system system + :target target + :title title} + version (assoc :version version))) + +(defn- part-related-target-systems [ds] + (mapv :ext_code_system + (jdbc/execute! ds + ["SELECT DISTINCT ext_code_system + FROM part_related_code_mapping + WHERE ext_code_system IS NOT NULL AND ext_code_system <> '' + ORDER BY ext_code_system"] + (row-builder)))) + +(defn- part-related-meta [ext-code-system version] + (let [{:keys [system title-prefix]} (model/conceptmap :part-related)] + (cm-meta {:url (model/part-related-conceptmap-url ext-code-system) + :system system + :target ext-code-system + :title (str title-prefix " to " ext-code-system)} + version))) + +(defn- static-conceptmap-metas [version] + (mapv #(cm-meta (model/conceptmap %) version) + [:map-to :ieee-medical-device :rsna-rid :rsna-rpid])) + +(defn- all-conceptmap-metas [ds version] + (into (static-conceptmap-metas version) + (map #(part-related-meta % version)) + (part-related-target-systems ds))) + +(defn- requested-part-related-target [{:keys [url system target]}] + (or (model/part-related-conceptmap-target url) + (when (= loinc-url system) target) + (when (= loinc-url target) system))) + +(defn- conceptmap-kind [{:keys [url system target] :as params}] + (let [map-to (model/conceptmap :map-to) + ieee (model/conceptmap :ieee-medical-device) + rid (model/conceptmap :rsna-rid) + rpid (model/conceptmap :rsna-rpid)] + (cond + (or (= url (:url map-to)) + (and (nil? url) (= system loinc-url) (= target loinc-url))) + {:kind :map-to :meta map-to} + + (or (= url (:url ieee)) + (and (nil? url) + (#{loinc-url (:target ieee)} system) + (#{loinc-url (:target ieee)} target))) + {:kind :ieee :meta ieee} + + (or (= url (:url rid)) + (and (nil? url) + (#{loinc-url (:target rid)} system) + (#{loinc-url (:target rid)} target))) + {:kind :rsna-rid :meta rid} + + (or (= url (:url rpid)) + (and (nil? url) + (#{loinc-url (:target rpid)} system) + (#{loinc-url (:target rpid)} target))) + {:kind :rsna-rpid :meta rpid} + + (requested-part-related-target params) + {:kind :part-related + :target-system (requested-part-related-target params)}))) + +(defn- forward? [{:keys [system target]} default-target] + (or (nil? system) + (= system loinc-url) + (and (= target default-target) (not= system default-target)))) + +(defn- matches-or-empty [rows f] + (if (seq rows) + {:result true :matches (mapv f rows)} + {:result false :message "No matches found"})) + +(defn- map-to-replacements [ds code] + (jdbc/execute! ds + ["SELECT m.map_to, t.long_common_name, t.status + FROM map_to m + LEFT JOIN loinc t ON t.loinc_num = m.map_to + WHERE m.loinc = ? COLLATE NOCASE + ORDER BY m.map_to" + code] + (row-builder))) + +(defn- translate-map-to [ds code] + (let [rows (map-to-replacements ds code)] + (matches-or-empty + rows + (fn [{:keys [map_to long_common_name status]}] + (cond-> {:equivalence "relatedto" + :system loinc-url + :code map_to} + long_common_name (assoc :display long_common_name) + (= "DEPRECATED" status) (assoc :inactive true)))))) + +(defn- translate-part-related [ds {:keys [system code]} target-system] + (if (forward? {:system system} target-system) + (matches-or-empty + (jdbc/execute! ds + ["SELECT ext_code_id, ext_code_display_name, equivalence, ext_code_system_version + FROM part_related_code_mapping + WHERE ext_code_system = ? + AND part_number = ? COLLATE NOCASE + ORDER BY ext_code_id" + target-system code] + (row-builder)) + (fn [{:keys [ext_code_id ext_code_display_name equivalence ext_code_system_version]}] + (cond-> {:equivalence equivalence + :system target-system + :code ext_code_id} + ext_code_display_name (assoc :display ext_code_display_name) + ext_code_system_version (assoc :version ext_code_system_version)))) + (matches-or-empty + (jdbc/execute! ds + ["SELECT part_number, part_name, equivalence + FROM part_related_code_mapping + WHERE ext_code_system = ? + AND ext_code_id = ? COLLATE NOCASE + ORDER BY part_number" + target-system code] + (row-builder)) + (fn [{:keys [part_number part_name equivalence]}] + (cond-> {:equivalence (invert-equivalence equivalence) + :system loinc-url + :code part_number} + part_name (assoc :display part_name)))))) + +(defn- translate-ieee [ds {:keys [system code]}] + (let [target (:target (model/conceptmap :ieee-medical-device))] + (if (forward? {:system system} target) + (matches-or-empty + (jdbc/execute! ds + ["SELECT ieee_cf_code10, ieee_refid, equivalence + FROM loinc_ieee_medical_device_mapping + WHERE loinc_num = ? COLLATE NOCASE + ORDER BY ieee_cf_code10, ieee_refid" + code] + (row-builder)) + (fn [{:keys [ieee_cf_code10 ieee_refid equivalence]}] + (cond-> {:equivalence equivalence + :system target + :code ieee_cf_code10} + ieee_refid (assoc :display ieee_refid)))) + (matches-or-empty + (jdbc/execute! ds + ["SELECT loinc_num, loinc_long_common_name, equivalence + FROM loinc_ieee_medical_device_mapping + WHERE ieee_cf_code10 = ? COLLATE NOCASE + OR ieee_refid = ? COLLATE NOCASE + ORDER BY loinc_num" + code code] + (row-builder)) + (fn [{:keys [loinc_num loinc_long_common_name equivalence]}] + (cond-> {:equivalence (invert-equivalence equivalence) + :system loinc-url + :code loinc_num} + loinc_long_common_name (assoc :display loinc_long_common_name))))))) + +(defn- translate-rsna-rid [ds {:keys [system code]}] + (let [target (:target (model/conceptmap :rsna-rid))] + (if (forward? {:system system} target) + (matches-or-empty + (jdbc/execute! ds + ["SELECT DISTINCT rid, preferred_name + FROM loinc_rsna_radiology_playbook + WHERE loinc_number = ? COLLATE NOCASE + AND rid IS NOT NULL AND rid <> '' + ORDER BY rid" + code] + (row-builder)) + (fn [{:keys [rid preferred_name]}] + (cond-> {:equivalence "relatedto" + :system target + :code rid} + preferred_name (assoc :display preferred_name)))) + (matches-or-empty + (jdbc/execute! ds + ["SELECT DISTINCT loinc_number, long_common_name + FROM loinc_rsna_radiology_playbook + WHERE rid = ? COLLATE NOCASE + ORDER BY loinc_number" + code] + (row-builder)) + (fn [{:keys [loinc_number long_common_name]}] + (cond-> {:equivalence "relatedto" + :system loinc-url + :code loinc_number} + long_common_name (assoc :display long_common_name))))))) + +(defn- translate-rsna-rpid [ds {:keys [system code]}] + (let [target (:target (model/conceptmap :rsna-rpid))] + (if (forward? {:system system} target) + (matches-or-empty + (jdbc/execute! ds + ["SELECT DISTINCT rpid, long_name + FROM loinc_rsna_radiology_playbook + WHERE loinc_number = ? COLLATE NOCASE + AND rpid IS NOT NULL AND rpid <> '' + ORDER BY rpid" + code] + (row-builder)) + (fn [{:keys [rpid long_name]}] + (cond-> {:equivalence "relatedto" + :system target + :code rpid} + long_name (assoc :display long_name)))) + (matches-or-empty + (jdbc/execute! ds + ["SELECT DISTINCT loinc_number, long_common_name + FROM loinc_rsna_radiology_playbook + WHERE rpid = ? COLLATE NOCASE + ORDER BY loinc_number" + code] + (row-builder)) + (fn [{:keys [loinc_number long_common_name]}] + (cond-> {:equivalence "relatedto" + :system loinc-url + :code loinc_number} + long_common_name (assoc :display long_common_name))))))) + +(defrecord LoincConceptMap [ds version] + protos/ConceptMap + (cm-metadata [_ {url-q :url version-q :version}] + (when (version-matches? version version-q) + (filterv (fn [{:keys [url]}] + (or (nil? url-q) (= url-q url))) + (all-conceptmap-metas ds version)))) + + (cm-resource [this params] + (first (protos/cm-metadata this params))) + + (cm-translate [_ {:keys [code] :as params}] + (if-let [{:keys [kind target-system]} (conceptmap-kind params)] + (case kind + :map-to (translate-map-to ds code) + :part-related (translate-part-related ds params target-system) + :ieee (translate-ieee ds params) + :rsna-rid (translate-rsna-rid ds params) + :rsna-rpid (translate-rsna-rpid ds params)) + {:result false :message "Unsupported LOINC ConceptMap request"}))) + +(defn open-providers [path] + (let [ds (store/open path) + version (meta-value ds :loinc_version)] + {:datasource ds + :codesystem (->LoincCodeSystem ds version) + :valueset (->LoincValueSet ds version) + :conceptmap (->LoincConceptMap ds version) + :naming-system loinc-naming-system})) diff --git a/src/com/eldrix/hades/providers/loinc/store.clj b/src/com/eldrix/hades/providers/loinc/store.clj new file mode 100644 index 0000000..efc1eb7 --- /dev/null +++ b/src/com/eldrix/hades/providers/loinc/store.clj @@ -0,0 +1,204 @@ +(ns com.eldrix.hades.providers.loinc.store + "LOINC SQLite store: file-level identity, schema, and lifecycle. + Per-connection pragmas (foreign_keys, synchronous, journal_mode) are + the caller's responsibility." + (:require [clojure.java.io :as io] + [clojure.string :as str] + [com.eldrix.hades.providers.loinc.model :as model] + [next.jdbc :as jdbc]) + (:import (com.zaxxer.hikari HikariConfig HikariDataSource) + (java.io Closeable File FileInputStream) + (java.nio.charset StandardCharsets) + (java.util Arrays))) + +(set! *warn-on-reflection* true) + +(def application-id + "ASCII 'LOIN' = 0x4C4F494E." + 0x4C4F494E) + +(def schema-version 1) + +(def schema-resource + "com/eldrix/hades/providers/loinc/schema-v1.sql") + +(def default-pool-size 32) + +(defn jdbc-spec [^String path] + {:dbtype "sqlite" :dbname path}) + +(defn pooled-datasource ^HikariDataSource [^String path] + (let [cfg (doto (HikariConfig.) + (.setJdbcUrl (str "jdbc:sqlite:" path)) + (.setMaximumPoolSize (int default-pool-size)) + (.setMinimumIdle 1) + (.setConnectionTimeout (long 5000)) + (.setPoolName (str "loinc[" (.getName (io/file path)) "]")))] + (HikariDataSource. cfg))) + +(defn read-pragma [conn pragma] + (some-> (jdbc/execute-one! conn [(str "PRAGMA " pragma)]) + vals + first)) + +(defn set-pragma! [conn pragma value] + (jdbc/execute! conn [(str "PRAGMA " pragma " = " value)])) + +(defn strip-line-comments [^String sql] + (->> (str/split-lines sql) + (map (fn [^String line] + (let [i (str/index-of line "--")] + (if i (subs line 0 i) line)))) + (str/join "\n"))) + +(defn exec-script! [conn ^String sql] + (doseq [stmt (->> (strip-line-comments sql) + (#(str/split % #";")) + (map str/trim) + (remove str/blank?))] + (jdbc/execute! conn [stmt]))) + +(defn read-schema-sql [] + (slurp (io/resource schema-resource))) + +(defn empty-file? [^File f] + (or (not (.exists f)) (zero? (.length f)))) + +(def ^"[B" sqlite-magic + (.getBytes "SQLite format 3\u0000" StandardCharsets/UTF_8)) + +(defn has-sqlite-header? [^File f] + (with-open [is (FileInputStream. f)] + (let [n (alength sqlite-magic) + buf (byte-array n) + read (.read is buf 0 n)] + (and (= read n) + (Arrays/equals buf ^"[B" sqlite-magic))))) + +(defn loinc-db? + "True when `f` is a Hades LOINC SQLite store (SQLite header intact + and `PRAGMA application_id` matches 'LOIN')." + [^File f] + (and (.isFile f) + (has-sqlite-header? f) + (let [ds (jdbc/get-datasource (jdbc-spec (.getPath f)))] + (with-open [conn (jdbc/get-connection ds)] + (= application-id + (long (or (read-pragma conn "application_id") 0))))))) + +(def loinc-db-recogniser + "Recognises a native Hades LOINC SQLite store." + {:id :loinc-db + :importable? false + :database? true + :recognise (fn [^File f _probe?] + (when (loinc-db? f) {}))}) + +(defn check-identity! [conn path] + (let [aid (long (or (read-pragma conn "application_id") 0))] + (when (not= aid application-id) + (throw (ex-info (str "Not a LOINC store (application_id " + (format "0x%X" aid) " ≠ " + (format "0x%X" application-id) "): " path) + {:reason :not-loinc-db + :path path + :application-id aid})))) + (let [uv (long (or (read-pragma conn "user_version") 0))] + (when (> uv schema-version) + (throw (ex-info (str "LOINC store schema v" uv + " is newer than supported (v" schema-version "): " path) + {:reason :schema-too-new + :path path :schema-version uv}))) + (when (< uv schema-version) + (throw (ex-info (str "LOINC store schema v" uv + " predates v" schema-version + " and migrations are not implemented yet: " path) + {:reason :schema-too-old + :path path :schema-version uv}))))) + +(defn close! + "Close a pooled datasource." + [ds] + (when (instance? Closeable ds) + (.close ^Closeable ds))) + +(defn upsert-meta! + [conn k v] + (jdbc/execute! conn ["INSERT OR REPLACE INTO meta (key, value) VALUES (?, ?)" + (name k) (str v)])) + +(defn- quote-ident [s] + (str "\"" (str/replace (name s) "\"" "\"\"") "\"")) + +(defn insert-rows! + "Insert row vectors into `table`. `columns` are database column names in + insertion order. Empty row collections are ignored." + [conn table columns rows] + (when-let [rows (seq rows)] + (let [cols (mapv name columns) + placeholders (str/join "," (repeat (count cols) "?")) + sql (str "INSERT OR REPLACE INTO " (quote-ident table) + " (" (str/join "," (map quote-ident cols)) ") VALUES (" + placeholders ")") + params (mapv vec rows)] + (jdbc/execute-batch! conn sql params {})))) + +(defn- apply-column-transforms + [columns column-transforms row] + (if (seq column-transforms) + (reduce-kv (fn [row column f] + (if-let [idx (first (keep-indexed #(when (= column %2) %1) columns))] + (update row idx f) + row)) + (vec row) + column-transforms) + (vec row))) + +(defn- block->table + [{:keys [headings data] :as block} {:keys [column-transforms table-transform]}] + (let [columns (mapv model/column-name headings) + rows (mapv (fn [row] (apply-column-transforms columns column-transforms row)) + data)] + ((or table-transform (fn [_block columns rows] + {:columns columns :rows rows})) + block columns rows))) + +(defmulti write-batch! + "Write a loader data block to its model-defined source table using + row-level upsert." + (fn [_conn block] (:type block))) + +(defmethod write-batch! :default [conn {:keys [type] :as block}] + (let [{:keys [table-name] :as file-def} (model/release-file type) + {:keys [columns rows]} (block->table block file-def)] + (insert-rows! conn table-name columns rows))) + +(defn create! + "Create (or open) a LOINC store at `path`. Stamps `application_id` + + `user_version` and applies the v1 schema on a fresh file. Throws if + `path` is a non-LOINC SQLite database. Returns a pooled + `HikariDataSource` — callers MUST `close!` it on shutdown." + [^String path] + (let [f (io/file path)] + (when (empty-file? f) + (let [boot (jdbc/get-datasource (jdbc-spec path))] + (with-open [conn (jdbc/get-connection boot)] + (exec-script! conn (read-schema-sql)) + (set-pragma! conn "application_id" application-id) + (set-pragma! conn "user_version" schema-version))))) + (let [ds (pooled-datasource path)] + (with-open [conn (jdbc/get-connection ds)] + (check-identity! conn path)) + ds)) + +(defn open + "Open an existing LOINC store. Throws if missing or not a v1 file." + [^String path] + (let [f (io/file path)] + (when (empty-file? f) + (throw (ex-info (str "LOINC store does not exist or is empty: " path) + {:reason :missing :path path})))) + (let [ds (pooled-datasource path)] + (with-open [conn (jdbc/get-connection ds)] + (check-identity! conn path)) + ds)) diff --git a/src/com/eldrix/hades/impl/snomed/batch.clj b/src/com/eldrix/hades/providers/snomed/batch.clj similarity index 98% rename from src/com/eldrix/hades/impl/snomed/batch.clj rename to src/com/eldrix/hades/providers/snomed/batch.clj index d03a348..f323026 100644 --- a/src/com/eldrix/hades/impl/snomed/batch.clj +++ b/src/com/eldrix/hades/providers/snomed/batch.clj @@ -1,4 +1,4 @@ -(ns com.eldrix.hades.impl.snomed.batch +(ns com.eldrix.hades.providers.snomed.batch "Batched SNOMED helpers that reach into Hermes' private implementation namespaces. Isolated here so `snomed.clj` depends only on Hermes' public API." (:require [com.eldrix.hermes.impl.lmdb :as lmdb] diff --git a/src/com/eldrix/hades/impl/snomed/expansion.clj b/src/com/eldrix/hades/providers/snomed/expansion.clj similarity index 99% rename from src/com/eldrix/hades/impl/snomed/expansion.clj rename to src/com/eldrix/hades/providers/snomed/expansion.clj index fa02ada..13a0427 100644 --- a/src/com/eldrix/hades/impl/snomed/expansion.clj +++ b/src/com/eldrix/hades/providers/snomed/expansion.clj @@ -1,4 +1,4 @@ -(ns com.eldrix.hades.impl.snomed.expansion +(ns com.eldrix.hades.providers.snomed.expansion "SNOMED concept-level $expand for Hades. Dispatches on `:limit`: @@ -19,7 +19,7 @@ keyed by each language-refset-id, so any representative doc per concept yields the correct display — no LMDB in either path. - Along with `com.eldrix.hades.impl.snomed.batch`, this is one of only two + Along with `com.eldrix.hades.providers.snomed.batch`, this is one of only two Hades namespaces allowed to import from `com.eldrix.hermes.impl.*` — see plan/concept-expansion.md §3." (:require [clojure.string :as str] diff --git a/src/com/eldrix/hades/impl/snomed.clj b/src/com/eldrix/hades/providers/snomed/provider.clj similarity index 96% rename from src/com/eldrix/hades/impl/snomed.clj rename to src/com/eldrix/hades/providers/snomed/provider.clj index 59cd197..9c9bf71 100644 --- a/src/com/eldrix/hades/impl/snomed.clj +++ b/src/com/eldrix/hades/providers/snomed/provider.clj @@ -1,13 +1,13 @@ -(ns com.eldrix.hades.impl.snomed +(ns com.eldrix.hades.providers.snomed.provider "Implementation of Hades protocols for SNOMED CT. A thin wrapper around the Hermes SNOMED terminology service" (:require [clojure.edn :as edn] [clojure.string :as str] - [com.eldrix.hades.impl.issues :as issues] - [com.eldrix.hades.impl.property-filter :as property-filter] - [com.eldrix.hades.impl.protocols :as protos] - [com.eldrix.hades.impl.snomed.batch :as batch] - [com.eldrix.hades.impl.snomed.expansion :as expansion] + [com.eldrix.hades.providers.common.issues :as issues] + [com.eldrix.hades.providers.common.property-filter :as property-filter] + [com.eldrix.hades.protocols :as protos] + [com.eldrix.hades.providers.snomed.batch :as batch] + [com.eldrix.hades.providers.snomed.expansion :as expansion] [com.eldrix.hermes.core :as hermes] [com.eldrix.hermes.impl.ecl :as hermes.ecl] [com.eldrix.hermes.impl.search :as hermes.search] @@ -189,6 +189,13 @@ (not-supported-issue (str "filter property=concept op=" op " not supported"))) (value-issue property op value)) + (= property "code") + (if-let [cid (parse-long (str value))] + (case op + "=" (hermes.search/q-concept-id cid) + (not-supported-issue (str "filter property=code op=" op " not supported"))) + (value-issue property op value)) + (= property "parent") (cond (not= op "=") (not-supported-issue (str "filter property=parent op=" op " not supported")) @@ -212,8 +219,7 @@ ;; so no finite enumeration of post-coord expressions exists for a ;; `<<` filter. No-op for both true/false. (= property "expressions") - (if (and (= op "=") (contains? #{"true" "false"} (str value))) - nil + (when-not (and (= op "=") (contains? #{"true" "false"} (str value))) (not-supported-issue (str "filter property=expressions op=" op " value=" value " not supported"))) @@ -697,17 +703,23 @@ (cs-subsumes [_ {:keys [systemA codeA systemB codeB]}] - (let [codeA' (Long/parseLong codeA) - codeB' (Long/parseLong codeB)] - {:outcome - (cond - ;; simple if they are the same - (and (= systemA systemB) (= codeA' codeB')) "equivalent" - (hermes/subsumed-by? svc codeA' codeB') "subsumed-by" ;; A is subsumed by B - (hermes/subsumed-by? svc codeB' codeA') "subsumes" ;; A subsumes B - ;; look up historical associations, and check for equivalence - this catches SAME-AS and REPLACED-BY etc. - (and (= systemA systemB) ((hermes/with-historical svc [codeA']) codeB')) "equivalent" - :else "not-subsumed")})) + (let [codeA' (try (Long/parseLong codeA) (catch NumberFormatException _ nil)) + codeB' (try (Long/parseLong codeB) (catch NumberFormatException _ nil))] + (cond + (or (nil? codeA') (nil? (hermes/concept svc codeA'))) + (issues/unknown-code-subsumes systemA codeA "codeA") + (or (nil? codeB') (nil? (hermes/concept svc codeB'))) + (issues/unknown-code-subsumes systemB codeB "codeB") + :else + {:outcome + (cond + ;; simple if they are the same + (and (= systemA systemB) (= codeA' codeB')) "equivalent" + (hermes/subsumed-by? svc codeA' codeB') "subsumed-by" ;; A is subsumed by B + (hermes/subsumed-by? svc codeB' codeA') "subsumes" ;; A subsumes B + ;; look up historical associations, and check for equivalence - this catches SAME-AS and REPLACED-BY etc. + (and (= systemA systemB) ((hermes/with-historical svc [codeA']) codeB')) "equivalent" + :else "not-subsumed")}))) (cs-expand* [_ q] (let [{:keys [version filters max-hits text active-only displayLanguage]} q ver (or version (version-uri svc)) @@ -851,11 +863,10 @@ :message-id "Unable_to_resolve_value_Set_" :text msg}]}) (let [lang-refset-ids (hermes/match-locale svc displayLanguage true) - focus-id (if code' - code' - (some-> (try (hermes/parse-expression svc code) (catch Exception _ nil)) - (get-in [:subExpression :focusConcepts]) - first :conceptId)) + focus-id (or code' + (some-> (try (hermes/parse-expression svc code) (catch Exception _ nil)) + (get-in [:subExpression :focusConcepts]) + first :conceptId)) preferred (when focus-id (:term (hermes/preferred-synonym* svc focus-id lang-refset-ids))) expr-display (when-not code' (try (hermes/render-expression* svc code diff --git a/test/com/eldrix/hades/bench.clj b/test/com/eldrix/hades/bench.clj index 56c7db4..fa68fdd 100644 --- a/test/com/eldrix/hades/bench.clj +++ b/test/com/eldrix/hades/bench.clj @@ -8,14 +8,18 @@ [clojure.test :refer [deftest]] [com.eldrix.hades.core :as hades] [com.eldrix.hades.fixtures :as fixtures] - [com.eldrix.hades.impl.compose :as compose] - [com.eldrix.hades.impl.protocols :as protos] + [com.eldrix.hades.providers.common.compose :as compose] + [com.eldrix.hades.providers.loinc.model :as loinc-model] + [com.eldrix.hades.protocols :as protos] [criterium.core :as crit])) (set! *warn-on-reflection* true) (def ^:private snomed-uri "http://snomed.info/sct") (def ^:private loinc-uri "http://loinc.org") +(def ^:private ieee-uri "urn:iso:std:iso:11073:10101") +(def ^:private radlex-uri "http://www.radlex.org") +(def ^:private rsna-playbook-uri "http://www.rsna.org/RadLex_Playbook") ;; ─── Well-known SNOMED anchors ───────────────────────────────────────────── @@ -123,6 +127,36 @@ {:url (str snomed-uri "?fhir_cm=900000000000526001") :system snomed-uri :code "56485000" :target snomed-uri}))} + {:id :translate/loinc-map-to + :fn (fn [svc] + (hades/translate svc + {:url (:url (loinc-model/conceptmap :map-to)) + :system loinc-uri :code "1009-0" + :target loinc-uri}))} + {:id :translate/loinc-part-related + :fn (fn [svc] + (hades/translate svc + {:url (loinc-model/part-related-conceptmap-url snomed-uri) + :system loinc-uri :code "LP14449-0" + :target snomed-uri}))} + {:id :translate/loinc-ieee + :fn (fn [svc] + (hades/translate svc + {:url (:url (loinc-model/conceptmap :ieee-medical-device)) + :system loinc-uri :code "11556-8" + :target ieee-uri}))} + {:id :translate/loinc-rsna-rid + :fn (fn [svc] + (hades/translate svc + {:url (:url (loinc-model/conceptmap :rsna-rid)) + :system loinc-uri :code "24531-6" + :target radlex-uri}))} + {:id :translate/loinc-rsna-rpid-reverse + :fn (fn [svc] + (hades/translate svc + {:url (:url (loinc-model/conceptmap :rsna-rpid)) + :system rsna-playbook-uri :code "RPID2142" + :target loinc-uri}))} ;; --- $expand via implicit-VS URLs -------------------------------------- {:id :expand/ecl-small :tx-bench "EX01" @@ -342,6 +376,38 @@ (json/write doc w)) (println "wrote" results-path))) +(defn operation + "Return the benchmark operation with `id`." + [id] + (let [id (keyword id)] + (or (some #(when (= id (:id %)) %) operations) + (throw (ex-info "Unknown benchmark operation" + {:id id :available (mapv :id operations)}))))) + +(defn bench-operation + "Run one benchmark operation against an already-open service." + ([svc id] (bench-operation svc id (bench-mode))) + ([svc id mode] + (let [{:keys [fn] :as entry} (operation id) + r (run-one mode fn svc)] + (crit/report-result r) + (summarise entry r)))) + +(defn bench-one! + "Open the standard fixture service and run one benchmark operation. + + Intended for REPL microbenchmarking: + (bench-one! :translate/loinc-part-related)" + ([id] (bench-one! (if (map? id) (:id id) id) (bench-mode))) + ([id mode] + (let [svc (hades/open [fixtures/snomed-db-path + fixtures/loinc-db-path + fixtures/fhir-smoke-db-path])] + (try + (bench-operation svc id mode) + (finally + (hades/close svc)))))) + (deftest operations-bench (let [svc (hades/open [fixtures/snomed-db-path fixtures/loinc-db-path diff --git a/test/com/eldrix/hades/cmd_test.clj b/test/com/eldrix/hades/cmd_test.clj index 987dc16..2e89b4e 100644 --- a/test/com/eldrix/hades/cmd_test.clj +++ b/test/com/eldrix/hades/cmd_test.clj @@ -7,7 +7,10 @@ [com.eldrix.hades.impl.cli :as cli] [com.eldrix.hades.impl.paths :as paths] [com.eldrix.hades.impl.sources :as sources] - [com.eldrix.hades.impl.sqlite.db :as db]) + [com.eldrix.hades.providers.ftrm.db :as db] + [com.eldrix.hades.providers.loinc.store :as loinc-store] + [next.jdbc :as jdbc] + [next.jdbc.plan :as plan]) (:import (clojure.lang ExceptionInfo) (java.io File) (java.nio.file Files) @@ -256,3 +259,45 @@ "the partial DB must still register as a hermes-db so a separate `index` invocation can complete it")) (finally (delete-tree! root)))))) + +(deftest import-loinc-release-roundtrip + (testing "LOINC fixture imports as a native LOINC SQLite store" + (let [root (mk-tmp-dir "loinc-import") + dest (.getPath (io/file root "loinc.db"))] + (try + (#'cmd/import-from {} [dest "test/resources/loinc-fixture"]) + (is (true? (loinc-store/loinc-db? (io/file dest)))) + (let [loinc-dbs (filter #(= :loinc-db (:kind %)) + (sources/tx-file-seq dest))] + (is (= 1 (count loinc-dbs)))) + (let [ds (loinc-store/open dest)] + (try + (with-open [conn (jdbc/get-connection ds)] + (is (= "2.74" + (plan/select-one! conn :value + ["SELECT value FROM meta WHERE key = 'loinc_version'"]))) + (is (= 1 + (plan/select-one! conn :count + ["SELECT COUNT(*) AS count FROM loinc"]))) + (is (= 21 + (plan/select-one! conn :count + ["SELECT COUNT(*) AS count FROM linguistic_variant_row"])))) + (finally + (loinc-store/close! ds)))) + (finally + (delete-tree! root)))))) + +(deftest import-rejects-loinc-and-fhir-json-mix + (testing "LOINC and FHIR JSON cannot share one destination" + (let [root (mk-tmp-dir "loinc+fhir-import") + dest (.getPath (io/file root "mixed.db")) + json-dir (io/file root "json")] + (try + (spit-file! (io/file json-dir "cs.json") + "{\"resourceType\":\"CodeSystem\",\"url\":\"http://example.com/cs\",\"content\":\"complete\"}") + (is (= :com.eldrix.hades.cmd/mixed-sources + (reason-of + #(#'cmd/import-from {:no-index true} + [dest "test/resources/loinc-fixture" (.getPath json-dir)])))) + (finally + (delete-tree! root)))))) diff --git a/test/com/eldrix/hades/impl/composite_test.clj b/test/com/eldrix/hades/composite_test.clj similarity index 82% rename from test/com/eldrix/hades/impl/composite_test.clj rename to test/com/eldrix/hades/composite_test.clj index 0a3e50b..fc6ae85 100644 --- a/test/com/eldrix/hades/impl/composite_test.clj +++ b/test/com/eldrix/hades/composite_test.clj @@ -1,4 +1,4 @@ -(ns com.eldrix.hades.impl.composite-test +(ns com.eldrix.hades.composite-test "Composite-layer unit tests. `register_test` covers `load-fhir/build-from-fhir-data` and the construction-time invariants (bare-URL binding, supplement wrapping, naming-system resolution). @@ -10,10 +10,10 @@ - version-availability + check-system-version issue construction" (:require [clojure.test :refer [deftest is testing]] [com.eldrix.hades.core :as hades] - [com.eldrix.hades.impl.composite :as composite] + [com.eldrix.hades.composite :as composite] [com.eldrix.hades.impl.load :as load-fhir] - [com.eldrix.hades.impl.loaders.fhir :as loaders] - [com.eldrix.hades.impl.protocols :as protos])) + [com.eldrix.hades.providers.common.fhir-loader :as loaders] + [com.eldrix.hades.protocols :as protos])) ;; --------------------------------------------------------------------------- ;; Fixtures @@ -56,6 +56,24 @@ (def ^:private cm-a-to-b-alt (assoc cm-a-to-b "url" "http://example.com/r/cm-2")) +(def ^:private cm-a-to-b-conflicting + (assoc-in cm-a-to-b-alt ["group" 0 "element" 0 "target" 0 "code"] "Y")) + +(def ^:private cm-b-to-b-alt + (-> cm-a-to-b-alt + (assoc-in ["group" 0 "element" 0 "code"] "B") + (assoc-in ["group" 0 "element" 0 "target" 0 "code"] "Y"))) + +(def ^:private cm-vs-declared-a-to-b + {"resourceType" "ConceptMap" + "url" "http://example.com/r/cm-vs-declared" "version" "1.0" "status" "active" + "sourceCanonical" "http://example.com/r/vs-source" + "targetCanonical" "http://example.com/r/vs-target" + "group" [{"source" "http://example.com/r/cs" + "target" "http://example.com/r/cs-other" + "element" [{"code" "A" + "target" [{"code" "X" "equivalence" "equivalent"}]}]}]}) + ;; --------------------------------------------------------------------------- (defn- fhir-data [resource-maps] @@ -103,7 +121,7 @@ (defn- multi-cs-provider "Mock provider that serves multiple CodeSystems through one impl — - mirrors `SqliteCodeSystemCatalogue/cs-resource` (sqlite/provider.clj), + mirrors `FtrmCodeSystemCatalogue/cs-resource` (ftrm/provider.clj), which dispatches on `(:url params)`. Returns nil from `cs-resource` unless the call carries a `:url` matching one of the configured entries. Empty params → nil, which is exactly the failure mode the @@ -126,7 +144,7 @@ (defn- multi-vs-provider "Mock provider that serves multiple ValueSets through one impl — - mirrors `SqliteValueSetCatalogue/vs-resource`." + mirrors `FtrmValueSetCatalogue/vs-resource`." [entries] (let [by-url (into {} (map (juxt :url identity)) entries)] (reify protos/ValueSet @@ -219,20 +237,52 @@ (is (true? (:result result))) (is (some? (seq (:matches result))))))) +(deftest cm-translate-uses-group-systems-when-top-level-declares-valuesets + (let [svc (svc-of [cs-v1 cs-other cm-vs-declared-a-to-b])] + (testing "URL-driven translate works when ConceptMap.source/target are ValueSets" + (let [result (hades/translate svc {:url "http://example.com/r/cm-vs-declared" + :code "A"})] + (is (true? (:result result))) + (is (= "X" (-> result :matches first :code))))) + (testing "system+target selection matches group CodeSystem pairs" + (let [result (hades/translate svc {:system "http://example.com/r/cs" + :target "http://example.com/r/cs-other" + :code "A"})] + (is (true? (:result result))) + (is (= "X" (-> result :matches first :code))))) + (testing "system+target selection accepts the ConceptMap target ValueSet scope" + (let [result (hades/translate svc {:system "http://example.com/r/cs" + :target "http://example.com/r/vs-target" + :code "A"})] + (is (true? (:result result))) + (is (= "X" (-> result :matches first :code))))))) + (deftest cm-translate-ambiguous-system-target-test - (let [svc (svc-of [cs-v1 cs-other cm-a-to-b cm-a-to-b-alt]) + (let [svc (svc-of [cs-v1 cs-other cm-a-to-b cm-a-to-b-conflicting]) result (hades/translate svc {:system "http://example.com/r/cs" :target "http://example.com/r/cs-other" :code "A"})] - (testing "two ConceptMaps for the same (source, target) pair forces :url" + (testing "conflicting ConceptMaps for the same code force :url" (is (false? (:result result))) (is (some #(= "ambiguous-target" (:details-code %)) (:issues result)))))) +(deftest cm-translate-disambiguates-multiple-candidates-by-code-test + (let [svc (svc-of [cs-v1 cs-other cm-a-to-b cm-b-to-b-alt]) + result (hades/translate svc {:system "http://example.com/r/cs" + :target "http://example.com/r/cs-other" + :code "A"})] + (testing "when only one matching ConceptMap contains the requested code, use it" + (is (true? (:result result))) + (is (= "X" (-> result :matches first :code)))))) + (deftest cm-translate-no-match-test (let [svc (svc-of [cs-v1 cs-other cm-a-to-b])] - (testing "no matching ConceptMap returns nil (falls through to caller)" - (is (nil? (hades/translate svc {:url "http://example.com/r/cm-missing" - :code "A"})))))) + (testing "no matching ConceptMap returns a structured failure" + (let [result (hades/translate svc {:url "http://example.com/r/cm-missing" + :code "A"})] + (is (false? (:result result))) + (is (:not-found result)) + (is (some #(= "not-found" (:details-code %)) (:issues result))))))) ;; --------------------------------------------------------------------------- ;; Version availability + check-system-version @@ -301,17 +351,17 @@ {"system" "http://example.com/r/veg"}]}}) (deftest validate-cc-cross-provider-mix-valid-and-invalid - (testing "FHIR semantics: any invalid coding makes overall result=false even if another coding is valid; the valid coding's metadata still surfaces" + (testing "mixed CodeableConcept validation keeps the valid display but fails overall when any coding is invalid" (let [svc (svc-of [cs-fruit cs-veg vs-produce]) codings [{:system "http://example.com/r/fruit" :code "apple"} {:system "http://example.com/r/veg" :code "potato"}] r (composite/validate-codeable-concept svc codings {:url "http://example.com/r/produce"})] - (is (false? (:result r)) - "matches the conformance fixture validation/complex-codeableconcept-full-response: any invalid coding flips result to false") + (is (false? (:result r))) (is (= :apple (:code r)) "valid coding's code surfaces (in-memory provider returns codes as keywords)") (is (= "Apple" (:display r))) + (is (string? (:message r))) (testing "the invalid coding's per-coding issue carries the demoted details-code" (is (some #(and (= "this-code-not-in-vs" (:details-code %)) (= 1 (:coding-index %)) diff --git a/test/com/eldrix/hades/conformance_test.clj b/test/com/eldrix/hades/conformance_test.clj index 743f478..650579a 100644 --- a/test/com/eldrix/hades/conformance_test.clj +++ b/test/com/eldrix/hades/conformance_test.clj @@ -138,19 +138,19 @@ (when-not port (throw (ex-info "No server to restart. Call (start!) first." {}))) (stop!) - (doseq [ns-sym '[com.eldrix.hades.impl.protocols - com.eldrix.hades.impl.canonical + (doseq [ns-sym '[com.eldrix.hades.protocols + com.eldrix.hades.providers.common.canonical com.eldrix.hades.impl.wire com.eldrix.hades.impl.metadata - com.eldrix.hades.impl.snomed - com.eldrix.hades.impl.compose - com.eldrix.hades.impl.fhir-extract - com.eldrix.hades.impl.loaders.fhir - com.eldrix.hades.impl.in-memory - com.eldrix.hades.impl.index.memory - com.eldrix.hades.impl.sqlite.db - com.eldrix.hades.impl.sqlite.provider - com.eldrix.hades.impl.composite + com.eldrix.hades.providers.snomed.provider + com.eldrix.hades.providers.common.compose + com.eldrix.hades.providers.common.fhir-extract + com.eldrix.hades.providers.common.fhir-loader + com.eldrix.hades.providers.in-memory.provider + com.eldrix.hades.providers.in-memory.index + com.eldrix.hades.providers.ftrm.db + com.eldrix.hades.providers.ftrm.provider + com.eldrix.hades.composite com.eldrix.hades.impl.http com.eldrix.hades.core com.eldrix.hades.fixtures]] diff --git a/test/com/eldrix/hades/fhir_packages_live_test.clj b/test/com/eldrix/hades/fhir_packages_live_test.clj index 2dc3d06..1b4b19d 100644 --- a/test/com/eldrix/hades/fhir_packages_live_test.clj +++ b/test/com/eldrix/hades/fhir_packages_live_test.clj @@ -18,11 +18,11 @@ [clojure.test :refer [deftest is testing use-fixtures]] [com.eldrix.hades.core :as hades] [com.eldrix.hades.fixtures :as fixtures] - [com.eldrix.hades.impl.composite :as composite] + [com.eldrix.hades.composite :as composite] [com.eldrix.hades.impl.load :as load-fhir] - [com.eldrix.hades.impl.loaders.fhir :as fhir-loader] - [com.eldrix.hades.impl.protocols :as protos] - [com.eldrix.hades.impl.sqlite.provider :as sqlite-provider]) + [com.eldrix.hades.providers.common.fhir-loader :as fhir-loader] + [com.eldrix.hades.protocols :as protos] + [com.eldrix.hades.providers.ftrm.provider :as ftrm-provider]) (:import (java.io File))) (def ^:dynamic *mem-svc* nil) @@ -50,7 +50,7 @@ {:keys [providers supplements]} (load-fhir/build-from-fhir-data data) mem-svc (composite/from-providers providers {:supplements supplements}) {:keys [datasource codesystem valueset conceptmap]} - (sqlite-provider/open-providers fixtures/fhir-smoke-db-path) + (ftrm-provider/open-providers fixtures/fhir-smoke-db-path) sql-svc (composite/from-providers (filterv some? [codesystem valueset conceptmap]) {:closers [#(when (instance? java.io.Closeable datasource) (.close ^java.io.Closeable datasource))]})] @@ -65,6 +65,10 @@ (defn- url-version-set [metadata] (->> metadata (map (juxt :url :version)) set)) +(defn- match-code? + [result code] + (some #(= code (:code %)) (:matches result))) + (defn- first-code-from-cs "Pull one code from a CodeSystem via `cs-expand*` with no filters, bounded by `:max-hits 1`. Returns nil when the CS exposes no concepts @@ -99,6 +103,47 @@ (is (= (url-version-set (protos/cm-metadata *mem-svc* {})) (url-version-set (protos/cm-metadata *sql-svc* {})))))) +(deftest ^:live cm-translate-by-system-target + (let [cases [{:label "administrative gender to v3 by target CodeSystem" + :params {:system "http://hl7.org/fhir/administrative-gender" + :target "http://terminology.hl7.org/CodeSystem/v3-AdministrativeGender" + :code "male"} + :code "M"} + {:label "administrative gender to v3 by target ValueSet" + :params {:system "http://hl7.org/fhir/administrative-gender" + :target "http://terminology.hl7.org/ValueSet/v3-AdministrativeGender" + :code "male"} + :code "M"} + {:label "address-use to v3 by target" + :params {:system "http://hl7.org/fhir/address-use" + :target "http://terminology.hl7.org/ValueSet/v3-AddressUse" + :code "home"} + :code "H"} + {:label "contact-point-use to v2 by target" + :params {:system "http://hl7.org/fhir/contact-point-use" + :target "http://terminology.hl7.org/CodeSystem/v2-0201" + :code "mobile"} + :code "PRS"} + {:label "IPS pregnancy LOINC answer to SNOMED by target" + :params {:system "http://loinc.org" + :target "http://snomed.info/sct" + :code "LA15173-0"} + :code "77386006"} + {:label "IPS smoking LOINC answer to SNOMED by target" + :params {:system "http://loinc.org" + :target "http://snomed.info/sct" + :code "LA18976-3"} + :code "449868002"}]] + (doseq [{:keys [label params code]} cases] + (testing (str label " (in-memory)") + (let [result (hades/translate *mem-svc* params)] + (is (true? (:result result)) (pr-str result)) + (is (match-code? result code) (pr-str (:matches result))))) + (testing (str label " (SQLite)") + (let [result (hades/translate *sql-svc* params)] + (is (true? (:result result)) (pr-str result)) + (is (match-code? result code) (pr-str (:matches result)))))))) + (deftest ^:live cs-lookup-parity-sampled (testing "$lookup agrees on the first concept of a sample of CodeSystems" ;; Sample the first 10 CodeSystems that expose at least one concept. diff --git a/test/com/eldrix/hades/fixtures.clj b/test/com/eldrix/hades/fixtures.clj index f278ac8..0851117 100644 --- a/test/com/eldrix/hades/fixtures.clj +++ b/test/com/eldrix/hades/fixtures.clj @@ -17,7 +17,7 @@ (def snomed-db-path (str ".hades/snomed-intl-" snomed-version ".db")) (def snomed-uk-db-path ".hades/snomed-uk-monolith.db") -(def loinc-version "2.81") +(def loinc-version "2.82") (def loinc-db-path (str ".hades/loinc-" loinc-version ".db")) (def fhir-packages-dir ".hades/fhir-packages") diff --git a/test/com/eldrix/hades/sqlite_vs_inmemory_bench.clj b/test/com/eldrix/hades/ftrm_vs_inmemory_bench.clj similarity index 86% rename from test/com/eldrix/hades/sqlite_vs_inmemory_bench.clj rename to test/com/eldrix/hades/ftrm_vs_inmemory_bench.clj index e2c17c2..99d4a1e 100644 --- a/test/com/eldrix/hades/sqlite_vs_inmemory_bench.clj +++ b/test/com/eldrix/hades/ftrm_vs_inmemory_bench.clj @@ -1,5 +1,5 @@ -(ns com.eldrix.hades.sqlite-vs-inmemory-bench - "One-shot comparison of the SQLite container vs the in-memory provider +(ns com.eldrix.hades.ftrm-vs-inmemory-bench + "One-shot comparison of the FTRM container vs the in-memory provider on the FHIR R4 standard terminology bundles. Provision (once): @@ -12,20 +12,20 @@ Run: - clj -X:bench :nses '[com.eldrix.hades.sqlite-vs-inmemory-bench]' + clj -X:bench :nses '[com.eldrix.hades.ftrm-vs-inmemory-bench]' ;; or in REPL: - (require 'com.eldrix.hades.sqlite-vs-inmemory-bench :reload) - (com.eldrix.hades.sqlite-vs-inmemory-bench/compare-providers!)" + (require 'com.eldrix.hades.ftrm-vs-inmemory-bench :reload) + (com.eldrix.hades.ftrm-vs-inmemory-bench/compare-providers!)" (:require [clojure.java.io :as io] [clojure.pprint :as pp] [com.eldrix.hades.core :as hades] - [com.eldrix.hades.impl.composite :as composite] + [com.eldrix.hades.composite :as composite] + [com.eldrix.hades.providers.ftrm.db :as db] + [com.eldrix.hades.providers.ftrm.provider :as ftrm-provider] + [com.eldrix.hades.providers.ftrm.index :as ftrm-index] [com.eldrix.hades.impl.load :as load-fhir] - [com.eldrix.hades.impl.index.sqlite :as sqlite-index] - [com.eldrix.hades.impl.loaders.fhir :as fhir-loader] - [com.eldrix.hades.impl.protocols :as protos] - [com.eldrix.hades.impl.sqlite.db :as db] - [com.eldrix.hades.impl.sqlite.provider :as sqlite-provider]) + [com.eldrix.hades.providers.common.fhir-loader :as fhir-loader] + [com.eldrix.hades.protocols :as protos]) (:import (java.io File))) (def ^:private terminology-dir ".hades/fhir-r4-terminology") @@ -71,8 +71,8 @@ (delete-quietly out-db) (let [load (time-ms (vec (fhir-loader/load-paths terminology-dir))) data (:result load) - build (time-ms (sqlite-index/build! out-db data {:loader-type "fhir-r4-defs"})) - index (time-ms (sqlite-index/index! out-db)) + build (time-ms (ftrm-index/build! out-db data {:loader-type "fhir-r4-defs"})) + index (time-ms (ftrm-index/index! out-db)) size (file-size-mb out-db) kinds (frequencies (map :type data))] {:load-ms (:ms load) @@ -83,7 +83,7 @@ (defn- bench-sqlite [] (let [build (build-sqlite!) - open (time-ms (sqlite-provider/open-providers out-db)) + open (time-ms (ftrm-provider/open-providers out-db)) {:keys [codesystem valueset conceptmap datasource]} (:result open)] (try (let [register (time-ms (composite/from-providers diff --git a/test/com/eldrix/hades/impl/expand_test.clj b/test/com/eldrix/hades/impl/expand_test.clj index 55dc365..310c290 100644 --- a/test/com/eldrix/hades/impl/expand_test.clj +++ b/test/com/eldrix/hades/impl/expand_test.clj @@ -26,7 +26,7 @@ [clojure.test.check.properties :as prop] [com.eldrix.hades.core :as hades] [com.eldrix.hades.fixtures :as fixtures] - [com.eldrix.hades.impl.compose :as compose] + [com.eldrix.hades.providers.common.compose :as compose] [com.eldrix.hades.impl.load :as load-fhir])) (set! *warn-on-reflection* true) diff --git a/test/com/eldrix/hades/impl/http_matrix_test.clj b/test/com/eldrix/hades/impl/http_matrix_test.clj index dfabeb3..7f5345b 100644 --- a/test/com/eldrix/hades/impl/http_matrix_test.clj +++ b/test/com/eldrix/hades/impl/http_matrix_test.clj @@ -37,6 +37,24 @@ (def ^:private fhir-cs "http://terminology.hl7.org/CodeSystem/v3-AdministrativeGender") (def ^:private fhir-vs "http://terminology.hl7.org/ValueSet/v3-AdministrativeGender") +;; ValueSets keyed off LOINC. `observation-codes` is the canonical +;; FHIR R4 entry point — its compose is `{include [{system http://loinc.org}]}`, +;; so a `$expand` against it routes through the compose engine to the +;; LOINC CodeSystem provider. `loinc.org/vs` is the LOINC IG's implicit +;; "all of LOINC" URL (parallel to `snomed.info/sct?fhir_vs`). +(def ^:private loinc-observation-vs "http://hl7.org/fhir/ValueSet/observation-codes") +(def ^:private loinc-implicit-vs "http://loinc.org/vs") +(def ^:private loinc-hgb-code "718-7") +(def ^:private loinc-hgb-de-display "Hämoglobin [Masse/Volumen] in Blut") +(def ^:private loinc-part-snomed-map + "http://loinc.org/cm/part-related-code-mapping/http%3A%2F%2Fsnomed.info%2Fsct") +(def ^:private loinc-ieee-map "http://loinc.org/cm/ieee-medical-device") +(def ^:private loinc-rsna-rid-map "http://loinc.org/cm/rsna-playbook/rid") +(def ^:private loinc-rsna-rpid-map "http://loinc.org/cm/rsna-playbook/rpid") +(def ^:private ieee-system "urn:iso:std:iso:11073:10101") +(def ^:private radlex-system "http://www.radlex.org") +(def ^:private rsna-playbook-system "http://www.rsna.org/RadLex_Playbook") + ;; A hierarchical FHIR CodeSystem used to exercise the `property=parent` ;; filter on the FHIR providers (in-memory + SQLite). `ActClassExposure` ;; sits one level under `ActClass`. @@ -54,6 +72,39 @@ "content" "complete" "caseSensitive" true "concept" [{"code" "OV1" "display" "Overlay One"}]}) +(def ^:private case-insensitive-cs-url "http://example.com/tx/case-insensitive-cs") +(def ^:private case-insensitive-vs-url "http://example.com/tx/case-insensitive-vs") +(def ^:private case-insensitive-cs + {"resourceType" "CodeSystem" + "url" case-insensitive-cs-url "version" "1.0" "status" "active" + "content" "complete" "caseSensitive" false + "concept" [{"code" "code1" "display" "Display 1"}]}) +(def ^:private case-insensitive-vs + {"resourceType" "ValueSet" + "url" case-insensitive-vs-url "version" "1.0" "status" "active" + "compose" {"include" [{"system" case-insensitive-cs-url}]}}) + +(def ^:private unsupported-loinc-filter-vs + {"resourceType" "ValueSet" + "url" "http://example.com/vs/unsupported-loinc-filter" + "status" "active" + "compose" {"include" [{"system" loinc-system + "filter" [{"property" "not-a-loinc-filter" + "op" "=" + "value" "x"}]}]}}) + +(def ^:private tx-benchmark-ex07-vs + {"resourceType" "ValueSet" + "compose" {"include" [{"system" snomed-system} + {"system" loinc-system} + {"system" "http://www.nlm.nih.gov/research/umls/rxnorm"}]}}) + +(def ^:private ips-pregnancy-status-map + "http://hl7.org/fhir/uv/ips/ConceptMap/loinc-pregnancy-status-to-snomed-ct-uv-ips") + +(def ^:private ips-smoking-status-map + "http://hl7.org/fhir/uv/ips/ConceptMap/loinc-smoking-status-to-snomed-ct-uv-ips") + ;; --------------------------------------------------------------------------- ;; Body inspectors. Each predicate takes the parsed JSON body and ;; returns truthy on match. Mirrors the helpers in @@ -68,9 +119,97 @@ (defn- result-false? [body] (false? (get (get-param body "result") "valueBoolean"))) (defn- has-issues? [body] (some? (get (get-param body "issues") "resource"))) (defn- has-display? [body] (some? (get (get-param body "display") "valueString"))) +(defn- parameters-resource? [body] (= "Parameters" (get body "resourceType"))) (defn- operation-outcome? [body] (= "OperationOutcome" (get body "resourceType"))) (defn- valueset-resource? [body] (= "ValueSet" (get body "resourceType"))) +(defn- lookup-display [body] (get (get-param body "display") "valueString")) + +(defn- param-value + [body nm value-key] + (get (get-param body nm) value-key)) + +(defn- param-value=? [nm value-key expected] + (fn [body] (= expected (param-value body nm value-key)))) + +(defn- operation-outcome-detail-codes [body] + (into #{} + (keep (fn [issue] + (some #(get % "code") (get-in issue ["details" "coding"])))) + (get body "issue"))) + +(defn- operation-outcome-has-detail-code? [code] + (fn [body] (contains? (operation-outcome-detail-codes body) code))) + +(defn- translate-match-codes + "Return the target concept codes in a $translate Parameters body." + [body] + (into #{} + (keep (fn [p] + (when (= "match" (get p "name")) + (some (fn [pp] + (when (= "concept" (get pp "name")) + (get-in pp ["valueCoding" "code"]))) + (get p "part"))))) + (get body "parameter"))) + +(defn- translate-match-code? [code] + (fn [body] (contains? (translate-match-codes body) code))) + +(defn- translate-matches + [body] + (mapv (fn [p] + (let [parts (get p "part") + equivalence (some #(when (= "equivalence" (get % "name")) + (get % "valueCode")) + parts) + coding (some #(when (= "concept" (get % "name")) + (get % "valueCoding")) + parts)] + {:equivalence equivalence + :system (get coding "system") + :code (get coding "code")})) + (filter #(= "match" (get % "name")) (get body "parameter")))) + +(defn- translate-match? + [expected] + (fn [body] (some #(= expected (select-keys % (keys expected))) + (translate-matches body)))) + +(defn- expansion-codes + "Return the set of `code` strings in `expansion.contains` of a + `$expand` ValueSet response body." + [body] + (into #{} (keep #(get % "code")) (get-in body ["expansion" "contains"] []))) + +(defn- expansion-has-results? [body] + (seq (get-in body ["expansion" "contains"]))) + +(defn- expansion-total [body] + (get-in body ["expansion" "total"])) + +(defn- expansion-total-at-least? [minimum] + (fn [body] + (let [total (expansion-total body)] + (and (integer? total) (<= minimum total))))) + +(defn- expansion-contains? + "Predicate: every code in `required` appears in the response's + expansion.contains. Locks down `$expand` cases that need to confirm a + filter / compose include actually surfaced specific concepts (not just + that the body shape is a ValueSet)." + [required] + (fn [body] + (let [present (expansion-codes body)] + (every? present required)))) + +(defn- display-equals? + "Predicate: `$lookup`'s `display` parameter equals `expected`. Used to + confirm the right designation type was selected — distinct from + `has-display?`, which only checks presence." + [expected] + (fn [body] (= expected (lookup-display body)))) + (defn- issues-of-severity? "Truthy when the `issues` Parameters part carries at least one OperationOutcome.issue with the given severity." @@ -78,8 +217,15 @@ (some (fn [iss] (= severity (get iss "severity"))) (get-in (get (get-param body "issues") "resource") ["issue"] []))) +(defn- parameter-issue-detail-codes [body] + (into #{} + (keep (fn [issue] + (some #(get % "code") (get-in issue ["details" "coding"])))) + (get-in (get (get-param body "issues") "resource") ["issue"] []))) + (defn- has-warning-issue? [body] (issues-of-severity? body "warning")) (defn- has-error-issue? [body] (issues-of-severity? body "error")) +(defn- has-information-issue? [body] (issues-of-severity? body "information")) (defn- property-codes "Return the set of property codes returned in a $lookup Parameters @@ -257,12 +403,40 @@ (is (has-warning-issue? body) (str label " — warning issue expected"))) (when (:error? expect) (is (has-error-issue? body) (str label " — error issue expected"))) + (when (:information? expect) + (is (has-information-issue? body) (str label " — information issue expected"))) (when (:display? expect) (is (has-display? body) (str label " — display parameter expected"))) + (when (:parameters? expect) + (is (parameters-resource? body) (str label " — Parameters body expected"))) (when (:outcome? expect) (is (operation-outcome? body) (str label " — OperationOutcome body expected"))) + (when-let [code (:outcome-detail-code expect)] + (is ((operation-outcome-has-detail-code? code) body) + (str label " — OperationOutcome detail code=" code + " expected; got " (operation-outcome-detail-codes body)))) (when (:valueset? expect) (is (valueset-resource? body) (str label " — ValueSet body expected"))) + (when (:expansion-results? expect) + (is (expansion-has-results? body) + (str label " — non-empty expansion expected"))) + (when-let [minimum (:expansion-total-at-least expect)] + (is ((expansion-total-at-least? minimum) body) + (str label " — expansion.total >= " minimum + " expected; got " (pr-str (expansion-total body))))) + (when-let [expected (:param-code expect)] + (is ((param-value=? "code" "valueCode" expected) body) + (str label " — Parameters code=" expected " expected"))) + (when-let [expected (:param-system expect)] + (is ((param-value=? "system" "valueUri" expected) body) + (str label " — Parameters system=" expected " expected"))) + (when-let [expected (:normalized-code expect)] + (is ((param-value=? "normalized-code" "valueCode" expected) body) + (str label " — Parameters normalized-code=" expected " expected"))) + (when-let [expected (:issue-detail-code expect)] + (is (contains? (parameter-issue-detail-codes body) expected) + (str label " — Parameters issues detail code=" expected + " expected; got " (parameter-issue-detail-codes body)))) (when-let [oc (:subsumes expect)] (is ((subsumes-outcome=? oc) body) (str label " — subsumes outcome=" oc " expected"))) @@ -277,7 +451,23 @@ (when-let [required (:contains-property-codes expect)] (is ((contains-property-codes? required) body) (str label " — all of " required " expected; got " - (property-codes body))))))) + (property-codes body)))) + (when-let [required (:expansion-contains expect)] + (is ((expansion-contains? required) body) + (str label " — expansion expected to contain " required + "; got " (expansion-codes body)))) + (when-let [d (:display-equals expect)] + (is ((display-equals? d) body) + (str label " — expected display=" (pr-str d) + ", got " (pr-str (lookup-display body))))) + (when-let [code (:translate-match-code expect)] + (is ((translate-match-code? code) body) + (str label " — translate expected match code=" code + "; got " (translate-match-codes body)))) + (when-let [match (:translate-match expect)] + (is ((translate-match? match) body) + (str label " — translate expected match " match + "; got " (translate-matches body))))))) ;; --------------------------------------------------------------------------- ;; Matrix — one row per case. New cases are a new row. @@ -348,7 +538,7 @@ {:terminology :snomed :method :get :op :cm-translate :url "http://example.com/fake-cm" :system snomed-system :code "73211009" :target snomed-system - :expect {:status 404 :outcome? true}} + :expect {:status 200 :result false :issues? true}} ;; $lookup with `property=` filter — restricts which property/slice ;; codes the response carries. Spec: "A property... that the client @@ -403,6 +593,14 @@ :system loinc-system :code "8480-6" :expect {:status 200 :display? true}} + {:terminology :loinc :method :get :op :cs-lookup + :system loinc-system :code "8867-4" + :reason "tx-benchmark LK02 preflight: Heart rate lookup echoes code + system" + :expect {:status 200 + :parameters? true + :param-code "8867-4" + :param-system loinc-system}} + {:terminology :loinc :method :post :op :cs-lookup :system loinc-system :code "8480-6" :expect {:status 200 :display? true}} @@ -422,7 +620,172 @@ {:terminology :loinc :method :get :op :cs-lookup :system loinc-system :code "0000000-0" - :expect {:status 404 :outcome? true}}]) + :expect {:status 404 :outcome? true}} + + {:terminology :loinc :method :get :op :cm-translate + :url "http://loinc.org/cm/map-to" + :system loinc-system :code "1009-0" :target loinc-system + :reason "MapTo.csv replacement ConceptMap" + :expect {:status 200 :result true :translate-match-code "1007-4"}} + + {:terminology :loinc :method :post :op :cm-translate + :url "http://loinc.org/cm/map-to" + :system loinc-system :code "1009-0" :target loinc-system + :reason "MapTo.csv replacement ConceptMap via POST Parameters" + :expect {:status 200 :result true :translate-match-code "1007-4"}} + + {:terminology :loinc :method :get :op :cm-translate + :url loinc-part-snomed-map + :system loinc-system :code "LP14449-0" :target snomed-system + :reason "PartRelatedCodeMapping.csv forward external mapping" + :expect {:status 200 :result true + :translate-match {:equivalence "equivalent" + :system snomed-system + :code "38082009"}}} + + {:terminology :loinc :method :get :op :cm-translate + :url loinc-part-snomed-map + :system snomed-system :code "38082009" :target loinc-system + :reason "PartRelatedCodeMapping.csv reverse external mapping" + :expect {:status 200 :result true + :translate-match {:equivalence "equivalent" + :system loinc-system + :code "LP14449-0"}}} + + {:terminology :loinc :method :post :op :cm-translate + :url loinc-part-snomed-map + :system snomed-system :code "38082009" :target loinc-system + :reason "PartRelatedCodeMapping.csv reverse external mapping via POST Parameters" + :expect {:status 200 :result true + :translate-match {:equivalence "equivalent" + :system loinc-system + :code "LP14449-0"}}} + + {:terminology :loinc :method :get :op :cm-translate + :url loinc-part-snomed-map + :system loinc-system :code "LP14448-2" :target snomed-system + :reason "PartRelatedCodeMapping.csv preserves wider equivalence" + :expect {:status 200 :result true + :translate-match {:equivalence "wider" + :system snomed-system + :code "38082009"}}} + + {:terminology :loinc :method :get :op :cm-translate + :url loinc-part-snomed-map + :system snomed-system :code "38082009" :target loinc-system + :reason "PartRelatedCodeMapping.csv inverts wider to narrower in reverse" + :expect {:status 200 :result true + :translate-match {:equivalence "narrower" + :system loinc-system + :code "LP14448-2"}}} + + {:terminology :loinc :method :get :op :cm-translate + :url loinc-ieee-map + :system loinc-system :code "11556-8" :target ieee-system + :reason "IEEE medical device mapping forward" + :expect {:status 200 :result true + :translate-match {:equivalence "equivalent" + :system ieee-system + :code "160116"}}} + + {:terminology :loinc :method :post :op :cm-translate + :url loinc-ieee-map + :system loinc-system :code "11556-8" :target ieee-system + :reason "IEEE medical device mapping forward via POST Parameters" + :expect {:status 200 :result true + :translate-match {:equivalence "equivalent" + :system ieee-system + :code "160116"}}} + + {:terminology :loinc :method :get :op :cm-translate + :url loinc-rsna-rid-map + :system loinc-system :code "24531-6" :target radlex-system + :reason "RSNA playbook RID mapping forward" + :expect {:status 200 :result true + :translate-match {:equivalence "relatedto" + :system radlex-system + :code "RID431"}}} + + {:terminology :loinc :method :get :op :cm-translate + :url loinc-rsna-rpid-map + :system rsna-playbook-system :code "RPID2142" :target loinc-system + :reason "RSNA playbook RPID mapping reverse" + :expect {:status 200 :result true + :translate-match {:equivalence "relatedto" + :system loinc-system + :code "24531-6"}}} + + {:terminology :loinc :method :get :op :cm-translate + :url ips-pregnancy-status-map + :system loinc-system :code "LA15173-0" :target snomed-system + :reason "tx-benchmark CM02 IPS LOINC pregnancy status map" + :expect {:status 200 :result true + :translate-match {:equivalence "equivalent" + :system snomed-system + :code "77386006"}}} + + {:terminology :loinc :method :get :op :cm-translate + :url ips-smoking-status-map + :system loinc-system :code "LA18976-3" :target snomed-system + :reason "tx-benchmark CM02 IPS LOINC smoking status map" + :expect {:status 200 :result true + :translate-match {:equivalence "equivalent" + :system snomed-system + :code "449868002"}}} + + ;; --- displayLanguage: $lookup must pick LONG_COMMON_NAME, not the + ;; first-by-row designation (which is CLASS — a LOINC axis). The de-DE + ;; designations for 718-7 are: CLASS, COMPONENT, LONG_COMMON_NAME, + ;; PROPERTY, SCALE_TYP, SYSTEM, TIME_ASPCT — all language-matched + ;; equally; the picker must rank by use_code, not insertion order. + {:terminology :loinc :method :get :op :cs-lookup + :system loinc-system :code loinc-hgb-code + :extras {:displayLanguage "de-DE"} + :reason "displayLanguage=de-DE → German LONG_COMMON_NAME, not CLASS axis" + :expect {:status 200 :display-equals loinc-hgb-de-display}} + + ;; --- ValueSet $expand: full-stack compose path through observation-codes. + ;; Both cases are designed to surface the compose-layer post-filter + ;; bug: cs-expand* matches on a non-English designation (en-AU + ;; LinguisticVariantDisplayName for "Haemoglobin", or both tokens + ;; across the primary display for "hemoglobin blood"), then the + ;; compose post-filter re-checks `str/includes?` against the English + ;; primary display and drops the match. + {:terminology :loinc :method :get :op :vs-expand + :url loinc-observation-vs + :extras {:filter "Haemoglobin" :count "50"} + :reason "British 'Haemoglobin' (designation match) must survive compose" + :expect {:status 200 :valueset? true + :expansion-contains #{loinc-hgb-code}}} + + {:terminology :loinc :method :get :op :vs-expand + :url loinc-observation-vs + :extras {:filter "hemoglobin blood" :count "50"} + :reason "multi-token AND across display must survive compose" + :expect {:status 200 :valueset? true + :expansion-contains #{loinc-hgb-code}}} + + ;; --- Implicit all-LOINC ValueSet URL. The LOINC IG defines this URL + ;; as the all-LOINC implicit set. + {:terminology :loinc :method :get :op :vs-expand + :url loinc-implicit-vs + :extras {:filter "hemoglobin" :count "5"} + :reason "implicit http://loinc.org/vs must resolve to all-of-LOINC" + :expect {:status 200 :valueset? true + :expansion-total-at-least 6 + :expansion-contains #{loinc-hgb-code}}} + + {:terminology :loinc :method :post :op :vs-expand + :extra-params [{:name "valueSet" :resource tx-benchmark-ex07-vs} + {:name "filter" :value "amphetamine"} + {:name "count" :value 200}] + :reason "tx-benchmark EX07 preflight: ad-hoc multi-system text expansion" + :expect {:status 200 :valueset? true :expansion-results? true}} + + {:terminology :loinc :method :post :op :vs-expand + :extra-params [{:name "valueSet" :resource unsupported-loinc-filter-vs}] + :reason "unsupported compose filters surface an error, not an empty expansion" + :expect {:status 422 :outcome? true :outcome-detail-code "vs-invalid"}}]) (def ^:private fhir-cases [{:terminology :fhir :method :get :op :cs-lookup @@ -519,7 +882,32 @@ {:terminology :overlay :method :get :op :cs-validate-code :system overlay-cs-url :code "OV1" :reason "without tx-resource the overlay system is unknown — no leakage" - :expect {:status 200 :result false :issues? true}}]) + :expect {:status 200 :result false :issues? true}} + + {:terminology :overlay :method :post :op :vs-validate-code + :system case-insensitive-cs-url :code "CODE1" + :extra-params [{:name "valueSet" :resource case-insensitive-vs} + {:name "tx-resource" :resource case-insensitive-cs}] + :reason "conformance case/case-insensitive-code1-*: wrong-case code validates with normalized-code" + :expect {:status 200 + :result true + :normalized-code "code1" + :information? true + :issue-detail-code "code-rule"}} + + {:terminology :overlay :method :post :op :vs-validate-code + :url case-insensitive-vs-url + :extra-params [{:name "coding" + :value-key "valueCoding" + :value {:system case-insensitive-cs-url :code "CODE1"}} + {:name "tx-resource" :resource case-insensitive-cs} + {:name "tx-resource" :resource case-insensitive-vs}] + :reason "tx-ecosystem case/case-insensitive-code1-2: Coding input preserves informational case issue" + :expect {:status 200 + :result true + :normalized-code "code1" + :information? true + :issue-detail-code "code-rule"}}]) (def ^:private all-cases (into [] cat [snomed-cases loinc-cases fhir-cases tx-resource-cases])) diff --git a/test/com/eldrix/hades/impl/index/sqlite_test.clj b/test/com/eldrix/hades/impl/index/sqlite_test.clj deleted file mode 100644 index ca4d093..0000000 --- a/test/com/eldrix/hades/impl/index/sqlite_test.clj +++ /dev/null @@ -1,166 +0,0 @@ -(ns com.eldrix.hades.impl.index.sqlite-test - (:require [clojure.java.io :as io] - [clojure.test :refer [deftest is testing]] - [com.eldrix.hades.impl.index.sqlite :as sqlite-index] - [com.eldrix.hades.impl.loaders.loinc :as loinc] - [com.eldrix.hades.impl.protocols :as protos] - [com.eldrix.hades.impl.sqlite.db :as db] - [com.eldrix.hades.impl.sqlite.provider :as sqlite-provider] - [next.jdbc :as jdbc]) - (:import (java.io File))) - -(def fixture-root "test/resources/loinc-fixture") - -(defn- temp-db-path [] - (let [^File f (File/createTempFile "hades-build-test" ".db")] - (.delete f) - (.getPath f))) - -(defn- delete-quietly [^String path] - (let [^File f (io/file path)] - (when (.exists f) (.delete f)))) - -(defn- count-rows [ds sql] - (-> (jdbc/execute-one! ds [sql]) vals first)) - -(defn- import-loinc-fixture! [path version] - (sqlite-index/import-fhir-data - path - (loinc/stream-release fixture-root {:version version}) - {:loader-type "loinc-csv"})) - -(deftest build-loinc-fixture-into-sqlite - (let [path (temp-db-path)] - (try - (let [result (import-loinc-fixture! path "2.82")] - (sqlite-index/index! path) - (let [ds (db/open path)] - (testing "result reports targets and resources" - (is (= path (:db-path result))) - (is (>= (count (:resources result)) 4)) - (is (some #(and (= "CodeSystem" (:resource-type %)) - (= "http://loinc.org" (:url %)) - (= "2.82" (:version %))) - (:resources result)))) - (testing "concept rows landed" - ;; 9 LOINC concepts + 6 LA-concepts + 6 LP-parts = 21 - (is (= 21 (count-rows ds "SELECT COUNT(*) FROM concept"))) - (is (= "Hemoglobin [Mass/volume] in Blood" - (-> (jdbc/execute-one! ds - ["SELECT display FROM concept - WHERE cs_url='http://loinc.org' AND code='718-7'"]) - vals first)))) - (testing "typed properties — STATUS as code, COMPONENT as string" - (let [props (jdbc/execute! ds - ["SELECT prop_code, value_type, value_str - FROM concept_property - WHERE cs_url='http://loinc.org' AND code='718-7' - ORDER BY prop_code"]) - by-code (into {} - (map (fn [{:concept_property/keys [prop_code value_type value_str]}] - [prop_code [value_type value_str]])) - props)] - (is (= ["code" "ACTIVE"] (get by-code "STATUS"))) - (is (= ["string" "Hemoglobin"] (get by-code "COMPONENT"))) - (is (= ["string" "Bld"] (get by-code "SYSTEM"))))) - (testing "designations carried" - (is (pos? (count-rows ds "SELECT COUNT(*) FROM concept_designation - WHERE cs_url='http://loinc.org' AND code='718-7'")))) - (testing "hierarchy: ComponentHierarchyBySystem becomes concept_parent rows" - (is (= 1 (count-rows ds "SELECT COUNT(*) FROM concept_parent - WHERE cs_url='http://loinc.org' AND code='2951-2'"))) - (let [parent (-> (jdbc/execute-one! ds - ["SELECT parent_code FROM concept_parent - WHERE cs_url='http://loinc.org' AND code='2951-2'"]) - vals first)] - (is (= "LP386648-2" parent)))) - (testing "ancestor closure populated for the hierarchy" - (is (pos? (count-rows ds "SELECT COUNT(*) FROM concept_ancestor - WHERE cs_url='http://loinc.org' AND descendent_code='2951-2'")))) - (testing "LP-* parts ingested as concepts" - (is (some? (jdbc/execute-one! ds - ["SELECT code FROM concept - WHERE cs_url='http://loinc.org' AND code='LP15099-2'"])))) - (testing "LoincPartLink_Primary surfaces typed Coding properties" - (let [rows (jdbc/execute! ds - ["SELECT prop_code, value_type, value_coding_code, value_coding_display - FROM concept_property - WHERE cs_url='http://loinc.org' AND code='2951-2' - AND value_type='Coding' - ORDER BY prop_code"]) - by-axis (into {} (map (fn [{:concept_property/keys [prop_code value_type value_coding_code value_coding_display]}] - [prop_code [value_type value_coding_code value_coding_display]])) - rows)] - (is (= ["Coding" "LP15099-2" "Sodium"] - (get by-axis "COMPONENT"))))) - (testing "linguistic variants land as language-tagged designations" - (let [de-rows (jdbc/execute! ds - ["SELECT use_code, value FROM concept_designation - WHERE cs_url='http://loinc.org' AND code='2951-2' - AND language='de-AT'"])] - (is (some #(= "Natrium" (:concept_designation/value %)) de-rows)))) - (testing "valuesets and conceptmaps landed" - (is (= 2 (count-rows ds "SELECT COUNT(*) FROM valueset"))) - (is (= 1 (count-rows ds "SELECT COUNT(*) FROM conceptmap"))) - (is (= 2 (count-rows ds "SELECT COUNT(*) FROM conceptmap_element")))) - (testing "tx_resource catalogue" - (let [rows (db/list-resources ds) - cs (filter #(= "CodeSystem" (:resource-type %)) rows)] - (is (= 1 (count cs))) - ;; 9 LOINC-table rows + 6 unique LA-codes + 6 LP-parts = 21 - (is (= 21 (:concept-count (first cs)))))))) - (finally (delete-quietly path))))) - -(deftest subsumes-uses-closure-table - (let [path (temp-db-path)] - (try - (import-loinc-fixture! path "2.82") - (sqlite-index/index! path) - (let [{:keys [datasource codesystem]} (sqlite-provider/open-providers path) - call (fn [params] (protos/cs-subsumes codesystem params))] - (try - (testing "ancestor → descendant returns 'subsumes'" - (is (= "subsumes" (:outcome (call {:systemA "http://loinc.org" - :codeA "LP386648-2" - :codeB "2951-2"}))))) - (testing "descendant → ancestor returns 'subsumed-by'" - (is (= "subsumed-by" (:outcome (call {:systemA "http://loinc.org" - :codeA "2951-2" - :codeB "LP386648-2"}))))) - (testing "same code returns 'equivalent'" - (is (= "equivalent" (:outcome (call {:systemA "http://loinc.org" - :codeA "2951-2" - :codeB "2951-2"}))))) - (testing "unrelated codes return 'not-subsumed'" - (is (= "not-subsumed" (:outcome (call {:systemA "http://loinc.org" - :codeA "2951-2" - :codeB "718-7"}))))) - (finally - (when (instance? java.io.Closeable datasource) - (.close ^java.io.Closeable datasource))))) - (finally (delete-quietly path))))) - -(deftest update-in-place-replaces-same-version - (let [path (temp-db-path)] - (try - (import-loinc-fixture! path "2.82") - (let [ds (db/open path) - cnt-before (count-rows ds "SELECT COUNT(*) FROM concept")] - (testing "second build with same version is idempotent in row count" - (import-loinc-fixture! path "2.82") - (let [ds (db/open path)] - (is (= cnt-before (count-rows ds "SELECT COUNT(*) FROM concept")))))) - (finally (delete-quietly path))))) - -(deftest multi-version-coexist - (let [path (temp-db-path)] - (try - (import-loinc-fixture! path "2.82") - (import-loinc-fixture! path "2.83") - (let [ds (db/open path) - versions (->> (jdbc/execute! ds - ["SELECT DISTINCT cs_version FROM concept WHERE cs_url='http://loinc.org'"]) - (map :concept/cs_version) - set)] - (is (= #{"2.82" "2.83"} versions))) - (finally (delete-quietly path))))) diff --git a/test/com/eldrix/hades/impl/internal_conformance_test.clj b/test/com/eldrix/hades/impl/internal_conformance_test.clj index 30873c8..dcca858 100644 --- a/test/com/eldrix/hades/impl/internal_conformance_test.clj +++ b/test/com/eldrix/hades/impl/internal_conformance_test.clj @@ -9,10 +9,10 @@ [clojure.string :as str] [clojure.test :refer [deftest is testing use-fixtures]] [com.eldrix.hades.core :as hades] - [com.eldrix.hades.impl.composite :as composite] - [com.eldrix.hades.impl.compose :as compose] + [com.eldrix.hades.composite :as composite] + [com.eldrix.hades.providers.common.compose :as compose] [com.eldrix.hades.impl.load :as load-fhir] - [com.eldrix.hades.impl.protocols.result :as result] + [com.eldrix.hades.protocols.result :as result] [com.eldrix.hades.impl.wire :as wire])) ;; --------------------------------------------------------------------------- @@ -270,13 +270,14 @@ (is (contains? (issue-codes result) "invalid-code"))))) (deftest cc-multi-coding-one-valid-test - (testing "two codings, one valid — result false with all issues" + (testing "two codings, one valid — result false with issues and message from rejected codings" (let [result (hades/validate-codeable-concept *svc* [{:system "http://hl7.org/fhir/test/CodeSystem/simple" :code "MISSING"} {:system "http://hl7.org/fhir/test/CodeSystem/simple" :code "code1"}] {:url "http://hl7.org/fhir/test/ValueSet/simple-all"})] - ;; The valid coding is found but invalid codings make result false + (is (false? (:result result))) (is (some? (:display result)) "display from valid coding") + (is (string? (:message result))) (is (some #(= "invalid-code" (:details-code %)) (:issues result)) "invalid-code issue from the bad coding")))) diff --git a/test/com/eldrix/hades/impl/loaders/loinc_test.clj b/test/com/eldrix/hades/impl/loaders/loinc_test.clj deleted file mode 100644 index 8cda595..0000000 --- a/test/com/eldrix/hades/impl/loaders/loinc_test.clj +++ /dev/null @@ -1,201 +0,0 @@ -(ns com.eldrix.hades.impl.loaders.loinc-test - (:require [clojure.core.async :as async] - [clojure.java.io :as io] - [clojure.test :refer [deftest is testing]] - [com.eldrix.hades.impl.loaders.loinc :as loinc])) - -(def fixture-root "test/resources/loinc-fixture") - -(defn- by-type [data t] - (filterv #(= t (:type %)) data)) - -(defn- by-code [concepts code] - (some #(when (= code (:code %)) %) concepts)) - -(defn- release-data - ([root] (release-data root nil)) - ([root opts] - (let [ch (loinc/stream-release root opts)] - (loop [acc []] - (if-let [batch (async/> (:properties c) - (map (fn [p] [(get p "code") - (or (get p "valueCode") - (get p "valueString"))])) - (into {}))] - (is (= "ACTIVE" (props "STATUS"))) - (is (= "Hemoglobin" (props "COMPONENT"))) - (is (= "Bld" (props "SYSTEM"))) - (is (= "Qn" (props "SCALE_TYP"))) - (is (= "HEM/BC" (props "CLASS")))) - (testing "STATUS is valueCode; axis columns are valueString" - (let [status (some #(when (= "STATUS" (get % "code")) %) (:properties c)) - system (some #(when (= "SYSTEM" (get % "code")) %) (:properties c))] - (is (contains? status "valueCode")) - (is (contains? system "valueString")))) - (testing "SHORTNAME emitted as designation" - (let [d (first (:designations c))] - (is (= "Hgb Bld" (:value d))) - (is (= "SHORTNAME" (get-in d [:use :code]))))))) - (testing "LA-codes emitted as concepts in same code system" - (let [c (by-code concepts "LA28912-9")] - (is (some? c)) - (is (= "http://loinc.org" (:system c))) - (is (= "Met" (:display c))))) - (testing "blank cells dropped from properties" - (let [c (by-code concepts "1009-0") - method (some #(when (= "METHOD_TYP" (get % "code")) %) (:properties c))] - ;; row has Agglutination as METHOD_TYP — should appear - (is (some? method)) - (is (= "Agglutination" (get method "valueString"))))))) - -(deftest answer-list-valuesets - (let [data (release-data fixture-root {:version "2.82"}) - vses (by-type data :valueset) - by-url (group-by :url vses)] - (testing "one ValueSet per LL-id" - (is (= 2 (count vses)))) - (testing "Met/Not met list contents (compose include block)" - (let [vs (first (by-url "http://loinc.org/vs/LL6136-7")) - include (get-in vs [:compose "include" 0]) - concepts (get include "concept")] - (is (= "http://loinc.org" (get include "system"))) - (is (= 4 (count concepts))) - (is (= #{"LA28912-9" "LA28913-7" "LA28914-5" "LA28915-2"} - (set (map #(get % "code") concepts)))))))) - -(deftest map-to-conceptmap - (let [data (release-data fixture-root {:version "2.82"}) - cms (by-type data :conceptmap)] - (testing "single ConceptMap aggregating MapTo.csv" - (is (= 1 (count cms))) - (let [cm (first cms) - elements (get-in cm [:groups 0 :elements])] - (is (= "http://loinc.org" (:source-uri cm))) - (is (= "http://loinc.org" (:target-uri cm))) - (is (= 2 (count elements))) - (let [el (first elements)] - (is (= "1009-0" (:code el))) - (is (= "1007-4" (-> el :target first :code))) - (is (= "equivalent" (-> el :target first :equivalence)))) - (testing "comment carried through when present" - (let [el (second elements)] - (is (= "Cross-domain note" (-> el :target first :comment))))))))) - -(deftest part-concepts-and-hierarchy - (let [data (release-data fixture-root {:version "2.82"}) - concepts (by-type data :concept) - comp-part (by-code concepts "LP15099-2") - parents (by-type data :concept-parent) - props (by-type data :concept-property)] - (testing "Part.csv emits LP-* concepts with PartName + STATUS + PartTypeName" - (is (some? comp-part)) - (is (= "Sodium" (:display comp-part))) - (let [m (->> (:properties comp-part) - (map (fn [p] [(get p "code") - (or (get p "valueCode") - (get p "valueString"))])) - (into {}))] - (is (= "ACTIVE" (m "STATUS"))) - (is (= "COMPONENT" (m "PartTypeName"))))) - (testing "core LOINC concept itself is emitted clean (no inline parents/links)" - (let [sodium (by-code concepts "2951-2")] - (is (some? sodium)) - (is (nil? (:parents sodium))) - (is (every? #(not (contains? % "valueCoding")) (:properties sodium))))) - (testing "ComponentHierarchyBySystem emits standalone :concept-parent entries" - (let [for-sodium (filter #(= "2951-2" (:code %)) parents)] - (is (= 1 (count for-sodium))) - (is (= "LP386648-2" (:parent (first for-sodium)))))) - (testing "LoincPartLink_Primary emits standalone :concept-property entries" - (let [for-sodium (filter #(and (= "2951-2" (:code %)) - (= "COMPONENT" (get-in % [:property "code"]))) - props) - coding (get-in (first for-sodium) [:property "valueCoding"])] - (is (= 1 (count for-sodium))) - (is (= "LP15099-2" (get coding "code"))) - (is (= "Sodium" (get coding "display"))))))) - -(deftest linguistic-variants-as-designations - (let [data (release-data fixture-root {:version "2.82"}) - ling (->> data - (filter #(and (= :concept-designation (:type %)) - (= "2951-2" (:code %)) - (= "de-AT" (:language %))))) - by-use (group-by #(get-in % [:use :code]) ling)] - (testing "German variant rows surface as standalone :concept-designation entries" - (is (seq ling)) - (is (= "Natrium" - (:value (first (get by-use "LinguisticVariantDisplayName")))))))) - -(deftest missing-files-tolerated - (testing "absent MapTo.csv / AnswerList.csv just omit those events" - (let [tmp (doto (java.io.File/createTempFile "loinc-empty" "") - (.delete)) - root (java.io.File. (.getParentFile tmp) "Loinc_0.1")] - (.mkdirs (java.io.File. root "LoincTableCore")) - (let [csv (java.io.File. root "LoincTableCore/LoincTableCore.csv")] - (spit csv (str "\"LOINC_NUM\",\"COMPONENT\",\"PROPERTY\",\"TIME_ASPCT\"," - "\"SYSTEM\",\"SCALE_TYP\",\"METHOD_TYP\",\"CLASS\"," - "\"CLASSTYPE\",\"LONG_COMMON_NAME\",\"SHORTNAME\"," - "\"EXTERNAL_COPYRIGHT_NOTICE\",\"STATUS\"," - "\"VersionFirstReleased\",\"VersionLastChanged\"\n" - "\"X\",\"\",\"\",\"\",\"\",\"\",\"\",\"\",\"\"," - "\"X display\",\"\",\"\",\"ACTIVE\",\"0.1\",\"0.1\"\n"))) - (try - (let [data (release-data (.getPath root))] - (is (= 1 (count (by-type data :codesystem-meta)))) - (is (= 1 (count (by-type data :concept)))) - (is (zero? (count (by-type data :valueset)))) - (is (zero? (count (by-type data :conceptmap))))) - (finally - (doseq [^java.io.File f (reverse (file-seq root))] - (.delete f))))))) diff --git a/test/com/eldrix/hades/impl/mcp_test.clj b/test/com/eldrix/hades/impl/mcp/tools_test.clj similarity index 98% rename from test/com/eldrix/hades/impl/mcp_test.clj rename to test/com/eldrix/hades/impl/mcp/tools_test.clj index e9dfd74..b19c1ed 100644 --- a/test/com/eldrix/hades/impl/mcp_test.clj +++ b/test/com/eldrix/hades/impl/mcp/tools_test.clj @@ -1,8 +1,8 @@ -(ns com.eldrix.hades.impl.mcp-test +(ns com.eldrix.hades.impl.mcp.tools-test (:require [clojure.data.json :as json] [clojure.string :as str] [clojure.test :refer [deftest is testing]] - [com.eldrix.hades.impl.mcp :as mcp])) + [com.eldrix.hades.impl.mcp.tools :as mcp])) (deftest tools-catalogue (let [tools (mcp/tools)] diff --git a/test/com/eldrix/hades/impl/register_test.clj b/test/com/eldrix/hades/impl/register_test.clj index 1375506..cfc75a4 100644 --- a/test/com/eldrix/hades/impl/register_test.clj +++ b/test/com/eldrix/hades/impl/register_test.clj @@ -4,11 +4,11 @@ alias resolution, ConceptMap translation." (:require [clojure.test :refer [deftest is testing]] [com.eldrix.hades.core :as hades] - [com.eldrix.hades.impl.canonical :as canonical] - [com.eldrix.hades.impl.composite :as composite] + [com.eldrix.hades.providers.common.canonical :as canonical] + [com.eldrix.hades.composite :as composite] [com.eldrix.hades.impl.load :as load-fhir] - [com.eldrix.hades.impl.loaders.fhir :as loaders] - [com.eldrix.hades.impl.protocols :as protos])) + [com.eldrix.hades.providers.common.fhir-loader :as loaders] + [com.eldrix.hades.protocols :as protos])) (def ^:private cs-v1 {"resourceType" "CodeSystem" diff --git a/test/com/eldrix/hades/impl/search_test.clj b/test/com/eldrix/hades/impl/search_test.clj index 0319452..1b6eab4 100644 --- a/test/com/eldrix/hades/impl/search_test.clj +++ b/test/com/eldrix/hades/impl/search_test.clj @@ -15,11 +15,11 @@ [clojure.test :refer [deftest is testing]] [com.eldrix.hades.core :as hades] [com.eldrix.hades.fixtures :as fixtures] - [com.eldrix.hades.impl.composite :as composite] + [com.eldrix.hades.composite :as composite] [com.eldrix.hades.impl.load :as load-fhir] - [com.eldrix.hades.impl.loaders.fhir :as loaders] - [com.eldrix.hades.impl.protocols :as protos] - [com.eldrix.hades.impl.protocols.result :as result] + [com.eldrix.hades.providers.common.fhir-loader :as loaders] + [com.eldrix.hades.protocols :as protos] + [com.eldrix.hades.protocols.result :as result] [com.eldrix.hades.impl.wire :as wire]) (:import (java.net URI URLEncoder) (java.net.http HttpClient HttpRequest HttpRequest$BodyPublishers HttpResponse$BodyHandlers) diff --git a/test/com/eldrix/hades/impl/server_test.clj b/test/com/eldrix/hades/impl/server_test.clj index 4703872..0037668 100644 --- a/test/com/eldrix/hades/impl/server_test.clj +++ b/test/com/eldrix/hades/impl/server_test.clj @@ -9,7 +9,7 @@ [clojure.test :refer [deftest is testing use-fixtures]] [com.eldrix.hades.core :as hades] [com.eldrix.hades.fixtures :as fixtures] - [com.eldrix.hades.impl.protocols :as protos])) + [com.eldrix.hades.protocols :as protos])) (def ^:dynamic *svc* nil) (def ^:dynamic *server* nil) @@ -94,6 +94,10 @@ (defn- no-match? [body] (nil? (get-param body "match"))) +(defn- subsumes-outcome-value-code? [expected] + (fn [body] + (= expected (get (get-param body "outcome") "valueCode")))) + (defn- not-parameters-with-empty-outcome? [body] ;; Guards against the regression where $subsumes returns ;; 200 + Parameters with outcome typed as valueString "" / "nil" @@ -260,11 +264,10 @@ :assertions [["result=false" result-false?] ["no match part" no-match?]]}} - {:name "$translate with unknown ConceptMap url returns 404 OperationOutcome" + {:name "$translate with unknown ConceptMap url returns structured failure" :request {:path "/ConceptMap/$translate?url=http://example.com/fake&system=http://snomed.info/sct&code=225983005"} - :expect {:status 404 - :assertions [["body is OperationOutcome" operation-outcome?] - ["issue.code = not-found" (issue-code-equals? "not-found")]]}} + :expect {:status 200 + :assertions [["result=false" result-false?]]}} {:name "unrouted path returns FHIR-shaped 404" :request {:path "/Observation?url=http://example.com" @@ -287,6 +290,13 @@ ["does not say 'No endpoint matches path'" (issue-text-not-matches? #"No endpoint matches path")]]}} + {:name "$subsumes valid response serializes outcome as valueCode" + :request {:path "/CodeSystem/$subsumes?system=http://snomed.info/sct&codeA=64572001&codeB=73211009"} + :expect {:status 200 + :content-type #"application/fhir\+json" + :assertions [["outcome valueCode=subsumes" + (subsumes-outcome-value-code? "subsumes")]]}} + ;; Regression: composite `cs-subsumes` returns nil when the system is ;; unknown; the wire layer then emits a Parameters body with an outcome ;; parameter typed off nil (effectively empty), and the handler wraps diff --git a/test/com/eldrix/hades/impl/sources_test.clj b/test/com/eldrix/hades/impl/sources_test.clj index 6484d3f..e1eef17 100644 --- a/test/com/eldrix/hades/impl/sources_test.clj +++ b/test/com/eldrix/hades/impl/sources_test.clj @@ -4,7 +4,7 @@ [clojure.test :refer [deftest is testing]] [com.eldrix.hades.fixtures :as fixtures] [com.eldrix.hades.impl.sources :as sources] - [com.eldrix.hades.impl.sqlite.db :as db] + [com.eldrix.hades.providers.ftrm.db :as db] [next.jdbc]) (:import (java.io File) (java.nio.file Files) @@ -58,11 +58,12 @@ ;; --------------------------------------------------------------------------- (deftest detects-loinc-fixture - (testing "loinc-fixture has a LoincTableCore.csv marker" + (testing "loinc-fixture has the native required LoincTable/Loinc.csv" (let [files (sources/tx-file-seq "test/resources/loinc-fixture") loinc (entries-by-kind files :loinc)] (is (= 1 (count loinc))) - (is (str/ends-with? (.getPath ^File (:file (first loinc))) "LoincTableCore.csv")) + (is (= "test/resources/loinc-fixture" + (.getPath ^File (:file (first loinc))))) (testing ":dir resolves to the release root" (is (= ["test/resources/loinc-fixture"] (dir-paths files :loinc))))))) @@ -122,9 +123,10 @@ (is (= [] (sources/tx-file-seq missing))))) ;; --------------------------------------------------------------------------- -;; File-level detection: sct2_*.txt anywhere is RF2; LoincTableCore.csv -;; anywhere is LOINC. Layout-agnostic — see the committed fixtures under -;; test/resources/sources/ for the exact tree shapes covered. +;; File-level detection: sct2_*.txt anywhere is RF2. LOINC is +;; directory-level detection based on the native loader's required files. +;; See the committed fixtures under test/resources/sources/ for the exact +;; tree shapes covered. ;; --------------------------------------------------------------------------- (deftest single-rf2-file-anywhere-is-detected @@ -150,19 +152,20 @@ ;; subtrees → three unique parent directories. (is (= 3 (count (dir-paths files :rf2))))))) -(deftest loinc-detected-in-flat-and-nested-layouts - (testing "nested release: :dir is the grandparent of LoincTableCore.csv" +(deftest loinc-detected-from-native-required-files + (testing "release root is recognised by LoincTable/Loinc.csv" (is (= ["test/resources/loinc-fixture"] - (dir-paths (sources/tx-file-seq "test/resources/loinc-fixture") :loinc)))) - (testing "flat release: :dir is the file's parent" - (is (= [(fixture "loinc-flat")] + (dir-paths (sources/tx-file-seq "test/resources/loinc-fixture") :loinc))))) + +(deftest core-only-loinc-layout-is-not-native-importable + (testing "LoincTableCore alone is not enough for the native loader" + (is (= [] (dir-paths (sources/tx-file-seq (fixture "loinc-flat")) :loinc))))) -(deftest finds-mixed-loinc-and-fhir-json-in-one-tree - (testing "LOINC release alongside a fhir-bundles dir" +(deftest finds-fhir-json-in-tree-with-core-only-loinc-files + (testing "core-only LOINC marker is ignored, FHIR resources are still found" (let [files (sources/tx-file-seq (fixture "mixed-loinc-fhir"))] - (is (= [(fixture "mixed-loinc-fhir" "loinc-2.82")] - (dir-paths files :loinc))) + (is (= [] (dir-paths files :loinc))) (is (= [(fixture "mixed-loinc-fhir" "fhir-bundles" "cs.json") (fixture "mixed-loinc-fhir" "fhir-bundles" "vs.json")] (file-paths files :fhir-json)))))) diff --git a/test/com/eldrix/hades/impl/sqlite/loinc_live_test.clj b/test/com/eldrix/hades/impl/sqlite/loinc_live_test.clj deleted file mode 100644 index e589c65..0000000 --- a/test/com/eldrix/hades/impl/sqlite/loinc_live_test.clj +++ /dev/null @@ -1,177 +0,0 @@ -(ns com.eldrix.hades.impl.sqlite.loinc-live-test - "Live integration tests against the pinned LOINC SQLite container. - Tagged `^:live`. Most tests are data-driven via `cases` — one row per - case, dispatched on `:op`. Multi-step / catalogue / setup-coupled - tests keep their own deftest below." - (:require [clojure.test :refer [deftest is testing use-fixtures]] - [com.eldrix.hades.core :as hades] - [com.eldrix.hades.fixtures :as fixtures] - [com.eldrix.hades.impl.composite :as composite] - [com.eldrix.hades.impl.protocols :as protos] - [com.eldrix.hades.impl.sqlite.db :as db] - [com.eldrix.hades.impl.sqlite.provider :as sqlite-provider])) - -(def ^:private loinc-url "http://loinc.org") - -(def ^:dynamic *svc* nil) -(def ^:dynamic *codesystem* nil) -(def ^:dynamic *valueset* nil) -(def ^:dynamic *conceptmap* nil) - -(defn provider-fixture [f] - ;; Open the SQLite providers separately so per-impl tests can call - ;; `protos/cs-expand*` directly. The Hades service is built from - ;; the same providers + a naming-system entry installed idempotently - ;; for the OID resolver test. - (let [{:keys [datasource codesystem valueset conceptmap]} - (sqlite-provider/open-providers fixtures/loinc-db-path)] - (db/add-naming-system! datasource - {:url loinc-url :name "LOINC" :status "active" :kind "codesystem" - :id-type "oid" :value "2.16.840.1.113883.6.1" :preferred true}) - (let [{:keys [naming-system]} (sqlite-provider/open-providers fixtures/loinc-db-path) - svc (composite/from-providers (filterv some? [codesystem valueset conceptmap]) - (cond-> {:closers [#(db/close! datasource)]} - naming-system (assoc :naming-systems [naming-system])))] - (binding [*svc* svc *codesystem* codesystem - *valueset* valueset *conceptmap* conceptmap] - (try (f) (finally (hades/close svc))))))) - -(use-fixtures :once provider-fixture) - -;; --------------------------------------------------------------------------- -;; Predicate helpers — keep the cases table flat -;; --------------------------------------------------------------------------- - -(defn- includes-code? [code] - (fn [{:keys [concepts]}] (some #{code} (map :code concepts)))) - -(defn- top-code? [code] - (fn [{:keys [concepts]}] (= code (-> concepts first :code)))) - -(defn- count>= [n] (fn [{:keys [concepts]}] (>= (count concepts) n))) -(defn- count<= [n] (fn [{:keys [concepts]}] (<= (count concepts) n))) -(defn- count= [n] (fn [{:keys [concepts]}] (= n (count concepts)))) - -(defn- display? [s] (fn [r] (= s (:display r)))) -(defn- result? [v] (fn [r] (= v (:result r)))) -(defn- not-found? [r] (true? (:not-found r))) -(defn- not-found-reason? [reason] (fn [r] (= reason (:not-found-reason r)))) -(defn- issue-details? [code] (fn [r] (= code (-> r :issues first :details-code)))) - -;; --------------------------------------------------------------------------- -;; Dispatch + check -;; --------------------------------------------------------------------------- - -(defn- run-op [op input] - (let [input (assoc input :system loinc-url)] - (case op - :lookup (hades/lookup *svc* input) - :validate-code (hades/validate-code *svc* input) - :search-concepts (protos/cs-expand* *codesystem* input)))) - -(defn- check [{:keys [name op input expect]}] - (testing name - (let [r (run-op op input)] - (doseq [[label pred] expect] - (is (pred r) (str name " — " label)))))) - -;; --------------------------------------------------------------------------- -;; Cases — one row per behaviour. Add new rows here, not new deftests. -;; These cases exercise the internal `cs-expand*` text/filter contract. -;; --------------------------------------------------------------------------- - -(def ^:private cases - [;; --- lookup --- - {:name "lookup: known code → display + code + system" - :op :lookup :input {:code "718-7"} - :expect [["display" (display? "Hemoglobin [Mass/volume] in Blood")] - ["code" #(= :718-7 (:code %))] - ["system" #(= loinc-url (:system %))]]} - - {:name "lookup: unknown code → not-found / unknown-code" - :op :lookup :input {:code "doesnt-exist-xx"} - :expect [["not-found" not-found?] - ["reason" (not-found-reason? :unknown-code)]]} - - ;; --- validate-code --- - {:name "validate-code: valid code → result=true + display" - :op :validate-code :input {:code "2160-0"} - :expect [["result" (result? true)] - ["display" (display? "Creatinine [Mass/volume] in Serum or Plasma")]]} - - {:name "validate-code: wrong display → result=false + invalid-display" - :op :validate-code :input {:code "2160-0" :display "Not the LOINC display"} - :expect [["result" (result? false)] - ["issue" (issue-details? "invalid-display")]]} - - ;; --- search-concepts: display path (spec §1 R1.1(a)) --- - {:name "search-concepts: multi-token display query ranks 718-7 first" - :op :search-concepts :input {:text "Hemoglobin Mass volume Blood" :max-hits 5} - :expect [["count>=1" (count>= 1)] - ["top=718-7" (top-code? "718-7")]]} - - {:name "search-concepts: text + STATUS filter includes 2160-0" - :op :search-concepts - :input {:text "Creatinine Mass volume Serum Plasma" - :filters [{:property "STATUS" :op "=" :value "ACTIVE"}] - :max-hits 5} - :expect [["includes 2160-0" (includes-code? "2160-0")]]} - - ;; --- search-concepts: designation path (spec §3.2 / §4.1 at live scale) --- - {:name "search-concepts: SHORTNAME 'Hgb' → includes 718-7" - :op :search-concepts :input {:text "Hgb" :max-hits 500} - :expect [["includes 718-7" (includes-code? "718-7")]]} - - {:name "search-concepts: SHORTNAME 'HbA1c' → includes 4548-4" - :op :search-concepts :input {:text "HbA1c" :max-hits 500} - :expect [["includes 4548-4" (includes-code? "4548-4")]]} - - {:name "search-concepts: LinguisticVariantDisplayName 'Natrium' → includes 2951-2" - :op :search-concepts :input {:text "Natrium" :max-hits 500} - :expect [["includes 2951-2" (includes-code? "2951-2")]]} - - ;; --- search-concepts: cross-locale RELATEDNAMES2 (spec §4.2) --- - {:name "search-concepts: British 'Haemoglobin' surfaces hemoglobin codes" - :op :search-concepts :input {:text "Haemoglobin" :max-hits 50} - :expect [["count>=1" (count>= 1)] - ["includes 4548-4/718-7" - #(or ((includes-code? "4548-4") %) - ((includes-code? "718-7") %))]]} - - ;; --- search-concepts: axis-only negative guard (spec §4.3) --- - {:name "search-concepts: axis-only 'Massenkonzentration' ≤ 10" - :op :search-concepts :input {:text "Massenkonzentration" :max-hits 1000} - :expect [["count<=10" (count<= 10)]]} - - {:name "search-concepts: axis-only 'Zeitpunkt' ≤ 10" - :op :search-concepts :input {:text "Zeitpunkt" :max-hits 1000} - :expect [["count<=10" (count<= 10)]]} - - ;; --- search-concepts: filter-only path --- - {:name "search-concepts: code = filter → exactly one concept" - :op :search-concepts :input {:filters [{:property "code" :op "=" :value "718-7"}]} - :expect [["count=1" (count= 1)] - ["is 718-7" #(= "718-7" (-> % :concepts first :code))]]}]) - -(deftest ^:live operation-cases - (doseq [c cases] (check c))) - -;; --------------------------------------------------------------------------- -;; Complex / multi-step tests — outside the cases table -;; --------------------------------------------------------------------------- - -(deftest ^:live live-loinc-oid-resolves-via-naming-system - (testing "request with system=urn:oid:... resolves to canonical LOINC URL" - (let [resolved (composite/resolve-canonical - (:naming-systems *svc*) "2.16.840.1.113883.6.1")] - (is (= loinc-url resolved))) - (let [r (hades/lookup *svc* - {:system "2.16.840.1.113883.6.1" :code "718-7"})] - (is (= "Hemoglobin [Mass/volume] in Blood" (:display r))) - (is (= loinc-url (:system r)))))) - -(deftest ^:live live-vs-expand-loinc-answer-list - (testing "$expand on any LOINC AnswerList VS returns concepts" - (let [some-vs (-> (protos/vs-metadata *valueset* {}) first :url) - r (hades/expand *svc* {:url some-vs})] - (is (sequential? (:concepts r)))))) diff --git a/test/com/eldrix/hades/impl/tx_resource_test.clj b/test/com/eldrix/hades/impl/tx_resource_test.clj index d21d88f..edfd5d8 100644 --- a/test/com/eldrix/hades/impl/tx_resource_test.clj +++ b/test/com/eldrix/hades/impl/tx_resource_test.clj @@ -12,9 +12,9 @@ free of pinned-data prerequisites." (:require [clojure.test :refer [deftest is testing use-fixtures]] [com.eldrix.hades.fixtures :as fixtures] - [com.eldrix.hades.impl.composite :as composite] + [com.eldrix.hades.composite :as composite] [com.eldrix.hades.impl.load :as load-fhir] - [com.eldrix.hades.impl.loaders.fhir :as loaders])) + [com.eldrix.hades.providers.common.fhir-loader :as loaders])) ;; --------------------------------------------------------------------------- ;; Fixtures diff --git a/test/com/eldrix/hades/impl/protocol_test.clj b/test/com/eldrix/hades/protocol_test.clj similarity index 97% rename from test/com/eldrix/hades/impl/protocol_test.clj rename to test/com/eldrix/hades/protocol_test.clj index 85aaccb..01d13ff 100644 --- a/test/com/eldrix/hades/impl/protocol_test.clj +++ b/test/com/eldrix/hades/protocol_test.clj @@ -1,4 +1,4 @@ -(ns com.eldrix.hades.impl.protocol-test +(ns com.eldrix.hades.protocol-test "Internal conformance harness for protocol implementations. Exercises protocol impls against the spec'd return contracts in @@ -11,9 +11,9 @@ [clojure.spec.test.alpha :as stest] [clojure.test :refer [deftest is testing use-fixtures]] [com.eldrix.hades.core :as hades] - [com.eldrix.hades.impl.composite :as composite] + [com.eldrix.hades.composite :as composite] [com.eldrix.hades.impl.load :as load-fhir] - [com.eldrix.hades.impl.protocols :as protos])) + [com.eldrix.hades.protocols :as protos])) (stest/instrument) ;; See in_memory_test for rationale: these Hermes fns spec-reject diff --git a/test/com/eldrix/hades/provider_parity_test.clj b/test/com/eldrix/hades/provider_parity_test.clj index d3b97b2..a9f58d6 100644 --- a/test/com/eldrix/hades/provider_parity_test.clj +++ b/test/com/eldrix/hades/provider_parity_test.clj @@ -28,11 +28,11 @@ (:require [clojure.java.io :as io] [clojure.test :refer [deftest is testing use-fixtures]] [com.eldrix.hades.core :as hades] - [com.eldrix.hades.impl.composite :as composite] + [com.eldrix.hades.composite :as composite] [com.eldrix.hades.impl.load :as load-fhir] - [com.eldrix.hades.impl.index.sqlite :as sqlite-index] - [com.eldrix.hades.impl.protocols :as protos] - [com.eldrix.hades.impl.sqlite.provider :as sqlite-provider]) + [com.eldrix.hades.providers.ftrm.provider :as ftrm-provider] + [com.eldrix.hades.providers.ftrm.index :as ftrm-index] + [com.eldrix.hades.protocols :as protos]) (:import (java.io File))) ;; --------------------------------------------------------------------------- @@ -108,7 +108,8 @@ ;; ConceptMap colours → ISO colours. {:type :conceptmap :url cm-url :version "1.0" - :source-uri cs-url :target-uri target-cs + :source-uri "http://example.org/vs/colours-source" + :target-uri "http://example.org/vs/iso-colours-target" :groups [{:source cs-url :target target-cs :elements [{:code "red" :target [{:code "ISO-R" :equivalence "equivalent"}]} {:code "green" :target [{:code "ISO-G" :equivalence "equivalent"}]} @@ -141,10 +142,10 @@ (defn- build-sqlite-providers [data] (let [path (temp-db-path)] - (sqlite-index/build! path data {:loader-type "parity-test"}) - (sqlite-index/index! path) + (ftrm-index/build! path data {:loader-type "parity-test"}) + (ftrm-index/index! path) (let [{:keys [codesystem valueset conceptmap datasource]} - (sqlite-provider/open-providers path) + (ftrm-provider/open-providers path) providers (filterv some? [codesystem valueset conceptmap]) svc (composite/from-providers providers)] {:cs codesystem :vs valueset :cm conceptmap @@ -359,10 +360,41 @@ (testing "code in VS with displayLanguage and matching designation" (check {:code "red" :system cs-url :display "Rouge" :displayLanguage "fr"})) (testing "code in VS with wrong display under displayLanguage" - (check {:code "red" :system cs-url :display "Rojo" :displayLanguage "es"})))) + (check {:code "red" :system cs-url :display "Rojo" :displayLanguage "es"})) + (testing "wrong-case code is rejected for case-sensitive CodeSystem" + (check {:code "RED" :system cs-url})))) + +(deftest parity-code-filters-respect-case-sensitivity + (let [im-svc (get-in @state [:in-mem :svc]) + sq-svc (get-in @state [:sqlite :svc]) + im-ci (composite/find-codesystem im-svc ci-cs-url) + sq-ci (get-in @state [:sqlite :cs]) + im-cs (get-in @state [:in-mem :cs]) + sq-cs (get-in @state [:sqlite :cs])] + (testing "case-insensitive CodeSystem code filter accepts different case" + (let [params {:system ci-cs-url + :filters [{:property "code" :op "=" :value "square"}]} + im-r (normalise-result (protos/cs-expand* im-ci params)) + sq-r (normalise-result (protos/cs-expand* sq-ci params))] + (is (= ["Square"] (mapv :code (:concepts im-r)))) + (is (= (mapv :code (:concepts im-r)) + (mapv :code (:concepts sq-r))) + (diff "cs-expand* case-insensitive code filter" [params] im-r sq-r)))) + (testing "case-sensitive CodeSystem code filter rejects different case" + (let [params {:system cs-url + :filters [{:property "code" :op "=" :value "RED"}]} + im-r (normalise-result (protos/cs-expand* im-cs params)) + sq-r (normalise-result (protos/cs-expand* sq-cs params))] + (is (empty? (:concepts im-r))) + (is (= (mapv :code (:concepts im-r)) + (mapv :code (:concepts sq-r))) + (diff "cs-expand* case-sensitive code filter" [params] im-r sq-r)))))) (deftest parity-cm-translate (let [{{im :cm} :in-mem {sq :cm} :sqlite} @state] + (testing "URL-only translate uses group source systems" + (parity-check "cm-translate" protos/cm-translate im sq + {:url cm-url :code "red"})) (testing "forward translate red → ISO-R" (parity-check "cm-translate" protos/cm-translate im sq {:url cm-url :system cs-url :code "red"})) diff --git a/test/com/eldrix/hades/impl/compose_test.clj b/test/com/eldrix/hades/providers/common/compose_test.clj similarity index 74% rename from test/com/eldrix/hades/impl/compose_test.clj rename to test/com/eldrix/hades/providers/common/compose_test.clj index da21df2..0515343 100644 --- a/test/com/eldrix/hades/impl/compose_test.clj +++ b/test/com/eldrix/hades/providers/common/compose_test.clj @@ -1,12 +1,14 @@ -(ns com.eldrix.hades.impl.compose-test +(ns com.eldrix.hades.providers.common.compose-test (:require [clojure.java.io :as io] [clojure.test :refer [deftest is testing use-fixtures]] [com.eldrix.hades.core :as hades] - [com.eldrix.hades.impl.compose :as compose] - [com.eldrix.hades.impl.composite :as composite] - [com.eldrix.hades.impl.index.sqlite :as sqlite-index] + [com.eldrix.hades.providers.common.compose :as compose] + [com.eldrix.hades.providers.common.vs-validate :as vs-validate] + [com.eldrix.hades.composite :as composite] + [com.eldrix.hades.providers.ftrm.provider :as ftrm-provider] + [com.eldrix.hades.providers.ftrm.index :as ftrm-index] [com.eldrix.hades.impl.load :as load-fhir] - [com.eldrix.hades.impl.sqlite.provider :as sqlite-provider]) + [com.eldrix.hades.protocols :as protos]) (:import (java.io File))) (def test-cs-map @@ -111,12 +113,74 @@ concepts (:concepts (compose/expand-compose *svc* compose {}))] (is (= 5 (count concepts)))))) +(deftest expand-compose-valueset-ref-preserves-filter-test + (testing "filter is still passed to imported ValueSet providers as :filter" + (let [svc (reify protos/ValueSet + (vs-metadata [_ _] [{:url "http://example.com/vs/imported"}]) + (vs-resource [_ _] {:url "http://example.com/vs/imported"}) + (vs-expand [_ _ {:keys [filter]}] + {:url "http://example.com/vs/imported" + :concepts (if filter + [{:system "http://example.com/cs" + :code "A" + :display "Alpha"}] + [{:system "http://example.com/cs" + :code "A" + :display "Alpha"} + {:system "http://example.com/cs" + :code "B" + :display "Beta"}])}) + (vs-validate-code [_ _ _] nil)) + compose {"include" [{"valueSet" ["http://example.com/vs/imported"]}]} + concepts (:concepts (compose/expand-compose svc compose {:filter "alpha"}))] + (is (= ["A"] (mapv :code concepts)))))) + (deftest expand-compose-circular-ref-test (testing "circular reference detection" (let [compose {"include" [{"valueSet" ["http://example.com/circular"]}]}] (is (thrown-with-msg? clojure.lang.ExceptionInfo #"Circular" (compose/expand-compose *svc* compose {:expanding #{"http://example.com/circular"}})))))) +(deftest validate-code-pushes-exact-code-filter-to-match-driven-includes + (testing "large provider-backed includes are validated by indexed code filter, not by scanning a truncated expansion" + (let [seen-queries (atom []) + system "http://example.com/truncated-cs" + target "TARGET" + cs (reify protos/CodeSystem + (cs-metadata [_ _] + [{:url system :version "1.0" :content "complete" :case-sensitive true}]) + (cs-resource [_ _] + {:url system :version "1.0" :content "complete" :case-sensitive true}) + (cs-lookup [_ {:keys [code]}] + (when (= target code) + {:system system :code target :display "Target" :version "1.0"})) + (cs-validate-code [_ {:keys [code]}] + (if (= target code) + {:result true :system system :code target :display "Target" :version "1.0"} + {:result false :system system :code code})) + (cs-subsumes [_ _] nil) + (cs-expand* [_ query] + (swap! seen-queries conj query) + (let [code-filter (some #(when (and (= "code" (:property %)) + (= "=" (:op %))) + (:value %)) + (:filters query))] + {:concepts (if (= target code-filter) + [{:system system :code target :display "Target" :version "1.0"}] + [{:system system :code "A" :display "Alpha" :version "1.0"}])}))) + svc (composite/from-providers [cs]) + result (vs-validate/validate-code + svc + {:url "http://example.com/vs" + :compose {"include" [{"system" system}]}} + {:system system :code target})] + (is (true? (:result result))) + (is (= "Target" (:display result))) + (is (some (fn [query] + (some #(= {:property "code" :op "=" :value target} %) + (:filters query))) + @seen-queries))))) + (deftest expand-compose-include-version-test (let [svc (multi-version-svc)] (testing "include with version selects versioned CodeSystem" @@ -219,7 +283,7 @@ (when (.exists f) (.delete f)))) (defn- build-draft-cs-db [path] - (sqlite-index/build! path + (ftrm-index/build! path [{:type :codesystem-meta :url "http://example.org/cs/draft" :version "1.0" @@ -230,14 +294,14 @@ :system "http://example.org/cs/draft" :version "1.0" :code "x" :display "X"}] {:loader-type "synthetic-draft"}) - (sqlite-index/index! path)) + (ftrm-index/index! path)) (deftest expand-compose-used-codesystem-from-sqlite-test (testing "used-codesystem entry carries status/experimental for SQLite catalogues" (let [path (temp-sqlite-path)] (try (build-draft-cs-db path) - (let [{:keys [codesystem]} (sqlite-provider/open-providers path) + (let [{:keys [codesystem]} (ftrm-provider/open-providers path) svc (composite/from-providers [codesystem]) compose {"include" [{"system" "http://example.org/cs/draft" "version" "1.0"}]} diff --git a/test/com/eldrix/hades/providers/common/display_test.clj b/test/com/eldrix/hades/providers/common/display_test.clj new file mode 100644 index 0000000..4117935 --- /dev/null +++ b/test/com/eldrix/hades/providers/common/display_test.clj @@ -0,0 +1,111 @@ +(ns com.eldrix.hades.providers.common.display-test + "Unit tests for the FHIR designation-use semantics of + `find-display-for-language`. The picker only honours designations + whose `use` is FHIR-standard (`designation-usage` `display`/`synonym`) + or absent; everything else falls through so callers use the + concept's primary `:display`. These tests are intentionally + provider-free so a regression surfaces with a clear stack." + (:require [clojure.test :refer [deftest is testing]] + [com.eldrix.hades.providers.common.display :as display])) + +(def ^:private std-usage "http://terminology.hl7.org/CodeSystem/designation-usage") + +(defn- d + "Build one designation. `lang` may be a string or keyword." + [{:keys [lang value use]}] + (cond-> {:value value} + lang (assoc :language lang) + use (assoc :use use))) + +(defn- ranges + "Parse a Accept-Language style string into the priority-ordered + `{:lang :q}` seq the picker consumes." + [s] + (display/parse-display-language s)) + +(deftest no-use-designation-is-eligible + (testing "writer didn't classify ⇒ treated as a display" + (is (= "Hallo" + (display/find-display-for-language + [(d {:lang "de-DE" :value "Hallo"})] + (ranges "de-DE")))))) + +(deftest fhir-standard-display-eligible + (testing "designation-usage#display is display-eligible" + (is (= "Hallo" + (display/find-display-for-language + [(d {:lang "de-DE" :value "Hallo" + :use {:system std-usage :code "display"}})] + (ranges "de-DE"))))) + (testing "designation-usage#synonym is also eligible" + (is (= "Hallo, Welt" + (display/find-display-for-language + [(d {:lang "de-DE" :value "Hallo, Welt" + :use {:system std-usage :code "synonym"}})] + (ranges "de-DE")))))) + +(deftest terminology-specific-use-not-eligible + (testing "LOINC use is ignored — picker returns nil so caller falls back to primary" + (is (nil? (display/find-display-for-language + [(d {:lang "de-DE" :value "Hämatologie und Zellzählung" + :use {:system "http://loinc.org" :code "CLASS"}}) + (d {:lang "de-DE" :value "Hämoglobin" + :use {:system "http://loinc.org" :code "COMPONENT"}})] + (ranges "de-DE"))))) + (testing "SNOMED description-type ids are ignored" + (is (nil? (display/find-display-for-language + [(d {:lang "de-DE" :value "Diabetes mellitus (Erkrankung)" + :use {:system "http://snomed.info/sct" + :code "900000000000003001"}})] + (ranges "de-DE"))))) + (testing "unrecognised designation-usage code is ignored" + ;; e.g. a hypothetical `#deprecated` slips in + (is (nil? (display/find-display-for-language + [(d {:lang "de-DE" :value "Veraltet" + :use {:system std-usage :code "deprecated"}})] + (ranges "de-DE")))))) + +(deftest eligible-shadows-ineligible + (testing "an eligible designation wins regardless of position in the seq" + (let [designations [(d {:lang "de-DE" :value "AXIS" + :use {:system "http://loinc.org" :code "CLASS"}}) + (d {:lang "de-DE" :value "Hämoglobin in Blut" + :use {:system std-usage :code "display"}}) + (d {:lang "de-DE" :value "MORE AXIS" + :use {:system "http://loinc.org" :code "COMPONENT"}})]] + (is (= "Hämoglobin in Blut" + (display/find-display-for-language designations (ranges "de-DE"))))))) + +(deftest language-priority-honoured + (testing "requested-language order wins over designation-list order" + (let [designations [(d {:lang "en-US" :value "Hello" + :use {:system std-usage :code "display"}}) + (d {:lang "de-DE" :value "Hallo" + :use {:system std-usage :code "display"}})]] + (is (= "Hallo" (display/find-display-for-language designations (ranges "de-DE,en-US")))) + (is (= "Hello" (display/find-display-for-language designations (ranges "en-US,de-DE"))))))) + +(deftest language-prefix-match + (testing "requested `de` matches designation `de-DE`" + (is (= "Hallo" + (display/find-display-for-language + [(d {:lang "de-DE" :value "Hallo" + :use {:system std-usage :code "display"}})] + (ranges "de")))))) + +(deftest language-keyword-and-string + (testing "keyword :de-DE on a designation matches string lang 'de-DE'" + (is (= "Hallo" + (display/find-display-for-language + [(d {:lang :de-DE :value "Hallo" + :use {:system std-usage :code "display"}})] + (ranges "de-DE")))))) + +(deftest first-eligible-language-match-wins + (testing "among eligible language-matched designations, source order decides" + (let [designations [(d {:lang "de-DE" :value "Erste" + :use {:system std-usage :code "display"}}) + (d {:lang "de-DE" :value "Zweite" + :use {:system std-usage :code "synonym"}})]] + (is (= "Erste" + (display/find-display-for-language designations (ranges "de-DE"))))))) diff --git a/test/com/eldrix/hades/impl/loaders/fhir_test.clj b/test/com/eldrix/hades/providers/common/fhir_loader_test.clj similarity index 98% rename from test/com/eldrix/hades/impl/loaders/fhir_test.clj rename to test/com/eldrix/hades/providers/common/fhir_loader_test.clj index 035e8ab..0c594d4 100644 --- a/test/com/eldrix/hades/impl/loaders/fhir_test.clj +++ b/test/com/eldrix/hades/providers/common/fhir_loader_test.clj @@ -1,11 +1,11 @@ -(ns com.eldrix.hades.impl.loaders.fhir-test +(ns com.eldrix.hades.providers.common.fhir-loader-test "Tests for the pure-data FHIR loader. Asserts shape and provenance of `fhir-data` produced from JSON files; verifies skip diagnostics for unsupported / `.index.json` / nested-Bundle entries; verifies hard failures (parse error, oversized file, symlink escape)." (:require [clojure.java.io :as io] [clojure.test :refer [deftest is testing]] - [com.eldrix.hades.impl.loaders.fhir :as loaders]) + [com.eldrix.hades.providers.common.fhir-loader :as loaders]) (:import (java.nio.file Files) (java.nio.file.attribute FileAttribute))) diff --git a/test/com/eldrix/hades/impl/issues_test.clj b/test/com/eldrix/hades/providers/common/issues_test.clj similarity index 95% rename from test/com/eldrix/hades/impl/issues_test.clj rename to test/com/eldrix/hades/providers/common/issues_test.clj index 4a112ea..696d25c 100644 --- a/test/com/eldrix/hades/impl/issues_test.clj +++ b/test/com/eldrix/hades/providers/common/issues_test.clj @@ -1,6 +1,6 @@ -(ns com.eldrix.hades.impl.issues-test +(ns com.eldrix.hades.providers.common.issues-test (:require [clojure.test :refer [deftest is testing]] - [com.eldrix.hades.impl.issues :as issues])) + [com.eldrix.hades.providers.common.issues :as issues])) (def ^:private given "XCode1") (def ^:private system "http://example.org/cs") diff --git a/test/com/eldrix/hades/impl/sqlite/db_test.clj b/test/com/eldrix/hades/providers/ftrm/db_test.clj similarity index 98% rename from test/com/eldrix/hades/impl/sqlite/db_test.clj rename to test/com/eldrix/hades/providers/ftrm/db_test.clj index d9be6e0..98ae93e 100644 --- a/test/com/eldrix/hades/impl/sqlite/db_test.clj +++ b/test/com/eldrix/hades/providers/ftrm/db_test.clj @@ -1,7 +1,7 @@ -(ns com.eldrix.hades.impl.sqlite.db-test +(ns com.eldrix.hades.providers.ftrm.db-test (:require [clojure.java.io :as io] [clojure.test :refer [deftest is testing]] - [com.eldrix.hades.impl.sqlite.db :as db] + [com.eldrix.hades.providers.ftrm.db :as db] [next.jdbc :as jdbc]) (:import (java.io File))) diff --git a/test/com/eldrix/hades/impl/sqlite/provider_test.clj b/test/com/eldrix/hades/providers/ftrm/provider_test.clj similarity index 64% rename from test/com/eldrix/hades/impl/sqlite/provider_test.clj rename to test/com/eldrix/hades/providers/ftrm/provider_test.clj index 235bde9..7330d3e 100644 --- a/test/com/eldrix/hades/impl/sqlite/provider_test.clj +++ b/test/com/eldrix/hades/providers/ftrm/provider_test.clj @@ -1,16 +1,15 @@ -(ns com.eldrix.hades.impl.sqlite.provider-test +(ns com.eldrix.hades.providers.ftrm.provider-test (:require [clojure.java.io :as io] + [clojure.spec.alpha :as s] [clojure.test :refer [deftest is testing]] - [com.eldrix.hades.impl.composite :as composite] - [com.eldrix.hades.impl.index.sqlite :as sqlite-index] - [com.eldrix.hades.impl.loaders.fhir :as loaders-fhir] - [com.eldrix.hades.impl.loaders.loinc :as loinc] - [com.eldrix.hades.impl.protocols :as protos] - [com.eldrix.hades.impl.sqlite.provider :as sqlite-provider]) + [com.eldrix.hades.composite :as composite] + [com.eldrix.hades.protocols :as protos] + [com.eldrix.hades.protocols.result :as result] + [com.eldrix.hades.providers.common.fhir-loader :as loaders-fhir] + [com.eldrix.hades.providers.ftrm.index :as ftrm-index] + [com.eldrix.hades.providers.ftrm.provider :as ftrm-provider]) (:import (java.io File))) -(def fixture-root "test/resources/loinc-fixture") - (defn- new-temp-path [] (let [^File f (File/createTempFile "hades-provider-test" ".db")] (.delete f) @@ -20,176 +19,11 @@ (let [^File f (io/file path)] (when (.exists f) (.delete f)))) -(defn- build-fixture-db [path] - (sqlite-index/import-fhir-data path - (loinc/stream-release fixture-root {:version "2.82"}) - {:loader-type "loinc-csv"}) - (sqlite-index/index! path)) - -(deftest providers-enumerate-from-fixture - (let [path (new-temp-path)] - (try - (build-fixture-db path) - (let [{:keys [codesystem valueset conceptmap]} - (sqlite-provider/open-providers path)] - (testing "one catalogue impl per resource type" - (is (some? codesystem)) - (is (some? valueset)) - (is (some? conceptmap))) - (testing "cs-metadata enumerates CodeSystems" - (let [meta (vec (protos/cs-metadata codesystem {}))] - (is (= 1 (count meta))) - (is (= "http://loinc.org" (:url (first meta)))) - (is (= "2.82" (:version (first meta)))))) - (testing "vs-metadata enumerates ValueSets" - (is (= 2 (count (vec (protos/vs-metadata valueset {})))))) - (testing "cm-metadata enumerates ConceptMaps" - (is (= 1 (count (vec (protos/cm-metadata conceptmap {}))))))) - (finally (delete-quietly path))))) - -(deftest cs-lookup-and-validate - (let [path (new-temp-path)] - (try - (build-fixture-db path) - (let [{:keys [codesystem]} (sqlite-provider/open-providers path)] - (testing "cs-lookup hits a known code" - (let [r (protos/cs-lookup codesystem - {:system "http://loinc.org" :code "718-7"})] - (is (some? r)) - (is (= "Hemoglobin [Mass/volume] in Blood" (:display r))) - (is (= :718-7 (:code r))) - (let [props (->> (:properties r) - (filter #(= :STATUS (:code %))) - first)] - (is (= :ACTIVE (:value props)))))) - (testing "cs-lookup returns a not-found map for an unknown code" - (let [r (protos/cs-lookup codesystem - {:system "http://loinc.org" :code "doesnt-exist"})] - (is (true? (:not-found r))) - (is (= :unknown-code (:not-found-reason r))))) - (testing "cs-validate-code green" - (let [r (protos/cs-validate-code codesystem - {:system "http://loinc.org" :code "2160-0"})] - (is (true? (:result r))) - (is (= "Creatinine [Mass/volume] in Serum or Plasma" (:display r))))) - (testing "cs-validate-code red on unknown" - (let [r (protos/cs-validate-code codesystem - {:system "http://loinc.org" :code "999-X"})] - (is (false? (:result r))) - (is (= "code-invalid" (-> r :issues first :type)))))) - (finally (delete-quietly path))))) - -(deftest cs-expand*-text-search - (let [path (new-temp-path)] - (try - (build-fixture-db path) - (let [{:keys [codesystem]} (sqlite-provider/open-providers path)] - (testing "FTS text query matches display" - (let [r (protos/cs-expand* codesystem - {:system "http://loinc.org" :text "Hemoglobin"}) - codes (set (map :code (:concepts r)))] - (is (contains? codes "718-7")) - (is (contains? codes "4548-4")) - (is (not (contains? codes "2160-0"))))) - (testing "FTS tokens are AND-ed" - (let [r (protos/cs-expand* codesystem - {:system "http://loinc.org" :text "Creatinine Serum"}) - codes (set (map :code (:concepts r)))] - (is (contains? codes "2160-0")) - (is (not (contains? codes "718-7"))))) - (testing "blank text returns whole CodeSystem (subject to active-only)" - (let [r (protos/cs-expand* codesystem - {:system "http://loinc.org" :text ""})] - (is (>= (count (:concepts r)) 8))))) - (finally (delete-quietly path))))) - -(deftest cs-expand*-searches-designations - ;; Search-concepts contract: text matching includes display/designations. - ;; designations whose use.code is on the searchable allowlist (LOINC - ;; SHORTNAME, RELATEDNAMES2, LinguisticVariantDisplayName, COMPONENT, - ;; LONG_COMMON_NAME), not just the primary display. - (let [path (new-temp-path)] - (try - (build-fixture-db path) - (let [{:keys [codesystem]} (sqlite-provider/open-providers path)] - (testing "matches a SHORTNAME token absent from primary display (Hgb → 718-7)" - (let [r (protos/cs-expand* codesystem - {:system "http://loinc.org" :text "Hgb"}) - codes (set (map :code (:concepts r)))] - (is (contains? codes "718-7") - "718-7 has SHORTNAME 'Hgb Bld'; query 'Hgb' is absent from LONG_COMMON_NAME"))) - (testing "matches a SHORTNAME token absent from primary display (HbA1c → 4548-4)" - (let [r (protos/cs-expand* codesystem - {:system "http://loinc.org" :text "HbA1c"}) - codes (set (map :code (:concepts r)))] - (is (contains? codes "4548-4") - "4548-4 has SHORTNAME 'HbA1c MFr Bld HPLC'; query 'HbA1c' is absent from LONG_COMMON_NAME"))) - (testing "matches a LinguisticVariantDisplayName (Natrium → 2951-2)" - (let [r (protos/cs-expand* codesystem - {:system "http://loinc.org" :text "Natrium"}) - codes (set (map :code (:concepts r)))] - (is (contains? codes "2951-2") - "2951-2 (Sodium) has de-AT LinguisticVariantDisplayName='Natrium'; absent from English display")))) - (finally (delete-quietly path))))) - -(deftest cs-expand*-filters - (let [path (new-temp-path)] - (try - (build-fixture-db path) - (let [{:keys [codesystem]} (sqlite-provider/open-providers path)] - (testing "= on a property" - (let [r (protos/cs-expand* codesystem - {:system "http://loinc.org" - :filters [{:property "CLASS" :op "=" :value "CHEM"}]}) - codes (set (map :code (:concepts r)))] - (is (contains? codes "2160-0")) - (is (contains? codes "2345-7")) - (is (not (contains? codes "718-7"))))) - (testing "in on a property" - (let [r (protos/cs-expand* codesystem - {:system "http://loinc.org" - :filters [{:property "CLASS" :op "in" :value "CHEM,HEM/BC"}]}) - codes (set (map :code (:concepts r)))] - (is (contains? codes "2160-0")) - (is (contains? codes "718-7")))) - (testing "exists on a property" - (let [r (protos/cs-expand* codesystem - {:system "http://loinc.org" - :filters [{:property "STATUS" :op "exists" :value "true"}]})] - (is (pos? (count (:concepts r)))))) - (testing "= on c.code direct column" - (let [r (protos/cs-expand* codesystem - {:system "http://loinc.org" - :filters [{:property "code" :op "=" :value "718-7"}]})] - (is (= 1 (count (:concepts r)))) - (is (= "718-7" (:code (first (:concepts r))))))) - (testing "max-hits caps results" - (let [r (protos/cs-expand* codesystem - {:system "http://loinc.org" :max-hits 2})] - (is (= 2 (count (:concepts r)))))) - (testing "unknown system → empty" - (let [r (protos/cs-expand* codesystem - {:system "http://nope.example/cs" :text "hemoglobin"})] - (is (= [] (:concepts r)))))) - (finally (delete-quietly path))))) - -(deftest cs-expand*-active-only-and-text - (let [path (new-temp-path)] - (try - (build-fixture-db path) - (let [{:keys [codesystem]} (sqlite-provider/open-providers path)] - (testing "text + filter combine (LOINC fixture has DEPRECATED row 1009-0)" - (let [r (protos/cs-expand* codesystem - {:system "http://loinc.org" - :text "antiglobulin"}) - codes (set (map :code (:concepts r)))] - (is (contains? codes "1009-0"))))) - (finally (delete-quietly path))))) (defn- build-multilang-db [path] ;; Synthetic CodeSystem with English/French/Welsh designations on one ;; concept and English-only on another, for displayLanguage tests. - (sqlite-index/build! path + (ftrm-index/build! path [{:type :codesystem-meta :url "http://example.org/cs/colours" :version "1.0" @@ -208,13 +42,13 @@ :code "blue" :display "Blue" :designations [{:value "Blue" :language :en}]}] {:loader-type "synthetic-multilang"}) - (sqlite-index/index! path)) + (ftrm-index/index! path)) (deftest cs-lookup-respects-displayLanguage (let [path (new-temp-path)] (try (build-multilang-db path) - (let [{:keys [codesystem]} (sqlite-provider/open-providers path)] + (let [{:keys [codesystem]} (ftrm-provider/open-providers path)] (testing "displayLanguage selects matching designation as display" (let [r (protos/cs-lookup codesystem {:system "http://example.org/cs/colours" :code "red" @@ -236,8 +70,19 @@ (is (= "Coch" (:display r)))))) (finally (delete-quietly path))))) +(deftest cs-expand*-supports-code-eq-filter + (let [path (new-temp-path)] + (try + (build-multilang-db path) + (let [{:keys [codesystem]} (ftrm-provider/open-providers path) + r (protos/cs-expand* codesystem + {:system "http://example.org/cs/colours" + :filters [{:property "code" :op "=" :value "red"}]})] + (is (= ["red"] (mapv :code (:concepts r))))) + (finally (delete-quietly path))))) + (defn- build-case-insensitive-db [path] - (sqlite-index/build! path + (ftrm-index/build! path [{:type :codesystem-meta :url "http://example.org/cs/ci" :version "1.0" @@ -248,10 +93,10 @@ :system "http://example.org/cs/ci" :version "1.0" :code "FOO" :display "Foo"}] {:loader-type "synthetic-ci"}) - (sqlite-index/index! path)) + (ftrm-index/index! path)) (defn- build-case-sensitive-db [path] - (sqlite-index/build! path + (ftrm-index/build! path [{:type :codesystem-meta :url "http://example.org/cs/cs" :version "1.0" @@ -262,13 +107,13 @@ :system "http://example.org/cs/cs" :version "1.0" :code "FOO" :display "Foo"}] {:loader-type "synthetic-cs"}) - (sqlite-index/index! path)) + (ftrm-index/index! path)) (deftest cs-lookup-respects-case-sensitivity (let [path (new-temp-path)] (try (build-case-insensitive-db path) - (let [{:keys [codesystem]} (sqlite-provider/open-providers path)] + (let [{:keys [codesystem]} (ftrm-provider/open-providers path)] (testing "case-insensitive CS resolves a different-case code" (let [r (protos/cs-lookup codesystem {:system "http://example.org/cs/ci" :code "foo"})] @@ -282,7 +127,7 @@ (let [path (new-temp-path)] (try (build-case-sensitive-db path) - (let [{:keys [codesystem]} (sqlite-provider/open-providers path)] + (let [{:keys [codesystem]} (ftrm-provider/open-providers path)] (testing "case-sensitive CS rejects different-case code" (is (= :unknown-code (:not-found-reason @@ -291,13 +136,29 @@ (testing "exact case works" (is (some? (protos/cs-lookup codesystem {:system "http://example.org/cs/cs" :code "FOO"}))))) + (finally (delete-quietly path))))) + +(deftest cs-metadata-advertises-case-sensitivity + (let [path (new-temp-path)] + (try + (build-case-insensitive-db path) + (let [{:keys [codesystem]} (ftrm-provider/open-providers path) + meta (first (protos/cs-metadata codesystem {:url "http://example.org/cs/ci"}))] + (is (= false (:case-sensitive meta)))) + (finally (delete-quietly path)))) + (let [path (new-temp-path)] + (try + (build-case-sensitive-db path) + (let [{:keys [codesystem]} (ftrm-provider/open-providers path) + meta (first (protos/cs-metadata codesystem {:url "http://example.org/cs/cs"}))] + (is (= true (:case-sensitive meta)))) (finally (delete-quietly path))))) (deftest cs-validate-code-case-insensitive-info-issue (let [path (new-temp-path)] (try (build-case-insensitive-db path) - (let [{:keys [codesystem]} (sqlite-provider/open-providers path)] + (let [{:keys [codesystem]} (ftrm-provider/open-providers path)] (testing "wrong-case code validates and surfaces a code-rule info issue" (let [r (protos/cs-validate-code codesystem {:system "http://example.org/cs/ci" :code "foo"})] @@ -317,7 +178,7 @@ (let [path (new-temp-path)] (try (build-multilang-db path) - (let [{:keys [codesystem]} (sqlite-provider/open-providers path)] + (let [{:keys [codesystem]} (ftrm-provider/open-providers path)] (testing "language-tagged designation is accepted as valid display" (let [r (protos/cs-validate-code codesystem {:system "http://example.org/cs/colours" :code "red" @@ -337,24 +198,6 @@ (is (true? (:result r)))))) (finally (delete-quietly path))))) -(deftest cm-translate-against-loinc-mapto - (let [path (new-temp-path)] - (try - (build-fixture-db path) - (let [{:keys [conceptmap]} (sqlite-provider/open-providers path) - cm-url (-> (protos/cm-metadata conceptmap {}) first :url) - result (protos/cm-translate conceptmap - {:url cm-url - :code "1009-0" - :system "http://loinc.org"})] - (is (true? (:result result))) - (is (= 2 (count (:matches result)))) - (let [first-match (first (:matches result))] - (is (= "http://loinc.org" (:system first-match))) - (is (= "1007-4" (:code first-match))) - (is (= "equivalent" (:equivalence first-match))))) - (finally (delete-quietly path))))) - ;; --------------------------------------------------------------------------- ;; Multi-version bare-URL selection — healthcare safety contract. ;; @@ -381,10 +224,10 @@ versions)) (defn- build-versions-db [path url versions] - (sqlite-index/build! path + (ftrm-index/build! path (multi-version-fhir-data url versions) {:loader-type "synthetic-multi-version"}) - (sqlite-index/index! path)) + (ftrm-index/index! path)) (deftest cs-lookup-bare-url-picks-latest-semver (testing "Healthcare safety: with multiple versions in one container, a bare-URL $lookup MUST return the latest SemVer version. Currently fails — provider's lookup-entry falls through to (some …) over a hash-map, yielding whichever entry the iterator hits first regardless of version. Tested with several version sets so the bug is exposed regardless of incidental hash order." @@ -397,7 +240,7 @@ (let [path (new-temp-path)] (try (build-versions-db path url versions) - (let [{:keys [codesystem]} (sqlite-provider/open-providers path) + (let [{:keys [codesystem]} (ftrm-provider/open-providers path) r (protos/cs-lookup codesystem {:system url :code "C1"})] (is (= expected (:version r)) (str "for " url " with versions " (vec versions) @@ -448,17 +291,17 @@ "display" "Echo"}]}}) (defn- build-baked-vs-db [path] - (sqlite-index/build! path + (ftrm-index/build! path (loaders-fhir/resource->fhir-data baked-vs-fhir-map :tx-resource) {:loader-type "synthetic-baked"}) - (sqlite-index/index! path)) + (ftrm-index/index! path)) (deftest expansion-only-vs-survives-sqlite-roundtrip (testing "synthesised compose for an expansion-only ValueSet survives SQLite round-trip" (let [path (new-temp-path)] (try (build-baked-vs-db path) - (let [{:keys [valueset]} (sqlite-provider/open-providers path) + (let [{:keys [valueset]} (ftrm-provider/open-providers path) r (protos/vs-resource valueset {:url "http://example.com/baked-vs" :version "1.0"}) compose (:compose r) @@ -474,7 +317,7 @@ (let [path (new-temp-path)] (try (build-baked-vs-db path) - (let [{:keys [valueset]} (sqlite-provider/open-providers path) + (let [{:keys [valueset]} (ftrm-provider/open-providers path) svc (composite/from-providers [valueset]) {:keys [concepts total]} (protos/vs-expand valueset svc {:url "http://example.com/baked-vs" @@ -491,7 +334,7 @@ (let [path (new-temp-path)] (try (build-baked-vs-db path) - (let [{:keys [valueset]} (sqlite-provider/open-providers path) + (let [{:keys [valueset]} (ftrm-provider/open-providers path) svc (composite/from-providers [valueset]) {:keys [concepts total]} (protos/vs-expand valueset svc {:url "http://example.com/baked-vs" @@ -507,7 +350,7 @@ (let [path (new-temp-path)] (try (build-baked-vs-db path) - (let [{:keys [valueset]} (sqlite-provider/open-providers path) + (let [{:keys [valueset]} (ftrm-provider/open-providers path) svc (composite/from-providers [valueset]) {:keys [concepts]} (protos/vs-expand valueset svc {:url "http://example.com/baked-vs" @@ -534,7 +377,7 @@ is its own transaction; calling repeatedly on the same path applies the upsert semantics under test." [path content concepts loader-tag] - (sqlite-index/build! path + (ftrm-index/build! path (into [{:type :codesystem-meta :url dup-cs-url :version "1.0" @@ -551,7 +394,7 @@ {:loader-type loader-tag})) (defn- meta-content-from-sqlite [path] - (-> (sqlite-provider/open-providers path) + (-> (ftrm-provider/open-providers path) :codesystem (protos/cs-metadata {}) first @@ -564,8 +407,8 @@ (try (write-cs-rows! path "not-present" [] "stub-first") (write-cs-rows! path "complete" [{:code "A" :display "Alpha"}] "complete-second") - (sqlite-index/index! path) - (let [{:keys [codesystem]} (sqlite-provider/open-providers path)] + (ftrm-index/index! path) + (let [{:keys [codesystem]} (ftrm-provider/open-providers path)] (is (= "complete" (meta-content-from-sqlite path))) (is (= "Alpha" (:display (protos/cs-lookup codesystem {:system dup-cs-url :code "A"}))))) @@ -580,8 +423,8 @@ (try (write-cs-rows! path "complete" [{:code "A" :display "Alpha"}] "complete-first") (write-cs-rows! path "not-present" [] "stub-second") - (sqlite-index/index! path) - (let [{:keys [codesystem]} (sqlite-provider/open-providers path)] + (ftrm-index/index! path) + (let [{:keys [codesystem]} (ftrm-provider/open-providers path)] (is (= "complete" (meta-content-from-sqlite path)) "non-stub meta must survive a later stub upsert") (is (= "Alpha" (:display (protos/cs-lookup codesystem @@ -600,8 +443,8 @@ (write-cs-rows! path "complete" [{:code "A" :display "Alpha-2"} {:code "C" :display "Charlie"}] "complete-second") - (sqlite-index/index! path) - (let [{:keys [codesystem]} (sqlite-provider/open-providers path)] + (ftrm-index/index! path) + (let [{:keys [codesystem]} (ftrm-provider/open-providers path)] (is (= "complete" (meta-content-from-sqlite path))) (is (= "Alpha-2" (:display (protos/cs-lookup codesystem {:system dup-cs-url :code "A"})))) @@ -610,3 +453,85 @@ (is (= "Charlie" (:display (protos/cs-lookup codesystem {:system dup-cs-url :code "C"}))))) (finally (delete-quietly path)))))) + +;; --------------------------------------------------------------------------- +;; Unknown-system / unknown-code contract +;; --------------------------------------------------------------------------- + +(defn- build-basic-db [path] + (ftrm-index/build! path + [{:type :codesystem-meta + :url "http://example.org/cs/basic" :version "1.0" + :status "active" :content "complete"} + {:type :concept + :system "http://example.org/cs/basic" :version "1.0" + :code "a" :display "A"} + {:type :concept + :system "http://example.org/cs/basic" :version "1.0" + :code "b" :display "B"}] + {:loader-type "synthetic-basic"}) + (ftrm-index/index! path)) + +(defn- build-supplement-db [path] + (ftrm-index/build! path + [{:type :codesystem-meta + :url "http://example.org/cs/supp" :version "1.0" + :status "active" :content "supplement" + :supplements-target "http://example.org/cs/base|1.0"} + {:type :concept + :system "http://example.org/cs/supp" :version "1.0" + :code "x" :display "X"}] + {:loader-type "synthetic-supplement"}) + (ftrm-index/index! path)) + +(deftest cs-metadata-surfaces-supplements + (let [path (new-temp-path)] + (try + (build-supplement-db path) + (let [{:keys [codesystem]} (ftrm-provider/open-providers path) + entry (->> (protos/cs-metadata codesystem nil) + (filter #(= "http://example.org/cs/supp" (:url %))) + first)] + (is (= "supplement" (:content entry))) + (is (= "http://example.org/cs/base|1.0" (:supplements entry)))) + (finally (delete-quietly path))))) + +(deftest cs-subsumes-unknown-system-signals-error + (let [path (new-temp-path)] + (try + (build-basic-db path) + (let [{:keys [codesystem]} (ftrm-provider/open-providers path) + r (protos/cs-subsumes codesystem + {:systemA "http://example.org/cs/nope" + :systemB "http://example.org/cs/nope" + :codeA "a" :codeB "b"})] + (is (not= "not-subsumed" (:outcome r))) + (is (or (:x-unknown-system r) + (= :unknown-system (:not-found-reason r)) + (seq (:issues r))))) + (finally (delete-quietly path))))) + +(deftest cs-subsumes-requires-codes-to-exist + (let [path (new-temp-path)] + (try + (build-basic-db path) + (let [{:keys [codesystem]} (ftrm-provider/open-providers path) + r (protos/cs-subsumes codesystem + {:systemA "http://example.org/cs/basic" + :systemB "http://example.org/cs/basic" + :version "1.0" + :codeA "bogus" :codeB "bogus"})] + (is (not= "equivalent" (:outcome r)))) + (finally (delete-quietly path))))) + +(deftest cs-validate-code-unknown-system-shape + (let [path (new-temp-path)] + (try + (build-basic-db path) + (let [{:keys [codesystem]} (ftrm-provider/open-providers path) + r (protos/cs-validate-code codesystem + {:system "http://example.org/cs/nope" + :code "a"})] + (is (s/valid? ::result/validate r) (s/explain-str ::result/validate r)) + (is (or (:x-unknown-system r) (true? (:not-found r))))) + (finally (delete-quietly path))))) diff --git a/test/com/eldrix/hades/impl/in_memory_test.clj b/test/com/eldrix/hades/providers/in_memory/provider_test.clj similarity index 97% rename from test/com/eldrix/hades/impl/in_memory_test.clj rename to test/com/eldrix/hades/providers/in_memory/provider_test.clj index 8ff9491..c44e05d 100644 --- a/test/com/eldrix/hades/impl/in_memory_test.clj +++ b/test/com/eldrix/hades/providers/in_memory/provider_test.clj @@ -1,14 +1,14 @@ -(ns com.eldrix.hades.impl.in-memory-test +(ns com.eldrix.hades.providers.in-memory.provider-test "Provider-level tests for in-memory CodeSystem, ValueSet, and ConceptMap built via `load-fhir/from-fhir`." (:require [clojure.spec.test.alpha :as stest] [clojure.string :as str] [clojure.test :refer [deftest is testing use-fixtures]] [com.eldrix.hades.core :as hades] - [com.eldrix.hades.impl.composite :as composite] + [com.eldrix.hades.composite :as composite] [com.eldrix.hades.impl.load :as load-fhir] - [com.eldrix.hades.impl.protocols :as protos] - [com.eldrix.hades.impl.supplement :as supplement])) + [com.eldrix.hades.protocols :as protos] + [com.eldrix.hades.providers.common.supplement :as supplement])) (stest/instrument) ;; Hermes' specs reject malformed SCT ids (zero, negative, Verhoeff @@ -265,6 +265,12 @@ (defn- search-concepts [impl query] (:concepts (protos/cs-expand* impl query))) +(deftest cs-expand*-supports-code-eq-filter + (let [concepts (search-concepts hier-cs + {:system "http://example.com/test-cs" + :filters [{:property "code" :op "=" :value "B"}]})] + (is (= ["B"] (mapv :code concepts))))) + (deftest cs-expand*-test (testing "nil filters returns all concepts" (let [result (search-concepts hier-cs {:system "http://example.com/test-cs"})] diff --git a/test/com/eldrix/hades/providers/loinc/import_test.clj b/test/com/eldrix/hades/providers/loinc/import_test.clj new file mode 100644 index 0000000..85d22f6 --- /dev/null +++ b/test/com/eldrix/hades/providers/loinc/import_test.clj @@ -0,0 +1,41 @@ +(ns com.eldrix.hades.providers.loinc.import-test + (:require [clojure.java.io :as io] + [clojure.test :refer [deftest is]] + [com.eldrix.hades.providers.loinc.import :as loinc-import] + [com.eldrix.hades.providers.loinc.store :as store] + [next.jdbc :as jdbc] + [next.jdbc.plan :as plan]) + (:import (java.io File))) + +(def fixture-root "test/resources/loinc-fixture") + +(defn- temp-db-path [] + (let [^File f (File/createTempFile "hades-loinc-import-test" ".db")] + (.delete f) + (.getPath f))) + +(defn- delete-quietly [^String path] + (let [^File f (io/file path)] + (when (.exists f) (.delete f)))) + +(deftest import-release-upserts-rows-and-stamps-metadata + (let [path (temp-db-path)] + (try + (loinc-import/import-release! path fixture-root {:batch-size 7}) + (loinc-import/import-release! path fixture-root {:batch-size 7}) + (let [ds (store/open path)] + (try + (with-open [conn (jdbc/get-connection ds)] + (is (= "2.74" + (plan/select-one! conn :value + ["SELECT value FROM meta WHERE key = 'loinc_version'"]))) + (is (= 1 + (plan/select-one! conn :count + ["SELECT COUNT(*) AS count FROM loinc"]))) + (is (= 21 + (plan/select-one! conn :count + ["SELECT COUNT(*) AS count FROM linguistic_variant_row"])))) + (finally + (store/close! ds)))) + (finally + (delete-quietly path))))) diff --git a/test/com/eldrix/hades/providers/loinc/index_test.clj b/test/com/eldrix/hades/providers/loinc/index_test.clj new file mode 100644 index 0000000..3b07f47 --- /dev/null +++ b/test/com/eldrix/hades/providers/loinc/index_test.clj @@ -0,0 +1,67 @@ +(ns com.eldrix.hades.providers.loinc.index-test + (:require [clojure.java.io :as io] + [clojure.test :refer [deftest is]] + [com.eldrix.hades.providers.loinc.import :as loinc-import] + [com.eldrix.hades.providers.loinc.index :as loinc-index] + [com.eldrix.hades.providers.loinc.store :as store] + [next.jdbc :as jdbc] + [next.jdbc.plan :as plan]) + (:import (java.io File))) + +(def fixture-root "test/resources/loinc-fixture") + +(defn- temp-db-path [] + (let [^File f (File/createTempFile "hades-loinc-index-test" ".db")] + (.delete f) + (.getPath f))) + +(defn- delete-quietly [^String path] + (let [^File f (io/file path)] + (when (.exists f) (.delete f)))) + +(deftest rebuilds-loinc-fts-index + (let [path (temp-db-path)] + (try + (loinc-import/import-release! path fixture-root {:batch-size 7}) + (loinc-index/index! path) + (let [ds (store/open path)] + (try + (with-open [conn (jdbc/get-connection ds)] + (is (= "100000-9" + (plan/select-one! + conn + :loinc_num + ["SELECT l.loinc_num + FROM loinc_fts f + JOIN loinc l ON l.rowid = f.rowid + WHERE loinc_fts MATCH 'informatics' + LIMIT 1"]))) + (is (= "14394-1" + (plan/select-one! + conn + :loinc_num + ["SELECT loinc_num + FROM loinc_variant_fts + WHERE loinc_variant_fts MATCH 'Harnstoff' + LIMIT 1"]))) + (is (= {:loinc_num "33512-5" + :variant_id "28" + :iso_language "es" + :iso_country "MX"} + (plan/select-one! + conn + [:loinc_num :variant_id :iso_language :iso_country] + ["SELECT loinc_num, variant_id, iso_language, iso_country + FROM loinc_variant_fts + WHERE loinc_variant_fts MATCH 'Punto' + AND iso_language = 'es' + ORDER BY CASE + WHEN iso_language = 'es' AND iso_country = 'MX' THEN 0 + WHEN iso_language = 'es' THEN 1 + ELSE 2 + END + LIMIT 1"])))) + (finally + (store/close! ds)))) + (finally + (delete-quietly path))))) diff --git a/test/com/eldrix/hades/providers/loinc/live_test.clj b/test/com/eldrix/hades/providers/loinc/live_test.clj new file mode 100644 index 0000000..f78443e --- /dev/null +++ b/test/com/eldrix/hades/providers/loinc/live_test.clj @@ -0,0 +1,268 @@ +(ns com.eldrix.hades.providers.loinc.live-test + "Live integration tests against the pinned native LOINC database." + (:require [clojure.test :refer [deftest is testing use-fixtures]] + [com.eldrix.hades.composite :as composite] + [com.eldrix.hades.core :as hades] + [com.eldrix.hades.fixtures :as fixtures] + [com.eldrix.hades.protocols :as protos])) + +(def ^:private loinc-url "http://loinc.org") + +(def ^:dynamic *svc* nil) + +(defn provider-fixture [f] + (with-open [svc (hades/open [fixtures/loinc-db-path])] + (binding [*svc* svc] + (f)))) + +(use-fixtures :once provider-fixture) + +(defn- includes-code? [code] + (fn [{:keys [concepts]}] (some #{code} (map :code concepts)))) + +(defn- top-code? [code] + (fn [{:keys [concepts]}] (= code (some-> concepts first :code)))) + +(defn- count>= [n] (fn [{:keys [concepts]}] (>= (count concepts) n))) +(defn- count<= [n] (fn [{:keys [concepts]}] (<= (count concepts) n))) +(defn- count= [n] (fn [{:keys [concepts]}] (= n (count concepts)))) + +(defn- total= [n] (fn [r] (= n (:total r)))) + +(defn- display? [s] (fn [r] (= s (:display r)))) +(defn- result? [v] (fn [r] (= v (:result r)))) +(defn- not-found? [r] (true? (:not-found r))) +(defn- not-found-reason? [reason] (fn [r] (= reason (:not-found-reason r)))) +(defn- issue-details? [code] (fn [r] (= code (-> r :issues first :details-code)))) +(defn- match-code? [code] (fn [r] (some #(= code (:code %)) (:matches r)))) + +(defn- vs-listed? [url] + (fn [m] (boolean (some #(= url (:url %)) (:valuesets m))))) + +(defn- vs-url-matching? [re] + (fn [m] (boolean (some #(re-find re (str (:url %))) (:valuesets m))))) + +(defn- equals? [v] (fn [r] (= v r))) + +(defn- run-op [op input] + (let [input (assoc input :system loinc-url)] + (case op + :lookup (hades/lookup *svc* input) + :validate-code (hades/validate-code *svc* input) + :search-concepts (protos/cs-expand* *svc* input) + :expand (hades/expand *svc* input) + :translate (hades/translate *svc* input) + :metadata (hades/metadata *svc*) + :resolve-canonical (composite/resolve-canonical (:naming-systems *svc*) (:id input))))) + +(defn- check [{:keys [name op input expect]}] + (testing name + (let [r (run-op op input)] + (doseq [[label pred] expect] + (is (pred r) (str name " - " label)))))) + +(def ^:private cases + [{:name "lookup: known code -> display + code + system" + :op :lookup :input {:code "718-7"} + :expect [["display" (display? "Hemoglobin [Mass/volume] in Blood")] + ["code" #(= "718-7" (:code %))] + ["system" #(= loinc-url (:system %))]]} + + {:name "lookup: unknown code -> not-found / unknown-code" + :op :lookup :input {:code "doesnt-exist-xx"} + :expect [["not-found" not-found?] + ["reason" (not-found-reason? :unknown-code)]]} + + {:name "validate-code: valid code -> result=true + display" + :op :validate-code :input {:code "2160-0"} + :expect [["result" (result? true)] + ["display" (display? "Creatinine [Mass/volume] in Serum or Plasma")]]} + + {:name "validate-code: wrong display -> result=false + invalid-display" + :op :validate-code :input {:code "2160-0" :display "Not the LOINC display"} + :expect [["result" (result? false)] + ["issue" (issue-details? "invalid-display")]]} + + {:name "search-concepts: multi-token display query ranks 718-7 first" + :op :search-concepts :input {:text "Hemoglobin Mass volume Blood" :max-hits 5} + :expect [["count>=1" (count>= 1)] + ["top=718-7" (top-code? "718-7")]]} + + {:name "search-concepts: text + STATUS filter includes 2160-0" + :op :search-concepts + :input {:text "Creatinine Mass volume Serum Plasma" + :filters [{:property "STATUS" :op "=" :value "ACTIVE"}] + :max-hits 5} + :expect [["includes 2160-0" (includes-code? "2160-0")]]} + + {:name "search-concepts: SHORTNAME 'Hgb' -> includes 718-7" + :op :search-concepts :input {:text "Hgb" :max-hits 500} + :expect [["includes 718-7" (includes-code? "718-7")]]} + + {:name "search-concepts: SHORTNAME 'HbA1c' -> includes 4548-4" + :op :search-concepts :input {:text "HbA1c" :max-hits 500} + :expect [["includes 4548-4" (includes-code? "4548-4")]]} + + {:name "search-concepts: LinguisticVariantDisplayName 'Natrium' -> includes 2951-2" + :op :search-concepts :input {:text "Natrium" :max-hits 500} + :expect [["includes 2951-2" (includes-code? "2951-2")]]} + + {:name "search-concepts: British 'Haemoglobin' surfaces hemoglobin codes" + :op :search-concepts :input {:text "Haemoglobin" :max-hits 50} + :expect [["count>=1" (count>= 1)] + ["includes 4548-4/718-7" + #(or ((includes-code? "4548-4") %) + ((includes-code? "718-7") %))]]} + + {:name "search-concepts: axis-only 'Massenkonzentration' <= 10" + :op :search-concepts :input {:text "Massenkonzentration" :max-hits 1000} + :expect [["count<=10" (count<= 10)]]} + + {:name "search-concepts: axis-only 'Zeitpunkt' <= 10" + :op :search-concepts :input {:text "Zeitpunkt" :max-hits 1000} + :expect [["count<=10" (count<= 10)]]} + + {:name "search-concepts: code = filter -> exactly one concept" + :op :search-concepts :input {:filters [{:property "code" :op "=" :value "718-7"}]} + :expect [["count=1" (count= 1)] + ["is 718-7" #(= "718-7" (some-> % :concepts first :code))]]} + + {:name "translate: MapTo maps deprecated LOINC to replacement" + :op :translate + :input {:url "http://loinc.org/cm/map-to" + :code "1009-0" + :target loinc-url} + :expect [["result=true" (result? true)] + ["maps to 1007-4" (match-code? "1007-4")]]} + + ;; ------------------------------------------------------------------------- + ;; LoincValueSet — desired behaviour from the LOINC FHIR IG. The IG + ;; defines four URL patterns under `http://loinc.org/vs[/...]`: + ;; • bare /vs -> all of LOINC + ;; • /vs/{LL-id} -> answer-list members + ;; • /vs/{LG-id} -> group members + ;; • /vs/{LP-code} -> multi-axial hierarchy descendants + ;; Cases that fail today are missing-functionality flags; the LL ones + ;; pass against the current implementation. + ;; ------------------------------------------------------------------------- + + {:name "metadata: vs catalogue lists the all-of-LOINC implicit VS" + :op :metadata :input {} + :expect [["http://loinc.org/vs is listed" (vs-listed? "http://loinc.org/vs")]]} + + {:name "metadata: vs catalogue lists at least one LL answer-list VS" + :op :metadata :input {} + :expect [["any LL URL listed" (vs-url-matching? #"^http://loinc\.org/vs/LL\d")]]} + + {:name "metadata: vs catalogue lists at least one LG group VS" + :op :metadata :input {} + :expect [["any LG URL listed" (vs-url-matching? #"^http://loinc\.org/vs/LG\d")]]} + + {:name "vs-expand: all-of-LOINC with filter narrows to hemoglobin" + :op :expand + :input {:url "http://loinc.org/vs" :filter "hemoglobin" :count 50} + :expect [["includes 718-7" (includes-code? "718-7")]]} + + {:name "vs-expand: all-of-LOINC includes answer codes" + :op :expand + :input {:url "http://loinc.org/vs" :filter "6 or more times" :count 10} + :expect [["includes LA14674-8" (includes-code? "LA14674-8")]]} + + {:name "vs-expand: all-of-LOINC includes part codes" + :op :expand + :input {:url "http://loinc.org/vs" :filter "Hemoglobin" :count 100} + :expect [["includes LP14449-0" (includes-code? "LP14449-0")]]} + + {:name "vs-expand: all-of-LOINC includes group codes" + :op :expand + :input {:url "http://loinc.org/vs" :filter "Cytomegalovirus DNA" :count 100} + :expect [["includes LG51973-2" (includes-code? "LG51973-2")]]} + + {:name "vs-expand: LP hierarchy ValueSet returns LNC descendants" + :op :expand :input {:url "http://loinc.org/vs/LP392452-1"} + :expect [["includes 718-7" (includes-code? "718-7")]]} + + {:name "vs-expand: LG group ValueSet returns group members" + :op :expand :input {:url "http://loinc.org/vs/LG51973-2"} + :expect [["count>=1" (count>= 1)]]} + + {:name "vs-expand: LL answer-list ValueSet returns answer items" + :op :expand :input {:url "http://loinc.org/vs/LL1234-5"} + :expect [["includes LA14674-8" (includes-code? "LA14674-8")] + ["total=5" (total= 5)]]} + + {:name "vs-validate-code: all-of-LOINC accepts any LOINC code" + :op :validate-code + :input {:url "http://loinc.org/vs" :code "718-7"} + :expect [["result=true" (result? true)]]} + + {:name "vs-validate-code: all-of-LOINC accepts answer list answer codes" + :op :validate-code + :input {:url "http://loinc.org/vs" :code "LA14674-8"} + :expect [["result=true" (result? true)]]} + + {:name "vs-validate-code: all-of-LOINC accepts part codes" + :op :validate-code + :input {:url "http://loinc.org/vs" :code "LP14449-0"} + :expect [["result=true" (result? true)]]} + + {:name "vs-validate-code: LP hierarchy accepts descendant" + :op :validate-code + :input {:url "http://loinc.org/vs/LP392452-1" :code "718-7"} + :expect [["result=true" (result? true)]]} + + {:name "vs-validate-code: LP hierarchy rejects non-descendant" + :op :validate-code + :input {:url "http://loinc.org/vs/LP392452-1" :code "2160-0"} + :expect [["result=false" (result? false)]]} + + {:name "vs-validate-code: LL answer-list accepts member" + :op :validate-code + :input {:url "http://loinc.org/vs/LL1234-5" :code "LA14674-8"} + :expect [["result=true" (result? true)]]} + + {:name "vs-validate-code: LL answer-list rejects non-member" + :op :validate-code + :input {:url "http://loinc.org/vs/LL1234-5" :code "LA9999-9"} + :expect [["result=false" (result? false)]]} + + {:name "vs-validate-code: wrong display surfaces invalid-display issue" + :op :validate-code + :input {:url "http://loinc.org/vs/LL1234-5" :code "LA14674-8" :display "Bogus"} + :expect [["result=false" (result? false)] + ["invalid-display" (issue-details? "invalid-display")]]} + + ;; ------------------------------------------------------------------------- + ;; NamingSystem — the LOINC OID resolves via both `urn:oid:` and bare + ;; forms; unknown OIDs must NOT resolve to LOINC. + ;; ------------------------------------------------------------------------- + + {:name "naming-system: urn:oid: prefix resolves to LOINC" + :op :resolve-canonical :input {:id "urn:oid:2.16.840.1.113883.6.1"} + :expect [["= loinc-url" (equals? loinc-url)]]} + + {:name "naming-system: bare OID resolves to LOINC" + :op :resolve-canonical :input {:id "2.16.840.1.113883.6.1"} + :expect [["= loinc-url" (equals? loinc-url)]]} + + {:name "naming-system: unknown OID is not claimed as LOINC" + :op :resolve-canonical :input {:id "1.2.3.4.5.6.7.8.9"} + :expect [["not loinc-url" #(not= loinc-url %)]]}]) + +(deftest ^:live operation-cases + (doseq [c cases] (check c))) + +(deftest ^:live live-loinc-oid-resolves-via-naming-system + (testing "request with system=urn:oid:... resolves to canonical LOINC URL" + (is (= loinc-url + (composite/resolve-canonical (:naming-systems *svc*) "2.16.840.1.113883.6.1"))) + (let [r (hades/lookup *svc* + {:system "2.16.840.1.113883.6.1" :code "718-7"})] + (is (= "Hemoglobin [Mass/volume] in Blood" (:display r))) + (is (= loinc-url (:system r)))))) + +(deftest ^:live live-vs-expand-loinc-answer-list + (testing "$expand on any LOINC AnswerList VS returns concepts once native ValueSet support exists" + (let [r (hades/expand *svc* {:url "http://loinc.org/vs/LL1234-5"})] + (is (sequential? (:concepts r))) + (is (seq (:concepts r)))))) diff --git a/test/com/eldrix/hades/providers/loinc/loader_test.clj b/test/com/eldrix/hades/providers/loinc/loader_test.clj new file mode 100644 index 0000000..ac12b78 --- /dev/null +++ b/test/com/eldrix/hades/providers/loinc/loader_test.clj @@ -0,0 +1,94 @@ +(ns com.eldrix.hades.providers.loinc.loader-test + (:require [clojure.core.async :as async] + [clojure.java.io :as io] + [clojure.test :refer [deftest is]] + [com.eldrix.hades.providers.loinc.loader :as loinc])) + +(def fixture-root "test/resources/loinc-fixture") + +(defn- drain [dir opts] + (let [ch (async/chan 8)] + (async/thread (loinc/stream-release ch dir opts)) + (async/ r :issues first :details-code)))))) + +(def implicit-valueset-validate-code-cases + [{:label "implicit ValueSet validate-code accepts matching localized display" + :input {:url "http://loinc.org/vs" + :system "http://loinc.org" + :code "718-7" + :display "Hämoglobin [Masse/Volumen] in Blut" + :displayLanguage "de-DE"} + :expected {:result true + :code "718-7" + :display "Hämoglobin [Masse/Volumen] in Blut"}} + {:label "implicit ValueSet validate-code rejects unrelated localized display" + :input {:url "http://loinc.org/vs" + :system "http://loinc.org" + :code "718-7" + :display "not the right display" + :displayLanguage "de-DE"} + :expected {:result false + :issues [{:details-code "invalid-display" + :expression ["Coding.display"]}]}}]) + +(deftest ^:live implicit-valueset-validate-code-checks-localized-display + (doseq [{:keys [label input expected]} implicit-valueset-validate-code-cases] + (testing label + (is (submap? expected (protos/vs-validate-code *vs* nil input)))))) + +(def cs-expand-cases + [{:label "canonical English multi-token search is AND-of-tokens" + :input {:system "http://loinc.org" + :text "hemoglobin blood" + :max-hits 10} + :expect-concepts? true} + {:label "canonical English multi-token search requires every token" + :input {:system "http://loinc.org" + :text "hemoglobin unlikelytoken" + :max-hits 10} + :expected-codes []} + {:label "German searches hit linguistic variant FTS" + :input {:system "http://loinc.org" + :text "Hämoglobin" + :displayLanguage "de-DE" + :max-hits 10} + :expect-concepts? true + :display-pattern #"Hämoglobin"} + {:label "French searches hit linguistic variant FTS" + :input {:system "http://loinc.org" + :text "hémoglobine" + :displayLanguage "fr-FR" + :max-hits 10} + :expect-concepts? true + :display-pattern #"(?i)hémoglobine"} + {:label "Chinese searches hit linguistic variant FTS" + :input {:system "http://loinc.org" + :text "血红蛋白" + :displayLanguage "zh-CN" + :max-hits 10} + :expect-concepts? true}]) + +(deftest ^:live expand-searches-canonical-and-linguistic-text + (doseq [{:keys [label input expected-codes expect-concepts? display-pattern]} cs-expand-cases] + (testing label + (let [concepts (:concepts (protos/cs-expand* *cs* input))] + (when (some? expected-codes) + (is (= expected-codes (mapv :code concepts)))) + (when expect-concepts? + (is (seq concepts))) + (when display-pattern + (is (every? #(re-find display-pattern (:display %)) concepts))))))) + +(deftest ^:live cs-expand*-supports-code-eq-filter + (let [r (protos/cs-expand* *cs* {:system "http://loinc.org" + :filters [{:property "code" + :op "=" + :value "718-7"}]})] + (is (= ["718-7"] (codes r))))) + +(deftest ^:live codesystem-expand-respects-requested-version + (let [r (protos/cs-expand* *cs* {:system "http://loinc.org" + :version "not-the-loaded-version" + :text "hemoglobin" + :max-hits 10})] + (is (empty? (:concepts r))))) + +(deftest ^:live expand-empty-token-filter-does-not-broaden-results + (testing "CodeSystem search" + (let [r (protos/cs-expand* *cs* {:system "http://loinc.org" + :text "&&&" + :max-hits 10})] + (is (empty? (:concepts r))))) + (testing "implicit ValueSet search" + (let [r (protos/vs-expand *vs* nil {:url "http://loinc.org/vs" + :filter "&&&" + :count 10})] + (is (empty? (:concepts r))) + (is (= 0 (:total r)))))) + +(def answer-list-expand-cases + [{:label "answer list ValueSets are expandable" + :input {:url "http://loinc.org/vs/LL1234-5"} + :expected {:total 5 + :concepts [{:system "http://loinc.org" + :code "LA14674-8" + :display "6 or more times"} + {:code "LA14675-5"} + {:code "LA14676-3"} + {:code "LA14677-1"} + {:code "LA14678-9"}]}} + {:label "answer list expansion supports filter" + :input {:url "http://loinc.org/vs/LL1234-5" + :filter "4 drinks"} + :expected {:total 1 + :concepts [{:code "LA14678-9"}]}} + {:label "answer list expansion supports paging" + :input {:url "http://loinc.org/vs/LL1234-5" + :offset 1 + :count 2} + :expected {:total 5 + :concepts [{:code "LA14675-5"} + {:code "LA14676-3"}]}}]) + +(def answer-list-validate-code-cases + [{:label "answer list validate-code accepts member code" + :input {:url "http://loinc.org/vs/LL1234-5" + :system "http://loinc.org" + :code "LA14674-8"} + :expected {:result true + :display "6 or more times"}} + {:label "answer list validate-code rejects non-member code" + :input {:url "http://loinc.org/vs/LL1234-5" + :system "http://loinc.org" + :code "LA2-8"} + :expected {:result false}} + {:label "answer list validate-code rejects wrong display with shared display issue" + :input {:url "http://loinc.org/vs/LL1234-5" + :system "http://loinc.org" + :code "LA14674-8" + :display "not the right display"} + :expected {:result false + :message "Wrong Display Name 'not the right display' for http://loinc.org#LA14674-8. Valid display is '6 or more times' (for the language(s) '--')" + :issues [{:details-code "invalid-display" + :expression ["Coding.display"]}]}}]) + +(def specific-valueset-validate-code-cases + [{:label "part hierarchy validate-code rejects non-LOINC system" + :input {:url "http://loinc.org/vs/LP248770-2" + :system "http://example.org" + :code "1009-0"} + :expected {:result false + :system "http://example.org" + :code "1009-0"}} + {:label "group validate-code rejects non-LOINC system" + :input {:url "http://loinc.org/vs/LG51017-8" + :system "http://example.org" + :code "101721-9"} + :expected {:result false + :system "http://example.org" + :code "101721-9"}} + {:label "group validate-code returns canonical code casing" + :input {:url "http://loinc.org/vs/LG51017-8" + :system "http://loinc.org" + :code "101721-9"} + :expected {:result true + :system "http://loinc.org" + :code "101721-9"}} + {:label "group validate-code rejects wrong display with shared display issue" + :input {:url "http://loinc.org/vs/LG51017-8" + :system "http://loinc.org" + :code "101721-9" + :display "not the right display"} + :expected {:result false + :message "Wrong Display Name 'not the right display' for http://loinc.org#101721-9. Valid display is 'Deprecated SARS-CoV-2 (COVID-19) in Respiratory specimen by NAA with probe detection' (for the language(s) '--')" + :issues [{:details-code "invalid-display" + :expression ["Coding.display"]}]}}]) + +(deftest ^:live answer-list-valuesets-expand-and-validate + (testing "answer list ValueSets are advertised" + (let [url "http://loinc.org/vs/LL1234-5" + meta (first (filter #(= url (:url %)) (protos/vs-metadata *vs* {})))] + (is (= url (:url meta))))) + (testing "part hierarchy ValueSets are advertised" + (let [url "http://loinc.org/vs/LP248770-2" + meta (first (filter #(= url (:url %)) (protos/vs-metadata *vs* {})))] + (is (= url (:url meta))))) + (doseq [{:keys [label input expected]} answer-list-expand-cases] + (testing label + (is (submap? expected (protos/vs-expand *vs* nil input))))) + (doseq [{:keys [label input expected]} answer-list-validate-code-cases] + (testing label + (is (submap? expected (protos/vs-validate-code *vs* nil input))))) + (doseq [{:keys [label input expected]} specific-valueset-validate-code-cases] + (testing label + (is (submap? expected (protos/vs-validate-code *vs* nil input))))) + (testing "non-answer-list LOINC ValueSet URLs are not claimed as answer lists" + (is (nil? (protos/vs-expand *vs* nil {:url "http://loinc.org/vs/LP12345-6"}))) + (is (nil? (protos/vs-expand *vs* nil {:url "http://loinc.org/vs/LG123-4"}))))) + +(deftest ^:live group-valuesets-expand-like-loinc + ;; fhir.loinc.org expands LG51973-2 to these five LOINC terms for the + ;; pinned 2.82 release. Exact membership is more stable than display + ;; text and catches broken group-file import or ordering. + (let [url "http://loinc.org/vs/LG51973-2" + r (protos/vs-expand *vs* nil {:url url :count 10})] + (is (= 5 (:total r))) + (is (= ["100675-8" "105880-9" "29604-6" "30247-1" "72493-0"] + (codes r))))) + +(deftest ^:live expansion-pagination-is-deterministic + (testing "answer-list paging is stable" + (let [url "http://loinc.org/vs/LL1234-5" + page #(codes (protos/vs-expand *vs* nil {:url url :offset 1 :count 2}))] + (is (= ["LA14675-5" "LA14676-3"] (page))) + (is (= (page) (page))))) + (testing "implicit all-LOINC paging is stable" + (let [page #(codes (protos/vs-expand *vs* nil {:url "http://loinc.org/vs" + :filter "hemoglobin" + :offset 1 + :count 5}))] + (is (= (page) (page))) + (is (= 5 (count (page))))))) + +(deftest ^:live filtered-implicit-valueset-reports-total + (let [r (protos/vs-expand *vs* nil {:url "http://loinc.org/vs" + :filter "hemoglobin" + :count 5})] + (is (= 5 (count (:concepts r)))) + (is (integer? (:total r))) + (is (< 5 (:total r))))) + +(def expansion-filter-cases + [{:label "column filters narrow expansion" + :input {:system "http://loinc.org" + :filters [{:property "PROPERTY" :op "=" :value "MCnc"} + {:property "SYSTEM" :op "=" :value "Bld"}] + :max-hits 1000} + :expected-codes ["718-7"]} + {:label "hierarchy filters narrow expansion" + :input {:system "http://loinc.org" + :filters [{:property "parent" :op "=" :value "LP392452-1"}] + :max-hits 100} + :expected-codes ["718-7"]} + {:label "active-only narrows code-filtered expansion" + :input {:system "http://loinc.org" + :filters [{:property "code" :op "=" :value "718-7"}] + :active-only true} + :expected-codes ["718-7"] + :exact-codes? true} + {:label "in filters are case-insensitive for LOINC property values" + :input {:system "http://loinc.org" + :filters [{:property "PROPERTY" :op "in" :value "mcnc"} + {:property "SYSTEM" :op "in" :value "bld"}] + :max-hits 1000} + :expected-codes ["718-7"]} + {:label "not-in filters are case-insensitive for LOINC property values" + :input {:system "http://loinc.org" + :filters [{:property "code" :op "=" :value "718-7"} + {:property "PROPERTY" :op "not-in" :value "mcnc"}] + :max-hits 1000} + :expected-codes [] + :exact-codes? true}]) + +(def subsumes-cases + [{:label "part parent subsumes term" + :input {:codeA "LP392452-1" + :codeB "718-7"} + :expected {:outcome "subsumes"}} + {:label "term is subsumed by part parent" + :input {:codeA "718-7" + :codeB "LP392452-1"} + :expected {:outcome "subsumed-by"}}]) + +(deftest ^:live expansion-filters-and-hierarchy + (doseq [{:keys [label input expected-codes exact-codes?]} expansion-filter-cases] + (testing label + (let [actual-codes (codes (protos/cs-expand* *cs* input))] + (if exact-codes? + (is (= expected-codes actual-codes)) + (doseq [code expected-codes] + (is (some #{code} actual-codes))))))) + (doseq [{:keys [label input expected]} subsumes-cases] + (testing label + (is (submap? expected (protos/cs-subsumes *cs* input)))))) + +(def expand-compose-cases + [{:label "STATUS and CLASS filters narrow the composed expansion" + :filters [(loinc-filter "STATUS" "=" "ACTIVE") + (loinc-filter "CLASS" "=" "HEM/BC") + (loinc-filter "code" "=" "718-7")] + :params {:count 10} + :codes ["718-7"]} + {:label "CLASS filter excludes a code from another class" + :filters [(loinc-filter "CLASS" "=" "HEM/BC") + (loinc-filter "code" "=" "8480-6")] + :params {:count 10} + :codes []} + {:label "activeOnly is pushed through compose filters" + :filters [(loinc-filter "code" "=" "1009-0")] + :params {:activeOnly true :count 10} + :codes []}]) + +(deftest ^:live compose-expansion-applies-loinc-property-filters + (doseq [{:keys [label filters params codes]} expand-compose-cases] + (testing label + (let [r (expand-compose filters params)] + (is (= codes (mapv :code (:concepts r)))) + (is (empty? (:issues r)))))) + (testing "unsupported LOINC filters surface as errors and do not broaden" + (let [r (expand-compose [(loinc-filter "not-a-loinc-filter" "=" "x")] {:count 10})] + (is (empty? (:concepts r))) + (is (= [{:severity "error" + :type "invalid" + :details-code "vs-invalid" + :text "Unsupported LOINC filter property=\"not-a-loinc-filter\", op=\"=\", value=\"x\""}] + (:issues r)))))) + +(deftest ^:live unsupported-filters-do-not-broaden-loinc-expansion + (let [r (protos/cs-expand* *cs* {:system "http://loinc.org" + :filters [{:property "not-a-loinc-filter" + :op "=" + :value "x"}] + :max-hits 5})] + (is (empty? (:concepts r)) + "unsupported LOINC filters must not be silently ignored") + (is (= [{:severity "error" + :type "invalid" + :details-code "vs-invalid" + :text "Unsupported LOINC filter property=\"not-a-loinc-filter\", op=\"=\", value=\"x\""}] + (:issues r))))) + +(deftest ^:live active-only-applies-to-unfiltered-implicit-loinc-expansion + ;; 100653-5 is the first deprecated code in the pinned 2.82 DB when + ;; the LNC slice is ordered by code. Expanding the implicit all-LOINC + ;; ValueSet at that page with activeOnly=true must skip it rather than + ;; returning an inactive concept. + (let [r (protos/vs-expand *vs* nil {:url "http://loinc.org/vs" + :activeOnly true + :offset 729 + :count 1}) + c (first (:concepts r))] + (is (not= "100653-5" (:code c))) + (is (not (:inactive c))))) + +(def filtered-active-only-cases + [{:label "deprecated parts are excluded" + :base {:url "http://loinc.org/vs" + :filter "Levomepromazine" + :count 20} + :inactive-code "LP101194-1"} + {:label "deprecated groups are excluded" + :base {:url "http://loinc.org/vs" + :filter "Views Broden" + :count 20} + :inactive-code "LG38463-2"}]) + +(deftest ^:live active-only-applies-to-filtered-implicit-loinc-expansion + (doseq [{:keys [label base inactive-code]} filtered-active-only-cases] + (testing label + (let [inactive (protos/vs-expand *vs* nil base) + active (protos/vs-expand *vs* nil (assoc base :activeOnly true))] + (is (has-code? inactive-code (:concepts inactive))) + (is (not (has-code? inactive-code (:concepts active)))))))) + +(def specific-active-only-cases + [{:label "part hierarchy ValueSets exclude deprecated member concepts" + :base {:url "http://loinc.org/vs/LP248770-2" + :offset 219 + :count 1} + :inactive-concept {:system "http://loinc.org" + :code "1009-0" + :display "Deprecated Direct antiglobulin test.poly specific reagent [Presence] on Red Blood Cells" + :inactive true}} + {:label "group ValueSets exclude deprecated member concepts" + :base {:url "http://loinc.org/vs/LG51017-8" + :count 200} + :inactive-concept {:code "101721-9" + :inactive true}}]) + +(deftest ^:live active-only-applies-to-specific-loinc-valuesets + (doseq [{:keys [label base inactive-concept]} specific-active-only-cases] + (testing label + (let [inactive (protos/vs-expand *vs* nil base) + active (protos/vs-expand *vs* nil (assoc base :activeOnly true)) + inactive-code (:code inactive-concept)] + (is (some #(submap? inactive-concept %) (:concepts inactive))) + (is (not (has-code? inactive-code (:concepts active)))) + (is (< (:total active) (:total inactive))))))) + +(def map-to-translate-cases + [{:label "MapTo uses imported release data" + :input {:url (:url (loinc-model/conceptmap :map-to)) + :system "http://loinc.org" + :code "1009-0" + :target "http://loinc.org"} + :expected {:result true + :matches [{:equivalence "relatedto" + :system "http://loinc.org" + :code "1007-4" + :display "Direct antiglobulin test.polyspecific reagent [Presence] on Red Blood Cells"}]}} + {:label "MapTo is directional for public FHIR translate" + :input {:url (:url (loinc-model/conceptmap :map-to)) + :system "http://loinc.org" + :code "1007-4" + :target "http://loinc.org"} + :expected {:result false + :message "No matches found"}}]) + +(deftest ^:live map-to-conceptmap-uses-imported-release-data + ;; fhir.loinc.org currently returns no match for this informal URL and + ;; tx.fhir.org does not publish it as a ConceptMap. The native provider + ;; deliberately exposes the imported MapTo.csv rows under this URL. + (doseq [{:keys [label input expected]} map-to-translate-cases] + (testing label + (is (submap? expected (protos/cm-translate *cm* input)))))) + +(deftest ^:live imported-conceptmaps-are-advertised + (let [metas (protos/cm-metadata *cm* {}) + urls (set (map :url metas)) + part-url (loinc-model/part-related-conceptmap-url "http://snomed.info/sct")] + (is (contains? urls (:url (loinc-model/conceptmap :map-to)))) + (is (contains? urls part-url)) + (is (contains? urls (:url (loinc-model/conceptmap :ieee-medical-device)))) + (is (contains? urls (:url (loinc-model/conceptmap :rsna-rid)))) + (is (contains? urls (:url (loinc-model/conceptmap :rsna-rpid)))) + (is (= {:url part-url + :system "http://loinc.org" + :target "http://snomed.info/sct" + :title "LOINC part related code mappings to http://snomed.info/sct" + :version fixtures/loinc-version} + (protos/cm-resource *cm* {:url part-url}))))) + +(def external-conceptmap-translate-cases + [{:label "part related code mappings translate LOINC to SNOMED CT" + :input {:url (loinc-model/part-related-conceptmap-url "http://snomed.info/sct") + :system "http://loinc.org" + :code "LP14449-0" + :target "http://snomed.info/sct"} + :expected {:matches [{:equivalence "equivalent" + :system "http://snomed.info/sct" + :code "38082009" + :display "Hemoglobin (substance)"}]}} + {:label "part related code mappings translate SNOMED CT to LOINC" + :input {:url (loinc-model/part-related-conceptmap-url "http://snomed.info/sct") + :system "http://snomed.info/sct" + :code "38082009" + :target "http://loinc.org"} + :expected {:matches [{:equivalence "equivalent" + :system "http://loinc.org" + :code "LP14449-0" + :display "Hemoglobin"}]}} + {:label "IEEE medical device mappings translate LOINC to IEEE" + :input {:url (:url (loinc-model/conceptmap :ieee-medical-device)) + :system "http://loinc.org" + :code "11556-8" + :target (:target (loinc-model/conceptmap :ieee-medical-device))} + :expected {:matches [{:equivalence "equivalent" + :system (:target (loinc-model/conceptmap :ieee-medical-device)) + :code "160116" + :display "MDC_CONC_PO2_GEN"}]}} + {:label "IEEE medical device mappings translate IEEE to LOINC" + :input {:url (:url (loinc-model/conceptmap :ieee-medical-device)) + :system (:target (loinc-model/conceptmap :ieee-medical-device)) + :code "160116" + :target "http://loinc.org"} + :expected {:matches [{:code "11556-8"}]}} + {:label "non-equivalent mappings preserve wider equivalence" + :input {:url (loinc-model/part-related-conceptmap-url "http://snomed.info/sct") + :system "http://loinc.org" + :code "LP14448-2" + :target "http://snomed.info/sct"} + :expected {:matches [{:equivalence "wider" + :system "http://snomed.info/sct" + :code "38082009"}]}} + {:label "non-equivalent mappings invert to narrower equivalence" + :input {:url (loinc-model/part-related-conceptmap-url "http://snomed.info/sct") + :system "http://snomed.info/sct" + :code "38082009" + :target "http://loinc.org"} + :expected {:matches [{:equivalence "narrower" + :system "http://loinc.org" + :code "LP14448-2"}]}} + {:label "RSNA RID mappings translate LOINC to RadLex" + :input {:url (:url (loinc-model/conceptmap :rsna-rid)) + :system "http://loinc.org" + :code "24531-6" + :target (:target (loinc-model/conceptmap :rsna-rid))} + :expected {:matches [{:code "RID431"}]}} + {:label "RSNA RID mappings translate RadLex to LOINC" + :input {:url (:url (loinc-model/conceptmap :rsna-rid)) + :system (:target (loinc-model/conceptmap :rsna-rid)) + :code "RID431" + :target "http://loinc.org"} + :expected {:matches [{:code "24531-6"}]}} + {:label "RSNA RPID mappings translate LOINC to Playbook procedure IDs" + :input {:url (:url (loinc-model/conceptmap :rsna-rpid)) + :system "http://loinc.org" + :code "24531-6" + :target (:target (loinc-model/conceptmap :rsna-rpid))} + :expected {:matches [{:equivalence "relatedto" + :system (:target (loinc-model/conceptmap :rsna-rpid)) + :code "RPID2142" + :display "US Retroperitoneum"}]}} + {:label "RSNA RPID mappings translate Playbook procedure IDs to LOINC" + :input {:url (:url (loinc-model/conceptmap :rsna-rpid)) + :system (:target (loinc-model/conceptmap :rsna-rpid)) + :code "RPID2142" + :target "http://loinc.org"} + :expected {:matches [{:code "24531-6"}]}}]) + +(deftest ^:live imported-external-conceptmaps-translate-both-directions + (doseq [{:keys [label input expected]} external-conceptmap-translate-cases] + (testing label + (is (submap? expected (protos/cm-translate *cm* input)))))) diff --git a/test/com/eldrix/hades/providers/loinc/store_test.clj b/test/com/eldrix/hades/providers/loinc/store_test.clj new file mode 100644 index 0000000..d7842e2 --- /dev/null +++ b/test/com/eldrix/hades/providers/loinc/store_test.clj @@ -0,0 +1,68 @@ +(ns com.eldrix.hades.providers.loinc.store-test + (:require [clojure.core.async :as async] + [clojure.java.io :as io] + [clojure.test :refer [deftest is testing]] + [com.eldrix.hades.providers.loinc.loader :as loader] + [com.eldrix.hades.providers.loinc.store :as store] + [next.jdbc :as jdbc] + [next.jdbc.plan :as plan]) + (:import (java.io File))) + +(def fixture-root "test/resources/loinc-fixture") + +(defn- temp-db-path [] + (let [^File f (File/createTempFile "hades-loinc-store-test" ".db")] + (.delete f) + (.getPath f))) + +(defn- delete-quietly [^String path] + (let [^File f (io/file path)] + (when (.exists f) (.delete f)))) + +(defn- stream-blocks [dir] + (let [ch (async/chan 8)] + (async/thread (loader/stream-release ch dir {:batch-size 7})) + (async/query nil - [{:property "concept" :op "=" :value "73211009"}])))))) + [{:property "concept" :op "=" :value "73211009"}]))))) + (is (= (.toString (hermes.search/q-concept-id 73211009)) + (.toString (only-query + (snomed/compose-filters->query nil + [{:property "code" :op "=" :value "73211009"}]))))) + "code = SCTID is accepted for shared compose validation narrowing") (testing "child = SCTID maps to q-childOf (no store needed)" (is (= (.toString (hermes.search/q-childOf 73211009)) @@ -192,6 +198,14 @@ (use-fixtures :once live-fixture) +(deftest ^:live cs-expand*-supports-code-eq-filter + (let [provider (snomed/->HermesService *svc*) + r (protos/cs-expand* provider {:system "http://snomed.info/sct" + :filters [{:property "code" + :op "=" + :value "73211009"}]})] + (is (= ["73211009"] (mapv :code (:concepts r)))))) + (deftest ^:live parent-eq-resolves-against-store (let [{:keys [query issues]} (snomed/compose-filters->query *svc* diff --git a/test/com/eldrix/hades/impl/snomed_uk_live_test.clj b/test/com/eldrix/hades/providers/snomed/snomed_uk_live_test.clj similarity index 96% rename from test/com/eldrix/hades/impl/snomed_uk_live_test.clj rename to test/com/eldrix/hades/providers/snomed/snomed_uk_live_test.clj index eddd475..1045101 100644 --- a/test/com/eldrix/hades/impl/snomed_uk_live_test.clj +++ b/test/com/eldrix/hades/providers/snomed/snomed_uk_live_test.clj @@ -1,10 +1,10 @@ -(ns com.eldrix.hades.impl.snomed-uk-live-test +(ns com.eldrix.hades.providers.snomed.snomed-uk-live-test "Live multi-module SNOMED routing test against a real UK Monolith DB." (:require [clojure.test :refer [deftest is testing]] [com.eldrix.hades.core :as hades] [com.eldrix.hades.fixtures :as fixtures] - [com.eldrix.hades.impl.composite :as composite] - [com.eldrix.hades.impl.snomed :as snomed] + [com.eldrix.hades.composite :as composite] + [com.eldrix.hades.providers.snomed.provider :as snomed] [com.eldrix.hermes.core :as hermes]) (:import (java.time.format DateTimeFormatter))) diff --git a/test/resources/logback-test.xml b/test/resources/logback-test.xml new file mode 100644 index 0000000..ee46628 --- /dev/null +++ b/test/resources/logback-test.xml @@ -0,0 +1,21 @@ + + + + System.err + + %date{ISO8601} %-5level [%thread] %logger{36} %mdc - %msg%n + + + + + + + + + + + + + + diff --git a/test/resources/loinc-fixture/AccessoryFiles/AnswerFile/AnswerList.csv b/test/resources/loinc-fixture/AccessoryFiles/AnswerFile/AnswerList.csv index 43da694..a4720b5 100644 --- a/test/resources/loinc-fixture/AccessoryFiles/AnswerFile/AnswerList.csv +++ b/test/resources/loinc-fixture/AccessoryFiles/AnswerFile/AnswerList.csv @@ -1,7 +1,2 @@ "AnswerListId","AnswerListName","AnswerListOID","ExtDefinedYN","ExtDefinedAnswerListCodeSystem","ExtDefinedAnswerListLink","AnswerStringId","LocalAnswerCode","LocalAnswerCodeSystem","SequenceNumber","DisplayText","ExtCodeId","ExtCodeDisplayName","ExtCodeSystem","ExtCodeSystemVersion","ExtCodeSystemCopyrightNotice","SubsequentTextPrompt","Description","Score" -"LL6136-7","Met/Not met/Ongoing/Unable to assess","2.16.840.1.113883.21","N","","","LA28912-9","M","","1","Met","","","","","","","","" -"LL6136-7","Met/Not met/Ongoing/Unable to assess","2.16.840.1.113883.21","N","","","LA28913-7","NM","","2","Not met","","","","","","","","" -"LL6136-7","Met/Not met/Ongoing/Unable to assess","2.16.840.1.113883.21","N","","","LA28914-5","O","","3","Ongoing","","","","","","","","" -"LL6136-7","Met/Not met/Ongoing/Unable to assess","2.16.840.1.113883.21","N","","","LA28915-2","UA","","4","Unable to assess","","","","","","","","" -"LL3044-6","Yes/No","2.16.840.1.113883.22","N","","","LA33-6","Y","","1","Yes","","","","","","","","" -"LL3044-6","Yes/No","2.16.840.1.113883.22","N","","","LA32-8","N","","2","No","","","","","","","","" +"LL1000-0","PhenX05_13_30D bread amt","1.3.6.1.4.1.12009.10.1.165","N","","","LA13825-7","1","","1","1 slice or 1 dinner roll","","","","","","","","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/AnswerFile/LoincAnswerListLink.csv b/test/resources/loinc-fixture/AccessoryFiles/AnswerFile/LoincAnswerListLink.csv new file mode 100644 index 0000000..c9da2be --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/AnswerFile/LoincAnswerListLink.csv @@ -0,0 +1,2 @@ +"LoincNumber","LongCommonName","AnswerListId","AnswerListName","AnswerListLinkType","ApplicableContext" +"100002-5","Specimen care is maintained","LL6136-7","Met/Not met/Ongoing/Unable to assess","NORMATIVE","100017-3" diff --git a/test/resources/loinc-fixture/AccessoryFiles/ChangeSnapshot/LoincChangeSnapshot.csv b/test/resources/loinc-fixture/AccessoryFiles/ChangeSnapshot/LoincChangeSnapshot.csv new file mode 100644 index 0000000..547cc4a --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/ChangeSnapshot/LoincChangeSnapshot.csv @@ -0,0 +1,2 @@ +"VersionEffective","LOINC_NUM","Property","ValuePrior","ValueCurrent","ChangeReason" +"2.82","100346-6","COMPONENT","Clotting time.extrinsic coagulation system activated.platelets inhibited","Clotting time","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/ChangeSnapshot/PartChangeSnapshot.csv b/test/resources/loinc-fixture/AccessoryFiles/ChangeSnapshot/PartChangeSnapshot.csv new file mode 100644 index 0000000..8f8c90c --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/ChangeSnapshot/PartChangeSnapshot.csv @@ -0,0 +1,2 @@ +"VersionEffective","PartNumber","PROPERTY","ValuePrior","ValueCurrent","ChangeReason" +"2.82","LP101300-4","STATUS","ACTIVE","INACTIVE","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/ComponentHierarchyBySystem/ComponentHierarchyBySystem.csv b/test/resources/loinc-fixture/AccessoryFiles/ComponentHierarchyBySystem/ComponentHierarchyBySystem.csv index ef48ea3..942f35f 100644 --- a/test/resources/loinc-fixture/AccessoryFiles/ComponentHierarchyBySystem/ComponentHierarchyBySystem.csv +++ b/test/resources/loinc-fixture/AccessoryFiles/ComponentHierarchyBySystem/ComponentHierarchyBySystem.csv @@ -1,2 +1,2 @@ -"PATH_TO_ROOT","SEQUENCE","IMMEDIATE_PARENT","CODE","CODE_TEXT" -"LP432695-7.LP29693-6.LP343631-0.LP7786-9.LP19403-2.LP15099-2.LP386648-2","2","LP386648-2","2951-2","Sodium SerPl-sCnc" +"PATH_TO_ROOT","SEQUENCE","IMMEDIATE_PARENT","CODE","CODE_TEXT" +"","1","","LP432695-7","{component}" diff --git a/test/resources/loinc-fixture/AccessoryFiles/ConsumerName/ConsumerName.csv b/test/resources/loinc-fixture/AccessoryFiles/ConsumerName/ConsumerName.csv new file mode 100644 index 0000000..491cb33 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/ConsumerName/ConsumerName.csv @@ -0,0 +1,2 @@ +"LoincNumber","ConsumerName" +"93418-2","(8;8)(q13;q21)(HEY1,NCOA2) fusion transcript analysis, Tissue" diff --git a/test/resources/loinc-fixture/AccessoryFiles/DocumentOntology/DocumentOntology.csv b/test/resources/loinc-fixture/AccessoryFiles/DocumentOntology/DocumentOntology.csv new file mode 100644 index 0000000..913f818 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/DocumentOntology/DocumentOntology.csv @@ -0,0 +1,2 @@ +"LoincNumber","PartNumber","PartTypeName","PartSequenceOrder","PartName" +"100018-1","LP173418-7","Document.Kind","1","Note" diff --git a/test/resources/loinc-fixture/AccessoryFiles/GroupFile/Group.csv b/test/resources/loinc-fixture/AccessoryFiles/GroupFile/Group.csv new file mode 100644 index 0000000..5ca99b1 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/GroupFile/Group.csv @@ -0,0 +1,2 @@ +"ParentGroupId","GroupId","Group","Archetype","Status","VersionFirstReleased" +"LG100-4","LG8749-6","(Acer negundo+Betula verrucosa+Fagus grandifolia+Quercus alba+Juglans californica) Ab.IgE|ACnc|Pt|ANYBldSerPl","","Active","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/GroupFile/GroupAttributes.csv b/test/resources/loinc-fixture/AccessoryFiles/GroupFile/GroupAttributes.csv new file mode 100644 index 0000000..c299115 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/GroupFile/GroupAttributes.csv @@ -0,0 +1,2 @@ +"ParentGroupId","GroupId","Type","Value" +"LG100-4","LG10324-8","MolecularWeightOfAnalyte","176.219" diff --git a/test/resources/loinc-fixture/AccessoryFiles/GroupFile/GroupLoincTerms.csv b/test/resources/loinc-fixture/AccessoryFiles/GroupFile/GroupLoincTerms.csv new file mode 100644 index 0000000..44692e0 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/GroupFile/GroupLoincTerms.csv @@ -0,0 +1,2 @@ +"Category","GroupId","Archetype","LoincNumber","LongCommonName" +"","LG51973-2","","100675-8","Cytomegalovirus DNA [Units/volume] (viral load) in Blood by NAA with probe detection" diff --git a/test/resources/loinc-fixture/AccessoryFiles/GroupFile/ParentGroup.csv b/test/resources/loinc-fixture/AccessoryFiles/GroupFile/ParentGroup.csv new file mode 100644 index 0000000..1d548ae --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/GroupFile/ParentGroup.csv @@ -0,0 +1,2 @@ +"ParentGroupId","ParentGroup","Status" +"LG100-4","Chem_DrugTox_Chal_Sero_Allergy","ACTIVE" diff --git a/test/resources/loinc-fixture/AccessoryFiles/GroupFile/ParentGroupAttributes.csv b/test/resources/loinc-fixture/AccessoryFiles/GroupFile/ParentGroupAttributes.csv new file mode 100644 index 0000000..6c3290c --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/GroupFile/ParentGroupAttributes.csv @@ -0,0 +1,2 @@ +"ParentGroupId","Type","Value" +"LG100-4","Description","This parent group contains groups for terms in any of the following classes: CHEM, DRUG/TOX, CHAL, SERO, and ALLERGY. Each group contains terms with the same Component, Property, and Time aspect. The terms in a given group also have the same System, except when the System is in the intravascular or urine category, in which case terms that have any of the Systems in that category are rolled up. For example, a group for a given analyte in CSF only has terms with the System 'CSF', but a group for an analyte in an intravascular specimen contains terms with a variety of Systems, including 'Bld', 'Ser/Plas', 'BldV', etc. Some intravascular Systems are purposely excluded from this rollup, including cord blood ('BldCo') and dried blood spots (DBS)." diff --git a/test/resources/loinc-fixture/AccessoryFiles/ImagingDocuments/ImagingDocumentCodes.csv b/test/resources/loinc-fixture/AccessoryFiles/ImagingDocuments/ImagingDocumentCodes.csv new file mode 100644 index 0000000..13d75ac --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/ImagingDocuments/ImagingDocumentCodes.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","LONG_COMMON_NAME" +"100349-0","US.doppler Penis vessels W vasodilator IV" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/LinguisticVariants.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/LinguisticVariants.csv index 58bc120..e0c4845 100644 --- a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/LinguisticVariants.csv +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/LinguisticVariants.csv @@ -1,2 +1,2 @@ -"ID","ISO_LANGUAGE","ISO_COUNTRY","LANGUAGE_NAME","PRODUCER" -"24","de","AT","German (AUSTRIA)","ELGA, Austria" +"ID","ISO_LANGUAGE","ISO_COUNTRY","LANGUAGE_NAME","PRODUCER" +"28","es","MX","Spanish (MEXICO)","Manuel Aragonés. Deep Dive Data Science." diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/arJO32LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/arJO32LinguisticVariant.csv new file mode 100644 index 0000000..9e45f8e --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/arJO32LinguisticVariant.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"50544-6","","","","","","","","","Everolimus [Mass/volume] in Blood","","الإيفيروليمس في الدم ( بتقنية الكتلة / الحجم )" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/csCZ33LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/csCZ33LinguisticVariant.csv new file mode 100644 index 0000000..92e8ee1 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/csCZ33LinguisticVariant.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"101797-9","8-aminoklonazolam","Přítomnost nebo práh","Časový bod","Moč","Ordinální","Konfirmace","DRUG/TOX","","8-aminoklonazolam [Přítomnost], systém: Moč, metoda: Konfirmace","","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/deAT24LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/deAT24LinguisticVariant.csv index 6014af1..541e40b 100644 --- a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/deAT24LinguisticVariant.csv +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/deAT24LinguisticVariant.csv @@ -1,2 +1,2 @@ -"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" -"2951-2","","","","","","","","","","Natrium","Natrium" +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"33512-5","","","","","","","","","","Farbe /SM","Farbe /Sondermaterial" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/deDE15LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/deDE15LinguisticVariant.csv new file mode 100644 index 0000000..dda3afa --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/deDE15LinguisticVariant.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"14394-1","Harnstoff-Stickstoff","Massenkonzentration","Zeitpunkt","Pleuraflüssigkeit","Quantitativ","","Klinische Chemie (keine Funktionstests)","","Harnstoff-Stickstoff [Masse/Volumen] in Pleuraflüssigkeit","","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/elGR17LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/elGR17LinguisticVariant.csv new file mode 100644 index 0000000..37690f8 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/elGR17LinguisticVariant.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"107877-3","Κόκκινο φασόλι Αντισώματα IgG","ACnc","Pt","Ορός/Πλάσμα","Qn","IA","ALLERGY","","","ACnc ALLERGY IA Pt Qn Ανοσοσφαιρίνη G Αντίσωμα Αντισώματα IgG Κόκκινο φασόλι Ορός Ορός/Πλάσμα Πλάσμα","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/esAR7LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/esAR7LinguisticVariant.csv new file mode 100644 index 0000000..f519258 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/esAR7LinguisticVariant.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"10369-7","opiáceos","contenido másico","punto en el tiempo","pelo","cuantitativo","","nivel de drogas y toxicología","opiáceos:contenido másico:punto en el tiempo:pelo:cuantitativo:","","","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/esES12LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/esES12LinguisticVariant.csv new file mode 100644 index 0000000..8c79eaa --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/esES12LinguisticVariant.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"106555-6","Virus Herpes simplex 1 ADN","PrThr","Punto temporal","Faringe","Ord","Sonda con amplificación dirigida","Pruebas de Microbiología (Cultivos, DNA, antígenos y anticuerpos)","","","","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/esMX28LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/esMX28LinguisticVariant.csv new file mode 100644 index 0000000..dfe02a7 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/esMX28LinguisticVariant.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"33512-5","Color","Tipo","Punto temporal","XXX","Nominal","","","","Color: XXX : Punto temporal: Tipo: Nominal:","","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/etEE10LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/etEE10LinguisticVariant.csv new file mode 100644 index 0000000..63538f4 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/etEE10LinguisticVariant.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"93488-5","Guanidinoatsetaat","SCnc","Pt","Vereplekk","Qn","","CHEM","","","Aine kontsentratsioon Juhuslik Kvantitatiivne Veri","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/frBE23LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/frBE23LinguisticVariant.csv new file mode 100644 index 0000000..c27e533 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/frBE23LinguisticVariant.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"103631-8","Natalizumab","Concentration de masse","Temps ponctuel","Sérum","Ordinal","IA","Médicaments et produits toxiques","","","","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/frCA8LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/frCA8LinguisticVariant.csv new file mode 100644 index 0000000..23eb6e3 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/frCA8LinguisticVariant.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"102269-8","Taxodium distichum, IgE","Présence-Seuil","Temps ponctuel","Sérum","SemiQn","RAST","Allergie","","","","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/frFR18LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/frFR18LinguisticVariant.csv new file mode 100644 index 0000000..6fe4f68 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/frFR18LinguisticVariant.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"14576-3","Anticorps irréguliers (RAI)","Interprétation","Ponctuel","Plasma/Érythrocytes","Résultat nominal","Sénior relecture","Immunohématologie","","Anticorps irréguliers (RAI) [Interprétation] Plasma/Érythrocytes ; Résultat nominal ; Sénior relecture","","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/itIT16LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/itIT16LinguisticVariant.csv new file mode 100644 index 0000000..61dfea5 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/itIT16LinguisticVariant.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"96976-6","Diossido di carbonio^a fine espirazione-Diossido di carbonio^a fine espirazione+Con esercizio sub-massimale","PPresDiff","Pt","Exhl gas","Qn","","CARDIO-POLM","","","a fine espirazione+Con esercizio submassimale alla fine dell''espirazione Biossido di carbonio Cardiopolmonare Differenza pressione parziale Gas esalato Gestione ventilazione polmonare Punto nel tempo (episodio)","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/koKR13LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/koKR13LinguisticVariant.csv new file mode 100644 index 0000000..4e262c4 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/koKR13LinguisticVariant.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"10340-8","Molindone","질량농도","검사시점","혈청/혈장","정량","","","","","","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/nlNL22LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/nlNL22LinguisticVariant.csv new file mode 100644 index 0000000..b6d827d --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/nlNL22LinguisticVariant.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"106031-8","Chlamydia trachomatis DNA","identificator","moment","peritoneaalvocht","nominaal","probe-detectie","microbiologie","","Chlamydia trachomatis DNA [identificator] in peritoneaalvocht d.m.v. probe-detectie","probe.amp.tar","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/plPL29LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/plPL29LinguisticVariant.csv new file mode 100644 index 0000000..77ff0c9 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/plPL29LinguisticVariant.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"13401-5","Hydroksyprolina","stężenie masowe","punkt w czasie","płyn owodniowy","ilościowy","","badania biochemiczne - testy bez obciążenia","","","","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/ptBR11LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/ptBR11LinguisticVariant.csv new file mode 100644 index 0000000..b3e756c --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/ptBR11LinguisticVariant.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"2750-8","pH","LsCnc","Pt","LiqPleur","Qn","","CHEM","pH Plr","","Log molar concentration; Point in time; Random; thoracentesis fluid; Pleural fluid; Quantitative; QNT; Quant; Quan; Chemistry","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/ruRU20LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/ruRU20LinguisticVariant.csv new file mode 100644 index 0000000..83ae148 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/ruRU20LinguisticVariant.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"99416-0","Протеин.моноклональная полоса 2","МассКонц","ТчкВрм","Сыв/Плаз","Колич","Иммунофиксация","CHEM","","","Белок Белок.моноклональная полоса 2 Количественный Массовая концентрация Плазма Сыворотка Сыворотка или Плазма Точка во времени;Момент","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/trTR19LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/trTR19LinguisticVariant.csv new file mode 100644 index 0000000..4a886af --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/trTR19LinguisticVariant.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"93429-9","Blastomyces sp Ag","KütlKons","Zmlı","İdrar","Kant","İA","MICRO","","","Antijen İmmünölçüm, immünoassay","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/ukUA30LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/ukUA30LinguisticVariant.csv new file mode 100644 index 0000000..5089231 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/ukUA30LinguisticVariant.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"34703-9","Вірус Гепатиту С РНК","Довільна Концентрація","МоментЧасу","Сироватка/Плазма","Кількісно","Зонд-детекція. цільова аміпліфікація НК межа визначення = 500 МО/мл","Мікробіологія","Вірус Гепатиту С РНК ДовКонц Свтк/Плаз Зонд-детек. ціль ампліф НК меж визн = 500 МО/мл","Вірус Гепатиту С РНК [Довільна Концентрація] у Сироватці/Плазмі методом Зонд-детекції.цільової аміпліфікації НК межа визначення = 500 МО/мл","3 Self-Sustaining Sequence Replication; 3SR SR; Amplif; Amplification; Amplified; Arbitrary concentration; DNA NUCLEIC ACID PROBE; DNA probe; HCV; Hep; Hep C; Hepatis; Hepatit; Hepatology; ID; Infectious Disease; InfectiousDisease; LAT; LCR; Ligase chain reaction; Ligation-activated transcription; Liver; Microbiology; NAA DL=500; NAA+probe; NAAT; NASBA; Nucleic acid sequence based analysis; PCR; Pl; Plasma; Plsm; Point in time; Polymerase chain reaction; Probe amp; Probe with ampification; Probe with target amplification; QBR; QNT; Quan; Quant; Quantitative; Random; Ribonucleic acid; SDA; SerP; SerPl; SerPlas; Serum; Serum or plasma; SR; Strand Displacement Amplification; TMA; Transcription mediated amplification; Viral load","Вірус Гепатиту С РНК Зонд-детек. ціль ампліф НК межа визначення = 500 МО/мл (Свтк/Плаз) [ДовКонц]" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/zhCN5LinguisticVariant.csv b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/zhCN5LinguisticVariant.csv new file mode 100644 index 0000000..0d520b1 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LinguisticVariants/zhCN5LinguisticVariant.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","SHORTNAME","LONG_COMMON_NAME","RELATEDNAMES2","LinguisticVariantDisplayName" +"11702-8","血流速度.收缩期.最大值","速度","时间点","大脑中动脉","定量型","超声.多普勒","产科学检查与测量指标.超声","","","Cereb 产科 产科.超声;产科.超声.印象与测量指标;产科学.超声;产科学.超声.印象与测量指标;产科学检查与测量指标.超声.印象与测量指标;产科学超声印象与测量指标 产科学 动态 可用数量表示的;定量性;数值型;数量型;连续数值型标尺 大脑（Cerebral） 心脏超声.多普勒 时刻;随机;随意;瞬间 最大;极大值 术语""cerebral""指的是主要由中枢半球（大脑皮质和基底神经节）组成的那部分脑结构 流 流量;流速;流体 血;全血 血流（血流量、血液流量）速度（速率）.收缩期（心脏收缩期、心缩期）.最大值（极大值、极大、最大、最高值、最高、峰值、高峰） 血流量;血液流量 超声检查方法;超声检查法;超声波;超声波检查方法;超声波检查法 速度(距离/时间);速率;速率(距离/时间)","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LoincIeeeMedicalDeviceCodeMappingTable/LoincIeeeMedicalDeviceCodeMappingTable.csv b/test/resources/loinc-fixture/AccessoryFiles/LoincIeeeMedicalDeviceCodeMappingTable/LoincIeeeMedicalDeviceCodeMappingTable.csv new file mode 100644 index 0000000..834b111 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LoincIeeeMedicalDeviceCodeMappingTable/LoincIeeeMedicalDeviceCodeMappingTable.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","LOINC_LONG_COMMON_NAME","IEEE_CF_CODE10","IEEE_REFID","EQUIVALENCE" +"11556-8","Oxygen [Partial pressure] in Blood","160116","MDC_CONC_PO2_GEN","equivalent" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LoincRsnaRadiologyPlaybook/LoincRsnaRadiologyPlaybook.csv b/test/resources/loinc-fixture/AccessoryFiles/LoincRsnaRadiologyPlaybook/LoincRsnaRadiologyPlaybook.csv new file mode 100644 index 0000000..d7980c8 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LoincRsnaRadiologyPlaybook/LoincRsnaRadiologyPlaybook.csv @@ -0,0 +1,2 @@ +"LoincNumber","LongCommonName","PartNumber","PartTypeName","PartName","PartSequenceOrder","RID","PreferredName","RPID","LongName" +"100349-0","US.doppler Penis vessels W vasodilator IV","LP207608-3","Rad.Modality.Modality Type","US","A","RID10326","Ultrasound","","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/LoincUniversalLabOrdersValueSet/LoincUniversalLabOrdersValueSet.csv b/test/resources/loinc-fixture/AccessoryFiles/LoincUniversalLabOrdersValueSet/LoincUniversalLabOrdersValueSet.csv new file mode 100644 index 0000000..2888f12 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/LoincUniversalLabOrdersValueSet/LoincUniversalLabOrdersValueSet.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","LONG_COMMON_NAME","ORDER_OBS" +"42176-8","1,3 beta glucan [Mass/volume] in Serum","Both" diff --git a/test/resources/loinc-fixture/AccessoryFiles/PanelsAndForms/AnswerList.csv b/test/resources/loinc-fixture/AccessoryFiles/PanelsAndForms/AnswerList.csv new file mode 100644 index 0000000..320c94d --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/PanelsAndForms/AnswerList.csv @@ -0,0 +1,2 @@ +"AnswerListId","AnswerListName","AnswerListOID","ExtDefinedYN","ExtDefinedAnswerListCodeSystem","ExtDefinedAnswerListLink","AnswerStringId","LocalAnswerCode","LocalAnswerCodeSystem","SequenceNumber","DisplayText","ExtCodeId","ExtCodeDisplayName","ExtCodeSystem","ExtCodeSystemVersion","ExtCodeSystemCopyrightNotice","SubsequentTextPrompt","Description","Score" +"LL1000-0","PhenX05_13_30D bread amt","1.3.6.1.4.1.12009.10.1.165","N","","","LA13825-7","1","","1","1 slice or 1 dinner roll","","","","","","","","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/PanelsAndForms/Loinc.csv b/test/resources/loinc-fixture/AccessoryFiles/PanelsAndForms/Loinc.csv new file mode 100644 index 0000000..f930885 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/PanelsAndForms/Loinc.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","VersionLastChanged","CHNG_TYPE","DefinitionDescription","STATUS","CONSUMER_NAME","CLASSTYPE","FORMULA","EXMPL_ANSWERS","SURVEY_QUEST_TEXT","SURVEY_QUEST_SRC","UNITSREQUIRED","RELATEDNAMES2","SHORTNAME","ORDER_OBS","HL7_FIELD_SUBFIELD_ID","EXTERNAL_COPYRIGHT_NOTICE","EXAMPLE_UNITS","LONG_COMMON_NAME","EXAMPLE_UCUM_UNITS","STATUS_REASON","STATUS_TEXT","CHANGE_REASON_PUBLIC","COMMON_TEST_RANK","COMMON_ORDER_RANK","HL7_ATTACHMENT_STRUCTURE","EXTERNAL_COPYRIGHT_LINK","PanelType","AskAtOrderEntry","AssociatedObservations","VersionFirstReleased","ValidHL7AttachmentRequest","DisplayName" +"100000-9","Health informatics pioneer and the father of LOINC","Hx","Pt","^Patient","Nar","","H&P.HX","2.74","ADD","This term honors the long-standing contributions of Dr. Clement J. McDonald, the founder of LOINC and health informatics pioneer. Dr. McDonald's dedication, innovation, and hands-on contributions helped develop and continually improve medical informatics and health data standards.","ACTIVE","","2","","","","","N","Clem McDonald; Dr. Clement J. McDonald Jr.; H+P; H+P.HX; Health Info Pioneer+Father of LOINC; History; Honorary; Logical Observation Identifiers Names and Codes; Narrative; P prime; Point in time; Random; Report","Health Info Pioneer+Father of LOINC","Observation","","","","Health informatics pioneer and the father of LOINC","","","","","0","0","","","","","","2.74","","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/PanelsAndForms/LoincAnswerListLink.csv b/test/resources/loinc-fixture/AccessoryFiles/PanelsAndForms/LoincAnswerListLink.csv new file mode 100644 index 0000000..c9da2be --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/PanelsAndForms/LoincAnswerListLink.csv @@ -0,0 +1,2 @@ +"LoincNumber","LongCommonName","AnswerListId","AnswerListName","AnswerListLinkType","ApplicableContext" +"100002-5","Specimen care is maintained","LL6136-7","Met/Not met/Ongoing/Unable to assess","NORMATIVE","100017-3" diff --git a/test/resources/loinc-fixture/AccessoryFiles/PanelsAndForms/PanelsAndForms.csv b/test/resources/loinc-fixture/AccessoryFiles/PanelsAndForms/PanelsAndForms.csv new file mode 100644 index 0000000..50c5ffc --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/PanelsAndForms/PanelsAndForms.csv @@ -0,0 +1,2 @@ +"ParentId","ParentLoinc","ParentName","ID","SEQUENCE","Loinc","LoincName","DisplayNameForForm","ObservationRequiredInPanel","ObservationIdInForm","SkipLogicHelpText","DefaultValue","EntryType","DataTypeInForm","DataTypeSource","AnswerSequenceOverride","ConditionForInclusion","AllowableAlternative","ObservationCategory","Context","ConsistencyChecks","RelevanceEquation","CodingInstructions","QuestionCardinality","AnswerCardinality","AnswerListIdOverride","AnswerListTypeOverride","EXTERNAL_COPYRIGHT_NOTICE","AdditionalCopyright" +"10142","13361-1","Semen Analysis Pnl","10142","1","13361-1","Semen Analysis Pnl","","","","","","Q","","","","","","","","","","","","","","","","" diff --git a/test/resources/loinc-fixture/AccessoryFiles/PartFile/LoincPartLink_Primary.csv b/test/resources/loinc-fixture/AccessoryFiles/PartFile/LoincPartLink_Primary.csv index 6e3bc93..2472ecc 100644 --- a/test/resources/loinc-fixture/AccessoryFiles/PartFile/LoincPartLink_Primary.csv +++ b/test/resources/loinc-fixture/AccessoryFiles/PartFile/LoincPartLink_Primary.csv @@ -1,6 +1,2 @@ -"LoincNumber","LongCommonName","PartNumber","PartName","PartCodeSystem","PartTypeName","LinkTypeName","Property" -"2951-2","Sodium [Moles/volume] in Serum or Plasma","LP15099-2","Sodium","http://loinc.org","COMPONENT","Primary","http://loinc.org/property/COMPONENT" -"2951-2","Sodium [Moles/volume] in Serum or Plasma","LP6860-3","SCnc","http://loinc.org","PROPERTY","Primary","http://loinc.org/property/PROPERTY" -"2951-2","Sodium [Moles/volume] in Serum or Plasma","LP6960-1","Pt","http://loinc.org","TIME","Primary","http://loinc.org/property/TIME_ASPCT" -"2951-2","Sodium [Moles/volume] in Serum or Plasma","LP7576-4","Ser/Plas","http://loinc.org","SYSTEM","Primary","http://loinc.org/property/SYSTEM" -"2951-2","Sodium [Moles/volume] in Serum or Plasma","LP7753-9","Qn","http://loinc.org","SCALE","Primary","http://loinc.org/property/SCALE_TYP" +"LoincNumber","LongCommonName","PartNumber","PartName","PartCodeSystem","PartTypeName","LinkTypeName","Property" +"100000-9","Health informatics pioneer and the father of LOINC","LP431397-1","Health informatics pioneer and the father of LOINC","http://loinc.org","COMPONENT","Primary","http://loinc.org/property/COMPONENT" diff --git a/test/resources/loinc-fixture/AccessoryFiles/PartFile/LoincPartLink_Supplementary.csv b/test/resources/loinc-fixture/AccessoryFiles/PartFile/LoincPartLink_Supplementary.csv new file mode 100644 index 0000000..75da1a2 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/PartFile/LoincPartLink_Supplementary.csv @@ -0,0 +1,2 @@ +"LoincNumber","LongCommonName","PartNumber","PartName","PartCodeSystem","PartTypeName","LinkTypeName","Property" +"100000-9","Health informatics pioneer and the father of LOINC","LP431397-1","Health informatics pioneer and the father of LOINC","http://loinc.org","COMPONENT","DetailedModel","http://loinc.org/property/analyte" diff --git a/test/resources/loinc-fixture/AccessoryFiles/PartFile/Part.csv b/test/resources/loinc-fixture/AccessoryFiles/PartFile/Part.csv index d3b921a..3dce955 100644 --- a/test/resources/loinc-fixture/AccessoryFiles/PartFile/Part.csv +++ b/test/resources/loinc-fixture/AccessoryFiles/PartFile/Part.csv @@ -1,7 +1,2 @@ -"PartNumber","PartTypeName","PartName","PartDisplayName","Status" -"LP15099-2","COMPONENT","Sodium","Sodium","ACTIVE" -"LP386648-2","COMPONENT","Sodium [Mass/volume]","Sodium [Mass/volume]","ACTIVE" -"LP6860-3","PROPERTY","SCnc","Substance Concentration","ACTIVE" -"LP7753-9","SCALE","Qn","Qn","ACTIVE" -"LP7576-4","SYSTEM","Ser/Plas","Serum or Plasma","ACTIVE" -"LP6960-1","TIME","Pt","Point in time (spot)","ACTIVE" +"PartNumber","PartTypeName","PartName","PartDisplayName","Status" +"LP101394-7","ADJUSTMENT","adjusted for maternal weight","adjusted for maternal weight","ACTIVE" diff --git a/test/resources/loinc-fixture/AccessoryFiles/PartFile/PartRelatedCodeMapping.csv b/test/resources/loinc-fixture/AccessoryFiles/PartFile/PartRelatedCodeMapping.csv new file mode 100644 index 0000000..58827e9 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/PartFile/PartRelatedCodeMapping.csv @@ -0,0 +1,2 @@ +"PartNumber","PartName","PartTypeName","ExtCodeId","ExtCodeDisplayName","ExtCodeSystem","Equivalence","ContentOrigin","ExtCodeSystemVersion","ExtCodeSystemCopyrightNotice" +"LP100006-8","Human papilloma virus 18 DNA","COMPONENT","708299006","Deoxyribonucleic acid of Human papillomavirus 18 (substance)","http://snomed.info/sct","equivalent","LN","http://snomed.info/sct/900000000000207008/version/20250730","This material includes SNOMED Clinical Terms® (SNOMED CT®) which is used by permission of the International Health Terminology Standards Development Organisation (IHTSDO) under license. All rights reserved. SNOMED CT® was originally created by The College of American Pathologists. ""SNOMED"" and ""SNOMED CT"" are registered trademarks of the IHTSDO. This material includes content from the US Edition to SNOMED CT, which is developed and maintained by the U.S. National Library of Medicine and is available to authorized UMLS Metathesaurus Licensees from the UTS Downloads site at https://uts.nlm.nih.gov. Use of SNOMED CT content is subject to the terms and conditions set forth in the SNOMED CT Affiliate License Agreement. It is the responsibility of those implementing this product to ensure they are appropriately licensed and for more information on the license, including how to register as an Affiliate Licensee, please refer to http://www.snomed.org/snomed-ct/get-snomed-ct or info@snomed.org. This may incur a fee in SNOMED International non-Member countries." diff --git a/test/resources/loinc-fixture/AccessoryFiles/Updates/Updates.csv b/test/resources/loinc-fixture/AccessoryFiles/Updates/Updates.csv new file mode 100644 index 0000000..72992ac --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/Updates/Updates.csv @@ -0,0 +1,2 @@ +"RecType","LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS" +"BEFORE","100346-6","Clotting time.extrinsic coagulation system activated.platelets inhibited","Time","Pt","Bld","Qn","Thromboelastography.rotational","COAG" diff --git a/test/resources/loinc-fixture/AccessoryFiles/Updates/UpdatesAdditionalFields.csv b/test/resources/loinc-fixture/AccessoryFiles/Updates/UpdatesAdditionalFields.csv new file mode 100644 index 0000000..d201ae2 --- /dev/null +++ b/test/resources/loinc-fixture/AccessoryFiles/Updates/UpdatesAdditionalFields.csv @@ -0,0 +1,2 @@ +"RecType","LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","VersionLastChanged","CHNG_TYPE","DefinitionDescription","STATUS","CONSUMER_NAME","CLASSTYPE","FORMULA","EXMPL_ANSWERS","SURVEY_QUEST_TEXT","SURVEY_QUEST_SRC","UNITSREQUIRED","RELATEDNAMES2","SHORTNAME","ORDER_OBS","HL7_FIELD_SUBFIELD_ID","EXTERNAL_COPYRIGHT_NOTICE","EXAMPLE_UNITS","LONG_COMMON_NAME","EXAMPLE_UCUM_UNITS","STATUS_REASON","STATUS_TEXT","CHANGE_REASON_PUBLIC","COMMON_TEST_RANK","COMMON_ORDER_RANK","HL7_ATTACHMENT_STRUCTURE","EXTERNAL_COPYRIGHT_LINK","PanelType","AskAtOrderEntry","AssociatedObservations","VersionFirstReleased","ValidHL7AttachmentRequest","DisplayName" +"BEFORE","100030-6","Axis I: Temporal aspects score","Score","Pt","^Patient","Qn","Mainz Pain Staging System","SURVEY.PAIN","2.72","ADD","The Axis I: temporal aspects of pain score is determined by three items including: patterns of occurrence, pain duration, and change of pain intensity. Individual items are scored from 1-3. Items are summed and converted to an axis stage between 3-9 and 3=I, 4-6=II, and 7-9=III, with higher values associated with greater pain chronicity. [PMID: 12799906, PMID: 20093984]","ACTIVE","","4","","","","","N","MPSS; Point in time; QNT; Quan; Quant; Quantitative; Random; Scale; Survey","","Observation","","© 1999 H.U. Gerbershagen, J. Korb, B. Nagel, P. Nilges. Used with permission.","score","Axis I: Temporal aspects score [Mainz Pain Staging System]","{score}","","","","0","0","","MAINZ","","","","2.72","","" diff --git a/test/resources/loinc-fixture/LoincTable/Loinc.csv b/test/resources/loinc-fixture/LoincTable/Loinc.csv new file mode 100644 index 0000000..f930885 --- /dev/null +++ b/test/resources/loinc-fixture/LoincTable/Loinc.csv @@ -0,0 +1,2 @@ +"LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","VersionLastChanged","CHNG_TYPE","DefinitionDescription","STATUS","CONSUMER_NAME","CLASSTYPE","FORMULA","EXMPL_ANSWERS","SURVEY_QUEST_TEXT","SURVEY_QUEST_SRC","UNITSREQUIRED","RELATEDNAMES2","SHORTNAME","ORDER_OBS","HL7_FIELD_SUBFIELD_ID","EXTERNAL_COPYRIGHT_NOTICE","EXAMPLE_UNITS","LONG_COMMON_NAME","EXAMPLE_UCUM_UNITS","STATUS_REASON","STATUS_TEXT","CHANGE_REASON_PUBLIC","COMMON_TEST_RANK","COMMON_ORDER_RANK","HL7_ATTACHMENT_STRUCTURE","EXTERNAL_COPYRIGHT_LINK","PanelType","AskAtOrderEntry","AssociatedObservations","VersionFirstReleased","ValidHL7AttachmentRequest","DisplayName" +"100000-9","Health informatics pioneer and the father of LOINC","Hx","Pt","^Patient","Nar","","H&P.HX","2.74","ADD","This term honors the long-standing contributions of Dr. Clement J. McDonald, the founder of LOINC and health informatics pioneer. Dr. McDonald's dedication, innovation, and hands-on contributions helped develop and continually improve medical informatics and health data standards.","ACTIVE","","2","","","","","N","Clem McDonald; Dr. Clement J. McDonald Jr.; H+P; H+P.HX; Health Info Pioneer+Father of LOINC; History; Honorary; Logical Observation Identifiers Names and Codes; Narrative; P prime; Point in time; Random; Report","Health Info Pioneer+Father of LOINC","Observation","","","","Health informatics pioneer and the father of LOINC","","","","","0","0","","","","","","2.74","","" diff --git a/test/resources/loinc-fixture/LoincTable/MapTo.csv b/test/resources/loinc-fixture/LoincTable/MapTo.csv index f0fc1ab..86cac1d 100644 --- a/test/resources/loinc-fixture/LoincTable/MapTo.csv +++ b/test/resources/loinc-fixture/LoincTable/MapTo.csv @@ -1,3 +1,2 @@ "LOINC","MAP_TO","COMMENT" "1009-0","1007-4","" -"1009-0","2160-0","Cross-domain note" diff --git a/test/resources/loinc-fixture/LoincTable/SourceOrganization.csv b/test/resources/loinc-fixture/LoincTable/SourceOrganization.csv new file mode 100644 index 0000000..1a7f063 --- /dev/null +++ b/test/resources/loinc-fixture/LoincTable/SourceOrganization.csv @@ -0,0 +1,2 @@ +"ID","COPYRIGHT_ID","NAME","COPYRIGHT","TERMS_OF_USE","URL" +"3","Pfizer","Pfizer, Inc","Copyright © Pfizer Inc. All rights reserved.","Developed by Drs. Robert L. Spitzer, Janet B.W. Williams, Kurt Kroenke and colleagues, with an educational grant from Pfizer Inc. No permission required to reproduce, translate, display or distribute.","https://www.phqscreeners.com/" diff --git a/test/resources/loinc-fixture/LoincTableCore/LoincTableCore.csv b/test/resources/loinc-fixture/LoincTableCore/LoincTableCore.csv index 552ba29..922b747 100644 --- a/test/resources/loinc-fixture/LoincTableCore/LoincTableCore.csv +++ b/test/resources/loinc-fixture/LoincTableCore/LoincTableCore.csv @@ -1,10 +1,2 @@ "LOINC_NUM","COMPONENT","PROPERTY","TIME_ASPCT","SYSTEM","SCALE_TYP","METHOD_TYP","CLASS","CLASSTYPE","LONG_COMMON_NAME","SHORTNAME","EXTERNAL_COPYRIGHT_NOTICE","STATUS","VersionFirstReleased","VersionLastChanged" -"718-7","Hemoglobin","MCnc","Pt","Bld","Qn","","HEM/BC","1","Hemoglobin [Mass/volume] in Blood","Hgb Bld","","ACTIVE","1.0","2.73" -"4548-4","Hemoglobin A1c/Hemoglobin.total","MFr","Pt","Bld","Qn","HPLC","HEM/BC","1","Hemoglobin A1c/Hemoglobin.total in Blood by HPLC","HbA1c MFr Bld HPLC","","ACTIVE","1.0","2.73" -"2160-0","Creatinine","MCnc","Pt","Ser/Plas","Qn","","CHEM","1","Creatinine [Mass/volume] in Serum or Plasma","Creat SerPl-mCnc","","ACTIVE","1.0","2.73" -"2345-7","Glucose","MCnc","Pt","Ser/Plas","Qn","","CHEM","1","Glucose [Mass/volume] in Serum or Plasma","Glucose SerPl-mCnc","","ACTIVE","1.0","2.73" -"1009-0","Direct antiglobulin test.poly specific reagent","ACnc","Pt","RBC","Ord","Agglutination","HEM/BC","1","Direct antiglobulin test.poly specific reagent [Presence] on Red Blood Cells by Agglutination","DAT poly RBC Ql","","DEPRECATED","1.0","2.74" -"100002-5","Specimen care is maintained","Find","Pt","^Patient","Ord","","H&P.HX","2","Specimen care is maintained","Specimen care maintained","","ACTIVE","2.74","2.74" -"100003-3","Team communication is maintained throughout care","Find","Pt","^Patient","Ord","","H&P.HX","2","Team communication is maintained throughout care","Team comm maintained","","ACTIVE","2.74","2.74" -"100017-3","Surgical safety checklist","-","Pt","^Patient","Doc","","DOC.ONTOLOGY","3","Surgical safety checklist","Surgical safety chk","","ACTIVE","2.74","2.74" -"2951-2","Sodium","SCnc","Pt","Ser/Plas","Qn","","CHEM","1","Sodium [Moles/volume] in Serum or Plasma","Na SerPl-sCnc","","ACTIVE","1.0","2.73" +"100000-9","Health informatics pioneer and the father of LOINC","Hx","Pt","^Patient","Nar","","H&P.HX","2","Health informatics pioneer and the father of LOINC","Health Info Pioneer+Father of LOINC","","ACTIVE","2.74","2.74" diff --git a/test/resources/loinc-fixture/LoincTableCore/MapTo.csv b/test/resources/loinc-fixture/LoincTableCore/MapTo.csv new file mode 100644 index 0000000..e1a735f --- /dev/null +++ b/test/resources/loinc-fixture/LoincTableCore/MapTo.csv @@ -0,0 +1,2 @@ +"LOINC","MAP_TO","COMMENT" +"1009-0","1007-4",""