-
Notifications
You must be signed in to change notification settings - Fork 4
/
message.clj
280 lines (231 loc) · 11.1 KB
/
message.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
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
;;
;; Functions to make it easier to work with parsed HL7 messages.
;;
(ns com.nervestaple.hl7-parser.message
(:use
[com.nervestaple.hl7-parser.parser]
[com.nervestaple.hl7-parser.util]
[com.nervestaple.hl7-parser.dump]
[com.nervestaple.hl7-parser.message])
(:import
(java.util Date)))
(def REGEX-MESSAGE-ID
#"MSH\|[^\|]*\|[^\|]*\|[^\|]*\|[^\|]*\|[^\|]*\|[^\|]*\|[^\|]*\|[^\|]*\|([^\|]*)\|")
(defn message-id-unparsed
"Returns the message id for an HL7 message by doing some simple
regular expression matching on the message. This function does *not*
involve parsing the message and may be faster."
[message]
(let [matches (re-find REGEX-MESSAGE-ID message)]
(if (and matches (second matches))
(second matches))))
(defn segment-ids
"Returns a list of the segment ids present in the message."
[message]
(map (fn [segment] (:id segment)) (:segments message)))
(defn get-segments
"Returns all of the segments in the message that have the provided
segment id."
[message segment-id]
(filter (fn [segment] (= segment-id (:id segment)))
(:segments message)))
(defn get-segment-field
"Returns the field with the provided index from the given
segment. Keep in mind that this function expects the index to adhere
to the HL7 specification where the first field of data is located at
index 1. Another gotcha in the MSH segment, the first field of data
starts at index 2 and that's the list of delimiters.
This function will return the id of the segment if you ask for index
0. For the MSH segment, it will return nil for index 1 instead of
returning the field delimiter. If you want the field delimiter you
can get it under the :delimiter key of the message."
[segment index]
(cond
;; handle MSH differently
(= "MSH" (:id segment))
(cond
;; index 0 returns the segment id
(= 0 index)
(:id segment)
;; index 1 should return the field delimiter
(= 1 index)
nil
;; correct our index and return the field
:else
(let [real-index (- index 2)]
(nth (:fields segment) real-index)))
:else
(cond
;; index 0 returns the segment id
(= 0 index)
(:id segment)
;; correct our index and return the field
:else
(let [real-index (dec index)
field (if (< real-index (count (:fields segment)))
(nth (:fields segment) real-index))]
(if (map? field)
(:content field)
field)))))
(defn get-field
"Returns the field with the provided index from the segment with the
given id of the provided message."
[message segment-id field-index]
(map (fn [segment] (get-segment-field segment field-index))
(get-segments message segment-id)))
(defn- get-nth-field
"Returns the item at index in the collection of field data. If
passed a collection of fields, the item at index from each field is
returned. If passed a collection that contains subcomponents, the
item at index for each subcomponent is returned."
[index field-or-fields]
(cond
(map? (first field-or-fields))
(map (fn [field]
(get-nth-field index (:content field)))
field-or-fields)
(coll? (first field-or-fields))
(map (partial get-nth-field index) field-or-fields)
:else
(nth field-or-fields index)))
(defn get-field-component
"Returns the component at the provided index from the field with the
provided index from the segment with the given id in the provided
message."
[message segment-id field-index component-index]
(let [data (flatten (get-field message segment-id field-index))]
(get-nth-field component-index data)))
(defn set-field
"Updates the message by altering the field value for the specified
segment. When specifying field indexes, be sure to use the correct
HL7 index (the segment id would be 0, the first field is at index
1).
Your value should be an atom or an collection, a collection
indicates a field with components. Subcomponents are represented as
a collection containing a collection. Pass in a collection of fields
to indicate repeating fields."
[message segment-id field-index value]
;; correct our index and value (put an atom in a collection)
(let [field-index-fixed (if (= "MSH" segment-id)
(- field-index 2) (dec field-index))
field-value (if (coll? value) value [value])]
;; throw an error if we have an illegal HL7 index
(if (< field-index-fixed 0)
(throw (Exception. "The first field is at index 1")))
;; create a whole new message
(struct-map message-struct
:delimiters (:delimiters message)
;; map over our segments looking for the one we're changing
:segments (map (fn [segment]
(if (= segment-id (:id segment))
;; associate our new fields
(assoc segment :fields
;; associate our new value with the
;; field collections
(assoc (:fields segment)
field-index-fixed
(create-field field-value)))
;; return the segment unaltered
segment))
(:segments message)))))
(defn extract-text-from-segments
"Extracts the text from the parsed message for the supplied index of
the given segments, the text will be concatenated and returned as
one String. For instance, this function would extract all of th text
from the fifth index of all of the OBX segments:
(extract-text-from-segments parsed-message 'OBX' 5)
You may pass in an optional argument that contains a character to
interleave between the chunks of extracted text (for instance,
'\n')."
[parsed-message segment-type index & options]
(apply str (if (first options)
(interpose (first options)
(flatten (get-field parsed-message segment-type index)))
(flatten (get-field parsed-message segment-type index)))))
(defn get-field-first
"Returns the first instance of the field with the provided index
from the segment with the given id of the provided message. This
function is handy when you know there's only one instance of a
particular segment (like 'MSH'), you won't have to grab the first
element; it will be returned by this function."
[parsed-message segment-id field-index]
(first (get-field parsed-message segment-id field-index)))
(defn get-field-first-value
"Returns the value of the first instance of the field with the
provided index from the segment with the given id of the provided
message. This function is handy when you know there's only one
instance of a particular segment (like 'MSH'), you won't have to
grab the first element and then it's :content value; it will be
returned by this function."
[parsed-message segment-id field-index]
(let [field (get-field-first parsed-message segment-id field-index)]
(if field (pr-field (:delimiters parsed-message) field))))
(defn ack-message
"Returns a parsed message that contains an acknowledgement message
for the provided parsed message, the acknowledgement message will
use the same delimiters. If the message indicates that no
acknowledgement should be returned, this function will return nil.
The 'option' should be a hash-map with the following keys:
:sending-app, :sending-facility, :production-mode, :version,
:text-message
These values will be used to fill out the ACK message. The
'ack-status' field should be a valid HL7 version 2.x acknowledgment
status:
AA (accepted), AE (error), AR (rejected)"
[options ack-status parsed-message]
;; make sure the sender of this message is looking to receive an
;; acknowledgement
(let [accept-ack-type (:content (get-field parsed-message "MSH" 15))]
(if (or (not= "NE" accept-ack-type)
(not= "ER" accept-ack-type))
;; we are returning an acknowledgement
(create-message (:delimiters parsed-message)
(create-segment "MSH"
(create-field (pr-delimiters (:delimiters parsed-message)))
(create-field [(:sending-app options)])
(create-field [(:sending-facility options)])
(get-field-first parsed-message "MSH" 3)
(get-field-first parsed-message "MSH" 4)
(create-field [(.format TIMESTAMP-FORMAT (new Date))])
(create-field [])
(create-field ["ACK"])
(get-field-first parsed-message "MSH" 10)
(create-field [(:production-mode options)])
(create-field [(:version options)]))
(create-segment "MSA"
(create-field [ack-status])
(get-field-first parsed-message "MSH" 10)
(create-field [(:text-message options)]))))))
(defn ack-message-fallback
"Returns a parsed message that contains an acknowledgement message
for the provided parsed message, the acknowledgement message will
use the same delimiters. If the message indicates that no
acknowledgement should be returned, this function will return nil.
The 'option' should be a hash-map with the following keys:
:sending-app, :sending-facility, :production-mode, :version,
:text-message
These values will be used to fill out the ACK message. The
'ack-status' field should be a valid HL7 version 2.x acknowledgment
status:
AA (accepted), AE (error), AR (rejected)"
[options ack-status message]
;; we are returning an acknowledgement
(create-message {:field 124, :component 94, :subcomponent 38,
:repeating 126, :escape 92}
(create-segment "MSH"
(create-field (pr-delimiters {:field 124, :component 94, :subcomponent 38,
:repeating 126, :escape 92}))
(create-field [(:sending-app options)])
(create-field [(:sending-facility options)])
(create-field ["UNKNOWN"])
(create-field ["UNKNOWN"])
(create-field [(.format TIMESTAMP-FORMAT (new Date))])
(create-field [])
(create-field ["ACK"])
(message-id-unparsed message)
(create-field [(:production-mode options)])
(create-field [(:version options)]))
(create-segment "MSA"
(create-field [ack-status])
(message-id-unparsed message)
(create-field [(:text-message options)]))))