source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VIN1.m@ 870

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1LA7VIN1 ;DALOI/JMC - Process Incoming UI Msgs, continued ; 01/14/99
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64**;Sep 27, 1994
3 ; This routine is a continuation of LA7VIN and is only called from there.
4 ; It is called with each message found in the incoming queue.
5 Q
6 ;
7NXTMSG ;
8 N FDA,LA7ABORT,LA7CNT,LA7END,LA7ERR
9 N LA7INDX,LA7QUIT,LA7SEG,LA7STYP
10 ;
11 S LA7ERR=""
12 S (LA7ABORT,LA7CNT,LA7END,LA7INDX,LA7QUIT,LA7SEQ)=0
13 S DT=$$DT^XLFDT
14 S LA7ID="UNKNOWN-I-"
15 ;
16 ; Message built but no text.
17 I '$O(^LAHM(62.49,LA76249,150,0)) D Q
18 . S (LA7ABORT,LA7ERR)=6
19 . D CREATE^LA7LOG(LA7ERR)
20 . D SETID^LA7VHLU1(LA76249,LA7ID,"UNKNOWN")
21 ;
22 ; Process message segments
23 ; Lab currently does not accept segments beginning with the letter "Z"
24 ; which are reserved for locally-defined messages. "Z" segments will be
25 ; ignored by this software.
26 F S LA7END=$$GETSEG^LA7VHLU2(LA76249,.LA7INDX,.LA7SEG) Q:LA7END!(LA7ABORT) D
27 . S LA7STYP=$E(LA7SEG(0),1,3) ; Segment type
28 . I $E(LA7STYP,1)="Z" Q
29 . ; Not a valid segment type
30 . I LA7STYP'?2U1UN D Q
31 . . S LA7ERR=34
32 . . D CREATE^LA7LOG(LA7ERR)
33 . ; Segment encoded wrong - field separator does not match
34 . I "MSH^FSH^BHS^"'[(LA7STYP_"^"),$E(LA7SEG(0),4)'=LA7FS D Q
35 . . S LA7ERR=35
36 . . D CREATE^LA7LOG(LA7ERR)
37 . I $T(@LA7STYP)="" Q ; No processing logic for this segment type
38 . D @LA7STYP
39 ;
40 ; Set id if only MSH segment received.
41 I LA7SEQ<5 D
42 . D SETID^LA7VHLU1(LA76249,LA7ID,"UNKNOWN")
43 ;
44 ; Set status to purgeable if no errors.
45 I $P($G(^LAHM(62.49,LA76249,0)),"^",3)'="E" D
46 . S FDA(1,62.49,LA76249_",",2)="X"
47 . D FILE^DIE("","FDA(1)","LA7ERR(1)")
48 ;
49 ; Store identifier's found in message.
50 D UPID^LA7VHLU1(LA76249)
51 ;
52 ; Send new result alert for ORU messages if turned on.
53 ; Currently only on LEDI (10) type interfaces.
54 I $G(LA7MTYP)="ORU",$D(^LAHM(62.48,+$G(LA76248),20,"B",1)) D
55 . I LA7INTYP=10,$D(^TMP("LA7-ORU",$J,LA76248)) D XQA^LA7UXQA(1,LA76248)
56 ;
57 ; Send new order alert for ORM messages if turned on.
58 I $G(LA7MTYP)="ORM",$D(^LAHM(62.48,+$G(LA76248),20,"B",3)) D
59 . N LA7ROOT
60 . S LA7ROOT="^TMP(""LA7-ORM"",$J)"
61 . F S LA7ROOT=$Q(@LA7ROOT) Q:$QS(LA7ROOT,1)'="LA7-ORM"!($QS(LA7ROOT,2)'=$J) D
62 . . D XQA^LA7UXQA(3,$QS(LA7ROOT,3),"",$QS(LA7ROOT,4),"",$QS(LA7ROOT,5))
63 ;
64 ; Cleanup shipping config test info used to process orders
65 I $G(LA7MTYP)="ORM" K ^TMP("LA7TC",$J)
66 ;
67 ; If amended results received then send bulletins
68 I $D(^TMP("LA7 AMENDED RESULTS",$J)) D SENDARB^LA7VIN1A
69 ;
70 ; If cancelled orders received then send bulletins
71 I $D(^TMP("LA7 ORDER STATUS",$J)) D SENDOSB^LA7VIN1A
72 ;
73 ; If units/normals changed then send bulletins
74 I $D(^TMP("LA7 UNITS/NORMALS CHANGED",$J)) D SENDUNCB^LA7VIN1A
75 ;
76 ; If abnormal/critical results then send bulletins
77 I $D(^TMP("LA7 ABNORMAL RESULTS",$J)) D SENDACB^LA7VIN1A
78 ;
79 D KILLMSH
80 ;
81 Q
82 ;
83 ;
84MSA ;; Process MSA segment
85 ;
86 D KILLMSA
87 ;
88 D MSA^LA7VIN3
89 ;
90 ; Set sequence flag
91 S LA7SEQ=5
92 Q
93 ;
94 ;
95BSH ;; Process various HL7 header segments
96FSH ;;
97MSH ;;
98 D KILLMSH
99 ;
100 D MSH^LA7VIN2
101 ;
102 ; Set sequence flag
103 S LA7SEQ=1
104 Q
105 ;
106 ;
107NTE ;; Process NTE segment
108 ;
109 I LA7SEQ<30 D Q
110 . ; Put code to log error - no OBR/OBX segment
111 ;
112 ; Flag set that there was problem with OBR segment,
113 ; skip associated NTE segments that follow OBR/OBX segments
114 I LA7QUIT=2 Q
115 ;
116 I LA7MTYP="ORU" D NTE^LA7VIN2
117 I LA7MTYP="ORM" D NTE^LA7VIN2
118 I LA7MTYP="ORR" D NTE^LA7VIN2
119 ;
120 Q
121 ;
122 ;
123OBR ;; Process OBR segment
124 ;
125 D KILLOBR
126 ;
127 ; Clear flag to process this segment
128 I LA7QUIT=2 S LA7QUIT=0
129 ;
130 ; If not UI interface and no PID segment
131 I LA7INTYP'=1,LA7SEQ<10 D Q
132 . S (LA7ABORT,LA7ERR)=46
133 . D CREATE^LA7LOG(LA7ERR)
134 ;
135 I LA7MTYP="ORR" D OBR^LA7VIN4
136 I LA7MTYP="ORU" D OBR^LA7VIN4
137 I LA7MTYP="ORM" D OBR^LA7VORM
138 ;
139 ; Set sequence flag
140 S LA7SEQ=30
141 Q
142 ;
143 ;
144OBX ;; Process OBX segment
145 ;
146 D KILLOBX
147 ;
148 ; No OBR segment, can't process OBX
149 I LA7SEQ<30 D Q
150 . S (LA7ABORT,LA7ERR)=9
151 . D CREATE^LA7LOG(LA7ERR)
152 ;
153 ; Flag set that there was problem with OBR segment,
154 ; skip associated OBX segments that follow OBR segment
155 I LA7QUIT=2 Q
156 ;
157 ; Process result messages (ORU).
158 I LA7MTYP="ORU" D
159 . ; Process "CH" subscript results.
160 . I $G(LA7SS)="CH" D
161 . . I '$G(LA7ISQN) Q ; No place to store results
162 . . D OBX^LA7VIN5
163 . ;
164 . ; Process "AP" subscript results.
165 . ;I $G(LA7SS)="AP",$L($T(OBX^LA7VIN6)) D OBX^LA7VIN6
166 . ;
167 . ; Process "MI" subscript results.
168 . ;I $G(LA7SS)="MI" D OBX^LA7VIN7
169 . ;
170 . ; Process "BB" subscript results.
171 . ;I $G(LA7SS)="BB",$L($T(OBX^LA7VIN8)) D OBX^LA7VIN8
172 . ;
173 . ; Update test status on manifest
174 . I $G(LA7628),LA7UID'="",$G(LA7OTST) D UTS^LA7VHLU1(LA7628,LA7UID,LA7OTST)
175 ;
176 ; Process results that accompany orders
177 I LA7MTYP="ORM" D OBX^LA7VIN5
178 ;
179 ; Set sequence flag
180 S LA7SEQ=40
181 Q
182 ;
183 ;
184ORC ;; Process ORC segment
185 ;
186 D KILLORC
187 ;
188 ; If not UI interface and no PID segment
189 I LA7INTYP'=1,LA7SEQ<10 D Q
190 . S (LA7ABORT,LA7ERR)=46
191 . D CREATE^LA7LOG(LA7ERR)
192 ;
193 D ORC^LA7VIN2
194 ;
195 ; Set sequence flag
196 S LA7SEQ=20
197 Q
198 ;
199 ;
200PID ;; Process PID segment
201 ;
202 D KILLPID
203 ;
204 ; no MSH segment
205 I LA7SEQ<1 D Q
206 . S (LA7ABORT,LA7ERR)=7
207 . D CREATE^LA7LOG(LA7ERR)
208 ;
209 ; Clear flag to process this segment
210 I LA7QUIT=1 S LA7QUIT=0
211 ;
212 D PID^LA7VIN2
213 ;
214 ; Set sequence flag
215 S LA7SEQ=10
216 Q
217 ;
218 ;
219PV1 ;; Process PV1 segment
220 ;
221 D KILLPV1
222 ;
223 ; no PID segment
224 I LA7SEQ<10 D Q
225 . S (LA7ABORT,LA7ERR)=46
226 . D CREATE^LA7LOG(LA7ERR)
227 ;
228 D PV1^LA7VIN2
229 ;
230 ; Set sequence flag
231 S LA7SEQ=11
232 Q
233 ;
234 ;
235 ; The section below is designed to clean up variables that are created
236 ; during the processing of a segment type and any created by processing
237 ; of segments that are within the message definition.
238 ;
239KILLMSH ; Clean up variables used by MSH and following segments
240 K LA7CSITE,LA7CS,LA7ECH,LA7FS,LA7HLV,LA7MEDT,LA7MID,LA7MTYP
241 K LA7RAP,LA7RFAC,LA7SAP,LA7SEQ,LA7SFAC
242 K ^TMP("LA7-ID",$J),^TMP("LA7-ORM",$J),^TMP("LA7-ORU",$J)
243 ;
244KILLMSA ; Clean up variables used by MSA and following segments
245 K LA7MSATM
246 ;
247KILLPID ; Clean up variables used by PID and following segments
248 K DFN
249 K LA7DOB,LA7ICN,LA7PNM,LA7PRACE,LA7PTID2,LA7PTID3,LA7PTID4
250 K LA7SEX,LA7SPID,LA7SSN
251 K LRDFN,LRTDFN
252 ;
253KILLPV1 ; Clean up variables used by PV1 and following segments
254 K LA7LOC,LA7SPV1
255 ;
256KILLORC ; Clean up variables used by ORC and following segments
257 K LA7628,LA7629
258 K LA7CSITE,LA7DUR,LA7DURU,LA7ODUR,LA7ODURU,LA7EOL,LA7OCR,LA7ORDT
259 K LA7OTYPE,LA7OUR,LA7PEB,LA7PON,LA7POP,LA7PVB,LA7SM
260 ;
261KILLOBR ; Clean up variables used by OBR and following segments
262 K LA70070,LA760,LA761,LA762,LA7624,LA7696
263 K LA7AA,LA7AD,LA7ACC,LA7AN,LA7CDT,LA7FID,LA7ISQN,LA7LWL,LA7ONLT,LA7OTST
264 K LA7POC,LA7SAC,LA7SID,LA7SOBR,LA7SPEC,LA7SPTY,LA7SS,LA7UID,LA7UR
265 ;
266KILLOBX ; Clean up variables used by OBX and following segments
267 K LA7ORS,LA7RLNC,LA7RMK,LA7RNLT,LA7RO,LA7SOBX
268 ;
269KILLBLG ;Clean up variables used by BLG and following segments
270 ;
271 Q
Note: See TracBrowser for help on using the repository browser.