├── .devcontainer ├── Dockerfile └── devcontainer.json ├── .github └── workflows │ └── ci.yml ├── .gitignore ├── LICENSE.txt ├── README.md ├── project.clj ├── src └── com │ └── nervestaple │ └── hl7_parser │ ├── batch.clj │ ├── dump.clj │ ├── main.clj │ ├── message.clj │ ├── parser.clj │ ├── test.clj │ └── util.clj ├── test └── com │ └── nervestaple │ └── hl7_parser │ ├── message_test.clj │ ├── parser_test.clj │ └── sample_message.clj └── tests.edn /.devcontainer/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM mcr.microsoft.com/vscode/devcontainers/java:16-bullseye 2 | 3 | # update packages 4 | RUN apt update -y 5 | RUN apt upgrade -y 6 | 7 | # install leiningen 8 | RUN curl -O https://raw.githubusercontent.com/technomancy/leiningen/stable/bin/lein 9 | RUN chmod +x lein 10 | RUN mv lein /usr/local/sbin 11 | RUN lein --version 12 | 13 | # install clj-kondo 14 | RUN curl -sLO https://raw.githubusercontent.com/clj-kondo/clj-kondo/master/script/install-clj-kondo 15 | RUN chmod +x install-clj-kondo 16 | RUN ./install-clj-kondo 17 | RUN rm ./install-clj-kondo 18 | 19 | # install node.js 20 | RUN curl -fsSL https://deb.nodesource.com/setup_lts.x | bash - 21 | RUN apt-get install -y nodejs 22 | 23 | ENTRYPOINT ["/bin/bash"] 24 | -------------------------------------------------------------------------------- /.devcontainer/devcontainer.json: -------------------------------------------------------------------------------- 1 | { 2 | "build": { 3 | "dockerfile": "Dockerfile" 4 | }, 5 | "extensions": [ 6 | "borkdude.clj-kondo", 7 | "betterthantomorrow.calva" 8 | ] 9 | } 10 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: Continuous Integration 2 | 3 | on: 4 | push: 5 | 6 | jobs: 7 | build: 8 | runs-on: [ubuntu-latest] 9 | steps: 10 | - name: Checkout 11 | uses: actions/checkout@v2 12 | - name: Setup Java 13 | uses: actions/setup-java@v1 14 | with: 15 | java-version: 17 16 | - name: Install Clojure Tools 17 | uses: DeLaGuardo/setup-clojure@3.5 18 | with: 19 | lein: 2.9.8 20 | - name: Run Tests 21 | run: lein kaocha 22 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | ._* 3 | *.log 4 | *.tmproj 5 | #* 6 | .\#* 7 | \#* 8 | *.jar 9 | classes/* 10 | lib/* 11 | target/* 12 | .cake 13 | .nrepl-port 14 | pom.xml 15 | pom.xml.* 16 | *-local 17 | *-local-* 18 | .lein-* 19 | .clj-kondo 20 | .lsp 21 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Copyright (c) 2010 Christopher M. Miles 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is 8 | furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in 11 | all copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 19 | THE SOFTWARE. 20 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Clojure HL7 Version 2.x Message Parser 2 | ====================================== 3 | 4 | [![Clojars Project](https://img.shields.io/clojars/v/org.clojars.cmiles74/clojure-hl7-parser.svg)](https://clojars.org/org.clojars.cmiles74/clojure-hl7-parser) 5 | 6 | This library provides functions for parsing and manipulating [HL7 version 2.x 7 | Messages][hl7v2]. 8 | 9 | Usage 10 | ----- 11 | 12 | To use these functions, first require it in your project. 13 | 14 | (ns com.example.project 15 | (:require 16 | [com.nervestaple.hl7-parser.parser :as parser] 17 | [com.nervestaple.hl7-parser.message :as message])) 18 | 19 | The "parser" namespace contains functions for parsing and emitting HL7 20 | version 2.x messages. The "message" namespace contains functions for 21 | pulling specific information out of a parsed message as well as 22 | manipulating messages. 23 | 24 | In addition, the "dump" namespace has some functions for displaying a 25 | parsed message in a human-readable format. The "util" namespace has 26 | methods that may come in handy while your developing your HL7 27 | solution. The "test" namespace contains functions to make testing 28 | easier, including a test HL7 message. 29 | 30 | ### Parse A Message 31 | 32 | In this example we have the text of an incoming HL7 version 2.x 33 | message in a var called "text-message" parsing it is as easy as... 34 | 35 | (def parsed-message (parser/parse message)) 36 | 37 | The parsed message is a hash-map that contains all of the information 38 | contained in the message. It's not a lot of fun to look at. 39 | 40 | {:delimiters {:field 124, :component 94, :subcomponent 38, 41 | :repeating 126, :escape 92}, 42 | :segments [{:id "MSH", :fields [{:content "^~\\&"} 43 | {:content ["AcmeHIS"]} {:content ["StJohn"]} 44 | {:content ["CATH"]} {:content["StJohn"]}...]} 45 | 46 | The "message" namespace provides functions that make it easy to get 47 | the information you need out of this structure. 48 | 49 | user> (message/get-field parsed-message "MSH" 10) 50 | ({:content ["1291058687937"]}) 51 | 52 | You probably just want the actual value and not the field from the 53 | parsed data structure. 54 | 55 | user> (message/get-field-first-value parsed-message "MSH" 10) 56 | "1291058687937" 57 | 58 | Take a look at the source code, there are functions for retrieving 59 | whole segments, extracting text and changing the value of fields. 60 | 61 | ### Creating an Acknowledgment Message 62 | 63 | Generating acknowledgment messages is easy, we provide a function in 64 | the message namespace just for this purpose. Pass in the required 65 | options, your acknowledgment status and the parsed message that you 66 | are acknowledging. 67 | 68 | (message/ack-message {:sending-app "MYAPP" 69 | :sending-facility "TEST LAB" 70 | :production-mode "P" 71 | :version "2.3" 72 | :text-message "Successfully received"} 73 | "AA" parsed-message) 74 | 75 | This function will return a parsed message containing the 76 | acknowledgment. 77 | 78 | ### Creating a Message from Scratch 79 | 80 | Creating new HL7 messages is easy. You'll need a set of delimiters, 81 | you can create these manually or retrieve them from a message you have 82 | already parsed. 83 | 84 | user> (:delimiters parsed-message) 85 | {:field 124, :component 94, :subcomponent 38, :repeating 126, 86 | :escape 92} 87 | 88 | Delimiters are stored by their character code in a hashmap. You can create a map 89 | if you need to setup your own. 90 | 91 | user> {:field 124 :component 94 :subcomponent 38 repeating 126 escape 92} 92 | 93 | We have functions for building up messages in the "message" namespace. 94 | 95 | (create-message my-delimiters 96 | (create-segment "MSH" 97 | (create-field (parser/pr-delimiters my-delimiters)) 98 | (create-field ["MYAPP"]) 99 | (create-field ["TEST LAB"]) 100 | (create-field ["19202830920"]))) 101 | 102 | That's not a real message or a complete MSH segment but you get the 103 | idea. 104 | 105 | ### Emit a Message 106 | 107 | Emitting a message is also pretty straightforward. 108 | 109 | user> (parser/pr-message parsed-message) 110 | MSH|^~\&|AcmeHIS|StJohn|CATH|StJohn|20061019172719|... 111 | 112 | You can also emit pieces of a message, like the delimiters or a 113 | segment or field. The field and segment methods require that you also 114 | pass in the delimiters for the message. 115 | 116 | user> (parser/pr-segment my-delimiters pid-segment) 117 | "PID|||20301||Durden^Tyler^^^Mr.||19700312|M|||..." 118 | 119 | ### Dump a Message 120 | 121 | Lastly we provide tools for displaying more detailed information about the 122 | structure and content of a parsed message. Provide a parsed message to the 123 | `dump` function to get detail on the segments and their data. 124 | 125 | ``` 126 | Delimiters: 127 | Field: | 128 | Component: ^ 129 | Repeating: ~ 130 | Escape: \ 131 | Subcomponent: & 132 | 133 | Segment ID: MSH 134 | Index HL7 Index Type Content 135 | ----- --------- ----------- ----------- 136 | - 1 Atom "|" 137 | 0 2 Atom "^~\&" 138 | 1 3 Atom "AcmeHIS" 139 | 2 4 Atom "StJohn" 140 | 3 5 Atom "CATH" 141 | 4 6 Atom "StJohn" 142 | 5 7 Atom "20061019172719" 143 | 7 9 Component 1: "ORM", 2: "O01" 144 | 8 10 Atom "1676926150678" 145 | 9 11 Atom "P" 146 | 10 12 Atom "2.3" 147 | 148 | Segment ID: PID 149 | Index HL7 Index Type Content 150 | ----- --------- ----------- ----------- 151 | 2 3 Atom "20301" 152 | 4 5 Component 1: "Durden", 2: "Tyler", 3: "", 4: "", 5: "Mr." 153 | 6 7 Atom "19700312" 154 | 7 8 Atom "M" 155 | 10 11 Component 1: "88 Punchward Dr.", 2: "", 3: "Los Angeles", 4: "CA", 5: "11221", 6: "USA" 156 | ... 157 | ``` 158 | 159 | Development 160 | ------------ 161 | 162 | This project is managed with [Leiningen][lein], more information is available on 163 | the project website. If you're working on a pull request, the important thing is 164 | that you have it installed and on your path. With that out of the way, you can 165 | run the tests with [Kaocha][kaocha] 166 | 167 | ```shell 168 | $ lein kaocha 169 | ``` 170 | 171 | As long as the tests pass, you are on the right track. 😉 172 | 173 | Future Plans 174 | ------------ 175 | 176 | I am actively using this library in several projects and will continue 177 | to work on this code. If you have any suggestions or patches, please 178 | fork this project and send me a pull request. 🙂 179 | 180 | 181 | [hl7v2]: https://secure.wikimedia.org/wikipedia/en/wiki/Health_Level_7#HL7_version_2.x "HL7 v2 Messaging" 182 | [lein]: https://leiningen.org/ "Leiningen" 183 | [kaocha]: https://github.com/lambdaisland/kaocha "Kaocha Test Runner" 184 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject org.clojars.cmiles74/clojure-hl7-parser "3.5.1" 2 | :description "A parser for parsing HL7 messages." 3 | :url "https://github.com/cmiles74/clojure-hl7-messaging-2-parser" 4 | :repositories [["clojars" {:url "https://repo.clojars.org" :cred :gpg}]] 5 | :profiles {:dev {:dependencies [[lambdaisland/kaocha "1.77.1236"]]}} 6 | :aliases {"kaocha" ["run" "-m" "kaocha.runner"]}) 7 | -------------------------------------------------------------------------------- /src/com/nervestaple/hl7_parser/batch.clj: -------------------------------------------------------------------------------- 1 | (ns com.nervestaple.hl7-parser.batch 2 | (:require 3 | [clojure.java.io :as io] 4 | [clojure.string :as string] 5 | [com.nervestaple.hl7-parser.parser :as parser]) 6 | (:import 7 | (java.io BufferedReader StringReader))) 8 | 9 | (defmulti get-lines 10 | "Returns a sequence of lines for the provided Object. We would prefer to wrap 11 | another reader but we'll read a string if required." 12 | class) 13 | 14 | (defmethod get-lines java.io.BufferedReader 15 | [reader] (line-seq reader)) 16 | 17 | (defmethod get-lines java.lang.Readable 18 | [reader] (line-seq (BufferedReader. reader))) 19 | 20 | (defmethod get-lines :default 21 | [text] (line-seq (BufferedReader. (StringReader. text)))) 22 | 23 | (defn conj-not-empty 24 | "Addes the supplied string to the given sequence only if it is not blank." 25 | [seq item] 26 | (if (not (string/blank? item)) 27 | (conj seq item) 28 | seq)) 29 | 30 | (defn read-message 31 | "Reads lines from the provided sequence and accumulates one HL7 message. 32 | Returns a vector where the first item is the message and the second the 33 | remaining lines in the sequence (or nil if all lines have been read)." 34 | [lines-in] 35 | (loop [line-this (first lines-in) message [] lines (rest lines-in)] 36 | (cond 37 | 38 | ;; we're out of lines, return the last line 39 | (nil? line-this) 40 | [(apply str (interpose (char parser/ASCII_CR) message)) 41 | nil] 42 | 43 | ;; combine the BTS and FTS segments into one message 44 | (and (< 0 (count message)) 45 | (and (string/starts-with? (first message) "BTS") 46 | (string/starts-with? line-this "FTS"))) 47 | (recur (first lines) 48 | (conj-not-empty message line-this) 49 | (rest lines)) 50 | 51 | ;; if the next line starts a new message, return our messages and the 52 | ;; rest of our lines 53 | (and (< 0 (count message)) 54 | (or (string/starts-with? line-this "MSH") 55 | (string/starts-with? line-this "BTS") 56 | (string/starts-with? line-this "FTS"))) 57 | [(apply str (interpose (char parser/ASCII_CR) message)) 58 | (cons line-this lines)] 59 | 60 | ;; accumulate the current message 61 | :else 62 | (recur (first lines) 63 | (conj-not-empty message line-this) 64 | (rest lines))))) 65 | 66 | (defn parse-trailer 67 | "Parses the trailer message into something like an HL7 message." 68 | [message] 69 | (let [segments (string/split message #"\r")] 70 | {:segments 71 | (into [] 72 | (for [segment segments] 73 | {:id (apply str (take 3 segment)) 74 | :fields (into [] 75 | (for [field (string/split 76 | (apply str (drop 4 segment)) 77 | #"\|")] 78 | {:content [field]}))}))})) 79 | 80 | (defn parse-message 81 | "Parses an HL7 messaging batch message, including trailer messages." 82 | [message] 83 | (cond 84 | (or (string/starts-with? message "BTS") 85 | (string/starts-with? message "FTS")) 86 | (parse-trailer message) 87 | 88 | :else 89 | (parser/parse message))) 90 | 91 | (defn read-messages 92 | "Reads through a set of data and returns a lazy sequence of parsed HL7 93 | messaging messages. If a sequence is provided it will be read directly 94 | otherwise a reader will be opened on the provided data." 95 | ([data-in] 96 | (cond 97 | (coll? data-in) 98 | (let [[message lines] (read-message data-in)] 99 | (read-messages message lines)) 100 | 101 | :else 102 | (let [lines (get-lines data-in)] 103 | (read-messages lines)))) 104 | ([message lines] 105 | (cond 106 | (nil? message) 107 | nil 108 | 109 | (nil? lines) 110 | (cons (parse-message message) (read-messages nil nil)) 111 | 112 | :else 113 | (lazy-seq (cons (parse-message message) 114 | (let [[message-next rest-lines] (read-message lines)] 115 | (read-messages message-next rest-lines))))))) 116 | 117 | (defn filter-segment 118 | "Returns a lazy sequence of messages that have a matching segment id in their 119 | first segment." 120 | [segment-id parsed-messages] 121 | (filter #(= segment-id (:id (first (:segments %)))) parsed-messages)) 122 | 123 | 124 | -------------------------------------------------------------------------------- /src/com/nervestaple/hl7_parser/dump.clj: -------------------------------------------------------------------------------- 1 | ;; 2 | ;; Provides functions for displaying human-readable versions of HL7 3 | ;; messages. 4 | ;; 5 | (ns com.nervestaple.hl7-parser.dump) 6 | 7 | (defn dump-collection 8 | "Returns an human-readable String representing a collection of 9 | atoms." 10 | [coll] 11 | (str "\"" (apply str (interpose "\", \"" coll)) "\"")) 12 | 13 | (defn dump-field 14 | "Returns an human-readable String representing the content of the 15 | field." 16 | [field] 17 | 18 | (let [items (count (:content field))] 19 | 20 | (cond 21 | 22 | (= 0 items) 23 | "null" 24 | 25 | (= 1 items) 26 | (if (map? (first (:content field))) 27 | (str "Repeating \n " (dump-field (first (:content field)))) 28 | (str "Atom \"" (first (:content field)) "\"")) 29 | 30 | (map? (first (:content field))) 31 | (str "Repeating \n " 32 | (apply str (interpose "\n " 33 | (map dump-field (:content field))))) 34 | 35 | :else 36 | (str "Component " 37 | (apply str 38 | (interpose ", " 39 | (map (fn [[index item]] 40 | (if (coll? item) 41 | (str " Subcomponent " (dump-collection item)) 42 | (str (inc index) ": \"" item "\""))) 43 | (map-indexed #(vector %1 %2) 44 | (:content field))))))))) 45 | 46 | (defn dump-segment 47 | "Returns an human-readable String representing the content of the segment. If 48 | the show-nulls parameter is provided and is true, null fields will also be 49 | displayed." 50 | ([delimiters segment] 51 | (dump-segment delimiters segment false)) 52 | ([delimiters segment show-nulls] 53 | 54 | (println (str "Segment ID: " (:id segment))) 55 | (println "Index HL7 Index Type Content") 56 | (println "----- --------- ----------- -----------") 57 | (let [segment-index-start (if (= "MSH" (:id segment)) 2 1)] 58 | (loop [field (first (:fields segment)) 59 | fields (rest (:fields segment)) 60 | index 0 61 | segment-index segment-index-start] 62 | 63 | (when (and (= "MSH" (:id segment)) (= 0 index)) 64 | (println (str " - 1 Atom \"" 65 | (char (:field delimiters)) "\""))) 66 | 67 | (when (or (< 0 (count (:content field))) show-nulls) 68 | (println (str " " 69 | (if (> 10 index) 70 | (str " " index) index) 71 | " " 72 | (if (> 10 segment-index) 73 | (str " " segment-index) segment-index) 74 | " " (dump-field field)))) 75 | 76 | (if (seq fields) 77 | (recur (first fields) 78 | (rest fields) 79 | (inc index) 80 | (inc segment-index))))))) 81 | 82 | (defn dump-delimiters 83 | "Returns a human-readable String representing the message's delimiters." 84 | [delimiters] 85 | 86 | (println "Delimiters: ") 87 | 88 | (if (:field delimiters) 89 | (println " Field: " (char (:field delimiters)))) 90 | 91 | (if (:component delimiters) 92 | (println " Component: " (char (:component delimiters)))) 93 | 94 | (if (:repeating delimiters) 95 | (println " Repeating: " (char (:repeating delimiters)))) 96 | 97 | (if (:escape delimiters) 98 | (println " Escape: " (char (:escape delimiters)))) 99 | 100 | (if (:subcomponent delimiters) 101 | (println " Subcomponent: " (char (:subcomponent delimiters))))) 102 | 103 | (defn dump 104 | "Prints a human-readable version of the HL7 message to the current *out* stream. 105 | If the show-nulls parameter is provided and is true, null fields will also be 106 | displayed." 107 | ([parsed-message] 108 | (dump parsed-message false)) 109 | ([parsed-message show-nulls] 110 | 111 | (dump-delimiters (:delimiters parsed-message)) 112 | (println) 113 | 114 | (doseq [segment (:segments parsed-message)] 115 | (dump-segment (:delimiters parsed-message) segment show-nulls) 116 | (println)))) 117 | -------------------------------------------------------------------------------- /src/com/nervestaple/hl7_parser/main.clj: -------------------------------------------------------------------------------- 1 | ;; 2 | ;; Provides simple test functions meant to demonstrate how the parser 3 | ;; works. 4 | ;; 5 | 6 | (ns com.nervestaple.hl7-parser.main 7 | (:gen-class) 8 | (:require 9 | [com.nervestaple.hl7-parser.parser :as parser] 10 | [com.nervestaple.hl7-parser.message :as message] 11 | [com.nervestaple.hl7-parser.test :as test] 12 | [com.nervestaple.hl7-parser.dump :as dump])) 13 | 14 | (defn main 15 | "Provides the main function invoked when the application starts. We 16 | use this method so that we can test startup." 17 | [& args] 18 | 19 | ;; get a test message 20 | (let [message (test/test-message) 21 | parsed-message (parser/parse message)] 22 | 23 | ;; provide a brief demonstration 24 | (println (str "Message Id: " 25 | (message/get-field-first-value parsed-message "MSH" 10))) 26 | (println (str "MSH Segment: " 27 | (pr-str (first (message/get-segments parsed-message "MSH"))))) 28 | (println (str "ACK: " 29 | (message/ack-message {:sending-app "Clojure HL7 Parser" 30 | :sending-facility "Test Facility" 31 | :production-mode "P" 32 | :version "2.3" 33 | :text-message "Message processed successfully"} 34 | "AA" parsed-message))) 35 | (println) 36 | (dump/dump parsed-message) 37 | 38 | ;; (with-open [reader (io/reader "file-of-batch-message.hl7.txt")] 39 | ;; (let [messages (batch/read-messages reader)] 40 | ;; (doall (take 5 (batch/filter-segment "MSH" messages))))) 41 | )) 42 | 43 | (defn -main 44 | "Provides the main function needed to bootstrap the application." 45 | [& args] 46 | (main args)) 47 | -------------------------------------------------------------------------------- /src/com/nervestaple/hl7_parser/message.clj: -------------------------------------------------------------------------------- 1 | ;; 2 | ;; Functions to make it easier to work with parsed HL7 messages. 3 | ;; 4 | (ns com.nervestaple.hl7-parser.message 5 | (:use 6 | [com.nervestaple.hl7-parser.parser] 7 | [com.nervestaple.hl7-parser.util] 8 | [com.nervestaple.hl7-parser.dump] 9 | [com.nervestaple.hl7-parser.message]) 10 | (:import 11 | (java.util Date))) 12 | 13 | (def REGEX-MESSAGE-ID 14 | #"MSH\|[^\|]*\|[^\|]*\|[^\|]*\|[^\|]*\|[^\|]*\|[^\|]*\|[^\|]*\|[^\|]*\|([^\|]*)\|") 15 | 16 | (defn message-id-unparsed 17 | "Returns the message id for an HL7 message by doing some simple 18 | regular expression matching on the message. This function does *not* 19 | involve parsing the message and may be faster." 20 | [message] 21 | (let [matches (re-find REGEX-MESSAGE-ID message)] 22 | (if (and matches (second matches)) 23 | (second matches)))) 24 | 25 | (defn segment-ids 26 | "Returns a list of the segment ids present in the message." 27 | [message] 28 | (map (fn [segment] (:id segment)) (:segments message))) 29 | 30 | (defn get-segments 31 | "Returns all of the segments in the message that have the provided 32 | segment id." 33 | [message segment-id] 34 | (filter (fn [segment] (= segment-id (:id segment))) 35 | (:segments message))) 36 | 37 | (defn get-segment-field 38 | "Returns the field with the provided index from the given 39 | segment. Keep in mind that this function expects the index to adhere 40 | to the HL7 specification where the first field of data is located at 41 | index 1. Another gotcha in the MSH segment, the first field of data 42 | starts at index 2 and that's the list of delimiters. 43 | 44 | This function will return the id of the segment if you ask for index 0. For 45 | the MSH segment, it will return nil for index 1 instead of returning the field 46 | delimiter. If you want the field delimiter you can get it under the :delimiter 47 | key of the message. If the provided index is out of bounds then nil will be 48 | returned." 49 | ([segment index] 50 | (get-segment-field segment index false)) 51 | ([segment index raw?] 52 | 53 | (cond 54 | 55 | ;; handle MSH differently 56 | (= "MSH" (:id segment)) 57 | (cond 58 | 59 | ;; index 0 returns the segment id 60 | (= 0 index) 61 | (:id segment) 62 | 63 | ;; index 1 should return the field delimiter 64 | (= 1 index) 65 | nil 66 | 67 | ;; correct our index and return the field 68 | :else 69 | (let [real-index (- index 2)] 70 | (when (> (count (:fields segment)) real-index) 71 | (nth (:fields segment) real-index)))) 72 | 73 | :else 74 | (cond 75 | 76 | ;; index 0 returns the segment id 77 | (= 0 index) 78 | (:id segment) 79 | 80 | ;; correct our index and return the field 81 | :else 82 | (let [real-index (dec index) 83 | field (when (< real-index (count (:fields segment))) 84 | (nth (:fields segment) real-index))] 85 | (if raw? field 86 | (if (map? field) 87 | (:content field) 88 | field))))))) 89 | 90 | (defn get-segment-field-raw 91 | [segment index] 92 | (get-segment-field segment index true)) 93 | 94 | (defn get-field 95 | "Returns the field with the provided index from the segment with the 96 | given id of the provided message." 97 | [message segment-id field-index] 98 | (map (fn [segment] (get-segment-field segment field-index)) 99 | (get-segments message segment-id))) 100 | 101 | (defn- get-nth-field 102 | "Returns the item at index in the collection of field data. If 103 | passed a collection of fields, the item at index from each field is 104 | returned. If passed a collection that contains subcomponents, the 105 | item at index for each subcomponent is returned." 106 | [index field-or-fields] 107 | (cond 108 | (map? (first field-or-fields)) 109 | (map (fn [field] 110 | (get-nth-field index (:content field))) 111 | field-or-fields) 112 | 113 | (coll? (first field-or-fields)) 114 | (map (partial get-nth-field index) field-or-fields) 115 | 116 | :else 117 | (nth field-or-fields index))) 118 | 119 | (defn get-field-component 120 | "Returns the component at the provided index from the field with the 121 | provided index from the segment with the given id in the provided 122 | message." 123 | [message segment-id field-index component-index] 124 | (let [data (flatten (get-field message segment-id field-index))] 125 | (get-nth-field component-index data))) 126 | 127 | (defn set-field 128 | "Updates the message by altering the field value for the specified 129 | segment. When specifying field indexes, be sure to use the correct 130 | HL7 index (the segment id would be 0, the first field is at index 131 | 1). 132 | 133 | Your value should be an atom or an collection, a collection 134 | indicates a field with components. Subcomponents are represented as 135 | a collection containing a collection. Pass in a collection of fields 136 | to indicate repeating fields." 137 | [message segment-id field-index value] 138 | 139 | ;; correct our index and value (put an atom in a collection) 140 | (let [field-index-fixed (if (= "MSH" segment-id) 141 | (- field-index 2) (dec field-index)) 142 | field-value (if (coll? value) value [value])] 143 | 144 | ;; throw an error if we have an illegal HL7 index 145 | (when (< field-index-fixed 0) 146 | (throw (Exception. "The first field is at index 1"))) 147 | 148 | ;; create a whole new message 149 | {:delimiters (:delimiters message) 150 | 151 | ;; map over our segments looking for the one we're changing 152 | :segments (map (fn [segment] 153 | 154 | (if (= segment-id (:id segment)) 155 | 156 | ;; associate our new fields 157 | (assoc segment :fields 158 | 159 | ;; associate our new value with the 160 | ;; field collections 161 | (assoc (:fields segment) 162 | field-index-fixed 163 | (create-field field-value))) 164 | 165 | ;; return the segment unaltered 166 | segment)) 167 | 168 | (:segments message))})) 169 | 170 | (defn extract-text-from-segments 171 | "Extracts the text from the parsed message for the supplied index of 172 | the given segments, the text will be concatenated and returned as 173 | one String. For instance, this function would extract all of the text 174 | from the fifth index of all of the OBX segments: 175 | 176 | (extract-text-from-segments parsed-message 'OBX' 5) 177 | 178 | You may pass in an optional argument that contains a character to 179 | interleave between the chunks of extracted text (for instance, 180 | '\n')." 181 | [parsed-message segment-type index & options] 182 | 183 | (apply str (if (first options) 184 | (interpose (first options) 185 | (flatten (get-field parsed-message segment-type index))) 186 | (flatten (get-field parsed-message segment-type index))))) 187 | 188 | (defn get-field-first 189 | "Returns the first instance of the field with the provided index 190 | from the segment with the given id of the provided message. This 191 | function is handy when you know there's only one instance of a 192 | particular segment (like 'MSH'), you won't have to grab the first 193 | element; it will be returned by this function." 194 | [parsed-message segment-id field-index] 195 | (first (get-field parsed-message segment-id field-index))) 196 | 197 | (defn get-field-first-value 198 | "Returns the value of the first instance of the field with the 199 | provided index from the segment with the given id of the provided 200 | message. This function is handy when you know there's only one 201 | instance of a particular segment (like 'MSH'), you won't have to 202 | grab the first element and then it's :content value; it will be 203 | returned by this function." 204 | [parsed-message segment-id field-index] 205 | (let [field (first (map #(get-segment-field-raw % field-index) 206 | (get-segments parsed-message segment-id)))] 207 | (pr-field (:delimiters parsed-message) field))) 208 | 209 | (defn ack-message 210 | "Returns a parsed message that contains an acknowledgement message 211 | for the provided parsed message, the acknowledgement message will 212 | use the same delimiters. If the message indicates that no 213 | acknowledgement should be returned, this function will return nil. 214 | 215 | The 'option' should be a hash-map with the following keys: 216 | 217 | :sending-app, :sending-facility, :production-mode, :version, 218 | :text-message 219 | 220 | Optionally, a `:message-id` key may be provided if you need a specific 221 | value. 222 | 223 | These values will be used to fill out the ACK message. The 224 | 'ack-status' field should be a valid HL7 version 2.x acknowledgment 225 | status: 226 | 227 | AA (accepted), AE (error), AR (rejected)" 228 | [options ack-status parsed-message] 229 | 230 | ;; make sure the sender of this message is looking to receive an 231 | ;; acknowledgement 232 | (let [accept-ack-type (get-field-first-value parsed-message "MSH" 15)] 233 | (when-not (or (= "NE" accept-ack-type) 234 | (= "ER" accept-ack-type)) 235 | 236 | ;; we are returning an acknowledgement 237 | (create-message (:delimiters parsed-message) 238 | (create-segment "MSH" 239 | (create-field (pr-delimiters (:delimiters parsed-message))) 240 | (create-field [(:sending-app options)]) 241 | (create-field [(:sending-facility options)]) 242 | (get-field-first parsed-message "MSH" 3) 243 | (get-field-first parsed-message "MSH" 4) 244 | (create-field [(or (:message-id options) 245 | (.format TIMESTAMP-FORMAT (new Date)))]) 246 | (create-field []) 247 | (create-field ["ACK"]) 248 | (get-field-first parsed-message "MSH" 10) 249 | (create-field [(:production-mode options)]) 250 | (create-field [(:version options)])) 251 | (create-segment "MSA" 252 | (create-field [ack-status]) 253 | (get-field-first parsed-message "MSH" 10) 254 | (create-field [(:text-message options)])))))) 255 | 256 | (defn ack-message-fallback 257 | "Returns a parsed message that contains an acknowledgement message for the 258 | provided un-parsed message, the acknowledgement message will use default 259 | delimiters. Use this function when you have an HL7v2 message that you need to 260 | acknowledge but you cannot parse. 261 | 262 | The 'option' should be a hash-map with the following keys: 263 | 264 | :sending-app, :sending-facility, :production-mode, :version, 265 | :text-message 266 | 267 | Optionally, a `:message-id` key may be provided if you need a specific 268 | value. 269 | 270 | These values will be used to fill out the ACK message. The 271 | 'ack-status' field should be a valid HL7 version 2.x acknowledgment 272 | status: 273 | 274 | AA (accepted), AE (error), AR (rejected)" 275 | [options ack-status message] 276 | 277 | ;; we are returning an acknowledgement 278 | (create-message {:field 124, :component 94, :subcomponent 38, 279 | :repeating 126, :escape 92} 280 | (create-segment "MSH" 281 | (create-field (pr-delimiters {:field 124, :component 94, :subcomponent 38, 282 | :repeating 126, :escape 92})) 283 | (create-field [(:sending-app options)]) 284 | (create-field [(:sending-facility options)]) 285 | (create-field ["UNKNOWN"]) 286 | (create-field ["UNKNOWN"]) 287 | (create-field [(or (:message-id options) 288 | (.format TIMESTAMP-FORMAT (new Date)))]) 289 | (create-field []) 290 | (create-field ["ACK"]) 291 | (message-id-unparsed message) 292 | (create-field [(:production-mode options)]) 293 | (create-field [(:version options)])) 294 | (create-segment "MSA" 295 | (create-field [ack-status]) 296 | (message-id-unparsed message) 297 | (create-field [(:text-message options)])))) 298 | -------------------------------------------------------------------------------- /src/com/nervestaple/hl7_parser/parser.clj: -------------------------------------------------------------------------------- 1 | ;; 2 | ;; Provides functions for parsing HL7 messages. 3 | ;; 4 | (ns com.nervestaple.hl7-parser.parser 5 | (:use 6 | [clojure.string :as string :only (trim)]) 7 | (:import 8 | (java.text SimpleDateFormat) 9 | (java.util Date) 10 | (java.io PushbackReader StringReader))) 11 | 12 | ;; HL7 timestamp format 13 | (def TIMESTAMP-FORMAT (new SimpleDateFormat "yyyyMMddHHmmss")) 14 | 15 | ;; ASCII codes of characters used to delimit and wrap messages 16 | (def ASCII_VT 11) 17 | (def ASCII_FS 28) 18 | (def ASCII_CR 13) 19 | (def ASCII_LF 10) 20 | 21 | ;; ASCII codes of characters used as default delimiters 22 | (def ASCII_PIPE 124) 23 | (def ASCII_CARAT 94) 24 | (def ASCII_AMPERSAND 38) 25 | (def ASCII_TILDE 126) 26 | (def ASCII_BACKSLASH 92) 27 | 28 | ;; HL7 Messaging v2.x segment delimiter 29 | (def SEGMENT-DELIMITER ASCII_CR) 30 | 31 | ;; Default set of message delimiters, these are the most common 32 | (def DEFAULT-DELIMITERS 33 | {:field ASCII_PIPE 34 | :component ASCII_CARAT 35 | :subcomponent ASCII_AMPERSAND 36 | :repeating ASCII_TILDE 37 | :escape ASCII_BACKSLASH}) 38 | 39 | ;; 40 | ;; Emit methods used to output messages 41 | ;; 42 | 43 | (defn pr-delimiters 44 | "Prints an HL7 compatible text representation of the provided 45 | delimiters to the current *out* stream." 46 | [delimiters] 47 | (str (char (:component delimiters)) 48 | (char (:repeating delimiters)) 49 | (char (:escape delimiters)) 50 | (char (:subcomponent delimiters)))) 51 | 52 | (defn- do-pr-content 53 | "Returns an HL7 compatible String representation of the provided 54 | content atom. Only Date objects are afforded special handling, an 55 | HL7 compatible timestamp is returned." 56 | [content] 57 | (if (instance? java.util.Date content) 58 | (.Format TIMESTAMP-FORMAT content) 59 | content)) 60 | 61 | (defn- pr-content 62 | "Returns an HL7 compatible String representation of the provided 63 | field content." 64 | [delimiters content] 65 | (if (coll? content) 66 | (apply str 67 | (interpose (char (:subcomponent delimiters)) 68 | (map do-pr-content content))) 69 | (do-pr-content content))) 70 | 71 | (defn pr-field 72 | "Returns an HL7 compatible String representation of the provided 73 | field." 74 | [delimiters field] 75 | (let [content (:content field)] 76 | (cond 77 | 78 | (= 0 (count content)) 79 | "" 80 | 81 | (map? (first content)) 82 | (apply str 83 | (interpose (char (:repeating delimiters)) 84 | (map (partial pr-field delimiters) content))) 85 | 86 | :else 87 | (apply str 88 | (interpose (char (:component delimiters)) 89 | (map (partial pr-content delimiters) content)))))) 90 | 91 | (defn pr-segment 92 | "Returns an HL7 compatible String representation of the provided 93 | segment." 94 | [delimiters segment] 95 | (if (or (not= "FHS" (:id segment)) 96 | (not= "BHS" (:id segment)) 97 | (not= "MSH" (:id segment))) 98 | 99 | (str (:id segment) (char (:field delimiters)) 100 | (apply str 101 | (interpose (char (:field delimiters)) 102 | (map (partial pr-field delimiters) (:fields segment))))) 103 | 104 | (str (:id segment) (char (:field delimiters)) 105 | (first (:content (first (:fields segment)))) (char (:field delimiters)) 106 | (apply str 107 | (interpose (char (:field delimiters)) 108 | (map (partial pr-field delimiters) 109 | (rest (:fields segment)))))))) 110 | 111 | (defn str-message 112 | "Returns the provided HL7 message as a string." 113 | [message] 114 | (str (apply str 115 | (interpose (char SEGMENT-DELIMITER) 116 | (map (partial pr-segment (:delimiters message)) 117 | (:segments message)))) 118 | (char SEGMENT-DELIMITER))) 119 | 120 | (defn pr-message 121 | "Prints the provided HL7 message to the current *out* stream." 122 | [message] 123 | (print (str-message message))) 124 | 125 | ;; 126 | ;; Construction methods used to build messages 127 | ;; 128 | 129 | (defn convert-values 130 | "If provided a list of values, any in items are replaced with an empty string. 131 | When provided a single value a list with that value will be returned or an 132 | empty list of that value is nil." 133 | [values] 134 | (cond 135 | (sequential? values) 136 | (replace {nil ""} values) 137 | 138 | (nil? values) 139 | [] 140 | 141 | :else 142 | [values])) 143 | 144 | (defn create-empty-message 145 | "Returns a new, empty message map. if no map of delimiters is provided then the 146 | default set will be used." 147 | ([] 148 | (create-empty-message DEFAULT-DELIMITERS)) 149 | ([delimiters] 150 | {:delimiters delimiters :segments []})) 151 | 152 | (defn create-message 153 | "Accepts a map of delimiters and segments. Returns a new parsed message using 154 | the provided delimiters (or the default set if none is provided) populated 155 | with the provided segments." 156 | [delimiters & segments] 157 | {:delimiters delimiters 158 | :segments (if (< 0 (count segments)) (vec segments) [])}) 159 | 160 | (defn create-segment 161 | "Returns a new, empty segment map with the provided id." 162 | [id & fields] 163 | {:id id :fields (if (< 0 (count fields)) (vec fields) [])}) 164 | 165 | (defn create-field 166 | "Returns a new field map populated with the provided data." 167 | ([] 168 | (create-field nil)) 169 | ([data] 170 | {:content (convert-values data)})) 171 | 172 | (defn add-segment 173 | "Adds the provided segment map to the provided message map and returns a new 174 | message." 175 | [message segment] 176 | (assoc message :segments (conj (:segments message) segment))) 177 | 178 | (defn add-field 179 | "Adds the provided field map to the provided segment map and returns a new 180 | segment." 181 | [segment field] 182 | (assoc segment :fields (conj (:fields segment) field))) 183 | 184 | (defn add-fields 185 | "Adds the provided field maps to the provided segment map and returns a new 186 | segment." 187 | [segment fields] 188 | (assoc segment :fields (into (:fields segment) fields))) 189 | 190 | ;; 191 | ;; Parser methods 192 | ;; 193 | 194 | (defmulti get-reader 195 | "Returns a PushBackReader for the provided Object. We want to wrap 196 | another Reader but we'll cast to a String and read that if 197 | required." 198 | class) 199 | 200 | (defmethod get-reader java.io.BufferedReader 201 | [reader-in] (PushbackReader. reader-in)) 202 | 203 | (defmethod get-reader java.lang.Readable 204 | [reader-in] (PushbackReader. reader-in)) 205 | 206 | (defmethod get-reader :default 207 | [text-in] (PushbackReader. (StringReader. (apply str text-in)))) 208 | 209 | (defn- peek-int 210 | "Returns the next integer that will be read. You can only peek ahead 211 | one integer." 212 | [reader] 213 | 214 | (let [next-int (.read reader)] 215 | (.unread reader next-int) 216 | next-int)) 217 | 218 | (defn- expect-char-int 219 | "Returns true if the int-in matches the char-expect-in and false if 220 | it does not. An exception will be thrown if the int-in has a value 221 | of -1 or is an invalid character." 222 | [char-expect-int int-in] 223 | 224 | (if (= -1 int-in) 225 | (throw (Exception. 226 | (str "End of file reached while looking for " (char char-expect-int) 227 | "(" char-expect-int ")"))) 228 | (if (= char-expect-int int-in) 229 | true 230 | (throw (Exception. 231 | (str "Expected \"" (char char-expect-int) "\" (" char-expect-int 232 | ") but read \"" (char int-in) "\" (" int-in ")")))))) 233 | 234 | (defn- delimiter? 235 | "Returns true if the provided Integer corresponds to the character 236 | value of one of this messages delimiters." 237 | [message int-in] 238 | 239 | (when (= -1 int-in) 240 | true) 241 | 242 | (if (or (= (:component (:delimiters message)) int-in) 243 | (= (:repeating (:delimiters message)) int-in) 244 | (= (:subcomponent (:delimiters message)) int-in) 245 | (= (:field (:delimiters message)) int-in) 246 | ;(= (:escape (:delimiters message)) int-in) 247 | (= SEGMENT-DELIMITER int-in)) 248 | true false)) 249 | 250 | (defn- read-delimiters 251 | "Parses through the delimiters and returns a map with those delimiters." 252 | [reader] 253 | 254 | ;; loop through the reader, buffer the message id and build up the delimiters 255 | (loop [int-in (.read reader) 256 | buffer [] 257 | segment-id nil 258 | delimiters {} 259 | char-index 0] 260 | 261 | (cond 262 | 263 | (= -1 int-in) 264 | (throw (Exception. "End of file reached while reading delimiters for segment")) 265 | 266 | (= SEGMENT-DELIMITER int-in) 267 | (throw (Exception. "End of segment reached while reading delmiters")) 268 | 269 | ;; read the field delimiter 270 | (= 0 char-index) 271 | (recur (.read reader) buffer segment-id (assoc delimiters :field int-in) (inc char-index)) 272 | 273 | ;; read the component delimiter 274 | (= 1 char-index) 275 | (recur (.read reader) buffer segment-id (assoc delimiters :component int-in) (inc char-index)) 276 | 277 | ;; read the repeating delimiter 278 | (= 2 char-index) 279 | (recur (.read reader) buffer segment-id (assoc delimiters :repeating int-in) (inc char-index)) 280 | 281 | ;; read the escape delimiter 282 | (= 3 char-index) 283 | (recur (.read reader) buffer segment-id (assoc delimiters :escape int-in) (inc char-index)) 284 | 285 | ;; read the subcomponent delimiter 286 | (= 4 char-index) 287 | (recur (.read reader) buffer segment-id (assoc delimiters :subcomponent int-in) (inc char-index)) 288 | 289 | ;; throw an exception if this isn't a field delimiter 290 | (= 5 char-index) 291 | (do 292 | (when (not (expect-char-int (:field delimiters) int-in)) 293 | (throw (Exception. 294 | "Expected beginning of next segment but read more delimiter data"))) 295 | (.unread reader int-in) 296 | delimiters) 297 | 298 | ;; handle text, this is likely the segment's id 299 | :else 300 | (recur (.read reader) 301 | (conj buffer (char int-in)) 302 | segment-id 303 | delimiters 304 | (inc char-index))))) 305 | 306 | (defn- read-segment-delimiters 307 | "Parsers through the MSH or FHS segment up until the end of the first field (the 308 | list of delimiters) and returns a map with the segment id (:segment-id) and 309 | the the delimiter values (a map)." 310 | [reader] 311 | 312 | ;; loop through the reader, buffer the message id and build up the delimiters 313 | (loop [int-in (.read reader) 314 | buffer [] 315 | segment-id nil 316 | delimiters {} 317 | char-index 0] 318 | 319 | (cond 320 | 321 | (= -1 int-in) 322 | (throw (Exception. "End of file reached while reading MSH or FHS segment")) 323 | 324 | (= SEGMENT-DELIMITER int-in) 325 | (throw (Exception. "End of segment reached while reading MSH or FHS segment")) 326 | 327 | ;; after reading 3 characters, make sure this is an MSH segment 328 | ;; and then start reading the delimiters 329 | (= 3 char-index) 330 | (let [segment-id (apply str buffer)] 331 | (when (not (or (= "MSH" segment-id) 332 | (= "FHS" segment-id))) 333 | (throw (Exception. (str "Expected first segment to have the id of " 334 | "\"MSH\" or \"FHS\" but found \"" 335 | segment-id "\"")))) 336 | (.unread reader int-in) 337 | {:segment-id segment-id 338 | :delimiters (read-delimiters reader)}) 339 | 340 | ;; handle text, this is likely the segment's id 341 | :else 342 | (recur (.read reader) 343 | (conj buffer (char int-in)) 344 | segment-id delimiters 345 | (inc char-index))))) 346 | 347 | (defn- read-escaped-text 348 | "Reads in escaped text to the next escape delimiter character." 349 | [message reader] 350 | 351 | ;; make sure the next character is an escape delimiter 352 | (expect-char-int (:escape (:delimiters message)) (.read reader)) 353 | 354 | ;; loop through the reader and store the escaped text in the 355 | ;; buffer. Start the buffer out with the escape delimiter. 356 | (loop [int-in (.read reader) buffer [(char (:escape (:delimiters message)))]] 357 | 358 | (cond 359 | 360 | (= int-in -1) 361 | (throw (Exception. "End of data reached while reading escaped text")) 362 | 363 | ;; when we hit the escape delimiter, that's the end of the 364 | ;; escaped text 365 | (= (:escape (:delimiters message)) int-in) 366 | (apply str (conj buffer (char int-in))) 367 | 368 | :else 369 | (recur (.read reader) (conj buffer (char int-in)))))) 370 | 371 | (defn- read-text 372 | "Reads in text up to the next delimiter character." 373 | [message reader] 374 | 375 | ;; loop the reader and store the text in buffer 376 | (loop [int-in (.read reader) buffer []] 377 | 378 | (cond 379 | 380 | (= int-in -1) 381 | (throw (Exception. "End of data reached while reading text")) 382 | 383 | ;; we may encounter some escaped text 384 | ;; (= (:escape (:delimiters message)) int-in) 385 | ;; (do (.unread reader int-in) 386 | ;; (recur nil (conj buffer (read-escaped-text message reader)))) 387 | 388 | ;; if we hit a delimiter, push it back and return the text 389 | (delimiter? message int-in) 390 | (do (.unread reader int-in) 391 | (apply str buffer)) 392 | 393 | (= nil int-in) 394 | (recur (.read reader) buffer) 395 | 396 | ;; store the text in the buffer and read the next int 397 | :else 398 | (recur (.read reader) (conj buffer (char int-in)))))) 399 | 400 | 401 | (defn- read-subcomponents 402 | "Reads in the field subcomponent data from the reader." 403 | [reader message data] 404 | 405 | ;; make sure the next character is a subcomponent delimiter 406 | (expect-char-int (:subcomponent (:delimiters message)) (.read reader)) 407 | 408 | ;; loop the reader, build up vector of subcomponents by building up 409 | ;; each subcomponent 410 | (loop [int-in (.read reader) 411 | subcomponents (if (not (nil? data)) [data] []) 412 | subcomponent []] 413 | 414 | (cond 415 | 416 | ;; subcomponent delimiter, add our subcomponent to our vector of 417 | ;; subcomponents 418 | (= (:subcomponent (:delimiters message)) int-in) 419 | (recur (.read reader) (conj subcomponents (apply str subcomponent)) []) 420 | 421 | ;; (= (:escape (:delimiters message)) int-in) 422 | ;; (do (.unread reader int-in) 423 | ;; (recur nil subcomponents (conj subcomponent 424 | ;; (read-escaped-text message reader)))) 425 | 426 | ;; another delimiter type, add our last subcomponent and return 427 | ;; our vector of subcomponents 428 | (or (= SEGMENT-DELIMITER int-in) 429 | (= (:field (:delimiters message)) int-in) 430 | (= (:component (:delimiters message)) int-in) 431 | (= (:repeating (:delimiters message)) int-in)) 432 | (do (.unread reader int-in) 433 | (conj subcomponents (apply str subcomponent))) 434 | 435 | (= nil int-in) 436 | (recur (.read reader) subcomponents subcomponent) 437 | 438 | ;; build up the individual subcomponent 439 | :else 440 | (recur (.read reader) subcomponents (conj subcomponent (char int-in)))))) 441 | 442 | (defn- read-field 443 | "Reads in the next field of segment data from the reader. The 444 | repeating flag indicates that repeating fields are okay, if the flag 445 | is set to false then repeating fields will be treated the same as 446 | regular fields. For instance, when parsing a message the repeating 447 | flag should be set to true. When parsing the individual fields in a 448 | repeating field, be sure this flag is set to false to ensure 449 | accurate decoding." 450 | [reader message repeating] 451 | 452 | ;; throw an exception if we aren't starting with a field or 453 | ;; repeating delimiter 454 | (let [int-in (.read reader)] 455 | (when-not (or (= (:field (:delimiters message)) int-in) 456 | (= (:repeating (:delimiters message)) int-in)) 457 | (throw (Exception. 458 | "Expected a field or repeating delimiter when reading field data")))) 459 | 460 | ;; loop through the reader, build up a vector of fields by building 461 | ;; up each individual field 462 | (loop [int-in (.read reader) field-data [] current-field nil] 463 | 464 | (cond 465 | 466 | ;; handle repeating fields by recursively calling this function 467 | (and (= (:repeating (:delimiters message)) int-in) repeating) 468 | (do (.unread reader int-in) 469 | (recur nil 470 | 471 | ;; decide if the current field of data should be 472 | ;; added to the last map of repeating field data 473 | (let [repeating-data 474 | (if (not (map? (first field-data))) 475 | [(create-field (if (not (nil? current-field)) 476 | (conj field-data (apply str current-field)) 477 | field-data))] 478 | field-data)] 479 | (conj repeating-data (read-field reader message false))) 480 | [])) 481 | 482 | ;; handle subcomponents, add the current field to our field data 483 | ;; if it's not nil 484 | (= (:subcomponent (:delimiters message)) int-in) 485 | (do (.unread reader int-in) 486 | (recur nil 487 | (conj field-data (read-subcomponents 488 | reader message 489 | (if (not (nil? current-field)) 490 | (apply str current-field) 491 | nil))) 492 | nil)) 493 | 494 | ;; handle components, add the field data to our current data or 495 | ;; a placeholder component if it's nil 496 | (= (:component (:delimiters message)) int-in) 497 | (recur (.read reader) 498 | (if (not (nil? current-field)) 499 | (conj field-data (apply str current-field)) 500 | (if (> 1 (count field-data)) 501 | [""] 502 | field-data)) 503 | [""]) 504 | 505 | ;; handle the end of the field or segment by returning our field 506 | ;; data 507 | (or (= SEGMENT-DELIMITER int-in) 508 | (= (:field (:delimiters message)) int-in) 509 | (and (not repeating) (= (:repeating (:delimiters message)) int-in)) 510 | (= -1 int-in)) 511 | (do 512 | 513 | ;; don't unread the end of file marker 514 | (if (not= -1 int-in) 515 | (.unread reader int-in)) 516 | 517 | ;; create our field 518 | (create-field 519 | 520 | ;; if we have current field data, add that to our field data 521 | (if (< 0 (count current-field)) 522 | (if (not (nil? current-field)) 523 | (conj field-data (apply str current-field)) field-data) 524 | field-data))) 525 | 526 | ;; (= (:escape (:delimiters message)) int-in) 527 | ;; (do (.unread reader int-in) 528 | ;; (recur nil field-data (if (not (nil? current-field)) 529 | ;; (conj current-field (read-escaped-text message reader)) 530 | ;; [(read-escaped-text message reader)]))) 531 | 532 | ;; build up the data for our current field 533 | :else 534 | (recur (.read reader) field-data 535 | (if int-in 536 | 537 | ;; if the current field is nil, start a new vector of 538 | ;; data 539 | (if (not (nil? current-field)) 540 | (conj current-field (char int-in)) [(char int-in)]) 541 | current-field))))) 542 | 543 | (defn- read-msh-fhs-segment 544 | "Adds the \"MSH\" or \"BHS\" segment and its first field of data to the provided 545 | message map and returns the new message. This first field will be the list of 546 | delimiters, the provided message must already have a valid set of delimiters." 547 | [segment-id reader message] 548 | 549 | ;; instantiate our new MSH segment and fill the first field with our 550 | ;; delimiters 551 | (let [segment (add-field (create-segment segment-id) 552 | (create-field (pr-delimiters (:delimiters message))))] 553 | 554 | ;; loop through the reader and build up our fields 555 | (loop [int-in (.read reader) fields []] 556 | 557 | (cond 558 | 559 | (= -1 int-in) 560 | (throw (Exception. "End of file reached while reading segment data")) 561 | 562 | ;; handle the end of field by reading the next field 563 | (= (:field (:delimiters message)) int-in) 564 | (do (.unread reader int-in) 565 | (recur nil (conj fields (read-field reader message true)))) 566 | 567 | ;; handle the end of segment by adding the fields to the 568 | ;; segment and then returning our segment of data 569 | (= SEGMENT-DELIMITER int-in) 570 | (add-segment message (add-fields segment fields)) 571 | 572 | ;; keep reading in more field data 573 | :else 574 | (recur (.read reader) fields))))) 575 | 576 | (defn- read-segment 577 | "Reads in the segment of data from the reader and returns a new 578 | message with the segment appended. Note that this method cannot 579 | handle an MSH segment, it will fail while reading the delimiters in 580 | the first field of the MSH segment." 581 | [reader message] 582 | 583 | ;; read in our segment id 584 | (let [segment-id (string/trim (read-text message reader))] 585 | 586 | ;; throw an exception if we don't get a valid segment id 587 | (when (or (nil? segment-id) (> 3 (count segment-id))) 588 | (throw (Exception. (str "Illegal segment id \"" segment-id "\" read")))) 589 | 590 | ;; create our new segment 591 | (let [segment (if (= "BHS" segment-id) 592 | (add-field (create-segment segment-id) 593 | (create-field (pr-delimiters (read-delimiters reader)))) 594 | (create-segment segment-id))] 595 | 596 | ;; loop through the reader and build up the fields for our 597 | ;; segment 598 | (loop [int-in (.read reader) fields []] 599 | 600 | (cond 601 | 602 | (= -1 int-in) 603 | (add-segment message (add-fields segment fields)) 604 | 605 | ;; handle segment delimiters by adding our fields to our 606 | ;; segment and then adding our segment to the message 607 | (= SEGMENT-DELIMITER int-in) 608 | (add-segment message (add-fields segment fields)) 609 | 610 | ;; handle the field delimiter by reading the next field and 611 | ;; adding it to our vector of fields 612 | (= (:field (:delimiters message)) int-in) 613 | (do (.unread reader int-in) 614 | (recur nil (conj fields (read-field reader message true)))) 615 | 616 | ;; read in more field data 617 | :else 618 | (recur (.read reader) fields)))))) 619 | 620 | (defn- parse-message 621 | "Parses the data read by the reader into a valid HL7 message data map." 622 | [reader] 623 | 624 | ;; loop through the reader and parse the delimiters, the MSH segment 625 | ;; and them the segments; build up the message structure 626 | (loop [int-in (.read reader) parsing :delimiters segment-id nil message (create-empty-message)] 627 | 628 | (cond 629 | 630 | ;; handle the end-of-file by returning our message 631 | (or (= -1 int-in) 632 | (and (nil? int-in) (= -1 (peek-int reader)))) 633 | message 634 | 635 | ;; parse out the delimiters, then loop to get the MSH segment 636 | (= parsing :delimiters) 637 | (do (.unread reader int-in) 638 | (let [delimiters (read-segment-delimiters reader)] 639 | (recur nil :header-segment 640 | (:segment-id delimiters) 641 | (assoc message :delimiters (:delimiters delimiters))))) 642 | 643 | ;; parse out the header (MSH or FHS) segment then loop for the other segments 644 | (= parsing :header-segment) 645 | (recur nil :segment segment-id (read-msh-fhs-segment segment-id reader message)) 646 | 647 | ;; parse out a segment of data and add it to the message 648 | (= parsing :segment) 649 | (recur nil :segment segment-id (read-segment reader message)) 650 | 651 | ;; loop to read more of the message 652 | :else 653 | (recur (.read reader) parsing segment-id message)))) 654 | 655 | (defn parse 656 | "Reads data from the provided source (a Reader, String, etc.) and parses that 657 | data into a map that represents the content of the message." 658 | [message-source] 659 | (parse-message (get-reader message-source))) 660 | -------------------------------------------------------------------------------- /src/com/nervestaple/hl7_parser/test.clj: -------------------------------------------------------------------------------- 1 | ;; 2 | ;; Functions to support testing of the HL7 version 2.x parser. 3 | ;; 4 | 5 | (ns com.nervestaple.hl7-parser.test 6 | (:gen-class) 7 | (:use 8 | [com.nervestaple.hl7-parser.parser]) 9 | (:import 10 | (java.util Date))) 11 | 12 | (defn test-message 13 | "Returns a test message with a unique message id." 14 | [] 15 | (str "MSH|^~\\&|AcmeHIS|StJohn|CATH|StJohn|20061019172719||ORM^O01|" 16 | (. (new Date) getTime) "|P|2.3" (char ASCII_CR) 17 | "PID|||20301||Durden^Tyler^^^Mr.||19700312|M|||88 Punchward Dr.^^Los Angeles^CA^11221^USA|||||||" (char ASCII_CR) 18 | "PV1||O|OP^^||||4652^Paulson^Robert|||OP|||||||||9|||||||||||||||||||||||||20061019172717|20061019172718" (char ASCII_CR) 19 | "ORC|NW|20061019172719" (char ASCII_CR) 20 | "OBR|1|20061019172719||76770^Ultrasound: retroperitoneal^C4|||12349876" (char ASCII_CR))) 21 | -------------------------------------------------------------------------------- /src/com/nervestaple/hl7_parser/util.clj: -------------------------------------------------------------------------------- 1 | ;; 2 | ;; Utility functions related to HL7 messages that don't really belong 3 | ;; anywhere else. 4 | ;; 5 | (ns com.nervestaple.hl7-parser.util 6 | (:import 7 | (java.util Date))) 8 | 9 | (defn sanitize-message 10 | "Removes all control characters from a message." 11 | [message] 12 | (if message 13 | (. message replaceAll "\\p{Cntrl}" ""))) 14 | 15 | -------------------------------------------------------------------------------- /test/com/nervestaple/hl7_parser/message_test.clj: -------------------------------------------------------------------------------- 1 | (ns com.nervestaple.hl7-parser.message-test 2 | (:require 3 | [clojure.string :as string] 4 | [clojure.test :refer :all] 5 | [com.nervestaple.hl7-parser.message :as sut] 6 | [com.nervestaple.hl7-parser.parser :as parser] 7 | [com.nervestaple.hl7-parser.sample-message :as sample])) 8 | 9 | (deftest get-segment-field-raw-test 10 | (testing "Gets the field of a segment" 11 | (is (= ["Durden" "Tyler" "" "" "Mr."] 12 | (sut/get-segment-field 13 | (first (sut/get-segments (parser/parse (sample/message)) "PID")) 14 | 5))))) 15 | 16 | (deftest get-segment-field-raw-test 17 | (testing "Gets the raw value for a segment's field" 18 | (is (= {:content ["Durden" "Tyler" "" "" "Mr."]} 19 | (sut/get-segment-field-raw 20 | (first (sut/get-segments (parser/parse (sample/message)) "PID")) 21 | 5))))) 22 | 23 | (deftest get-field-test 24 | (testing "Gets the field of a segment" 25 | (is (= (list ["Durden" "Tyler" "" "" "Mr."]) 26 | (sut/get-field (parser/parse (sample/message)) "PID" 5))))) 27 | 28 | (deftest get-field-component-test 29 | (testing "Gets the component of a field at the provided index" 30 | (is (= "Tyler" 31 | (sut/get-field-component (parser/parse (sample/message)) "PID" 5 1))))) 32 | 33 | (deftest set-field-test 34 | (testing "Sets the value of a field of a parsed message" 35 | (is (= "MSH|^~\\&|AcmeHIS|StJohn|CATH|StJohn|20061019172719||ORM^O01|1676735383748|P|2.3\rPID|||20301||Singer^Marla^^^Ms.||19700312|M|||88 Punchward Dr.^^Los Angeles^CA^11221^USA|||||||\rPV1||O|OP^^||||4652^Paulson^Robert|||OP|||||||||9|||||||||||||||||||||||||20061019172717|20061019172718\rORC|NW|20061019172719\rOBR|1|20061019172719||76770^Ultrasound: retroperitoneal^C4|||12349876\r" 36 | (parser/str-message (sut/set-field (parser/parse (sample/message)) 37 | "PID" 5 38 | ["Singer" "Marla" "" "" "Ms."])))))) 39 | 40 | (deftest extract-text-test 41 | (testing "Extracts and concatenates test of the first instance of the field at the index" 42 | (is (= "DurdenTylerMr." 43 | (sut/extract-text-from-segments (parser/parse (sample/message)) 44 | "PID" 5))))) 45 | 46 | (deftest get-field-first-test 47 | (testing "Fetches the first instance of the field at the index" 48 | (is (= ["Durden" "Tyler" "" "" "Mr."] 49 | (sut/get-field-first (parser/parse (sample/message)) 50 | "PID" 5))))) 51 | 52 | (deftest get-field-first-value-test 53 | (testing "Fetches the value of the first instance of the field at the index" 54 | (is (= "Durden^Tyler^^^Mr." 55 | (sut/get-field-first-value (parser/parse (sample/message)) 56 | "PID" 5))))) 57 | 58 | (deftest ack-test 59 | (testing "Generates an acknowledgement for a parsed message" 60 | (is (= {:delimiters 61 | {:field 124, :component 94, :subcomponent 38, :repeating 126, :escape 92}, 62 | :segments 63 | [{:id "MSH", 64 | :fields 65 | [{:content ["^~\\&"]} 66 | {:content [""]} 67 | {:content [""]} 68 | {:content ["AcmeHIS"]} 69 | {:content ["StJohn"]} 70 | {:content ["20230218125600"]} 71 | {:content []} 72 | {:content ["ACK"]} 73 | {:content ["1676735383748"]} 74 | {:content [""]} 75 | {:content [""]}]} 76 | {:id "MSA", 77 | :fields [{:content ["AA"]} {:content ["1676735383748"]} {:content [""]}]}]} 78 | (sut/ack-message {:message-id "20230218125600"} 79 | "AA" (parser/parse (sample/message))))))) 80 | 81 | (deftest no-ack-test 82 | (testing "Does not generate an acknowledgement for a parsed message" 83 | (is (= nil 84 | (sut/ack-message {} "AA" (parser/parse (sample/message-no-ack))))))) 85 | 86 | (deftest ack-fallback-test 87 | (testing "Generates an acknowledgement for a parsed message" 88 | (is (= {:delimiters 89 | {:field 124, :component 94, :subcomponent 38, :repeating 126, :escape 92}, 90 | :segments 91 | [{:id "MSH", 92 | :fields 93 | [{:content ["^~\\&"]} 94 | {:content [""]} 95 | {:content [""]} 96 | {:content ["UNKNOWN"]} 97 | {:content ["UNKNOWN"]} 98 | {:content ["20230218125600"]} 99 | {:content []} 100 | {:content ["ACK"]} 101 | nil 102 | {:content [""]} 103 | {:content [""]}]} 104 | {:id "MSA", :fields [{:content ["AR"]} nil {:content [""]}]}]} 105 | (sut/ack-message-fallback {:message-id "20230218125600"} 106 | "AR" "BLERG!"))))) 107 | (deftest message-with-long-segment-id 108 | (testing "Parses a message that includes a long segment identifier" 109 | (is (= {:id "ZQRY" 110 | :fields [{:content ["Y"]} {:content ["Y"]} {:content []} 111 | {:content []} {:content []} {:content []} {:content []} 112 | {:content []} {:content []} {:content []} {:content []} 113 | {:content []} {:content []} {:content []} 114 | {:content ["20230915"]} {:content ["000072816"]} 115 | {:content ["1907838"]} {:content []} {:content []} 116 | {:content []} {:content []} {:content []} {:content []} 117 | {:content []} {:content []} {:content []}]} 118 | (first (sut/get-segments (parser/parse (sample/message-long-segment-id)) "ZQRY")))))) 119 | -------------------------------------------------------------------------------- /test/com/nervestaple/hl7_parser/parser_test.clj: -------------------------------------------------------------------------------- 1 | (ns com.nervestaple.hl7-parser.parser-test 2 | (:require 3 | [clojure.string :as string] 4 | [clojure.test :refer :all] 5 | [com.nervestaple.hl7-parser.parser :as sut] 6 | [com.nervestaple.hl7-parser.sample-message :as sample] 7 | [com.nervestaple.hl7-parser.parser :as parser])) 8 | 9 | (def short-message-parsed 10 | {:delimiters 11 | {:field 124, :component 94, :subcomponent 38, :repeating 126, :escape 92}, 12 | :segments 13 | [{:id "MSH", 14 | :fields 15 | [{:content ["^~\\&"]} 16 | {:content ["AcmeHIS"]} 17 | {:content ["StJohn"]} 18 | {:content ["CATH"]} 19 | {:content ["StJohn"]} 20 | {:content ["20061019172719"]} 21 | {:content []} 22 | {:content ["ORM" "O01"]} 23 | {:content ["1676735383748"]} 24 | {:content ["P"]} 25 | {:content ["2.3"]}]} 26 | {:id "PID", 27 | :fields 28 | [{:content []} 29 | {:content []} 30 | {:content ["20301"]} 31 | {:content []} 32 | {:content ["Durden" "Tyler" "" "" "Mr."]} 33 | {:content []} 34 | {:content ["19700312"]} 35 | {:content ["M"]} 36 | {:content []} 37 | {:content []} 38 | {:content ["88 Punchward Dr." "" "Los Angeles" "CA" "11221" "USA"]} 39 | {:content []} 40 | {:content []} 41 | {:content []} 42 | {:content []} 43 | {:content []} 44 | {:content []} 45 | {:content []}]} 46 | {:id "PV1", 47 | :fields 48 | [{:content []} 49 | {:content ["O"]} 50 | {:content ["OP" "" ""]} 51 | {:content []} 52 | {:content []} 53 | {:content []} 54 | {:content ["4652" "Paulson" "Robert"]} 55 | {:content []} 56 | {:content []} 57 | {:content ["OP"]} 58 | {:content []} 59 | {:content []} 60 | {:content []} 61 | {:content []} 62 | {:content []} 63 | {:content []} 64 | {:content []} 65 | {:content []} 66 | {:content ["9"]} 67 | {:content []} 68 | {:content []} 69 | {:content []} 70 | {:content []} 71 | {:content []} 72 | {:content []} 73 | {:content []} 74 | {:content []} 75 | {:content []} 76 | {:content []} 77 | {:content []} 78 | {:content []} 79 | {:content []} 80 | {:content []} 81 | {:content []} 82 | {:content []} 83 | {:content []} 84 | {:content []} 85 | {:content []} 86 | {:content []} 87 | {:content []} 88 | {:content []} 89 | {:content []} 90 | {:content []} 91 | {:content ["20061019172717"]} 92 | {:content ["20061019172718"]}]} 93 | {:id "ORC", :fields [{:content ["NW"]} {:content ["20061019172719"]}]} 94 | {:id "OBR", 95 | :fields 96 | [{:content ["1"]} 97 | {:content ["20061019172719"]} 98 | {:content []} 99 | {:content ["76770" "Ultrasound: retroperitoneal" "C4"]} 100 | {:content []} 101 | {:content []} 102 | {:content ["12349876"]}]}]}) 103 | 104 | (deftest parse-message-test 105 | (testing "Parses a test message" 106 | (is (= short-message-parsed (sut/parse (sample/message)))))) 107 | 108 | (deftest parse-message-test-no-trailing-segment-delimiter 109 | (testing "Parses a test message" 110 | (is (= short-message-parsed (sut/parse (string/trim (sample/message))))))) 111 | 112 | (deftest parse-message-test-extra-trailing-segment-delimiter 113 | (testing "Parses a test message" 114 | (is (thrown? Exception (sut/parse (str (sample/message) parser/ASCII_CR)))))) 115 | 116 | (deftest emit-message-test 117 | (testing "Emits the test message" 118 | (is (= (sample/message) (parser/str-message short-message-parsed))))) 119 | 120 | (deftest empty-message-delimiters-test 121 | (testing "Empty messages contain default delimiters" 122 | (is (= (:delimiters short-message-parsed) 123 | (:delimiters (parser/create-empty-message)))))) 124 | 125 | (deftest pr-delimiters-test 126 | (testing "Returns a string with the provided delimiters" 127 | (is (= "^~\\&" 128 | (parser/pr-delimiters parser/DEFAULT-DELIMITERS))))) 129 | 130 | (deftest create-empty-message 131 | (testing "Creates an empty message" 132 | (is (= {:delimiters 133 | {:field 124, :component 94, :subcomponent 38, :repeating 126, :escape 92}, 134 | :segments []} 135 | (parser/create-empty-message))))) 136 | 137 | (deftest create-empty-message-with-delimiters 138 | (testing "Creates an empty message" 139 | (is (= {:delimiters 140 | {:field 1 :component 2 :subcomponent 3 :repeating 4 :escape 5} 141 | :segments []} 142 | (parser/create-empty-message 143 | {:field 1 :component 2 :subcomponent 3 :repeating 4 :escape 5}))))) 144 | 145 | (deftest create-segment-test 146 | (testing "Creates an empty segment" 147 | (is (= {:id "PID" :fields []} 148 | (parser/create-segment "PID"))))) 149 | 150 | (deftest create-segment-with-fields 151 | (testing "Creates a segment with field data" 152 | (is (= {:id "PID", 153 | :fields 154 | [{:content []} 155 | {:content []} 156 | {:content ["20301"]} 157 | {:content []} 158 | {:content ["Durden" "Tyler" "" "" "Mr."]} 159 | {:content []} 160 | {:content ["19700312"]} 161 | {:content ["M"]} 162 | {:content []} 163 | {:content []} 164 | {:content ["88 Punchward Dr." "" "Los Angeles" "CA" "11221" "USA"]}]} 165 | (parser/create-segment "PID" 166 | (parser/create-field) 167 | (parser/create-field) 168 | (parser/create-field "20301") 169 | (parser/create-field) 170 | (parser/create-field ["Durden" "Tyler" nil nil "Mr."]) 171 | (parser/create-field) 172 | (parser/create-field "19700312") 173 | (parser/create-field "M") 174 | (parser/create-field) 175 | (parser/create-field) 176 | (parser/create-field ["88 Punchward Dr." nil "Los Angeles" "CA" "11221" "USA"])))))) 177 | 178 | (deftest add-segment-to-message 179 | (testing "Creates a message and adds as segment" 180 | (is (= {:delimiters 181 | {:field 124, :component 94, :subcomponent 38, :repeating 126, :escape 92}, 182 | :segments 183 | [{:id "PID", 184 | :fields 185 | [{:content []} 186 | {:content []} 187 | {:content ["20301"]} 188 | {:content []} 189 | {:content ["Durden" "Tyler" "" "" "Mr."]} 190 | {:content []} 191 | {:content ["19700312"]} 192 | {:content ["M"]} 193 | {:content []} 194 | {:content []} 195 | {:content ["88 Punchward Dr." "" "Los Angeles" "CA" "11221" "USA"]}]}]} 196 | (parser/add-segment 197 | (parser/create-empty-message) 198 | (parser/create-segment "PID" 199 | (parser/create-field) 200 | (parser/create-field) 201 | (parser/create-field "20301") 202 | (parser/create-field) 203 | (parser/create-field ["Durden" "Tyler" nil nil "Mr."]) 204 | (parser/create-field) 205 | (parser/create-field "19700312") 206 | (parser/create-field "M") 207 | (parser/create-field) 208 | (parser/create-field) 209 | (parser/create-field ["88 Punchward Dr." nil "Los Angeles" "CA" "11221" "USA"]))))))) 210 | 211 | (deftest add-field-to-segment 212 | (testing "Adds a field to a segment" 213 | (is (= {:id "PID", 214 | :fields 215 | [{:content []} 216 | {:content []} 217 | {:content ["20301"]} 218 | {:content []} 219 | {:content ["Durden" "Tyler" "" "" "Mr."]}]} 220 | (parser/add-field 221 | (parser/create-segment "PID" 222 | (parser/create-field) 223 | (parser/create-field) 224 | (parser/create-field "20301") 225 | (parser/create-field)) 226 | (parser/create-field ["Durden" "Tyler" nil nil "Mr."])))))) 227 | 228 | (deftest add-fields-to-segment 229 | (testing "Adds a field to a segment" 230 | (is (= {:id "PID", 231 | :fields 232 | [{:content []} 233 | {:content []} 234 | {:content ["20301"]} 235 | {:content []} 236 | {:content ["Durden" "Tyler" "" "" "Mr."]}]} 237 | (parser/add-fields 238 | (parser/create-segment "PID" 239 | (parser/create-field) 240 | (parser/create-field) 241 | (parser/create-field "20301")) 242 | [(parser/create-field) 243 | (parser/create-field ["Durden" "Tyler" nil nil "Mr."])]))))) 244 | -------------------------------------------------------------------------------- /test/com/nervestaple/hl7_parser/sample_message.clj: -------------------------------------------------------------------------------- 1 | (ns com.nervestaple.hl7-parser.sample-message 2 | (:require 3 | [com.nervestaple.hl7-parser.parser :as parser]) 4 | (:import 5 | (java.util Date))) 6 | 7 | (defn message 8 | "Returns a short test message." 9 | [] 10 | (str "MSH|^~\\&|AcmeHIS|StJohn|CATH|StJohn|20061019172719||ORM^O01|1676735383748|P|2.3" (char parser/ASCII_CR) 11 | "PID|||20301||Durden^Tyler^^^Mr.||19700312|M|||88 Punchward Dr.^^Los Angeles^CA^11221^USA|||||||" (char parser/ASCII_CR) 12 | "PV1||O|OP^^||||4652^Paulson^Robert|||OP|||||||||9|||||||||||||||||||||||||20061019172717|20061019172718" (char parser/ASCII_CR) 13 | "ORC|NW|20061019172719" (char parser/ASCII_CR) 14 | "OBR|1|20061019172719||76770^Ultrasound: retroperitoneal^C4|||12349876" (char parser/ASCII_CR))) 15 | 16 | (defn message-no-ack 17 | "Returns a short test message that doesn't require an acknowledgement." 18 | [] 19 | (str "MSH|^~\\&|AcmeHIS|StJohn|CATH|StJohn|20061019172719||ORM^O01|1676735383748|P|2.3|||NE" (char parser/ASCII_CR) 20 | "PID|||20301||Durden^Tyler^^^Mr.||19700312|M|||88 Punchward Dr.^^Los Angeles^CA^11221^USA|||||||" (char parser/ASCII_CR) 21 | "PV1||O|OP^^||||4652^Paulson^Robert|||OP|||||||||9|||||||||||||||||||||||||20061019172717|20061019172718" (char parser/ASCII_CR) 22 | "ORC|NW|20061019172719" (char parser/ASCII_CR) 23 | "OBR|1|20061019172719||76770^Ultrasound: retroperitoneal^C4|||12349876" (char parser/ASCII_CR))) 24 | 25 | (defn message-unique-id 26 | "Returns a short test message with a unique message id." 27 | [] 28 | (str "MSH|^~\\&|AcmeHIS|StJohn|CATH|StJohn|20061019172719||ORM^O01|" 29 | (. (new Date) getTime) "|P|2.3" (char parser/ASCII_CR) 30 | "PID|||20301||Durden^Tyler^^^Mr.||19700312|M|||88 Punchward Dr.^^Los Angeles^CA^11221^USA|||||||" (char parser/ASCII_CR) 31 | "PV1||O|OP^^||||4652^Paulson^Robert|||OP|||||||||9|||||||||||||||||||||||||20061019172717|20061019172718" (char parser/ASCII_CR) 32 | "ORC|NW|20061019172719" (char parser/ASCII_CR) 33 | "OBR|1|20061019172719||76770^Ultrasound: retroperitoneal^C4|||12349876" (char parser/ASCII_CR))) 34 | 35 | (defn message-long-segment-id 36 | "Returns a short message that includes a proprietary segment with a long identifier" 37 | [] 38 | (str "MSH|^~\\&|AcmeHIS|StJohn|CATH|StJohn|20061019172719||ORM^O01|" 39 | (. (new Date) getTime) "|P|2.3" (char parser/ASCII_CR) 40 | "PID|||20301||Durden^Tyler^^^Mr.||19700312|M|||88 Punchward Dr.^^Los Angeles^CA^11221^USA|||||||" (char parser/ASCII_CR) 41 | "PV1||O|OP^^||||4652^Paulson^Robert|||OP|||||||||9|||||||||||||||||||||||||20061019172717|20061019172718" (char parser/ASCII_CR) 42 | "ORC|NW|20061019172719" (char parser/ASCII_CR) 43 | "OBR|1|20061019172719||76770^Ultrasound: retroperitoneal^C4|||12349876" (char parser/ASCII_CR) 44 | "ZQRY|Y|Y|||||||||||||20230915|000072816|1907838|||||||||" (char parser/ASCII_CR))) 45 | -------------------------------------------------------------------------------- /tests.edn: -------------------------------------------------------------------------------- 1 | #kaocha/v1 {} 2 | --------------------------------------------------------------------------------