source: FOIAVistA/tag/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VMSG1.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 7.5 KB
Line 
1LA7VMSG1 ;DALOI/JMC - LAB ORU (Observation Result) message builder cont'd; 4-10-00
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**56,46,61,64**;Sep 27, 1994
3 ;
4START ; Process entries in queue
5 ; Called from LA7VMSG
6 ;
7 N LA,LAER,LA7VER
8 N EID,HLEID,HLMTIEN,HLRESLT,HLARYTYP,HLECH,HLFS,HLCOMP,HLFORMAT
9 N GBL,LA7MID,LA7V,LA7VS,LA7V0N,LA7VIEN,RSITE,LRNT
10 N LA76248,LA76249,LA76249P,LA7DT,LA7ECH,LA7END,LA7FS,LA7NVAF,LA7ROOT,LA7X,LRDFN,LRUID
11 ;
12 ; variable list
13 ; LA("LRUID") - Host Unique ID from the local ACCESSION file (#68)
14 ; LA("SITE") - Primary site number of remote site ($$SITE^VASITE)
15 ; LA("RUID") - Remote sites Unique ID from ACCESSION file (#68)
16 ; LA("ORD") - Free text ordered test name from WKLD CODE file (#64)
17 ; LA("LRNLT") - National Laboratory test code from WKLD CODE file (#64)
18 ; LA("LRIDT") - Inverse date/time (accession date/time)
19 ; LA("LRSS") - test subscript defined in LABORATORY TEST file (#60)
20 ; LA("LRDFN") - IEN in LAB DATA file (#63)
21 ; LA("ORDT") - Order date
22 ; LA(62.49) - entry in #62.49 which contains pointer to results to build
23 ;
24 L +^LAHM(62.49,"HL7 PROCESS",LA7MTYP):0 Q:'$T
25 ;
26 S GBL="^TMP(""HLS"","_$J_")"
27 ;
28 D SORTPAT
29 I $D(^TMP("LA76248",$J)) D PROCESS
30 D KVAR^LRX
31 ;
32 ; Release lock
33 L -^LAHM(62.49,"HL7 PROCESS",LA7MTYP)
34 ;
35 K ^TMP("LA76248",$J),^TMP("LA7VS",$J),^TMP("HLS",$J)
36 ;
37 I $D(ZTQUEUED) S ZTREQ="@"
38 ;
39 Q
40 ;
41 ;
42SORTPAT ; Sort all results for tranmsission
43 ;
44 N LA76248,LA76249,LA7END,LA7ROOT,LRDFN,LRUID
45 ;
46 K ^TMP("LA76248",$J)
47 ; Flag to indicate end of global.
48 S LA7END=0
49 ;
50 ; Sort by configuration (LA76248), patient (LRDFN), UID (LRUID), file #62.49 ien (LA76249)
51 S LA7ROOT="^LAHM(62.49,""AC"",LA7MTYP,""P"")"
52 F S LA7ROOT=$Q(@LA7ROOT) Q:LA7END D
53 . I $QS(LA7ROOT,3)'=LA7MTYP!($QS(LA7ROOT,6)<1) S LA7END=1 Q
54 . S LA76248=$QS(LA7ROOT,5),LA76249=$QS(LA7ROOT,6)
55 . L +^LAHM(62.49,LA76249):5 Q:'$T
56 . S LRDFN=$P($G(^LAHM(62.49,LA76249,63)),"^",8)
57 . S LRUID=$P($G(^LAHM(62.49,LA76249,63)),"^",1)
58 . I LRDFN,LRUID]"" S ^TMP("LA76248",$J,LA76248,LRDFN,LRUID,LA76249)=""
59 . L -^LAHM(62.49,LA76249)
60 ;
61 Q
62 ;
63 ;
64PROCESS ; Process and build messages to be sent
65 ;
66 N LA7101,LA76248,LA76249,LA76249P,LA7NTESN,LA7OBRSN,LA7OBXSN,LA7PIDSN,LA7SMSG,LA7VS,LRDFN
67 ;
68 ; Cleanup
69 K ^TMP("LA7VS",$J),^TMP("HLS",$J)
70 ; Initialize variables
71 S (LA76248,LA76249,LA76249P,LA7END,LRDFN)=0,LRUID=""
72 ;
73 ; Process sorted list of results to transmit.
74 S LA7ROOT="^TMP(""LA76248"",$J)"
75 F S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT="" D Q:LA7END
76 . I $QS(LA7ROOT,1)'="LA76248"!($QS(LA7ROOT,2)'=$J) S LA7END=1 Q
77 . I LA76248'=$QS(LA7ROOT,3) D CONFIG
78 . I '$P(LA76248(0),"^",3) Q
79 . S (LA76249,LA(62.49))=$QS(LA7ROOT,6)
80 . S LA7X=$G(^LAHM(62.49,LA76249,63))
81 . S LA("HUID")=$P(LA7X,U),LA("SITE")=$P(LA7X,U,2),LA("RUID")=$P(LA7X,U,3),LA("ORD")=$P(LA7X,U,4),LA("NLT")=$P(LA7X,U,5),LA("LRIDT")=$P(LA7X,U,6),LA("SUB")=$P(LA7X,U,7),LA("LRDFN")=$P(LA7X,U,8),LA("ORDT")=$P(LA7X,U,9)
82 . S LA7NVAF=$$NVAF^LA7VHLU2(+LA("SITE"))
83 . I LRUID'=$QS(LA7ROOT,5),LA7SMSG=2 D PAT Q:LA7END
84 . I LRDFN'=$QS(LA7ROOT,4) D PAT Q:LA7END
85 . S LRUID=$QS(LA7ROOT,5)
86 . S ^TMP("LA7VS",$J,LA76249)=LA76249P
87 . N LA76249
88 . S LA76249=LA76249P
89 . I LA7MTYP="ORU" D EN^LA7VORU(.LA)
90 . I LA7MTYP="ORR" D EN^LA7VORR1(.LA)
91 ;
92 I LA76249P D SENDMSG
93 ;
94 Q
95 ;
96 ;
97STARTMSG ; Initialize a HL7 message and variables
98 ;
99 N LA7EVNT,SITE
100 ;
101 K ^TMP("LA7VS",$J),@GBL
102 ;
103 S LA76249P=LA76249
104 S SITE=$$RETFACID^LA7VHLU2(LA("SITE"),2,1)
105 ;
106 I LA7MTYP="ORU" S LA7EVNT="LA7V Results Reporting to "_SITE
107 I LA7MTYP="ORR" S LA7EVNT="LA7V Order Response to "_SITE
108 D STARTMSG^LA7VHLU(LA7EVNT,LA76249P)
109 I $G(HL) S LA7END=1
110 ;
111 Q
112 ;
113 ;
114SENDMSG ; File HL7 message with HL and LAB packages
115 ;
116 ; No data to send
117 I '$D(^TMP("HLS",$J)) Q
118 ;
119 D GEN^LA7VHLU
120 I $P(LA7MID,U)=0 D
121 . N LA7X
122 . S LA7X(1)=LA76249P,LA7X(2)=$TR($P(HLMID,"^",2,3),"^","-")
123 . D CREATE^LA7LOG(28)
124 ;
125 D UPDT6249
126 D UPDLPD
127 ;
128 S (LA76249P,LA7PIDSN,LA7OBRSN,LA7OBXSN,LA7NTESN)=0
129 ;
130 Q
131 ;
132 ;
133CONFIG ; Setup for this configuration
134 ;
135 ; Send a building message
136 I LA76249P D SENDMSG
137 ;
138 ; Retrieve configuration information from #62.48
139 S LA76248=$QS(LA7ROOT,3)
140 S LA76248(0)=$G(^LAHM(62.48,LA76248,0))
141 ;
142 ; Flag to control message building; 1-one patient/msg, 2-one order/msg
143 S LA7SMSG=+$P(LA76248(0),"^",8)
144 ;
145 ; Initialize variables
146 S (LA76249,LA76249P,LRDFN)=0
147 S LRUID=""
148 ;
149 Q
150 ;
151 ;
152PAT ; Build patient information
153 ;
154 N LA7ALTID,LA7EXTID,LA7PID,LA7PV1
155 ;
156 ; If one patient/msg or one order/msg and message building then send it.
157 I LA7SMSG>0,LA76249P D SENDMSG
158 ;
159 ; If no message building then start one.
160 I 'LA76249P S LA7PIDSN=0 D STARTMSG Q:LA7END
161 ;
162 ; Setup PID and PV1 segments.
163 S LRDFN=$QS(LA7ROOT,4)
164 S LRDPF=$P(^LR(LRDFN,0),"^",2),DFN=$P(^(0),"^",3)
165 D DEM^LRX
166 ;
167 ; Send placer's patient id (PID-3), return in PID-2, return PID-4 with alternate id
168 S (LA7ALTID,LA7EXTID)=""
169 D PTEXTID^LA7VHLU(LA("SITE"),LA("RUID"),.LA7EXTID)
170 I $L($G(LA7EXTID("PID-2"))) S LA7EXTID=$$CNVFLD^LA7VHLU3(LA7EXTID("PID-2"),LA7EXTID("ECH"),LA7ECH)
171 I $L($G(LA7EXTID("PID-4"))) S LA7ALTID=$$CNVFLD^LA7VHLU3(LA7EXTID("PID-4"),LA7EXTID("ECH"),LA7ECH)
172 ;
173 ; Build PID segment
174 D PID^LA7VPID(LRDFN,LA7EXTID,.LA7PID,.LA7PIDSN,.HL,LA7ALTID)
175 D FILESEG^LA7VHLU(GBL,.LA7PID)
176 D FILE6249^LA7VHLU(LA76249P,.LA7PID)
177 ;
178 ; Build PV1 segment
179 ; Not built when sending to DoD facility - not used by CHCS
180 I LA7NVAF'=1 D
181 . D PV1^LA7VPID(LRDFN,.LA7PV1,LA7FS,LA7ECH)
182 . D FILESEG^LA7VHLU(GBL,.LA7PV1)
183 . D FILE6249^LA7VHLU(LA76249P,.LA7PV1)
184 ;
185 S LRUID="",(LA7OBRSN,LA7OBXSN,LA7NTESN)=0
186 ;
187 Q
188 ;
189 ;
190UPDT6249 ; Update entries in file #62.49
191 ;
192 N LA7ERR,LA76249,LA76249P
193 ;
194 S LA76249=0
195 F S LA76249=$O(^TMP("LA7VS",$J,LA76249)) Q:'LA76249 D
196 . N FDA,LA7ERR
197 . S LA76249P=+$G(^TMP("LA7VS",$J,LA76249))
198 . ; Set pointer to parent on child entry.
199 . I LA76249'=LA76249P S FDA(1,62.49,LA76249_",",6)=LA76249P
200 . I $G(HL("APAT"))="AL"!($G(HL("APAT"))="") S FDA(1,62.49,LA76249_",",2)="A"
201 . E S FDA(1,62.49,LA76249_",",2)="X"
202 . S FDA(1,62.49,LA76249_",",102)=HL("SAN")
203 . S FDA(1,62.49,LA76249_",",103)=HL("SAF")
204 . S FDA(1,62.49,LA76249_",",108)=HL("MTN")
205 . S FDA(1,62.49,LA76249_",",110)=HL("PID")
206 . S FDA(1,62.49,LA76249_",",111)=HL("VER")
207 . I $P($G(LA7MID),"^")'="" S FDA(1,62.49,LA76249_",",109)=$P(LA7MID,"^")
208 . I $P($G(LA7MID),"^",2) D
209 . . S FDA(1,62.49,LA76249_",",160)=$P(LA7MID,"^",2)
210 . . S FDA(1,62.49,LA76249_",",161)=$P(LA7MID,"^",3)
211 . D FILE^DIE("","FDA(1)","LA7ERR(1)")
212 . D CLEAN^DILF
213 ;
214 Q
215 ;
216 ;
217UPDLPD ; Update lab pending orders (#69.6) for each entry in #62.49
218 ;
219 N LA76249
220 ;
221 S LA76249=0
222 F S LA76249=$O(^TMP("LA7VS",$J,LA76249)) Q:'LA76249 D UPD696
223 Q
224 ;
225 ;
226UPD696 ; Update LAB PENDING ORDERS file #69.6
227 ;
228 N LA74,LA7696,LA76964,LA7ERR,LA7ORDT,LA7STAT,LA7X
229 ;
230 ; Find "Results Available" status in #64.061
231 S LA7STAT=$$FIND1^DIC(64.061,"","OMX","Results Available","","I $P(^LAB(64.061,Y,0),U,7)=""U""")
232 ;
233 S LA7X=$G(^LAHM(62.49,LA76249,63))
234 ;
235 ; Ordering institution - pointer to file #4
236 S LA74=$P(LA7X,"^",2)
237 I LA74="" Q
238 ;
239 ; Ordered test
240 S LA7ORDT=$P(LA7X,"^",4)
241 I LA7ORDT="" Q
242 ;
243 ; File #69.6 ien and ordered test multiple ien
244 S LA7696=0
245 F S LA7696=$O(^LRO(69.6,"RST",LA74,LA("RUID"),LA7696)) Q:'LA7696 D
246 . N FDA
247 . S LA76964=$O(^LRO(69.6,LA7696,2,"B",LA7ORDT,0))
248 . I LA76964<1 Q
249 . ;
250 . L +^LRO(69.6,LA7696):99999
251 . ; Cannot get lock on ENTRY in 69.6
252 . I '$T D CREATE^LA7LOG(33) Q
253 . ;
254 . ; Store outgoing HL7 message ID
255 . S FDA(1,69.64,LA76964_","_LA7696_",",7)=$P(LA7MID,U)
256 . ; Set to Results Available.
257 . S FDA(1,69.64,LA76964_","_LA7696_",",5)=LA7STAT
258 . D FILE^DIE("","FDA(1)","LA7ERR(1)")
259 . D CLEAN^DILF
260 . ;
261 . L -^LRO(69.6,LA7696)
262 ;
263 Q
Note: See TracBrowser for help on using the repository browser.