source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VIN1A.m@ 1806

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

initial load of FOIAVistA 6/30/08 version
File size: 8.1 KB
Line 
1LA7VIN1A ;DALOI/JMC - Process Incoming UI Msgs, continued ; 01/14/99
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**64,67**;Sep 27, 1994
3 ; This routine is a continuation of LA7VIN1.
4 ; It performs generation of any mail bulletins needed.
5 ;
6 ; Reference to DUZ^XUP supported by DBIA #4129
7 Q
8 ;
9 ;
10SENDARB ; Send amended report bulletin
11 N LA76304,LA7BODY,LA7I,LA7IQSN,LA7TSK,LA7X,LWL
12 N XMBODY,XMDUZ,XMBNAME,XMINSTR,XMPARM,XMTO,X,Y
13 N XQA,XQAID,XQADATA,XQAFLAG,XQAMSG,XQAOPT,XQAROU
14 ;
15 I '$G(DUZ) D DUZ^XUP(.5)
16 S XMBNAME="LA7 AMENDED RESULTS RECEIVED"
17 S LA7I=0
18 F S LA7I=$O(^TMP("LA7 AMENDED RESULTS",$J,LA7I)) Q:'LA7I D
19 . S LA7I(0)=^TMP("LA7 AMENDED RESULTS",$J,LA7I)
20 . S LWL=$P(LA7I(0),"^",1),LA7ISQN=$P(LA7I(0),"^",2),LA76304=$P(LA7I(0),"^",3)
21 . S XMPARM(1)=$$GET1^DIQ(62.48,$P(LA7I(0),"^",4)_",",.01)
22 . S XMPARM(2)=$P(LA7I(0),"^",5)
23 . S XMPARM(3)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","PNM"))
24 . S XMPARM(4)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","SSN"))
25 . S XMPARM(5)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID"))
26 . S XMPARM(6)=$$FMTE^XLFDT($G(^LAH(LWL,1,LA7ISQN,.1,"OBR","ORCDT")),"MZ")
27 .S XMPARM(7)=$P(LA7I(0),"^",8)_" ["_$P(LA7I(0),"^",7)_"]"
28 . S X=$G(^LAH(LWL,1,LA7ISQN,LA76304)),X(5)=$P(X,"^",5)
29 . S XMPARM(8)=$$GET1^DIQ(4,$P(X,"^",9)_",",.01)
30 . S XMPARM(9)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","FID"))
31 . S XMPARM(10)=$P(X,"^")
32 . S XMPARM(11)=$P(X(5),"!",7)
33 . S XMPARM(12)=$P(X(5),"!",2)_$S($P(X(5),"!",3)'="":"-"_$P(X(5),"!",3),1:"")
34 . S LA7X=$P(LA7I(0),"^",9),X=" L^ H^LL^HH^ <^ >^ N^ A^AA^ U^ D^ B^ W^ S^ R^ I^MS^VS"
35 . S I=$F(X,LA7X)\3 S:I LA7X=$P($T(ABFLAGS+I^LA7VHLU1),";;",2)
36 . S XMPARM(13)=LA7X
37 . S X="UNKNOWN"
38 . I $P(LA7I(0),"^",6)="C" S X="Record coming over is a correction and thus replaces a final result"
39 . I $P(LA7I(0),"^",6)="D" S X="Deletes the OBX record"
40 . I $P(LA7I(0),"^",6)="W" S X="Post original as wrong, e.g., transmitted for wrong patient"
41 . S XMPARM(14)=X
42 . S LA7BODY(1)=" ",LA7BODY(2)="Comments:"
43 . S I=0
44 . F S I=$O(^LAH(LWL,1,LA7ISQN,1,I)) Q:'I S LA7BODY(I+2)=$P(^(I),"^")
45 . D SMB
46 . S XQAMSG="Lab Messaging - Amended results received from "_XMPARM(1),XQAID="LA7-AMENDED-"_XMPARM(1)
47 . D SA
48 ;
49 K ^TMP("LA7 AMENDED RESULTS",$J)
50 ;
51 Q
52 ;
53 ;
54SENDOSB ; Send order status bulletin when status not OK.
55 ;
56 N I,J,K,LA76248,LA7BODY,LA7I,LA7IQSN,LA7ONLT,LA7TSK,LA7X,LWL
57 N X,XMDUZ,XMBNAME,XMINSTR,XMPARM,XMBODY,XMTO
58 I '$G(DUZ) D DUZ^XUP(.5)
59 ;
60 S XMBNAME="LA7 ORDER STATUS CHANGED"
61 S LA7I=0
62 F S LA7I=$O(^TMP("LA7 ORDER STATUS",$J,LA7I)) Q:'LA7I D
63 . S LA7I(0)=^TMP("LA7 ORDER STATUS",$J,LA7I)
64 . S LWL=$P(LA7I(0),"^",1),LA7ISQN=$P(LA7I(0),"^",2),LA7ONLT=$P(LA7I(0),"^",3),LA76248=$P(LA7I(0),"^",5)
65 . S X="UNKNOWN"
66 . I $P(LA7I(0),"^",7)="UA" S X="Unable to accept order/service"
67 . I $P(LA7I(0),"^",7)="OC" S X="Order/service cancel"
68 . I $P(LA7I(0),"^",7)="CR" S X="Canceled as requested"
69 . I $P(LA7I(0),"^",8)="A" S X="Add ordered tests to the existing specimen"
70 . I $P(LA7I(0),"^",8)="G" S X="Generated order; reflex order"
71 . I $P(LA7I(0),"^",8)?1(1"A",1"G") Q:'$$CHKOK(LA7I)
72 . S XMPARM(1)=X
73 . S XMPARM(2)=$$GET1^DIQ(62.48,LA76248_",",.01)
74 . S XMPARM(3)=$P(LA7I(0),"^",6)
75 . S XMPARM(4)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","PNM"))
76 . S XMPARM(5)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","SSN"))
77 . S XMPARM(6)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID"))
78 . S XMPARM(7)=$$FMTE^XLFDT($G(^LAH(LWL,1,LA7ISQN,.1,"OBR","ORCDT")),"MZ")
79 . S XMPARM(8)=$P(LA7I(0),"^",4)_" ["_$P(LA7I(0),"^",3)_"]"
80 . S XMPARM(9)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","FID"))
81 . S XMPARM(10)=$P(LA7I(0),"^",9)
82 . S J=2,LA7BODY(1)=" ",LA7BODY(2)="Comments:"
83 . F K="MSA","OCR" D
84 . . S X=$G(^TMP("LA7 ORDER STATUS",$J,LA7I,K))
85 . . I X'="" S J=J+1,LA7BODY(J)=X
86 . S I=0
87 . F S I=$O(^LAH(LWL,1,LA7ISQN,1,I)) Q:'I S J=J+1,LA7BODY(J)=$P(^(I),"^")
88 . D SMB
89 . S XQAMSG="Lab Messaging - Order status change received from "_XMPARM(2),XQAID="LA7-ORDER STATUS-"_XMPARM(2)
90 . D SA
91 ;
92 K ^TMP("LA7 ORDER STATUS",$J)
93 ;
94 Q
95 ;
96 ;
97SENDUNCB ; Send units/normals changed bulletin
98 ;
99 N LA76248,LA76304,LA7BODY,LA7I,LA7IQSN,LA7TSK,LA7X,LWL
100 N XMBODY,XMDUZ,XMBNAME,XMINSTR,XMPARM,XMTO,X,Y
101 N XQA,XQAID,XQADATA,XQAFLAG,XQAMSG,XQAOPT,XQAROU
102 ;
103 I '$G(DUZ) D DUZ^XUP(.5)
104 S XMBNAME="LA7 UNITS/NORMALS CHANGED"
105 S LA7I=0
106 F S LA7I=$O(^TMP("LA7 UNITS/NORMALS CHANGED",$J,LA7I)) Q:'LA7I D
107 . S LA7I(0)=^TMP("LA7 UNITS/NORMALS CHANGED",$J,LA7I)
108 . S LWL=$P(LA7I(0),"^",1),LA7ISQN=$P(LA7I(0),"^",2),LA76304=$P(LA7I(0),"^",3),LA76248=$P(LA7I(0),"^",4)
109 . S XMPARM(1)=$$GET1^DIQ(62.48,LA76248_",",.01)
110 . S XMPARM(2)=$P(LA7I(0),"^",5)
111 . S XMPARM(3)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","PNM"))
112 . S XMPARM(4)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","SSN"))
113 . S XMPARM(5)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID"))
114 . S XMPARM(6)=$$FMTE^XLFDT($G(^LAH(LWL,1,LA7ISQN,.1,"OBR","ORCDT")),"MZ")
115 .S XMPARM(7)=$P(LA7I(0),"^",8)_" ["_$P(LA7I(0),"^",7)_"]"
116 . S X=$G(^LAH(LWL,1,LA7ISQN,LA76304)),X(5)=$P(X,"^",5)
117 . S XMPARM(8)=$$GET1^DIQ(4,$P(X,"^",9)_",",.01)
118 . S XMPARM(9)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","FID"))
119 . S XMPARM(10)=$$GET1^DIQ(60,$P(LA7I(0),"^",10)_",",.01)
120 . S XMPARM(11)=$P(X(5),"!",7)
121 . S XMPARM(12)=$P(X(5),"!",2)_$S($P(X(5),"!",3)'="":"-"_$P(X(5),"!",3),1:"")
122 . S XMTO("G."_$$FAMG^LA7VHLU1(LA76248,2))=""
123 . D SMB
124 . S XQAMSG="Lab Messaging - Reference Lab Units/Normals Change received from "_XMPARM(1),XQAID="LA7-UNITS/NORMALS-CHANGED-"_XMPARM(1)
125 . D SA
126 ;
127 K ^TMP("LA7 UNITS/NORMALS CHANGED",$J)
128 ;
129 Q
130 ;
131 ;
132SENDACB ; Send abnormal/critical bulletin
133 ;
134 N LA76248,LA76304,LA7BODY,LA7I,LA7IQSN,LA7TSK,LA7X,LWL
135 N XMBODY,XMDUZ,XMBNAME,XMINSTR,XMPARM,XMTO,X,Y
136 N XQA,XQAID,XQADATA,XQAFLAG,XQAMSG,XQAOPT,XQAROU
137 ;
138 I '$G(DUZ) D DUZ^XUP(.5)
139 S XMBNAME="LA7 ABNORMAL RESULTS RECEIVED"
140 S LA7I=0
141 F S LA7I=$O(^TMP("LA7 ABNORMAL RESULTS",$J,LA7I)) Q:'LA7I D
142 . S LA7I(0)=^TMP("LA7 ABNORMAL RESULTS",$J,LA7I)
143 . S LWL=$P(LA7I(0),"^",1),LA7ISQN=$P(LA7I(0),"^",2),LA76304=$P(LA7I(0),"^",3),LA76248=$P(LA7I(0),"^",4)
144 . S XMPARM(1)=$$GET1^DIQ(62.48,LA76248_",",.01)
145 . S XMPARM(2)=$P(LA7I(0),"^",5)
146 . S XMPARM(3)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","PNM"))
147 . S XMPARM(4)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","SSN"))
148 . S XMPARM(5)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID"))
149 . S XMPARM(6)=$$FMTE^XLFDT($G(^LAH(LWL,1,LA7ISQN,.1,"OBR","ORCDT")),"MZ")
150 .S XMPARM(7)=$P(LA7I(0),"^",8)_" ["_$P(LA7I(0),"^",7)_"]"
151 . S X=$G(^LAH(LWL,1,LA7ISQN,LA76304)),X(5)=$P(X,"^",5)
152 . S XMPARM(8)=$$GET1^DIQ(4,$P(X,"^",9)_",",.01)
153 . S XMPARM(9)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","FID"))
154 . S XMPARM(10)=$P(X,"^")
155 . S XMPARM(11)=$P(X(5),"!",7)
156 . S XMPARM(12)=$P(X(5),"!",2)_$S($P(X(5),"!",3)'="":"-"_$P(X(5),"!",3),1:"")
157 . S LA7X=$P(LA7I(0),"^",9),X=" L^ H^LL^HH^ <^ >^ N^ A^AA^ U^ D^ B^ W^ S^ R^ I^MS^VS"
158 . S I=$F(X,LA7X)\3 S:I LA7X=$P($T(ABFLAGS+I^LA7VHLU1),";;",2)
159 . S XMPARM(13)=LA7X
160 . D SMB
161 . S XQAMSG="Lab Messaging - Reference Lab Abnormal Results received from "_XMPARM(1),XQAID="LA7-ABNORMAL-RESULTS-"_XMPARM(1)
162 . D SA
163 ;
164 K ^TMP("LA7 ABNORMAL RESULTS",$J)
165 ;
166 Q
167 ;
168 ;
169SMB ; Send mail bulletin
170 ; Ignore any restrictions (domain closed or protected by security key)
171 ; MailMan rejects bulletins sent by 'non-human' user LRLAB,HL.
172 ; Use POSTMASTER (.5) as sender to insure successful delivery.
173 ;
174 N LRDUZ,XMERR
175 S LRDUZ=DUZ
176 D DUZ^XUP(.5)
177 S XMINSTR("ADDR FLAGS")="R"
178 S XMINSTR("FROM")="LAB PACKAGE"
179 S XMTO("G."_$$FAMG^LA7VHLU1(LA76248,1))=""
180 D SENDBULL^XMXAPI(DUZ,XMBNAME,.XMPARM,$S($D(LA7BODY):"LA7BODY",1:""),.XMTO,.XMINSTR,.LA7TSK,"")
181 D DUZ^XUP(LRDUZ)
182 ;
183 Q
184 ;
185 ;
186SA ; Send alert
187 ;
188 M XQA=XMTO
189 D DEL^LA7UXQA(XQAID)
190 D SETUP^XQALERT
191 ;
192 Q
193 ;
194 ;
195CHKOK(LA7INDX) ; Check if ok to send bulletin on added/reflexed tests order change
196 ; Returns OK = 1 if results associated with added/reflex test are not
197 ; on the accession.
198 ; OK = 0 if accession already has tests on accession.
199 ;
200 N LA760,LA7AA,LA7AD,LA7AN,LA7I,LA7TREEN,LRUID,OK,X
201 S OK=1,LRUID=$P($G(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID")),"^")
202 ;
203 ; Store all tests accessioned in ^TMP
204 S X=$Q(^LRO(68,"C",LRUID))
205 I X'="",$QS(X,3)=LRUID D
206 . K ^TMP("LA7TREE",$J)
207 . S LA7AA=$QS(X,4),LA7AD=$QS(X,5),LA7AN=$QS(X,6),LA7I=0
208 . F S LA7I=$O(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA7I)) Q:'LA7I D UNWIND^LA7UTIL(LA7I)
209 . S (LA7I,OK)=0
210 . F S LA7I=$O(^TMP("LA7 ORDER STATUS",$J,LA7INDX,LA7I)) Q:'LA7I D Q:OK
211 . . I '$D(^TMP("LA7TREE",$J,LA7I)) S OK=1 ;wasn't ordered
212 . K ^TMP("LA7TREE",$J)
213 Q OK
Note: See TracBrowser for help on using the repository browser.