source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7UIO1.m@ 901

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

initial load of WorldVistAEHR
File size: 5.2 KB
Line 
1LA7UIO1 ;DALOI/JMC - Process Download Message for an entry in 62.48 ;May 20, 2008
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**66**;Sep 27, 1994;Build 30
3 Q
4 ;
5BUILD ; Build one accession into an HL7 message
6 ;
7 N GBL,HL,LA760,LA761,LA7CDT,LA7CMT,LA7ERR,LA7FAC,LA7FS,LA7ECH,LA7HLP,LA7I,LA7ID
8 N LA7LINK,LA7OBRSN,LA7PIDSN,LA7SID,LA7SPEC,LA7X,LA7Y
9 S GBL="^TMP(""HLS"","_$J_")"
10 ;
11 I '$D(ZTQUEUED),$G(LRLL) W:$X+5>IOM !,$S($G(LRTYPE):"Cup",1:"Seq"),": " W LA76822,", "
12 ;
13 S LA7CNT=0
14 F I=0,.1,.2,.3,3 S LA76802(I)=$G(^LRO(68,LA768,1,LA76801,1,LA76802,I))
15 S LA7X=LA76802(3)
16 ; Draw time
17 S LA7CDT=+LA7X
18 ; Specimen comment if any, strip "~"
19 S LA7CMT=$TR($P(LA7X,"^",6),"~")
20 ; Specimen
21 S LA761=+$G(^LRO(68,LA768,1,LA76801,1,LA76802,5,1,0))
22 ; Accession/unique ID - Long (UID) or short (accession #) sample ID
23 S LA7ACC=$P(LA76802(.2),"^"),LA7UID=$P(LA76802(.3),"^"),LA7X=$G(^LRO(68,LA768,.4))
24 I $P(LA7X,"^",2)="S" S LA7SID=$$RJ^XLFSTR(LA76802,+$P(LA7X,"^",3),"0")
25 E S LA7SID=LA7UID
26 ;
27 ; Start message
28 D INIT Q:$G(HL)
29 ;
30 ; Setup links and subscriber array for HL7 message generation
31 S LA76248(0)=$G(^LAHM(62.48,LA76248,0)),LA7Y=$P(LA76248(0),"^")
32 I $E(LA7Y,1,5)'="LA7UI"!($P(LA76248(0),"^",9)'=1) Q
33 S LA7LINK="LA7UI ORM-O01 SUBS 2.2^"_LA7Y
34 S LA7FAC=$P($$SITE^VASITE(DT),"^",3)
35 S LA7HLP("SUBSCRIBER")="^^"_LA7FAC_"^"_LA7Y_"^"
36 ; Following line used when debugging
37 ;S $P(LA7HLP("SUBSCRIBER"),"^",8)="1-1-2"
38 ;
39 ; Build segments PID, PV1, and ORC/OBR segment for each test to be sent
40 D PID,PV1
41 S (LA7I,LA7OBRSN)=0
42 F S LA7I=$O(LA7ACC(LA7I)) Q:'LA7I D ORC,OBR
43 ; Build entry in MESSAGE QUEUE file 62.49
44 D SENDMSG
45 L -^LAHM(62.49,LA76249)
46 D KVAR^LRX
47 Q
48 ;
49 ;
50INIT ; Create/initialize HL message
51 ;
52 K @GBL
53 S (LA76249,LA7NVAF,LA7PIDSN)=0
54 D STARTMSG^LA7VHLU("LA7UI ORM-O01 EVENT 2.2",.LA76249)
55 S LA7ID=$P(LRAUTO,"^",1)_"-O-"_LA7UID
56 I $G(HL) S LA7ERR=28 D UPDT6249^LA7VORM1
57 Q
58 ;
59 ;
60PID ; Build PID segment
61 N LA7DATA,PID
62 S LRDFN=+LA7ACC0,LRDPF=$P(^LR(LRDFN,0),"^",2),DFN=$P(^(0),"^",3)
63 D DEM^LRX
64 ;
65 S PID(0)="PID"
66 S PID(1)=1
67 S PID(3)=$$M11^HLFNC(LRDFN)
68 S PID(5)=$$HLNAME^HLFNC(PNM)
69 S PID(8)=$S(SEX'="":SEX,1:"U")
70 I SSN'="" S PID(19)=SSN
71 I DOB S PID(7)=$$FMTHL7^XLFDT(DOB)
72 D BUILDSEG^LA7VHLU(.PID,.LA7DATA,LA7FS)
73 D FILESEG^LA7VHLU(GBL,.LA7DATA)
74 D FILE6249^LA7VHLU(LA76249,.LA7DATA)
75 Q
76 ;
77 ;
78PV1 ; Build PV1 segment
79 N LA7PV1,LA7X
80 D PV1^LA7VPID(LRDFN,.LA7PV1,LA7FS,LA7ECH)
81 ; If not inpatient use patient location from Accession
82 I $P(LA7PV1(0),LA7FS,3)'="I" S LA7X=$P($G(LA76802(0)),"^",7) S LA7X=$$CHKDATA^LA7VHLU3(LA7X,LA7FS_LA7ECH) S $P(LA7PV1(0),LA7FS,4)=LA7X
83 ;
84 D FILESEG^LA7VHLU(GBL,.LA7PV1)
85 D FILE6249^LA7VHLU(LA76249,.LA7PV1)
86 Q
87 ;
88 ;
89ORC ; Build ORC segment
90 N LA7DATA,ORC
91 S ORC(0)="ORC"
92 S ORC(1)="NW"
93 ;
94 ; Placer/filler order number - sample ID
95 S ORC(2)=$$ORC2^LA7VORC(LA7SID,LA7FS,LA7ECH)
96 S ORC(3)=$$ORC3^LA7VORC(LA7SID,LA7FS,LA7ECH)
97 ;
98 ; Order/draw time - if no order date/time then try draw time
99 I $P(LA76802(0),"^",4) S ORC(9)=$$ORC9^LA7VORC($P(LA76802(0),"^",4))
100 I '$P(LA76802(0),"^",4),$P(LA76802(3),"^") S ORC(9)=$$ORC9^LA7VORC($P(LA76802(3),"^"))
101 ;
102 ; Provider
103 S LA7X=$$FNDOLOC^LA7VHLU2(LA7UID)
104 S ORC(12)=$$ORC12^LA7VORC($P(LA76802(0),"^",8),$P(LA7X,"^",3),LA7FS,LA7ECH)
105 D BUILDSEG^LA7VHLU(.ORC,.LA7DATA,LA7FS)
106 D FILESEG^LA7VHLU(GBL,.LA7DATA)
107 D FILE6249^LA7VHLU(LA76249,.LA7DATA)
108 Q
109 ;
110 ;
111OBR ; Build OBR segment
112 N LA764,LA7ALT,LA7CADR,LA7NLT
113 K OBR
114 ;
115 S LA760=+LA7ACC(LA7I)
116 S LA764=+$P($G(^LAB(60,LA760,64)),"^")
117 S LA7NLT=$P($G(^LAM(LA764,0)),"^",2)
118 S LA7TMP=$G(^TMP("LA7",$J,LA7INST,LA7I))
119 Q:'LA7TMP
120 ;
121 S LA7CODE=$P(LA7TMP,"^",6),LA7DATA=$P(LA7TMP,"^",7)
122 S OBR(0)="OBR"
123 S OBR(1)=$$OBR1^LA7VOBR(.LA7OBRSN)
124 ; Placer/filler order number - sample ID
125 S OBR(2)=$$OBR2^LA7VOBR(LA7SID,LA7FS,LA7ECH)
126 S OBR(3)=$$OBR3^LA7VOBR(LA7SID,LA7FS,LA7ECH)
127 ; Test order code
128 S LA7ALT=LA7CODE_"^"_$$GET1^DIQ(60,LA760_",",.01)_"^"_"99001"
129 S OBR(4)=$$OBR4^LA7VOBR(LA7NLT,LA760,LA7ALT,LA7FS,LA7ECH)
130 ; Draw time.
131 I $G(LA7CDT) S OBR(7)=$$OBR7^LA7VOBR(LA7CDT)
132 ; Infection warning.
133 S OBR(12)=$$OBR12^LA7VOBR(LRDFN,LA7FS,LA7ECH)
134 ; Specimen comment
135 S OBR(13)=LA7CMT
136 ; Lab Arrival Time
137 S OBR(14)=$$OBR14^LA7VOBR($P(LA76802(3),"^",3))
138 ; HL7 code from Topography
139 S LA7X=$S(LRDPF=62.3:"^^^CONTROL",1:"")
140 S OBR(15)=$$OBR15^LA7VOBR(LA761,"",LA7X,LA7FS,LA7ECH)
141 ; Ordering provider
142 S LA7X=$$FNDOLOC^LA7VHLU2(LA7UID)
143 S OBR(16)=$$ORC12^LA7VORC($P(LA76802(0),"^",8),$P(LA7X,"^",3),LA7FS,LA7ECH)
144 ; Placer's field #1 - instrument name^card address
145 K LA7X
146 S LA7X(1)=$P(LRAUTO,"^")
147 S LA7CADR=$P($G(^LAB(62.4,LRINST,9)),U,9)
148 I LA7CADR'="" S LA7X(2)=LA7CADR
149 S OBR(18)=$$OBR18^LA7VOBR(.LA7X,LA7FS,LA7ECH)
150 ; Placer's field #2 - tray^cup^lraa^lrad^lran^lracc^lruid
151 K LA7X
152 ; No tray/cup if don't send tray/cup flag.
153 I $G(LRFORCE) S:LA76821 LA7X(1)=LA76821 S:LA76822 LA7X(2)=LA76822
154 S LA7X(3)=LA768,LA7X(4)=LA76801,LA7X(5)=LA76802,LA7X(6)=LA7ACC,LA7X(7)=LA7UID
155 S OBR(19)=$$OBR19^LA7VOBR(.LA7X,LA7FS,LA7ECH)
156 ;
157 ; Test urgency
158 S OBR(27)=$$OBR27^LA7VOBR("","",+$P(LA7ACC(LA7I),"^",2),LA7FS,LA7ECH)
159 ;
160 K LA7DATA
161 D BUILDSEG^LA7VHLU(.OBR,.LA7DATA,LA7FS)
162 D FILESEG^LA7VHLU(GBL,.LA7DATA)
163 D FILE6249^LA7VHLU(LA76249,.LA7DATA)
164 Q
165 ;
166 ;
167SENDMSG ; Send the HL7 message.
168 N HLL,HLP
169 S HLL("LINKS",1)=LA7LINK
170 I $D(LA7HLP) M HLP=LA7HLP
171 D GEN^LA7VHLU,UPDT6249^LA7VORM1
172 Q
Note: See TracBrowser for help on using the repository browser.