source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORB3SPEC.m

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

initial load of FOIAVistA 6/30/08 version
File size: 8.6 KB
Line 
1ORB3SPEC ; slc/CLA - Support routine for ORB3 ;4/4/02 14:40
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**139,220,215**;Dec 17, 1997
3SPECIAL(ORN,ORBASPEC,ORBU,ORBUI,ORNUM,ORDFN,ORDATA,ORBSMSG,ORBMSG,ORBSDEV,ORBPRIM,ORBATTD) ;
4 ;process special notifs to get recips (users,teams,devices)
5 ; ORN: notif ien
6 ; ORBASPEC: recip DUZ array
7 ; ORBU: recip debug array
8 ; ORBUI: ORBU cntr
9 ; ORNUM: order no
10 ; ORDFN: pt id
11 ; ORDATA: pkg data
12 ; ORBSMSG: special notif msg rtn by SPECIAL
13 ; ORBMSG: original notif msg
14 ; ORBSDEV: array of recip devices
15 ; ORBPRIM: pt's inpt primary care provider
16 ; ORBATTD: pt's attending physician
17 ;
18 N ORPAR,ORPTLOC
19 S ORPTLOC=$S($L($G(^DPT(ORDFN,.1))):"I",1:"O") ;DBIA #10035
20 ;
21 I ORPTLOC="I" D ;inpt flagged OI notifs
22 .I ORN=32 S ORPAR="ORB OI RESULTS - INPT" D OI
23 .I ORN=41 S ORPAR="ORB OI ORDERED - INPT" D OI
24 .I ORN=64 S ORPAR="ORB OI EXPIRING - INPT" D OI
25 ;
26 I ORPTLOC="O" D ;outpt flagged OI notifs
27 .I ORN=60 S ORPAR="ORB OI RESULTS - OUTPT" D OI
28 .I ORN=61 S ORPAR="ORB OI ORDERED - OUTPT" D OI
29 .I ORN=65 S ORPAR="ORB OI EXPIRING - OUTPT" D OI
30 ;
31 I ORN=3!(ORN=14)!(ORN=44)!(ORN=57) D ;lab results notifs
32 .D LRALRTS(ORN,ORDFN,ORDATA,.ORBSMSG,ORBMSG)
33 ;
34 I ORN=33 D ;requested results notif
35 .I $D(ORBU) D
36 ..S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
37 ..S ORBU(ORBUI)="Potential Orderer-flagged Results recipient: ",ORBUI=ORBUI+1
38 .N RECIP
39 .S RECIP=$$RSLTFLG^ORQOR2(ORNUM)
40 .I +$G(RECIP)>0 D
41 ..S ORBASPEC(+$G(RECIP))=""
42 ..I $D(ORBU) N NODE S NODE=$G(^VA(200,+$G(RECIP),0)) I $L(NODE) D
43 ...S ORBU(ORBUI)=" "_$P(NODE,U)_" is a potential recipient.",ORBUI=ORBUI+1
44 Q
45OI ;get potential recips for OI-flagged notifs
46 N OROI,ORLST,ORERR,ORBX,ORBZ,ORBE,ORBDUZ,ORBDEV,ORBUF
47 S OROI=+$G(^OR(100,+$G(ORNUM),.1,1,0)) ;get oi
48 Q:+$G(OROI)<0
49 I $D(ORBU) D
50 .S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
51 .S ORBU(ORBUI)="Special potential recipients from parameter: "_ORPAR,ORBUI=ORBUI+1
52 S ORBE=0,ORBX=0
53 ;
54 ;process special recip users, teams and devices:
55 D ENVAL^XPAR(.ORLST,ORPAR,"`"_OROI,.ORERR)
56 I 'ORERR,$G(ORLST)>0 D
57 .F ORBX=1:1:ORLST S ORBE=$O(ORLST(ORBE)),ORBZ=$P(ORBE,";",2),ORBUF=0 D
58 ..;
59 ..; process USERS:
60 ..I ORBZ="VA(200," S ORBDUZ=$P(ORBE,";") I $L(ORBDUZ) D
61 ...I ORLST(ORBE,OROI)=1 S ORBASPEC(ORBDUZ)="",ORBUF=1
62 ...I ORLST(ORBE,OROI)=0,$$PPLINK^ORQPTQ1(ORBDUZ,ORDFN) S ORBASPEC(ORBDUZ)="",ORBUF=1
63 ...I $D(ORBU),ORBUF=1 N NODE S NODE=$G(^VA(200,ORBDUZ,0)) I $L(NODE) D
64 ....S ORBU(ORBUI)=" "_$P(NODE,U)_" is a potential recipient.",ORBUI=ORBUI+1
65 ..;
66 ..; process DEVICES:
67 ..I ORBZ="%ZIS(1," S ORBDEV=$P(ORBE,";") I $L(ORBDEV),$D(^%ZIS(1,ORBDEV))>0 D
68 ...S ORBDEV=$G(^%ZIS(1,ORBDEV,0)) I $D(ORBDEV) D
69 ....I ORLST(ORBE,OROI)=1 S ORBSDEV($P(ORBDEV,U))="",ORBUF=1
70 ....I ORLST(ORBE,OROI)=0,$$PDLINK^ORQPTQ1(ORBDEV,ORDFN) S ORBSDEV($P(ORBDEV,U))="",ORBUF=1
71 ....I $D(ORBU),ORBUF=1 D
72 .....S ORBU(ORBUI)=" "_$P(ORBDEV,U)_" is a device recipient.",ORBUI=ORBUI+1
73 ..;
74 ..; process TEAMS:
75 ..I ORBZ="OR(100.21," D SPECTEAM(ORBE)
76 D TITLE(OROI,ORPAR)
77 Q
78SPECTEAM(ORBE) ;get special team recips
79 N ORBLST,IJ,ORBTM
80 S ORBTM=$P(ORBE,";")
81 D TEAMPROV^ORQPTQ1(.ORBLST,ORBTM)
82 I $D(ORBU) N TNODE S TNODE=$G(^OR(100.21,ORBTM,0)) I $L(TNODE) D
83 .S ORBU(ORBUI)=" Team potential recipients from team "_$P(TNODE,U)_":",ORBUI=ORBUI+1
84 I +$G(ORBLST(1))>0 S IJ="" F S IJ=$O(ORBLST(IJ)) Q:IJ="" D
85 .S ORBDUZ=$P(ORBLST(IJ),U),ORBUF=0 I $L(ORBDUZ) D
86 ..I ORLST(ORBE,OROI)=1 S ORBASPEC(ORBDUZ_U_ORBTM)="",ORBUF=1
87 ..I ORLST(ORBE,OROI)=0,$D(^OR(100.21,ORBTM,10,"B",ORDFN_";DPT(")) S ORBASPEC(ORBDUZ_U_ORBTM)="",ORBUF=1
88 ..I $D(ORBU),ORBUF=1 N NODE S NODE=$G(^VA(200,ORBDUZ,0)) I $L(NODE) D
89 ...S ORBU(ORBUI)=" "_$P(NODE,U),ORBUI=ORBUI+1
90 ;
91 S ORBTD=$P($$TMDEV^ORB31(ORBTM),U,2) ;tm's device
92 I $L(ORBTD) D
93 .S ORBSDEV(ORBTD)=""
94 .I $D(ORBU) D
95 ..S ORBU(ORBUI)=" Team's Device "_ORBTD_" is a recipient",ORBUI=ORBUI+1
96 Q
97LRALRTS(ORN,ORDFN,ORDATA,ORBSMSG,ORBMSG) ;find & delete matching alerts and gather recips
98 ; ORN: notif ien
99 ; ORDFN: pt id
100 ; ORDATA: pkg data
101 ; ORBSMSG: special notif msg rtn by LRALRTS
102 ; ORBMSG: original notif msg
103 ;
104 Q:+$G(ORN)<1
105 Q:+$G(ORDFN)<1
106 Q:+$G(ORDATA)<1
107 N LRID,ORY,I,J,XQAID,XQ0,XQ1,ORNE,RECIP,ORDATAE,LRIDE,STDATE
108 N ORTST,ORBMSGE,ORBMSGX,TXQAID,XQF,ORBHX,ORX,ORBI
109 ;
110 S LRID=$P($P(ORDATA,"|",2),"@") ;get lab unique results id (OE IDE)
111 Q:+$G(LRID)<1
112 ;
113 ;get pt's alerts within 24 hours:
114 S STDATE=$$FMADD^XLFDT($$NOW^XLFDT,"","-24","","")
115 D PATIENT^XQALERT("ORY",ORDFN,STDATE,"") ;get pt's alerts
116 ;
117 ;look for pt's alerts with same notif ien and unique lab results id:
118 F I=1:1:ORY D
119 .S XQAID=$P(ORY(I),U,2)
120 .S ORBMSGX=$P(ORY(I),U)
121 .S ORNE=$P($P(XQAID,";"),",",3) ;get notif ien
122 .Q:ORNE'=ORN
123 .;
124 .;find matching alert:
125 .D AHISTORY^XQALBUTL(XQAID,"ORBHX")
126 .S ORDATAE=$G(ORBHX(2))
127 .Q:'$L(ORDATAE)
128 .S LRIDE=$P($P(ORDATAE,"|",2),"@") ;get lab rslts id from existng alert
129 .Q:LRIDE'=LRID
130 .;
131 .S:ORBMSG["[" ORTST=$P($P(ORBMSG,"[",2),"]")
132 .I ORBMSG'["[" D
133 ..S:ORBMSG["labs: " ORTST=$P(ORBMSG,"labs: ",2)
134 ..S:ORBMSG["results: " ORTST=$P(ORBMSG,"results: ",2)
135 .;
136 .S ORBMSGE=$P(ORBMSGX,"): ",2)
137 .;
138 .S ORX=0
139 .;if alert has recips, get recips from existing alert:
140 .S:$L($G(ORBHX(20,0))) ORX=$P(ORBHX(20,0),U,4)
141 .F ORBI=1:1:ORX D
142 ..S RECIP=+ORBHX(20,ORBI,0)
143 ..S ORBASPEC(RECIP)="" ;add recip to new alert recip list
144 .;
145 .;delete existing alert:
146 .S XQAKILL=0 ;delete for all recips
147 .D DELETE^XQALERT
148 .K XQAKILL,XQAID
149 ;
150 ;if NO prev alert msg for this pt, notif, lab unique id:
151 I '$L($G(ORBMSGE)) S ORBSMSG=ORBMSG
152 ;
153 ;if prev alert msg for this pt, notif, lab unique id:
154 I $L($G(ORBMSGE)) D
155 .S:ORBMSGE["[" ORBSMSG=$P(ORBMSGE,"]")_", "_ORTST_"]"
156 .S:ORBMSGE'["[" ORBSMSG=ORBMSGE_", "_ORTST
157 ;
158 Q
159 ;
160TITLE(OROI,ORPAR) ;get provider recips
161 N ORTIT
162 I $D(ORBU) D
163 .S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
164 .S ORBU(ORBUI)="Special potential recipients from parameter: "_ORPAR_" PR",ORBUI=ORBUI+1
165 ;
166 ;process special recip users, teams and devices for Provider Recipients
167 S ORTIT=$$GET^XPAR("ALL",ORPAR_" PR","`"_OROI,"E")
168 Q:'$L(ORTIT)
169 I ORTIT["P" D PRIMARY
170 I ORTIT["A" D ATTEND
171 I ORTIT["T" D TEAMS
172 I ORTIT["O" D ORDERER
173 I ORTIT["E" D ENTERBY
174 I ORTIT["R" D PCMMPRIM
175 I ORTIT["S" D PCMMASSC
176 I ORTIT["M" D PCMMTEAM
177 Q
178PRIMARY ;
179 I $D(ORBU),+$G(ORBPRIM)>0 S ORBU(ORBUI)=" Flagged OI Inpt primary provider:",ORBUI=ORBUI+1
180 I $D(ORBU),+$G(ORBPRIM)<1 S ORBU(ORBUI)=" Flagged OI Inpt primary provider: option cannot determine without A/D/T event data.",ORBUI=ORBUI+1
181 I +$G(ORBPRIM)>0 S ORBASPEC(ORBPRIM)=""
182 Q
183ATTEND ;
184 I $D(ORBU),+$G(ORBATTD)>0 S ORBU(ORBUI)=" Flagged OI Attending physician:",ORBUI=ORBUI+1
185 I $D(ORBU),+$G(ORBATTD)<1 S ORBU(ORBUI)=" Flagged OI Attending physician: option cannot determine without A/D/T event data.",ORBUI=ORBUI+1
186 I +$G(ORBATTD)>0 S ORBASPEC(ORBATTD)=""
187 Q
188TEAMS ;
189 N ORBLST,ORBI,ORBJ,ORBTM,ORBTNAME,ORBTTYPE,ORBTD
190 I $D(ORBU) S ORBU(ORBUI)=" Flagged OI Teams/Personal Lists related to patient:",ORBUI=ORBUI+1
191 D TMSPT^ORQPTQ1(.ORBLST,ORDFN)
192 Q:+$G(ORBLST(1))<1
193 S ORBI="" F S ORBI=$O(ORBLST(ORBI)) Q:ORBI="" D
194 .S ORBTM=$P(ORBLST(ORBI),U),ORBTNAME=$P(ORBLST(ORBI),U,2)
195 .S ORBTTYPE=$P(ORBLST(ORBI),U,3)
196 .I $D(ORBU) D
197 ..S ORBU(ORBUI)=" Patient list "_ORBTNAME_" ["_ORBTTYPE_"]:",ORBUI=ORBUI+1
198 .N ORBLST2 D TEAMPROV^ORQPTQ1(.ORBLST2,ORBTM)
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_ORBTM I +$G(ORBDUZ)>0 S ORBASPEC(ORBDUZ)=""
202 .S ORBTD=$P($$TMDEV^ORB31(ORBTM),U,2) ;tm's device
203 .I $L(ORBTD) D
204 ..S ORBSDEV(ORBTD)=""
205 ..I $D(ORBU) D
206 ...S ORBU(ORBUI)=" Team's Device "_ORBTD_" is a recipient",ORBUI=ORBUI+1
207 Q
208ORDERER ;
209 N ORBDUZ
210 I $D(ORBU) S ORBU(ORBUI)=" Flagged OI Ordering provider:",ORBUI=ORBUI+1
211 Q:+$G(ORNUM)<1
212 S ORBDUZ=$$ORDERER^ORQOR2(ORNUM)
213 I +$G(ORBDUZ)>0 D
214 .S ORBASPEC(ORBDUZ)=""
215 Q
216ENTERBY ;
217 N ORBDUZ
218 I $D(ORBU) S ORBU(ORBUI)=" Flagged OI User entering order's most recent activity:",ORBUI=ORBUI+1
219 Q:+$G(ORNUM)<1
220 I $D(^OR(100,ORNUM,8,0)) D
221 .S ORBDUZ=$P(^OR(100,ORNUM,8,$P(^OR(100,ORNUM,8,0),U,3),0),U,13)
222 I +$G(ORBDUZ)>0 S ORBASPEC(ORBDUZ)=""
223 Q
224PCMMPRIM ;
225 N ORBDUZ
226 I $D(ORBU) S ORBU(ORBUI)=" Flagged OI PCMM Primary Care Practitioner:",ORBUI=ORBUI+1
227 S ORBDUZ=+$$OUTPTPR^SDUTL3(ORDFN,$$NOW^XLFDT,1) ;DBIA #1252
228 I +$G(ORBDUZ)>0 S ORBASPEC(ORBDUZ)=""
229 Q
230PCMMASSC ;
231 N ORBDUZ
232 I $D(ORBU) S ORBU(ORBUI)=" Flagged OI PCMM Associate Provider:",ORBUI=ORBUI+1
233 S ORBDUZ=+$$OUTPTAP^SDUTL3(ORDFN,$$NOW^XLFDT) ;DBIA #1252
234 I +$G(ORBDUZ)>0 S ORBASPEC(ORBDUZ)=""
235 Q
236PCMMTEAM ;
237 N ORPCMM,ORPCMMDZ,ORBDUZ
238 I $D(ORBU) S ORBU(ORBUI)=" Flagged OI PCMM Team Position Assignments:",ORBUI=ORBUI+1
239 S ORPCMM=$$PRPT^SCAPMC(ORDFN,,,,,,"^TMP(""ORPCMM"",$J)",) ;DBIA #1916
240 S ORPCMMDZ=0
241 F S ORPCMMDZ=$O(^TMP("ORPCMM",$J,"SCPR",ORPCMMDZ)) Q:'ORPCMMDZ D
242 .S ORBDUZ=ORPCMMDZ S ORBASPEC(ORBDUZ)=""
243 K ^TMP("ORPCMM",$J)
244 Q
Note: See TracBrowser for help on using the repository browser.