source: WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7U.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 8.4 KB
RevLine 
[613]1MHV7U ;WAS/GPM - HL7 UTILITIES ; [1/7/08 10:21pm]
2 ;;1.0;My HealtheVet;**1,2**;Aug 23, 2005;Build 22
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;This routine contains generic utilities used when building
6 ;or processing HL7 messages.
7 ;
8 Q ;Direct entry not supported
9 ;
10LOADMSG(MSGROOT) ; Load HL7 message into temporary global for processing
11 ;
12 ;This subroutine assumes that all VistA HL7 environment variables are
13 ;properly initialized and will produce a fatal error if they aren't.
14 ;
15 N CNT,SEG
16 K @MSGROOT
17 F SEG=1:1 X HLNEXT Q:HLQUIT'>0 D
18 . S CNT=0
19 . S @MSGROOT@(SEG,CNT)=HLNODE
20 . F S CNT=$O(HLNODE(CNT)) Q:'CNT S @MSGROOT@(SEG,CNT)=HLNODE(CNT)
21 Q
22 ;
23LOADXMT(XMT) ;Set HL dependent XMT values
24 ;
25 ; The HL array and variables are expected to be defined. If not,
26 ; message processing will fail. These references should not be
27 ; wrapped in $G, as null values will simply postpone the failure to
28 ; a point that will be harder to diagnose. Except HL("APAT") which
29 ; is not defined on synchronous calls.
30 ; Also assumes MHV RESPONSE MAP file is setup for every protocol
31 ; pair defined by MHV package.
32 ;
33 ; Integration Agreements:
34 ; 1373 : Reference to PROTOCOL file #101
35 ;
36 N SUBPROT,RESPIEN,RESP0
37 S XMT("MID")=HL("MID") ;Message ID
38 S XMT("MODE")="A" ;Response mode
39 I $G(HL("APAT"))="" S XMT("MODE")="S" ;Synchronous mode
40 S XMT("HLMTIENS")=HLMTIENS ;Message IEN
41 S XMT("MESSAGE TYPE")=HL("MTN") ;Message type
42 S XMT("EVENT TYPE")=HL("ETN") ;Event type
43 S XMT("DELIM")=HL("FS")_HL("ECH") ;HL Delimiters
44 S XMT("MAX SIZE")=0 ;Default size unlimited
45 ;
46 ; Map response protocol and builder
47 S SUBPROT=$P(^ORD(101,HL("EIDS"),0),"^")
48 S RESPIEN=$O(^MHV(2275.4,"B",SUBPROT,0))
49 S RESP0=$G(^MHV(2275.4,RESPIEN,0))
50 S XMT("PROTOCOL")=$P(RESP0,"^",2) ;Response Protocol
51 S XMT("BUILDER")=$TR($P(RESP0,"^",3),"~","^") ;Response Builder
52 S XMT("BREAK SEGMENT")=$P(RESP0,"^",4) ;Boundary Segment
53 Q
54 ;
55DELIM(PROTOCOL) ;Return string of message delimiters based on Protocol
56 ;
57 ; Integration Agreements:
58 ; 2161 : INIT^HLFNC2
59 ;
60 N HL
61 Q:PROTOCOL="" ""
62 D INIT^HLFNC2(PROTOCOL,.HL)
63 Q $G(HL("FS"))_$G(HL("ECH"))
64 ;
65PARSEMSG(MSGROOT,HL) ; Message Parser
66 ; Does not handle segments that span nodes
67 ; Does not handle extremely long segments (uses a local)
68 ; Does not handle long fields (segment parser doesn't)
69 ;
70 N SEG,CNT,DATA,MSG
71 F CNT=1:1 Q:'$D(@MSGROOT@(CNT)) M SEG=@MSGROOT@(CNT) D
72 . D PARSESEG(SEG(0),.DATA,.HL)
73 . K @MSGROOT@(CNT)
74 . I DATA(0)'="" M @MSGROOT@(CNT)=DATA
75 . Q:'$D(SEG(1))
76 . ;Add handler for segments that span nodes here.
77 . Q
78 Q
79 ;
80PARSESEG(SEG,DATA,HL) ;Generic segment parser
81 ;This procedure parses a single HL7 segment and builds an array
82 ;subscripted by the field number containing the data for that field.
83 ; Does not handle segments that span nodes
84 ;
85 ; Input:
86 ; SEG - HL7 segment to parse
87 ; HL - HL7 environment array
88 ;
89 ; Output:
90 ; Function value - field data array [SUB1:field, SUB2:repetition,
91 ; SUB3:component, SUB4:sub-component]
92 ;
93 N CMP ;component subscript
94 N CMPVAL ;component value
95 N FLD ;field subscript
96 N FLDVAL ;field value
97 N REP ;repetition subscript
98 N REPVAL ;repetition value
99 N SUB ;sub-component subscript
100 N SUBVAL ;sub-component value
101 N FS ;field separator
102 N CS ;component separator
103 N RS ;repetition separator
104 N SS ;sub-component separator
105 ;
106 K DATA
107 S FS=HL("FS")
108 S CS=$E(HL("ECH"))
109 S RS=$E(HL("ECH"),2)
110 S SS=$E(HL("ECH"),4)
111 ;
112 S DATA(0)=$P(SEG,FS)
113 S SEG=$P(SEG,FS,2,9999)
114 F FLD=1:1:$L(SEG,FS) D
115 . S FLDVAL=$P(SEG,FS,FLD)
116 . F REP=1:1:$L(FLDVAL,RS) D
117 . . S REPVAL=$P(FLDVAL,RS,REP)
118 . . I REPVAL[CS F CMP=1:1:$L(REPVAL,CS) D
119 . . . S CMPVAL=$P(REPVAL,CS,CMP)
120 . . . I CMPVAL[SS F SUB=1:1:$L(CMPVAL,SS) D
121 . . . . S SUBVAL=$P(CMPVAL,SS,SUB)
122 . . . . I SUBVAL'="" S DATA(FLD,REP,CMP,SUB)=SUBVAL
123 . . . I '$D(DATA(FLD,REP,CMP)),CMPVAL'="" S DATA(FLD,REP,CMP)=CMPVAL
124 . . I '$D(DATA(FLD,REP)),REPVAL'="",FLDVAL[RS S DATA(FLD,REP)=REPVAL
125 . I '$D(DATA(FLD)),FLDVAL'="" S DATA(FLD)=FLDVAL
126 Q
127 ;
128BLDSEG(DATA,HL) ;generic segment builder
129 ;
130 ; Input:
131 ; DATA - field data array [SUB1:field, SUB2:repetition,
132 ; SUB3:component, SUB4:sub-component]
133 ; HL - HL7 environment array
134 ;
135 ; Output:
136 ; Function Value - Formatted HL7 segment on success, "" on failure
137 ;
138 N CMP ;component subscript
139 N CMPVAL ;component value
140 N FLD ;field subscript
141 N FLDVAL ;field value
142 N REP ;repetition subscript
143 N REPVAL ;repetition value
144 N SUB ;sub-component subscript
145 N SUBVAL ;sub-component value
146 N FS ;field separator
147 N CS ;component separator
148 N RS ;repetition separator
149 N ES ;escape character
150 N SS ;sub-component separator
151 N SEG,SEP
152 ;
153 S FS=HL("FS")
154 S CS=$E(HL("ECH"))
155 S RS=$E(HL("ECH"),2)
156 S ES=$E(HL("ECH"),3)
157 S SS=$E(HL("ECH"),4)
158 ;
159 S SEG=$G(DATA(0))
160 F FLD=1:1:$O(DATA(""),-1) D
161 . S FLDVAL=$G(DATA(FLD)),SEP=FS
162 . S SEG=SEG_SEP_FLDVAL
163 . F REP=1:1:$O(DATA(FLD,""),-1) D
164 . . S REPVAL=$G(DATA(FLD,REP))
165 . . S SEP=$S(REP=1:"",1:RS)
166 . . S SEG=SEG_SEP_REPVAL
167 . . F CMP=1:1:$O(DATA(FLD,REP,""),-1) D
168 . . . S CMPVAL=$G(DATA(FLD,REP,CMP))
169 . . . S SEP=$S(CMP=1:"",1:CS)
170 . . . S SEG=SEG_SEP_CMPVAL
171 . . . F SUB=1:1:$O(DATA(FLD,REP,CMP,""),-1) D
172 . . . . S SUBVAL=$G(DATA(FLD,REP,CMP,SUB))
173 . . . . S SEP=$S(SUB=1:"",1:SS)
174 . . . . S SEG=SEG_SEP_SUBVAL
175 Q SEG
176 ;
177BLDWP(WP,SEG,MAXLEN,FORMAT,FMTLEN,HL) ;
178 ;Builds segment nodes to add word processing fields to a segment
179 N CNT,LINE,LAST,FS,RS,LENGTH,I
180 I MAXLEN<1 S MAXLEN=99999999999999999
181 S FS=HL("FS") ;field separator
182 S RS=$E(HL("ECH"),2) ;repeat separator
183 S CNT=$O(SEG(""),-1)+1
184 S SEG(CNT)=FS
185 S FMTLEN=0
186 S LENGTH=0
187 ;
188 S I=0
189 F S I=$O(WP(I)) Q:'I D Q:LENGTH'<MAXLEN
190 . I $D(WP(I,0)) S LINE=$G(WP(I,0)) ;conventional WP field
191 . E S LINE=$G(WP(I))
192 . S LENGTH=LENGTH+$L(LINE)
193 . I LENGTH'<MAXLEN S LINE=$E(LINE,1,$L(LINE)-(LENGTH-MAXLEN))
194 . S LINE=$$ESCAPE(LINE,.HL)
195 . S LAST=$E(LINE,$L(LINE))
196 . ;first line
197 . I SEG(CNT)=FS S SEG(CNT)=FS_LINE,FMTLEN=FMTLEN+$L(SEG(CNT)) Q
198 . S CNT=CNT+1
199 . S SEG(CNT)=RS_LINE,FMTLEN=FMTLEN+$L(SEG(CNT))
200 . Q:'FORMAT
201 . ;attempt to keep sentences together
202 . I $E(LINE)=" "!(LAST=" ") S SEG(CNT)=LINE,FMTLEN=FMTLEN+$L(LINE)
203 . Q
204 Q
205 ;
206ESCAPE(VAL,HL) ;Escape any special characters
207 ; *** Does not handle long strings of special characters ***
208 ;
209 ; Input:
210 ; VAL - value to escape
211 ; HL - HL7 environment array
212 ;
213 ; Output:
214 ; VAL - passed by reference
215 ;
216 N FS ;field separator
217 N CS ;component separator
218 N RS ;repetition separator
219 N ES ;escape character
220 N SS ;sub-component separator
221 N L,STR,I
222 ;
223 S FS=HL("FS")
224 S CS=$E(HL("ECH"))
225 S RS=$E(HL("ECH"),2)
226 S ES=$E(HL("ECH"),3)
227 S SS=$E(HL("ECH"),4)
228 ;
229 I VAL[ES D
230 . S L=$L(VAL,ES),STR=""
231 . F I=1:1:L S $P(STR,ES_"E"_ES,I)=$P(VAL,ES,I)
232 . S VAL=STR
233 I VAL[FS D
234 . S L=$L(VAL,FS),STR=""
235 . F I=1:1:L S $P(STR,ES_"F"_ES,I)=$P(VAL,FS,I)
236 . S VAL=STR
237 I VAL[RS D
238 . S L=$L(VAL,RS),STR=""
239 . F I=1:1:L S $P(STR,ES_"R"_ES,I)=$P(VAL,RS,I)
240 . S VAL=STR
241 I VAL[CS D
242 . S L=$L(VAL,CS),STR=""
243 . F I=1:1:L S $P(STR,ES_"S"_ES,I)=$P(VAL,CS,I)
244 . S VAL=STR
245 I VAL[SS D
246 . S L=$L(VAL,SS),STR=""
247 . F I=1:1:L S $P(STR,ES_"T"_ES,I)=$P(VAL,SS,I)
248 . S VAL=STR
249 Q VAL
250 ;
251UNESC(VAL,HL) ;Reconstitute any escaped characters
252 ;
253 ; Input:
254 ; VAL - Value to reconstitute
255 ; HL - HL7 environment array
256 ;
257 ; Output:
258 ; VAL - passed by reference
259 ;
260 N FS ;field separator
261 N CS ;component separator
262 N RS ;repetition separator
263 N ES ;escape character
264 N SS ;sub-component separator
265 N L,STR,I,FESC,CESC,RESC,EESC,SESC
266 ;
267 S FS=HL("FS")
268 S CS=$E(HL("ECH"))
269 S RS=$E(HL("ECH"),2)
270 S ES=$E(HL("ECH"),3)
271 S SS=$E(HL("ECH"),4)
272 S FESC=ES_"F"_ES
273 S CESC=ES_"S"_ES
274 S RESC=ES_"R"_ES
275 S EESC=ES_"E"_ES
276 S SESC=ES_"T"_ES
277 ;
278 I VAL'[ES Q VAL
279 I VAL[FESC D
280 . S L=$L(VAL,FESC),STR=""
281 . F I=1:1:L S $P(STR,FS,I)=$P(VAL,FESC,I)
282 . S VAL=STR
283 I VAL[CESC D
284 . S L=$L(VAL,CESC),STR=""
285 . F I=1:1:L S $P(STR,CS,I)=$P(VAL,CESC,I)
286 . S VAL=STR
287 I VAL[RESC D
288 . S L=$L(VAL,RESC),STR=""
289 . F I=1:1:L S $P(STR,RS,I)=$P(VAL,RESC,I)
290 . S VAL=STR
291 I VAL[SESC D
292 . S L=$L(VAL,SESC),STR=""
293 . F I=1:1:L S $P(STR,SS,I)=$P(VAL,SESC,I)
294 . S VAL=STR
295 I VAL[EESC D
296 . S L=$L(VAL,EESC),STR=""
297 . F I=1:1:L S $P(STR,ES,I)=$P(VAL,EESC,I)
298 . S VAL=STR
299 Q VAL
300 ;
Note: See TracBrowser for help on using the repository browser.