source: FOIAVistA/trunk/r/MY_HEALTHEVET-MHV/MHV7U.m@ 1783

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

initial load of FOIAVistA 6/30/08 version
File size: 9.0 KB
Line 
1MHV7U ;WAS/GPM - HL7 UTILITIES ; [4/19/06 12:41pm]
2 ;;1.0;My HealtheVet;**1**;Aug 23, 2005
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 ;
23PARSEMSG(MSGROOT,HL) ; Message Parser
24 ; Does not handle segments that span nodes
25 ; Does not handle extremely long segments (uses a local)
26 ; Does not handle long fields (segment parser doesn't)
27 ;
28 N SEG,CNT,DATA,MSG
29 F CNT=1:1 Q:'$D(@MSGROOT@(CNT)) M SEG=@MSGROOT@(CNT) D
30 . D PARSESEG(SEG(0),.DATA,.HL)
31 . K @MSGROOT@(CNT)
32 . I DATA(0)'="" M @MSGROOT@(CNT)=DATA
33 . Q:'$D(SEG(1))
34 . ;Add handler for segments that span nodes here.
35 . Q
36 Q
37 ;
38LOG(NAME,DATA,TYPE,NEW) ;Log to MHV application log
39 ;
40 ; Input:
41 ; NAME - Name to identify log line
42 ; DATA - Value,Tree, or Name of structure to put in log
43 ; TYPE - Type of log entry
44 ; S:Set Single Value
45 ; M:Merge Tree
46 ; I:Indirect Merge @
47 ; NEW - Flag to create new log entry
48 ;
49 ; Output:
50 ; Updates log
51 ;
52 ; ^XTMP("MHV7LOG",0) - Head of log file
53 ; ^XTMP("MHV7LOG",1) - if set indicates that logging is on
54 ; ^XTMP("MHV7LOG",2) - contains the log
55 ; ^XTMP("MHV7LOG",2,negated FM timestamp,$J,counter,NAME) - log entry
56 ;
57 ; ^TMP("MHV7LOG",$J) - Session current log entry (DTM)
58 ;
59 ;Quit if logging is not turned on
60 Q:'$G(^XTMP("MHV7LOG",1))
61 N DTM,CNT
62 ;
63 Q:'$D(DATA)
64 Q:$G(TYPE)=""
65 Q:$G(NAME)=""
66 S NAME=$TR(NAME,"^","-")
67 ;
68 ; Check ^TMP("MHV7LOG",$J) If no current log node start a new node
69 I '$G(^TMP("MHV7LOG",$J)) S NEW=1
70 ;
71 I $G(NEW) D
72 . S DTM=-$$NOW^XLFDT()
73 . K ^XTMP("MHV7LOG",2,DTM,$J)
74 . S ^TMP("MHV7LOG",$J)=DTM
75 . S CNT=1
76 . S ^XTMP("MHV7LOG",2,DTM,$J)=CNT
77 . D AUTOPRG
78 . Q
79 E D
80 . S DTM=^TMP("MHV7LOG",$J)
81 . S CNT=$G(^XTMP("MHV7LOG",2,DTM,$J))+1
82 . S ^XTMP("MHV7LOG",2,DTM,$J)=CNT
83 . Q
84 ;
85 I TYPE="S" S ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=DATA Q
86 I TYPE="M" M ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=DATA Q
87 I TYPE="I" M ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=@DATA Q
88 ;
89 Q
90 ;
91AUTOPRG ;
92 Q:'$G(^XTMP("MHV7LOG",1,"AUTOPURGE"))
93 N DT,DAYS,RESULT
94 ; Purge only once per day
95 S DT=$$DT^XLFDT
96 Q:$G(^XTMP("MHV7LOG",1,"AUTOPURGE","PURGE DATE"))=DT
97 ;
98 S DAYS=$G(^XTMP("MHV7LOG",1,"AUTOPURGE","DAYS"))
99 I DAYS<1 S DAYS=7
100 ;*** Consider tasking the purge
101 D LOGPRG^MHVUL1(.RESULT,$$HTFM^XLFDT($H-DAYS,1))
102 S ^XTMP("MHV7LOG",1,"AUTOPURGE","PURGE DATE")=DT
103 Q
104 ;
105TRIMSPC(STR) ;Trim leading and trailing spaces from a text string
106 ;
107 ; Input:
108 ; STR - Text string
109 ;
110 ; Output:
111 ; Function Value - Input text string with leading and trailing
112 ; spaces removed
113 ;
114 N SPACE,POS,LEN
115 S SPACE=$C(32)
116 S LEN=$L(STR)
117 S POS=1
118 F Q:$E(STR,POS)'=SPACE!(POS>LEN) S POS=POS+1
119 S STR=$E(STR,POS,LEN)
120 S POS=$L(STR)
121 F Q:$E(STR,POS)'=SPACE!(POS<1) S POS=POS-1
122 S STR=$E(STR,1,POS)
123 Q STR
124 ;
125PARSESEG(SEG,DATA,HL) ;Generic segment parser
126 ;This procedure parses a single HL7 segment and builds an array
127 ;subscripted by the field number containing the data for that field.
128 ; Does not handle segments that span nodes
129 ;
130 ; Input:
131 ; SEG - HL7 segment to parse
132 ; HL - HL7 environment array
133 ;
134 ; Output:
135 ; Function value - field data array [SUB1:field, SUB2:repetition,
136 ; SUB3:component, SUB4:sub-component]
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 SS ;sub-component separator
150 ;
151 K DATA
152 S FS=HL("FS")
153 S CS=$E(HL("ECH"))
154 S RS=$E(HL("ECH"),2)
155 S SS=$E(HL("ECH"),4)
156 ;
157 S DATA(0)=$P(SEG,FS)
158 S SEG=$P(SEG,FS,2,9999)
159 F FLD=1:1:$L(SEG,FS) D
160 . S FLDVAL=$P(SEG,FS,FLD)
161 . F REP=1:1:$L(FLDVAL,RS) D
162 . . S REPVAL=$P(FLDVAL,RS,REP)
163 . . I REPVAL[CS F CMP=1:1:$L(REPVAL,CS) D
164 . . . S CMPVAL=$P(REPVAL,CS,CMP)
165 . . . I CMPVAL[SS F SUB=1:1:$L(CMPVAL,SS) D
166 . . . . S SUBVAL=$P(CMPVAL,SS,SUB)
167 . . . . I SUBVAL'="" S DATA(FLD,REP,CMP,SUB)=SUBVAL
168 . . . I '$D(DATA(FLD,REP,CMP)),CMPVAL'="" S DATA(FLD,REP,CMP)=CMPVAL
169 . . I '$D(DATA(FLD,REP)),REPVAL'="",FLDVAL[RS S DATA(FLD,REP)=REPVAL
170 . I '$D(DATA(FLD)),FLDVAL'="" S DATA(FLD)=FLDVAL
171 Q
172 ;
173BLDSEG(DATA,HL) ;generic segment builder
174 ;
175 ; Input:
176 ; DATA - field data array [SUB1:field, SUB2:repetition,
177 ; SUB3:component, SUB4:sub-component]
178 ; HL - HL7 environment array
179 ;
180 ; Output:
181 ; Function Value - Formatted HL7 segment on success, "" on failure
182 ;
183 N CMP ;component subscript
184 N CMPVAL ;component value
185 N FLD ;field subscript
186 N FLDVAL ;field value
187 N REP ;repetition subscript
188 N REPVAL ;repetition value
189 N SUB ;sub-component subscript
190 N SUBVAL ;sub-component value
191 N FS ;field separator
192 N CS ;component separator
193 N RS ;repetition separator
194 N ES ;escape character
195 N SS ;sub-component separator
196 N SEG,SEP
197 ;
198 S FS=HL("FS")
199 S CS=$E(HL("ECH"))
200 S RS=$E(HL("ECH"),2)
201 S ES=$E(HL("ECH"),3)
202 S SS=$E(HL("ECH"),4)
203 ;
204 S SEG=$G(DATA(0))
205 F FLD=1:1:$O(DATA(""),-1) D
206 . S FLDVAL=$G(DATA(FLD)),SEP=FS
207 . S SEG=SEG_SEP_FLDVAL
208 . F REP=1:1:$O(DATA(FLD,""),-1) D
209 . . S REPVAL=$G(DATA(FLD,REP))
210 . . S SEP=$S(REP=1:"",1:RS)
211 . . S SEG=SEG_SEP_REPVAL
212 . . F CMP=1:1:$O(DATA(FLD,REP,""),-1) D
213 . . . S CMPVAL=$G(DATA(FLD,REP,CMP))
214 . . . S SEP=$S(CMP=1:"",1:CS)
215 . . . S SEG=SEG_SEP_CMPVAL
216 . . . F SUB=1:1:$O(DATA(FLD,REP,CMP,""),-1) D
217 . . . . S SUBVAL=$G(DATA(FLD,REP,CMP,SUB))
218 . . . . S SEP=$S(SUB=1:"",1:SS)
219 . . . . S SEG=SEG_SEP_SUBVAL
220 Q SEG
221 ;
222BLDWPSEG(WP,SEG,MAXLEN,HL) ;
223 ;Builds segment nodes to add word processing fields to a segment
224 N CNT,LINE,LAST,FS,RS,LENGTH
225 I MAXLEN<1 S MAXLEN=999999999999
226 S FS=HL("FS") ;field separator
227 S RS=$E(HL("ECH"),2) ;repeat separator
228 S CNT=$O(SEG(""),-1)+1
229 S LINE=$O(WP(0))
230 S LENGTH=$L(LINE)
231 S SEG(CNT)=""
232 S SEG(CNT)=FS_$$ESCAPE($G(WP(LINE,0)),.HL)
233 F S LINE=$O(WP(LINE)) Q:LINE="" D Q:LENGTH'<MAXLEN
234 . S LENGTH=LENGTH+$L(LINE)
235 . I LENGTH'<MAXLEN S LINE=$E(LINE,1,$L(LINE)-(LENGTH-MAXLEN))
236 . S LAST=$E(SEG(CNT),$L(SEG(CNT)))
237 . S CNT=CNT+1
238 . S SEG(CNT)=$$ESCAPE($G(WP(LINE,0)),.HL)
239 . I $E(SEG(CNT))'=" ",LAST'=" " S SEG(CNT)=RS_SEG(CNT)
240 . Q
241 Q
242 ;
243ADD(VAL,SEP,SEG) ;append a value onto segment
244 ;
245 ; Input:
246 ; VAL - value to append
247 ; SEP - HL7 separator
248 ;
249 ; Output:
250 ; SEG - segment passed by reference
251 ;
252 S SEP=$G(SEP)
253 S VAL=$G(VAL)
254 ; Escape VAL??
255 ; If exceed 512 characters don't add
256 S SEG=SEG_SEP_VAL
257 Q
258 ;
259ESCAPE(VAL,HL) ;Escape any special characters
260 ; *** Does not handle long strings of special characters ***
261 ;
262 ; Input:
263 ; VAL - value to escape
264 ; HL - HL7 environment array
265 ;
266 ; Output:
267 ; VAL - passed by reference
268 ;
269 N FS ;field separator
270 N CS ;component separator
271 N RS ;repetition separator
272 N ES ;escape character
273 N SS ;sub-component separator
274 N L,STR,I
275 ;
276 S FS=HL("FS")
277 S CS=$E(HL("ECH"))
278 S RS=$E(HL("ECH"),2)
279 S ES=$E(HL("ECH"),3)
280 S SS=$E(HL("ECH"),4)
281 ;
282 I VAL[ES D
283 . S L=$L(VAL,ES),STR=""
284 . F I=1:1:L S $P(STR,ES_"E"_ES,I)=$P(VAL,ES,I)
285 . S VAL=STR
286 I VAL[FS D
287 . S L=$L(VAL,FS),STR=""
288 . F I=1:1:L S $P(STR,ES_"F"_ES,I)=$P(VAL,FS,I)
289 . S VAL=STR
290 I VAL[RS D
291 . S L=$L(VAL,RS),STR=""
292 . F I=1:1:L S $P(STR,ES_"R"_ES,I)=$P(VAL,RS,I)
293 . S VAL=STR
294 I VAL[CS D
295 . S L=$L(VAL,CS),STR=""
296 . F I=1:1:L S $P(STR,ES_"S"_ES,I)=$P(VAL,CS,I)
297 . S VAL=STR
298 I VAL[SS D
299 . S L=$L(VAL,SS),STR=""
300 . F I=1:1:L S $P(STR,ES_"T"_ES,I)=$P(VAL,SS,I)
301 . S VAL=STR
302 Q VAL
303 ;
304UNESC(VAL,HL) ;Reconstitute any escaped characters
305 ;
306 ; Input:
307 ; VAL - Value to reconstitute
308 ; HL - HL7 environment array
309 ;
310 ; Output:
311 ; VAL - passed by reference
312 ;
313 N FS ;field separator
314 N CS ;component separator
315 N RS ;repetition separator
316 N ES ;escape character
317 N SS ;sub-component separator
318 N L,STR,I,FESC,CESC,RESC,EESC,SESC
319 ;
320 S FS=HL("FS")
321 S CS=$E(HL("ECH"))
322 S RS=$E(HL("ECH"),2)
323 S ES=$E(HL("ECH"),3)
324 S SS=$E(HL("ECH"),4)
325 S FESC=ES_"F"_ES
326 S CESC=ES_"S"_ES
327 S RESC=ES_"R"_ES
328 S EESC=ES_"E"_ES
329 S SESC=ES_"T"_ES
330 ;
331 I VAL'[ES Q VAL
332 I VAL[FESC D
333 . S L=$L(VAL,FESC),STR=""
334 . F I=1:1:L S $P(STR,FS,I)=$P(VAL,FESC,I)
335 . S VAL=STR
336 I VAL[CESC D
337 . S L=$L(VAL,CESC),STR=""
338 . F I=1:1:L S $P(STR,CS,I)=$P(VAL,CESC,I)
339 . S VAL=STR
340 I VAL[RESC D
341 . S L=$L(VAL,RESC),STR=""
342 . F I=1:1:L S $P(STR,RS,I)=$P(VAL,RESC,I)
343 . S VAL=STR
344 I VAL[SESC D
345 . S L=$L(VAL,SESC),STR=""
346 . F I=1:1:L S $P(STR,SS,I)=$P(VAL,SESC,I)
347 . S VAL=STR
348 I VAL[EESC D
349 . S L=$L(VAL,EESC),STR=""
350 . F I=1:1:L S $P(STR,ES,I)=$P(VAL,EESC,I)
351 . S VAL=STR
352 Q VAL
353 ;
Note: See TracBrowser for help on using the repository browser.