source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL7A.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 7.7 KB
Line 
1RORHL7A ;HCIOFO/SG - HL7 UTILITIES ; 4/4/07 1:07pm
2 ;;1.5;CLINICAL CASE REGISTRIES;**2**;Feb 17, 2006;Build 6
3 ;
4 Q
5 ;
6 ;***** ADDS THE SEGMENT TO THE HL7 MESSAGE BUFFER
7 ;
8 ; SEG Complete HL7 segment
9 ;
10 ; The ADDSEGC^RORHL7A procedure adds the HL7 segment to the HL7
11 ; message buffer defined by the ROREXT("HL7BUF") parameter
12 ; (the ^TMP("HLS",$J), by default). The <TAB>, <CR> and <LF>
13 ; characters are replaced with spaces. Long segments are split
14 ; among sub-nodes of the main segment node in the destination
15 ; buffer.
16 ;
17 ; The RORHL array and some nodes of the ROREXT array must be
18 ; initialized (either by the $$INIT^RORHL7 or manually) before
19 ; calling this procedure.
20 ;
21ADDSEGC(SEG) ;
22 N I1,I2,MAXLEN,NODE,PTR,PTR1,SID,SL
23 S NODE=ROREXT("HL7BUF"),PTR=$G(ROREXT("HL7PTR"))+1
24 S HLFS=RORHL("FS"),HLECH=RORHL("ECH")
25 Q:$P(SEG,HLFS)="" ; Segment Name
26 ;--- Assign the Set ID if necessary
27 S SID=$$SETID($P(SEG,HLFS))
28 S:SID>0 $P(SEG,HLFS,2)=SID
29 ;--- Remove empty trailing fields
30 S I2=$L(SEG,HLFS)
31 F I1=I2:-1:1 Q:$TR($P(SEG,HLFS,I1),HLECH)'=""
32 S:I1<I2 $P(SEG,HLFS,I1+1,I2)=""
33 ;--- Store the segment
34 S SL=$L(SEG),MAXLEN=245 K @NODE@(PTR)
35 S @NODE@(PTR)=$TR($E(SEG,1,MAXLEN),$C(9,10,13)," ")
36 S ROREXT("HL7SIZE")=$G(ROREXT("HL7SIZE"))+SL+1
37 ;--- Split the segment into sub-nodes if necessary
38 D:SL>MAXLEN
39 . S I2=MAXLEN
40 . F PTR1=1:1 S I1=I2+1,I2=I1+MAXLEN-1 Q:I1>SL D
41 . . S @NODE@(PTR,PTR1)=$TR($E(SEG,I1,I2),$C(9,10,13)," ")
42 ;--- Save the pointer
43 S ROREXT("HL7PTR")=PTR
44 Q
45 ;
46 ;***** ASSEMBLES THE SEGMENT AND ADDS IT TO THE HL7 MESSAGE BUFFER
47 ;
48 ; .FIELDS Reference to a local variable where the HL7
49 ; fields are stored
50 ;
51 ; FIELDS(
52 ; 0) Segment name
53 ; I, Field value
54 ; i) Continuation of the value if it is
55 ; ... longer than than 245 characters
56 ;
57 ; The ADDSEGF^RORHL7A procedure assembles the HL7 segment from
58 ; provided field values and adds it to the HL7 message buffer
59 ; defined by the ROREXT("HL7BUF") node (the ^TMP("HLS",$J), by
60 ; default). The <TAB>, <CR> and <LF> characters are replaced with
61 ; spaces. Long segments are split among sub-nodes of the main
62 ; segment node in the destination buffer.
63 ;
64 ; The RORHL array and some nodes of the ROREXT array must be
65 ; initialized (either by the $$INIT^RORHL7 or manually) before
66 ; calling this procedure.
67 ;
68ADDSEGF(FIELDS) ;
69 ; RORBUF Temporary buffer for the segment construction
70 ; RORIS Current continuation subscript in the HL7 buffer
71 ; RORNODE Closed root of the HL7 message buffer
72 ; RORPTR Current subscript in the HL7 message buffer
73 ; RORSL Number of characters that can be appended to the
74 ; RORBUF before it has to be emptied into the HL7
75 ; message buffer
76 ;
77 N FLD,I,LASTFLD,RORBUF,RORIS,RORNODE,RORPTR,RORSL
78 Q:$G(FIELDS(0))="" ; Segment Name
79 S RORNODE=ROREXT("HL7BUF"),RORPTR=$G(ROREXT("HL7PTR"))+1
80 S HLFS=RORHL("FS"),HLECH=RORHL("ECH")
81 ;--- Assign the Set ID if necessary
82 S I=$$SETID(FIELDS(0))
83 S:I>0 FIELDS(1)=I
84 ;--- Remove empty trailing fields
85 S I=$NA(FIELDS(" "))
86 F S I=$$Q^RORUTL18(I,-1) Q:I="" Q:$TR(@I,HLECH)'="" K @I
87 ;--- Initialize construction variables
88 S RORBUF=FIELDS(0),I=$L(RORBUF)
89 S ROREXT("HL7SIZE")=$G(ROREXT("HL7SIZE"))+I+1
90 S RORIS=0,RORSL=245-I
91 ;--- Append the fields and store the segment
92 S LASTFLD=+$O(FIELDS(" "),-1)
93 F FLD=1:1:LASTFLD D
94 . D APPEND(HLFS_$G(FIELDS(FLD)))
95 . ;--- Process the field continuation nodes
96 . S I=""
97 . F S I=$O(FIELDS(FLD,I)) Q:I="" D APPEND(FIELDS(FLD,I))
98 ;--- Flush the buffer if necessary
99 D:RORBUF'=""
100 . I 'RORIS S @RORNODE@(RORPTR)=RORBUF Q
101 . S @RORNODE@(RORPTR,RORIS)=RORBUF
102 S ROREXT("HL7PTR")=RORPTR
103 Q
104 ;
105 ;***** APPENDS THE FIELD VALUE TO THE HL7 SEGMENT
106 ;
107 ; VAL Value of the field (or its part)
108 ;
109 ; This is an internal function. Do not call it directly.
110 ;
111APPEND(VAL) ;
112 N BASE,L
113 S VAL=$TR(VAL,$C(9,10,13)," "),L=$L(VAL)
114 S ROREXT("HL7SIZE")=$G(ROREXT("HL7SIZE"))+L
115 I L'>RORSL S RORBUF=RORBUF_VAL,RORSL=RORSL-L Q
116 ;---
117 S RORBUF=RORBUF_$E(VAL,1,RORSL),L=L-RORSL
118 S BASE=1
119 F D Q:L'>0
120 . I 'RORIS S @RORNODE@(RORPTR)=RORBUF
121 . E S @RORNODE@(RORPTR,RORIS)=RORBUF
122 . S BASE=BASE+RORSL,RORIS=RORIS+1,RORSL=245
123 . S RORBUF=$E(VAL,BASE,BASE+RORSL-1),L=L-RORSL
124 S RORSL=-L
125 Q
126 ;
127 ;***** RETURNS THE BHS SEGMENT
128 ;
129 ; BID Batch message ID
130 ;
131 ; [BDT] Batch message creation time in internal FileMan
132 ; format (NOW by default)
133 ;
134 ; [COMMENT] Optional comment
135 ;
136 ; The RORHL local variable must be initialized by the $$INIT^RORHL7
137 ; function before calling this entry point.
138 ;
139BHS(BID,BDT,COMMENT) ;
140 N CS,SEG,TMP
141 D BHS^HLFNC3(.RORHL,BID,.SEG)
142 Q:$G(SEG)="" ""
143 S HLFS=RORHL("FS"),HLECH=RORHL("ECH"),CS=$E(HLECH,1)
144 ;--- Post-processing
145 S SEG=SEG_$G(SEG(1))
146 S:$G(BDT)'>0 BDT=$$NOW^XLFDT
147 S TMP=$E($P($$SITE^VASITE,U,3),1,3)
148 S $P(SEG,HLFS,4)=TMP_CS_$G(^XMB("NETNAME"))_CS_"DNS"
149 S $P(SEG,HLFS,5)="ROR AAC"
150 S $P(SEG,HLFS,7)=$$FMTHL7^XLFDT(BDT)
151 S TMP=$P(SEG,HLFS,9)
152 S $P(TMP,CS,3)=$P(TMP,CS,3)_$E(HLECH,2)_$G(RORHL("ETN"))
153 S $P(SEG,HLFS,9)=TMP
154 S $P(SEG,HLFS,10)=$G(COMMENT)
155 Q SEG
156 ;
157 ;***** RETURNS BTS SEGMENT
158 ;
159 ; MSGCNT Batch message count
160 ; [COMMENT] Batch comment
161 ;
162 ; The RORHL variable must be initialized by the INIT^HLFNC2 before
163 ; calling this entry point
164 ;
165BTS(MSGCNT,COMMENT) ;
166 Q "BTS"_RORHL("FS")_MSGCNT_RORHL("FS")_$G(COMMENT)
167 ;
168 ;***** LOADS THE HL7 FIELD (OR ITS PART) TO THE BUFFER
169 ;
170 ; VAL Value of the field (or its part)
171 ;
172 ; FLD Number of the field in the segment (piece number)
173 ;
174FIELD(VAL,FLD) ;
175 N BASE,L
176 S:FLD>RORFLD RORFLD=FLD,RORIS=0,RORSL=245
177 S L=$L(VAL),BASE=1
178 F RORIS=RORIS:1 D Q:L'>0
179 . I 'RORIS S RORSEG(RORFLD)=$G(RORSEG(RORFLD))_$E(VAL,BASE,BASE+RORSL-1)
180 . E S RORSEG(RORFLD,RORIS)=$G(RORSEG(RORFLD,RORIS))_$E(VAL,BASE,BASE+RORSL-1)
181 . S BASE=BASE+RORSL,L=L-RORSL,RORSL=245
182 S RORSL=-L
183 Q
184 ;
185 ;***** LOADS THE HL7 SEGMENT INTO THE RPOVIDED BUFFER
186 ;
187 ; .RORSEG Reference to a local variable where the HL7
188 ; fields will be stored. The fields are stored
189 ; in the following format:
190 ;
191 ; RORSEG(FldNum)=FldVal
192 ;
193 ; If the value is longer that 245 characters then
194 ; the continuation nodes are created:
195 ;
196 ; RORSEG(FldNum,#)=FldValCont
197 ;
198 ; ROR8SRC Closed root of the source buffer containing
199 ; the HL7 segment
200 ;
201LOADSEG(RORSEG,ROR8SRC) ;
202 N BUF,FLD,I,IFL,NFL,RORFLD,RORIS,RORSL
203 S HLFS=RORHL("FS") K RORSEG
204 ;--- Process the main segment
205 S BUF=$G(@ROR8SRC),NFL=$L(BUF,HLFS)
206 F IFL=1:1:NFL S RORSEG(IFL-1)=$P(BUF,HLFS,IFL)
207 Q:$D(@ROR8SRC)<10
208 ;--- Process the sub-segments
209 S (FLD,RORFLD)=NFL-1,RORIS=0,RORSL=245-$L(RORSEG(FLD))
210 S I=""
211 F S I=$O(@ROR8SRC@(I)) Q:I="" D
212 . S BUF=@ROR8SRC@(I),NFL=$L(BUF,HLFS)
213 . D FIELD($P(BUF,HLFS),FLD)
214 . F IFL=2:1:NFL S FLD=FLD+1 D FIELD($P(BUF,HLFS,IFL),FLD)
215 Q
216 ;
217 ;***** RETURNS TEXT EXPLANATIONS OF THE HL7 MESSAGE STATUS
218 ;
219 ; MSGST Status value returned by the $$MSGSTAT^HLUTIL
220 ;
221MSGSTXT(MSGST) ;
222 N ST S ST=+MSGST
223 Q:'ST "Message does not exist"
224 Q:ST=1 "Waiting in queue"
225 Q:ST=1.5 "Opening connection"
226 Q:ST=1.7 "Awaiting response"
227 Q:ST=2 "Awaiting application ack"
228 Q:ST=3 "Successfully completed"
229 Q:ST=4 "Error"
230 Q:ST=8 "Being generated"
231 Q:ST=9 "Awaiting processing"
232 Q "Unknown"
233 ;
234 ;***** ASSIGNS THE 'SET ID'
235 ;
236 ; SEGNAME Name of the HL7 segment
237 ; [DISINC] Disable increment of the Set ID
238 ;
239 ; Return Values:
240 ; "" Not required for this segment
241 ; >0 Value for the Set ID field
242 ;
243SETID(SEGNAME,DISINC) ;
244 N SETID
245 Q:$G(SEGNAME)="" ""
246 S SETID=+$G(ROREXT("HL7SID",SEGNAME))
247 Q:SETID'>0 ""
248 S:'$G(DISINC) ROREXT("HL7SID",SEGNAME)=SETID+1
249 Q SETID
Note: See TracBrowser for help on using the repository browser.