source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORB3.m@ 990

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

initial load of FOIAVistA 6/30/08 version
File size: 9.1 KB
Line 
1ORB3 ; slc/CLA - Main routine for OE/RR 3 notifications ;6/6/01 10:46 [8/16/05 5:33am]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**31,74,91,105,139,190,220,253,265**;Dec 17, 1997;Build 17
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4EN(ORN,ORBDFN,ORNUM,ORBADUZ,ORBPMSG,ORBPDATA) ;
5 ;
6 N ORBENT
7 S ORBENT=$$ENTITY^ORB31(ORNUM)
8 ;
9 Q:$$GET^XPAR(ORBENT,"ORB SYSTEM ENABLE/DISABLE",1,"I")="D"
10 Q:'$L($G(^ORD(100.9,ORN,0)))
11 Q:+$$ONOFF^ORB3FN(ORN)=0
12 ;
13 S ORBPMSG=$E($G(ORBPMSG),1,51)
14 ;
15 ;if msg from notif file or oc notif (#54), quit if dup w/in past 1 min:
16 N ORBDUP,ORBN
17 S ORBN=^ORD(100.9,ORN,0)
18 I ($P(ORBN,"^",4)="NOT")!(ORN=54) D
19 .S ORBDUP=$$DUP^ORB31(ORN,ORBDFN,ORBPMSG,ORNUM)
20 Q:+$G(ORBDUP)=1
21 ;
22 N ORBDESC
23 S ORBDESC=" Send Alert Notification ("_(+ORN)_") "_$P($G(^ORD(100.9,+ORN,0)),U,1)_" "
24 ;
25 D QUEUE^ORB31(ORN,ORBDFN,$G(ORNUM),.ORBADUZ,$G(ORBPMSG),$G(ORBPDATA),$H,ORBDESC,$G(DGPMA))
26 Q
27ZTSK ;
28 D START
29 S ZTREQ="@"
30 Q
31UTL(ORBU,ORN,ORBDFN,ORNUM,ORBADUZ,ORBPMSG,ORBPDATA) ;
32 Q:$G(ORBU)'=1
33START Q:$G(ORN)=""!($G(ORBDFN)="")
34 Q:'$L($G(^ORD(100.9,ORN,0)))
35 N ORBNOW,ORBID,ORBLOCK,ORBDESC
36 S ORBNOW=$$NOW^XLFDT
37 S ORBLOCK=0
38 ;
39 ;lock to prevent concurrent processing by other resource slots:
40 I '$D(ORBU) D
41 .S ^XTMP("ORBLOCK",0)=$$FMADD^XLFDT(ORBNOW,1,"","","")_"^"_ORBNOW
42 .S ORBID=$P($P($G(ORBPDATA),"|",2),"@") ;get unique data id
43 .I $L(ORBID) D
44 ..LOCK +^XTMP("ORBLOCK",ORBDFN,ORN,ORBID):60 E D Q
45 ...S ORBDESC=" Requeue Alert Notification ("_(+ORN)_") "_$P($G(^ORD(100.9,+ORN,0)),U,1)_" "
46 ...D QUEUE^ORB31(ORN,ORBDFN,$G(ORNUM),.ORBADUZ,$G(ORBPMSG),$G(ORBPDATA),$$HADD^XLFDT($H,"","",5,""),ORBDESC,$G(DGPMA)) ;requeue in 5 min.
47 ...S ORBLOCK=1
48 .;
49 .I '$L(ORBID) D
50 ..LOCK +^XTMP("ORBLOCK",ORBDFN,ORN):60 E D Q
51 ...S ORBDESC=" Requeue Alert Notification ("_(+ORN)_") "_$P($G(^ORD(100.9,+ORN,0)),U,1)_" "
52 ...D QUEUE^ORB31(ORN,ORBDFN,$G(ORNUM),.ORBADUZ,$G(ORBPMSG),$G(ORBPDATA),$$HADD^XLFDT($H,"","",5,""),ORBDESC,$G(DGPMA)) ;requeue in 5 min.
53 ...S ORBLOCK=1
54 .;
55 I ORBLOCK=1 D QUIT Q
56 ;
57DOALERT ; Entry point for alert logic outside of TaskMan
58 N ORBDUZ,ORBN,ORBXQAID,ORPTNAM,ORBPRIM,ORBATTD,ORBDEV,ORBENT
59 N ORBUI,ORBASPEC,ORBSMSG,ORBADT,ORBSDEV,ORBDEL,ORBDI,ORBTDEV,ORY
60 S ORBUI=1,ORBADT=0
61 S:'$L($G(ORBPMSG)) ORBPMSG=""
62 I '$L(ORBPDATA),(+$G(ORNUM)>0) S ORBPDATA=+$G(ORNUM)_"@"
63 S ORBN=^ORD(100.9,ORN,0)
64 ;
65 S ORBENT=$$ENTITY^ORB31(ORNUM)
66 ;
67 N DFN S DFN=ORBDFN,VA200="" D OERR^VADPT
68 I ('$L($G(VA("BID"))))!('$L($G(VADM(1)))) D QUIT Q
69 I (ORN=18)!(ORN=20)!(ORN=35) S ORBADT=1 ;A/D/T notif
70 ;if not an A/D/T notif, get primary & attending from OERR^VADPT:
71 I ORBADT=0 S ORBPRIM=+$P(VAIN(2),U),ORBATTD=+$P(VAIN(11),U)
72 I ORBADT=1 D ADT^ORB31(ORN,ORBDFN,.ORBPRIM,.ORBATTD,$G(ORDGPMA)) ;A/D/T notif
73 I $D(ORBU) D ;create debug msg
74 .S ORBU(ORBUI)="Processing notification: "_$P(ORBN,U),ORBUI=ORBUI+1
75 .S ORBU(ORBUI)=" for patient: "_VADM(1),ORBUI=ORBUI+1
76 .I $G(ORNUM)>0 S ORBU(ORBUI)=" for order: "_ORNUM,ORBUI=ORBUI+1
77 D REGULAR^ORB3REG(ORN,.XQA,.ORBU,.ORBUI,.ORBDEV,ORBDFN)
78 D SPECIAL^ORB3SPEC(ORN,.ORBASPEC,.ORBU,.ORBUI,$G(ORNUM),ORBDFN,$G(ORBPDATA),.ORBSMSG,$G(ORBPMSG),.ORBSDEV,$G(ORBPRIM),$G(ORBATTD))
79 I $L($G(ORBSMSG)) S ORBPMSG=$E(ORBSMSG,1,51)
80 I $D(ORBASPEC)>1 D SPECDUZS ;special recips
81 I $D(ORBADUZ)>1 D PKGDUZS ;pkg-supplied recips
82 D TITLE ;provider recips
83 S ORBXQAID=$P(ORBN,"^",2)_","_ORBDFN_","_ORN
84 ;
85 I ($D(XQA)>1)!($D(ORBDEV)>1)!($D(ORBSDEV)>1) D ;recips found
86 .S XQAFLG=$P(ORBN,"^",5)
87 .S XQADFN=ORBDFN
88 .I XQAFLG="R" S XQAROU=$P(ORBN,"^",6)_"^"_$P(ORBN,"^",7)
89 .I $G(ORBPDATA)'="" S XQADATA=ORBPDATA
90 .S ORPTNAM=$E(VADM(1)_" ",1,9)
91 .S XQAMSG=ORPTNAM_" "_"("_$E(ORPTNAM)_$E(VA("BID"),1,4)_")"_": "
92 .S XQAMSG=XQAMSG_$S(ORBPMSG'="":ORBPMSG,1:$P(ORBN,"^",3))
93 .S XQAARCH=$$GET^XPAR(ORBENT,"ORB ARCHIVE PERIOD",ORN,"I")
94 .S XQASUPV=$$GET^XPAR(ORBENT,"ORB FORWARD SUPERVISOR",ORN,"I")
95 .S XQASURO=$$GET^XPAR(ORBENT,"ORB FORWARD SURROGATES",ORN,"I")
96 .S XQAREVUE=$$GET^XPAR(ORBENT,"ORB FORWARD BACKUP REVIEWER",ORN,"I")
97 .S XQACNDEL=$$GET^XPAR(ORBENT,"ORB REMOVE",ORN,"I")
98 .S XQACNDEL=$S(XQACNDEL=1:1,1:"")
99 .I $D(ORBDEV)>1 D REGDEV^ORB31(.ORBDEV)
100 .I $D(ORBSDEV)>1 D REGDEV^ORB31(.ORBSDEV)
101 .I $D(ORBTDEV)>1 D REGDEV^ORB31(.ORBTDEV)
102 .S XQAID=ORBXQAID
103 .I $D(XQA) D SETUP^XQALERT ;if no [new] recips don't send alert
104QUIT ;
105 K VA,VA200,VADM,VAERR,VAIN,XQA,XQADATA,XQAID,XQAFLG,XQAMSG,XQAROU,XQAARCH,XQASUPV,XQASURO,XQADFN
106 K ^XTMP("ORBUSER",$J)
107 I '$D(ORBU),$D(ORBLOCK) D
108 .I $G(ORBID)]"" LOCK -^XTMP("ORBLOCK",ORBDFN,ORN,ORBID)
109 .E LOCK -^XTMP("ORBLOCK",ORBDFN,ORN)
110 Q
111PKGDUZS ;get DUZs from pkg-passed ORBADUZ() array
112 N ORBPDUZ
113 I $D(ORBU) D
114 .S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
115 .I ORN=68 S ORBU(ORBUI)="Recipients with Lab Threshold Exceeded:",ORBUI=ORBUI+1
116 .E S ORBU(ORBUI)="Recipients defined when notif was triggered:",ORBUI=ORBUI+1
117 S ORBPDUZ=""
118 F S ORBPDUZ=$O(ORBADUZ(ORBPDUZ)) Q:ORBPDUZ="" S ORBDUZ=ORBPDUZ D USER
119 Q
120SPECDUZS ;get DUZs rtn by SPECIAL^ORB3SPEC
121 N ORBSDUZ
122 I $D(ORBU) D
123 .S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
124 .S ORBU(ORBUI)="Special recipients associated with the notification:",ORBUI=ORBUI+1
125 S ORBSDUZ=""
126 F S ORBSDUZ=$O(ORBASPEC(ORBSDUZ)) Q:ORBSDUZ="" S ORBDUZ=ORBSDUZ D USER
127 Q
128TITLE ;get provider recips
129 N TITLES
130 I $D(ORBU) D
131 .S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
132 .S ORBU(ORBUI)="Recipients determined by Provider Recipient parameter:",ORBUI=ORBUI+1
133 ;
134 S TITLES=$$GET^XPAR(ORBENT,"ORB PROVIDER RECIPIENTS",ORN,"I")
135 I TITLES["P" D PRIMARY
136 I TITLES["A" D ATTEND
137 I TITLES["T" D TEAMS
138 I TITLES["O" D ORDERER
139 I TITLES["E" D ENTERBY
140 I TITLES["R" D PCMMPRIM
141 I TITLES["S" D PCMMASSC
142 I TITLES["M" D PCMMTEAM
143 Q
144PRIMARY ;
145 I $D(ORBU),ORBADT=0 S ORBU(ORBUI)=" Inpt primary provider:",ORBUI=ORBUI+1
146 I $D(ORBU),ORBADT=1 S ORBU(ORBUI)=" Inpt primary provider: option cannot determine without A/D/T event data.",ORBUI=ORBUI+1
147 I +$G(ORBPRIM)>0 S ORBDUZ=ORBPRIM D USER
148 Q
149ATTEND ;
150 I $D(ORBU),ORBADT=0 S ORBU(ORBUI)=" Attending physician:",ORBUI=ORBUI+1
151 I $D(ORBU),ORBADT=1 S ORBU(ORBUI)=" Attending physician: option cannot determine without A/D/T event data.",ORBUI=ORBUI+1
152 I +$G(ORBATTD)>0 S ORBDUZ=ORBATTD D USER
153 Q
154TEAMS ;
155 I $D(ORBU) S ORBU(ORBUI)=" Teams/Personal Lists related to patient:",ORBUI=ORBUI+1
156 N ORBLST,ORBI,ORBJ,ORBTM,ORBTNAME,ORBTTYPE,ORBTD
157 D TMSPT^ORQPTQ1(.ORBLST,ORBDFN)
158 Q:+$G(ORBLST(1))<1
159 S ORBI="" F S ORBI=$O(ORBLST(ORBI)) Q:ORBI="" D
160 .S ORBTM=$P(ORBLST(ORBI),U),ORBTNAME=$P(ORBLST(ORBI),U,2)
161 .S ORBTTYPE=$P(ORBLST(ORBI),U,3)
162 .I $D(ORBU) D
163 ..S ORBU(ORBUI)=" Patient list "_ORBTNAME_" ["_ORBTTYPE_"]:",ORBUI=ORBUI+1
164 .N ORBLST2 D TEAMPROV^ORQPTQ1(.ORBLST2,ORBTM)
165 .Q:+$G(ORBLST2(1))<1
166 .S ORBJ="" F S ORBJ=$O(ORBLST2(ORBJ)) Q:ORBJ="" D
167 ..S ORBDUZ=$P(ORBLST2(ORBJ),U)_U_ORBTM I +$G(ORBDUZ)>0 D USER
168 .;
169 .S ORBTD=$P($$TMDEV^ORB31(ORBTM),U,2) ;Team's device
170 .I $L(ORBTD) D
171 ..S ORBTDEV(ORBTD)=""
172 ..I $D(ORBU) D
173 ...S ORBU(ORBUI)=" Team's Device "_ORBTD_" is a recipient",ORBUI=ORBUI+1
174 Q
175ORDERER ;
176 Q:+$G(ORNUM)<1
177 I $D(ORBU) S ORBU(ORBUI)=" Ordering provider:",ORBUI=ORBUI+1
178 N ORBLST,ORBI,ORBTM,ORBJ,ORBTNAME,ORBPLST,ORBPI,ORBPTM,ORBTTYPE
179 S ORBDUZ=$S(ORN=12:+$$UNSIGNOR^ORQOR2(ORNUM),1:$$ORDERER^ORQOR2(ORNUM))
180 I +$G(ORBDUZ)>0 D
181 .D USER
182 .;if notif = Order Req E/S (#12) or Order Req Co-sign (#37) and
183 .;user doesn't have ES authority, send to fellow team members w/ES:
184 .I ((ORN=12)!(ORN=37)),('$D(^XUSEC("ORES",ORBDUZ))) D
185 ..I $D(ORBU) S ORBU(ORBUI)=" Orderer can't elec sign, getting teams orderer belongs to:",ORBUI=ORBUI+1
186 ..D TEAMPR^ORQPTQ1(.ORBLST,ORBDUZ) ;get orderer's tms
187 ..Q:+$G(ORBLST(1))<1
188 ..D TMSPT^ORQPTQ1(.ORBPLST,ORBDFN) ;get pt's tms
189 ..Q:+$G(ORBPLST(1))<1
190 ..S ORBI="" F S ORBI=$O(ORBLST(ORBI)) Q:ORBI="" D
191 ...S ORBPI="" F S ORBPI=$O(ORBPLST(ORBPI)) Q:ORBPI="" D
192 ....S ORBTM=$P(ORBLST(ORBI),U),ORBPTM=$P(ORBPLST(ORBPI),U)
193 ....I ORBTM=ORBPTM D ;if pt is on provider's team
194 .....I +$G(ORBPTM)>0 D
195 ......S ORBTNAME=$P(ORBPLST(ORBPI),U,2)
196 ......S ORBTTYPE=$P(ORBPLST(ORBPI),U,3)
197 ......I $D(ORBU) S ORBU(ORBUI)=" Orderer's pt list "_ORBTNAME_" ["_ORBTTYPE_"] recipients: ",ORBUI=ORBUI+1
198 ......N ORBLST2 D TEAMPROV^ORQPTQ1(.ORBLST2,ORBPTM)
199 ......Q:+$G(ORBLST2(1))<1
200 ......S ORBJ="" F S ORBJ=$O(ORBLST2(ORBJ)) Q:ORBJ="" D
201 .......S ORBDUZ=$P(ORBLST2(ORBJ),U)_U_ORBPTM I +$G(ORBDUZ)>0,($D(^XUSEC("ORES",+ORBDUZ))) D USER
202 Q
203ENTERBY ;
204 I $D(ORBU) S ORBU(ORBUI)=" User entering order's most recent activity:",ORBUI=ORBUI+1
205 Q:+$G(ORNUM)<1
206 I $D(^OR(100,ORNUM,8,0)) D
207 .S ORBDUZ=$P(^OR(100,ORNUM,8,$P(^OR(100,ORNUM,8,0),U,3),0),U,13)
208 I +$G(ORBDUZ)>0 D USER
209 Q
210PCMMPRIM ;
211 I $D(ORBU) S ORBU(ORBUI)=" PCMM Primary Care Practitioner:",ORBUI=ORBUI+1
212 S ORBDUZ=+$$OUTPTPR^SDUTL3(ORBDFN,$$NOW^XLFDT,1) ;DBIA #1252
213 I +$G(ORBDUZ)>0 D USER
214 Q
215PCMMASSC ;
216 I $D(ORBU) S ORBU(ORBUI)=" PCMM Associate Provider:",ORBUI=ORBUI+1
217 S ORBDUZ=+$$OUTPTAP^SDUTL3(ORBDFN,$$NOW^XLFDT) ;DBIA #1252
218 I +$G(ORBDUZ)>0 D USER
219 Q
220PCMMTEAM ;
221 N ORPCMM,ORPCMMDZ
222 I $D(ORBU) S ORBU(ORBUI)=" PCMM Team Position Assignments:",ORBUI=ORBUI+1
223 S ORPCMM=$$PRPT^SCAPMC(ORBDFN,,,,,,"^TMP(""ORPCMM"",$J)",) ;DBIA #1916
224 S ORPCMMDZ=0
225 F S ORPCMMDZ=$O(^TMP("ORPCMM",$J,"SCPR",ORPCMMDZ)) Q:'ORPCMMDZ D
226 .S ORBDUZ=ORPCMMDZ D USER
227 K ^TMP("ORPCMM",$J)
228 Q
229USER ;should USER (ORBDUZ) be a recip
230 D USER^ORB3USER(.XQA,ORBDUZ,ORN,.ORBU,.ORBUI,ORBDFN,+$G(ORNUM))
231 Q
Note: See TracBrowser for help on using the repository browser.