source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL7.m@ 677

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

initial load of FOIAVistA 6/30/08 version
File size: 7.6 KB
Line 
1RORHL7 ;HCIOFO/SG - HL7 UTILITIES ; 11/2/05 10:30am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** ADDS THE SEGMENT TO THE HL7 MESSAGE BUFFER
7 ;
8 ; .SOURCE Reference to a local variable where the
9 ; source data is stored
10 ;
11 ; [SRCTYPE] Type and format of the source data
12 ; "C" Complete segment (see the ADDSEGC^RORHL7A
13 ; for source data format description)
14 ; "F" List of field values (see the ADDSEGF^RORHL7A
15 ; for source data format description).
16 ; This is the default parameter value.
17 ;
18ADDSEG(SOURCE,SRCTYPE) ;
19 I $G(SRCTYPE)?."F" D ADDSEGF^RORHL7A(.SOURCE) Q
20 I SRCTYPE="C" D ADDSEGC^RORHL7A(.SOURCE) Q
21 D ERROR^RORERR(-88,,,,"SRCTYPE",$G(SRCTYPE))
22 Q
23 ;
24 ;***** CREATES A NEW MESSAGE IN THE BATCH
25 ;
26 ; The function adds a new message header to the batch. If the batch
27 ; does not exist yet, it is created.
28 ;
29 ; [.RORMSH] Reference to a variable in what a MSH segment of
30 ; the message is returned.
31 ;
32 ; Return Values:
33 ; <0 Error Code
34 ; >0 Index of a subnode of the ^TMP("HLS",$J) that
35 ; contains the new MSH segment.
36 ;
37 ; MSH segment is returned as a value of the RORMSH parameter. In case
38 ; of a long segment, continuations are returned as subnodes.
39 ;
40 ; Several nodes (HL7*) in ROREXT are set and the ^TMP("HLS",$J) node
41 ; is deleted by this entry point before it creates a new batch.
42 ;
43CREATE(RORMSH) ;
44 N NDX,RC,TMP K RORMSH
45 Q:$G(ROREXT("HL7PROT"))="" $$ERROR^RORERR(-25)
46 ;--- Create a message stub for the new batch message
47 ; (if it has not been created before)
48 I '$G(ROREXT("HL7MTIEN")) D Q:$G(RC)<0 RC
49 . N RORMID,RORIEN,RORDT
50 . ;--- Set up HL7 environment variables
51 . S RC=$$INIT($NA(^TMP("HLS",$J))) Q:RC<0
52 . ;--- Create a stub
53 . S RORDT=$S($G(ROREXT("HDTIEN"))>0:$G(ROREXT("HL7DT")),1:"")
54 . D CREATE^HLTF(.RORMID,.RORIEN,.RORDT)
55 . ;--- Save parameters of the new batch message
56 . S (ROREXT("HL7CNT"),ROREXT("HL7SIZE"))=0
57 . S ROREXT("HL7DT")=RORDT
58 . S ROREXT("HL7MID")=RORMID
59 . S ROREXT("HL7MTIEN")=RORIEN
60 . ;--- Initialize temporary storage
61 . K ^TMP("HLS",$J)
62 ;--- Initialize the HL7 environment variables
63 S RC=$$INIT() Q:RC<0 RC
64 S NDX=$G(ROREXT("HL7PTR"))+1
65 ;--- Reset the Set ID's for all supported segments
66 F TMP="OBR","OBX","PID","PV1","ZRD","ZSP" D
67 . S ROREXT("HL7SID",TMP)=1
68 ;--- Create and store a MSH segment for individual message
69 S ROREXT("HL7CNT")=ROREXT("HL7CNT")+1
70 S TMP=ROREXT("HL7MID")_"-"_ROREXT("HL7CNT")
71 D MSH^HLFNC2(.RORHL,TMP,.RORMSH)
72 S:$P(RORMSH,RORHL("FS"),17)="US" $P(RORMSH,RORHL("FS"),17)="USA"
73 M ^TMP("HLS",$J,NDX)=RORMSH
74 S ROREXT("HL7SIZE")=ROREXT("HL7SIZE")+$L(RORMSH)+$L($G(RORMSH(1)))+1
75 S ROREXT("HL7PTR")=NDX
76 Q NDX
77 ;
78 ;***** REPLACES ENCODING CHARACTERS WITH ESCAPE CODES
79 ;
80 ; STR Source string
81 ;
82 ; The HLFS and HLECH variables must be initialized before
83 ; calling this function (either by the INIT^HLFNC2 or manually).
84 ;
85 ; The function returns the source string with encoding
86 ; characters replaced with corresponding escape codes.
87 ;
88ESCAPE(STR) ;
89 Q:STR="" STR
90 N BUF,ESC,CH,I1,I2,SCLST
91 S SCLST=HLECH_HLFS
92 ;--- Find all occurrences of encoding characters and
93 ; save their positions to a local array
94 F I1=1:1:5 S CH=$E(SCLST,I1),I2=1 Q:CH="" D
95 . F S I2=$F(STR,CH,I2) Q:'I2 S BUF(I2-1)=I1
96 Q:$D(BUF)<10 STR
97 ;--- Replace encoding characters with escape codes
98 S (BUF,I2)="",ESC=$E(HLECH,3) S:ESC="" ESC="\"
99 F S I1=I2,I2=$O(BUF(I2)) Q:I2="" D
100 . S BUF=BUF_$E(STR,I1+1,I2-1)_ESC_$E("SRETF",BUF(I2))_ESC
101 Q BUF_$E(STR,I1+1,$L(STR))
102 ;
103 ;***** CHECKS THE DATE/TIME AND CONVERTS IT TO HL7 FORMAT
104 ;
105 ; DATE Date/time in FileMan format
106 ;
107FM2HL(DATE) ;
108 Q:'$G(DATE) """"""
109 S DATE=$$FMTHL7^XLFDT(DATE)
110 Q $S(DATE>0:DATE,1:"")
111 ;
112 ;***** INITIALIZES THE HL7 SEPARATORS
113 ;
114 ; [.CS] Reference to a local variable where the
115 ; component separator will be returned to.
116 ;
117 ; [.SCS] Reference to a local variable where the
118 ; sub-component separator will be returned to.
119 ;
120 ; [.RPS] Reference to a local variable where the
121 ; repetition separator will be returned to.
122 ;
123ECH(CS,SCS,RPS) ;
124 S HLECH=$G(RORHL("ECH"),"^~\&")
125 S CS=$E(HLECH,1),SCS=$E(HLECH,4),RPS=$E(HLECH,2)
126 Q
127 ;
128 ;***** INITIALIZES THE HL7 ENVIRONMENT VARIABLES
129 ;
130 ; [ROR8FILE] Closed root of the buffer that will be used for
131 ; construction of the HL7 message.
132 ;
133 ; Return Values:
134 ; <0 Error Code
135 ; 0 Ok
136 ;
137INIT(ROR8FILE) ;
138 N TMP K RORHL
139 D INIT^HLFNC2(ROREXT("HL7PROT"),.RORHL)
140 Q:$G(RORHL) $$ERROR^RORERR(-23,,RORHL)
141 S TMP=$G(RORHL("ECH"))
142 Q:$L(TMP)<4 $$ERROR^RORERR(-75)
143 ;--- Initialize the nodes required for the API's
144 S:$G(ROR8FILE)'="" ROREXT("HL7BUF")=ROR8FILE
145 D:$G(ROREXT("HL7BUF"))'=""
146 . S ROREXT("HL7PTR")=+$O(@ROREXT("HL7BUF")@(""),-1)
147 Q 0
148 ;
149 ;***** CHECKS IF MAXIMUM BATCH SIZE IS REACHED
150 ;
151 ; [RESERVE] Number of bytes reserved in the batch (0 by default)
152 ;
153 ; Return Values:
154 ; 0 Messages can be added to the batch
155 ; 1 Maximum size of the batch has been reached
156 ;
157ISMAXSZ(RESERVE) ;
158 Q:$G(ROREXT("MAXHL7SIZE"))'>0 0
159 Q:($G(ROREXT("HL7SIZE"))+$G(RESERVE))<ROREXT("MAXHL7SIZE") 0
160 S $P(ROREXT("HL7SIZE"),U,2)=1
161 Q 1
162 ;
163 ;***** RETURNS NUMBER OF MESSAGES IN THE CURRENT BATCH
164MSGCNT() ;
165 Q $G(ROREXT("HL7CNT"))
166 ;
167 ;***** RETURNS THE POINTER TO LAST SEGMENT IN THE MESSAGE BUFFER
168PTR() Q +$G(ROREXT("HL7PTR"))
169 ;
170 ;***** DELETES THE SEGMENTS FROM THE HL7 MESSAGE BUFFER
171 ;
172 ; SEGPTR An index of the HL7 segment in the message buffer
173 ;
174 ; [KEEP] Keep the segment referenced by the SEGPTR and start
175 ; the rollback from the next segment.
176 ;
177ROLLBACK(SEGPTR,KEEP) ;
178 N BUF,I,I1,MSH,NODE,SEGNAME
179 S NODE=ROREXT("HL7BUF"),HLFS=$G(RORHL("FS"),"|")
180 S I=$S($G(KEEP):$O(@NODE@(SEGPTR)),1:+SEGPTR)
181 S MSH=$S(I>0:$P($G(@NODE@(I)),HLFS)="MSH",1:0)
182 ;---
183 F Q:I'>0 D S I=$O(@NODE@(I))
184 . S BUF=$G(@NODE@(I))
185 . ;--- Decrement the batch size indicator
186 . S ROREXT("HL7SIZE")=$G(ROREXT("HL7SIZE"))-$L(BUF)-1
187 . S I1=""
188 . F S I1=$O(@NODE@(I,I1)) Q:I1="" D
189 . . S ROREXT("HL7SIZE")=ROREXT("HL7SIZE")-$L(@NODE@(I,I1))
190 . ;--- Decrement the 'Set ID' counter if necessary
191 . S SEGNAME=$P(BUF,HLFS),I1=+$G(ROREXT("HL7SID",SEGNAME))
192 . I I1>0 S:$P(BUF,HLFS,2)>0 ROREXT("HL7SID",SEGNAME)=I1-1
193 . ;--- Delete the segment
194 . K @NODE@(I)
195 ;--- Validate current size of the batch
196 S:$G(ROREXT("HL7SIZE"))<0 ROREXT("HL7SIZE")=0
197 ;--- Decrease number of messages in the batch if necessary
198 I MSH S:$G(ROREXT("HL7CNT"))>0 ROREXT("HL7CNT")=ROREXT("HL7CNT")-1
199 Q
200 ;
201 ;***** SENDS THE BATCH MESSAGE
202 ;
203 ; .MID Reference to a local variable where the batch
204 ; message ID (returned by the GENERATE^HLMA) is
205 ; returned to.
206 ;
207 ; Return Values:
208 ; <0 Error Code
209 ; 0 Ok
210 ; >0 There was nothing to send
211 ;
212 ; Several nodes (HL7*) in the ROREXT and the ^TMP("HLS",$J) node
213 ; are deleted by this entry point.
214 ;
215SEND(MID) ;
216 N RC,RORBUF,RORHLP S MID=""
217 Q:$G(ROREXT("HL7PROT"))="" $$ERROR^RORERR(-25)
218 ;--- Quit if there is nothing to send
219 Q:'$G(ROREXT("HL7MTIEN"))!($D(^TMP("HLS",$J))<10) 1
220 ;--- Set up the HL7 environment variables
221 D INIT^HLFNC2(ROREXT("HL7PROT"),.RORHL)
222 Q:$G(RORHL) $$ERROR^RORERR(-23,,RORHL)
223 ;--- Send the message
224 S RORHLP("NAMESPACE")="ROR"
225 D GENERATE^HLMA(ROREXT("HL7PROT"),"GB",1,.RORBUF,ROREXT("HL7MTIEN"),.RORHLP)
226 S RC=$S($P(RORBUF,U,2):$$ERROR^RORERR(-24,,RORBUF),1:0)
227 S MID=$P(RORBUF,U)
228 ;--- Cleanup if there is no error or not in debug mode
229 D:'$G(RORPARM("DEBUG"))!(RC'<0)
230 . F TMP="HL7CNT","HL7MTIEN","HL7SIZE" K ROREXT(TMP)
231 . K ^TMP("HLS",$J)
232 Q RC
Note: See TracBrowser for help on using the repository browser.