-
Notifications
You must be signed in to change notification settings - Fork 0
/
core.clj
152 lines (127 loc) · 6.58 KB
/
core.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
(ns com.eldrix.codelists.core
"Codelists provides functionality to generate a list of codes from different
specifications.
There are three broad approaches:
1. Keep a manual list of codes.
2. One can generate a canonical set of codes given an input specification, and
use those as required to test data. This approach is good when you have
millions of rows of data and lots of checks to perform. Set-up time is longer
but checks should be quicker. It is possible to generate a crossmap table
to demonstrate how selection has occurred, and helpful for reproducibility at
a time point.
3. One can test a set of identifiers against a specification. This approach
is good when a codelist is very large, and fewer checks are needed. Set-up
time is small.
In many situations all approaches might be necessary, depending on trade-offs.
You might generate a codelist for documentation purposes but use a different
approach to check each row of source data. All approaches should give the
same answers."
(:require [clojure.data.json :as json]
[clojure.set :as set]
[clojure.string :as str]
[com.eldrix.dmd.core :as dmd]
[com.eldrix.hermes.core :as hermes]
[com.eldrix.hermes.snomed :as snomed]))
(defn parse-json [s]
(json/read-str s :key-fn keyword))
(defn apply-union
"Applies function f to x, but if x is a sequence, returns the logical union
of applying f to each member. 'f' should be a function returning a set."
[f x]
(if (sequential? x)
(apply set/union (map f x))
(f x)))
(defn tf-for-product [hermes concept-id]
(filter #(seq (hermes/component-refset-items hermes % 999000631000001100)) (hermes/all-parents hermes concept-id)))
(defn atc->snomed-ecl
"Map an ATC regexp into a SNOMED expression that can include all UK product
identifiers (VTM, VMP, AMP and TF). This does not include product packs,
by design."
[{:com.eldrix/keys [dmd hermes]} atc]
(let [products (dmd/atc->products-for-ecl dmd atc)
tfs (->> (:AMP products)
(mapcat #(tf-for-product hermes %))
(map #(str "<<" %)))
vtms (map #(str "<<" %) (:VTM products))
vmps (map #(str "<<" %) (:VMP products))]
(str/join " OR " (concat tfs vtms vmps))))
(declare realize-concepts)
(defn realize-concepts*
[{:com.eldrix/keys [hermes dmd] :as env} {and' :and or' :or not' :not :keys [ecl icd10 atc]}]
(let [incl (set/union
(when and' (apply set/intersection (map #(realize-concepts env %) and')))
(when or' (apply set/union (map #(realize-concepts env %) or')))
(when ecl (apply-union #(into #{} (map :conceptId (hermes/expand-ecl-historic hermes %))) ecl))
(when icd10 (hermes/with-historical hermes (set (apply-union #(hermes/member-field-wildcard hermes 447562003 "mapTarget" %) icd10))))
(when atc (apply-union #(let [atc' (atc->snomed-ecl env (re-pattern (str/replace % "*" ".*")))]
(when-not (= "" atc') (into #{} (map :conceptId (hermes/expand-ecl-historic hermes atc' ))))) atc)))]
(if not'
(set/difference incl (realize-concepts env not'))
incl)))
(defn realize-concepts [env x]
(apply-union #(realize-concepts* env %) x))
(defn disjoint?
"Are sets disjoint, so that no set shares a member with any other set?
Note this is different to determining the intersection between the sets.
e.g.
(clojure.set/intersection #{1 2} #{2 3} #{4 5}) => #{} ; no intersection
(disjoint? #{1 2} #{2 3} #{4 5}) => false ; not disjoint."
[& sets]
(apply distinct? (apply concat sets)))
(defn to-icd10
"Map a collection of concept identifiers to a set of ICD-10 codes."
[{:com.eldrix/keys [hermes]} concept-ids]
(->> concept-ids
(mapcat #(hermes/component-refset-items hermes % 447562003))
(map :mapTarget)
(filter identity)
(into #{})))
(defn ^:private is-trade-family?
"Is the product a type of trade family product?
We simply use the TF reference set as a check for membership."
[{:com.eldrix/keys [hermes]} concept-id]
(seq (hermes/component-refset-items hermes concept-id 999000631000001100)))
(defn to-atc
"Map a collection of concept identifiers to a set of ATC codes.
The UK dm+d via the dmd library supports VTMs, VMPs, AMPs, AMPPs and VMPPs,
but cannot map from TF concepts. As such, this checks whether the product is
a TF concept id, and simply uses the VMPs instead."
[{:com.eldrix/keys [hermes dmd] :as system} concept-ids]
(->> concept-ids
(mapcat (fn [concept-id]
(if (is-trade-family? system concept-id)
(distinct (map #(dmd/atc-for-product dmd %) (hermes/child-relationships-of-type hermes concept-id snomed/IsA)))
(vector (dmd/atc-for-product dmd concept-id)))))
(filter identity)
set))
(comment
(def hermes (hermes/open "/Users/mark/Dev/hermes/snomed.db"))
(def dmd (dmd/open-store "/Users/mark/Dev/dmd/dmd-2022-05-09.db"))
(def system {:com.eldrix/hermes hermes :com.eldrix/dmd dmd})
(defn ps [id] (vector id (:term (hermes/preferred-synonym (:com.eldrix/hermes system) id "en-GB"))))
(ps 24700007)
(dmd/fetch-release-date dmd)
(dmd/fetch-product dmd 108537001)
(hermes/concept hermes 108537001)
(ps 108537001)
(def calcium-channel (realize-concepts system {:atc #"C08CA.*"})) ;; see https://www.whocc.no/atc_ddd_index/?code=C08CA01
(count calcium-channel)
(contains? calcium-channel 108537001)
(def multiple-sclerosis (realize-concepts system {:icd10 "G35"}))
(contains? multiple-sclerosis 24700007)
(def basal-ganglion (-> (hermes/search hermes {:s "Basal ganglion" :max-hits 1}) first :conceptId))
(def peripheral-nerve (-> (hermes/search hermes {:s "Peripheral nerve structure" :max-hits 1}) first :conceptId))
basal-ganglion
peripheral-nerve
(defn finding-site?
[concept-id site-concept-id]
(let [concept-ids (get (hermes/parent-relationships-expanded hermes concept-id snomed/FindingSite) snomed/FindingSite)]
(contains? concept-ids site-concept-id)))
(def parkinsons (realize-concepts system {:icd10 "G20"}))
parkinsons
;; is G20 a disease of the basal ganglia? -> yes
(some #(finding-site? % basal-ganglion) (realize-concepts system {:icd10 "G20"}))
;; is G20 a disease of the peripheral nerve? -> no
(some #(finding-site? % peripheral-nerve) (realize-concepts system {:icd10 "G20"}))
;; are G61.* diseases of the peripheral nerve -> yes
(some #(finding-site? % peripheral-nerve) (realize-concepts system {:icd10 "G61.*"}))) ; G61.* = peripheral neuropathy