source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWORB.m@ 1535

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

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1ORWORB ; slc/dee/REV/CLA - RPC functions which return user alert ;10:12 am JAN 31, 2001
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,148,173,190,215**;Dec 17, 1997
3 ;
4URGENLST(ORY) ;return array of the urgency for the notification
5 N ORSRV,ORERROR
6 S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
7 D GETLST^XPAR(.ORY,"USR^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG","ORB URGENCY","I",.ORERROR)
8 Q
9 ;
10FASTUSER(ORY) ;return current user's notifications across all patients
11 N STRTDATE,STOPDATE,ORTOT,I,ORURG,URG,ORN,SORT,ORN0,URGLIST,REMLIST,REM,NONORLST,NONOR
12 N ALRT,ALRTDT,ALRTPT,ALRTMSG,ALRTI,ALRTLOC,ALRTXQA,J,FWDBY,PRE,ALRTDFN
13 K ^TMP("ORBG",$J)
14 S STRTDATE="",STOPDATE="",FWDBY="Forwarded by: "
15 D GETUSER1^XQALDATA("^TMP(""ORB"",$J)",DUZ,STRTDATE,STOPDATE)
16 S ORTOT=^TMP("ORB",$J)
17 D URGLIST^ORQORB(.URGLIST)
18 D REMLIST^ORQORB(.REMLIST)
19 D REMNONOR^ORQORB(.NONORLST)
20 S J=0
21 F I=1:1:ORTOT D
22 .S ALRTDFN=""
23 .S ALRT=^TMP("ORB",$J,I)
24 .S PRE=$E(ALRT,1,1)
25 .S ALRTXQA=$P(ALRT,U,2) ;XQAID
26 .S NONOR="" F S NONOR=$O(NONORLST(NONOR)) Q:NONOR="" D
27 ..I ALRTXQA[NONOR S REM=1 ;allow this type of alert to be Removed
28 .S ALRTMSG=$P($P(ALRT,U),PRE_" ",2)
29 .I $E(ALRT,4,8)'="-----" D ;not forwarded alert info/comment
30 ..S ORURG="n/a"
31 ..S ALRTI=$P(ALRT," ")
32 ..S ALRTPT=""
33 ..S ALRTLOC=""
34 ..I $E($P(ALRTXQA,";"),1,3)="TIU" S ORURG="Moderate"
35 ..I $P(ALRTXQA,",")="OR" D
36 ...S ORN=$P($P(ALRTXQA,";"),",",3)
37 ...S URG=$G(URGLIST(ORN))
38 ...S ORURG=$S(URG=1:"HIGH",URG=2:"Moderate",1:"low")
39 ...S REM=$G(REMLIST(ORN))
40 ...S ORN0=^ORD(100.9,ORN,0)
41 ...S ALRTI=$S($P(ORN0,U,6)="INFODEL":"I",1:"")
42 ...S ALRTDFN=$P(ALRTXQA,",",2)
43 ...S ALRTLOC=$G(^DPT(+$G(ALRTDFN),.1))
44 ..S ALRTI=$S(ALRTI="I":"I",1:"")
45 ..I ALRT["): " D
46 ...S ALRTPT=$P(ALRT,": ")
47 ...S ALRTPT=$E(ALRTPT,4,$L(ALRTPT))
48 ...S ALRTMSG=$P($P(ALRT,U),"): ",2)
49 ...I $E(ALRTMSG,1,1)="[" D
50 ....S:'$L(ALRTLOC) ALRTLOC=$P($P(ALRTMSG,"]"),"[",2)
51 ....S ALRTMSG=$P(ALRTMSG,"] ",2)
52 ..I '$L($G(ALRTPT)) S ALRTPT="no patient"
53 ..S ALRTDT=$P(ALRTXQA,";",3)
54 ..S ALRTDT=$P(ALRTDT,".")_"."_$E($P(ALRTDT,".",2)_"0000",1,4)
55 ..S ALRTDT=$E(ALRTDT,4,5)_"/"_$E(ALRTDT,6,7)_"/"_($E(ALRTDT,1,3)+1700)_"@"_$E($P(ALRTDT,".",2),1,2)_":"_$E($P(ALRTDT,".",2),3,4)
56 ..;S ALRTDT=($E(ALRTDT,1,3)+1700)_"/"_$E(ALRTDT,4,5)_"/"_$E(ALRTDT,6,7)_"@"_$E($P(ALRTDT,".",2),1,2)_":"_$E($P(ALRTDT,".",2),3,4)
57 ..S J=J+1,^TMP("ORBG",$J,J)=ALRTI_U_ALRTPT_U_ALRTLOC_U_ORURG_U_ALRTDT_U
58 ..S ^TMP("ORBG",$J,J)=^TMP("ORBG",$J,J)_ALRTMSG_U_U_ALRTXQA_U_$G(REM)_U
59 .;
60 .;if alert forward info/comment:
61 .I $E(ALRTMSG,1,5)="-----" D
62 ..S ALRTMSG=$P(ALRTMSG,"-----",2)
63 ..I $E(ALRTMSG,1,14)=FWDBY D
64 ...S J=J+1,^TMP("ORBG",$J,J)=FWDBY_U_$P($P(ALRTMSG,FWDBY,2),"Generated: ")_$P($P(ALRTMSG,FWDBY,2),"Generated: ",2)
65 ..E S ^TMP("ORBG",$J,J)=^TMP("ORBG",$J,J)_U_""""_ALRTMSG_""""
66 S ^TMP("ORBG",$J)=""
67 S ORY=$NA(^TMP("ORBG",$J))
68 Q
69 ;
70GETDATA(ORY,XQAID) ; return XQADATA for an alert
71 N SHOWADD
72 S ORY=""
73 Q:$G(XQAID)=""!('$D(^XTV(8992,"AXQA",XQAID)))
74 D GETACT^XQALERT(XQAID)
75 S ORY=XQADATA
76 I ($E(XQAID,1,3)="TIU"),(+ORY>0) D
77 . S SHOWADD=1
78 . S ORY=ORY_$$RESOLVE^TIUSRVLO(+ORY)
79 K XQAID,XQADATA,XQAOPT,XQAROU
80 Q
81 ;
82KILUNSNO(Y,ORVP) ; Delete unsigned order alerts if no unsigned orders remaining
83 S ORVP=ORVP_";DPT("
84 D UNOTIF^ORCSIGN
85 Q
86 ;
87UNFLORD(Y,DFN,XQAID) ; -- auto-unflag orders?/delete alert
88 Q:'$L(DFN)!('$L(XQAID))
89 N ORI,ORIFN,ORA,XQAKILL,ORN,ORBY,ORAUTO,ORUNF
90 S ORN=+$O(^ORD(100.9,"B","FLAGGED ORDERS",0))
91 S XQAKILL=$$XQAKILL^ORB3F1(ORN)
92 D LIST^ORQOR1(.ORBY,DFN,"ALL",12,"","")
93 S ORAUTO=+$$GET^XPAR("ALL","ORPF AUTO UNFLAG")
94 S ORI=0 F S ORI=$O(ORBY(ORI)) Q:ORI'>0 D
95 . I ORAUTO D ; unflag
96 . . S ORUNF=+$E($$NOW^XLFDT,1,12)_U_DUZ_"^Auto-Unflagged"
97 . . S ORIFN=$P(ORBY(ORI),U),ORA=+$P(ORIFN,";",2)
98 . . I ORIFN,$D(^OR(100,+ORIFN,0)) S $P(^(8,ORA,3),U)=0,$P(^(3),U,6,8)=ORUNF ; unflag
99 I ORAUTO!(+$G(ORBY(1))=0) D DELETE^XQALERT
100 Q
101KILEXMED(Y,ORDFN) ; -- Delete expiring meds notification if no expiring meds remaining
102 N ORDG,ORLST S ORDG=$$DG^ORQOR1("RX")
103 D AGET^ORWORR(.ORLST,ORDFN,5,ORDG)
104 Q:+(@ORLST@(.1)) ;more left
105 N XQAKILL,ORNIFN,ORVP,ORIO S OROI=""
106 F OROI="INPT","OUTPT" D
107 .S ORNIFN=$O(^ORD(100.9,"B","MEDICATIONS EXPIRING - "_OROI,0)),ORVP=ORDFN_";DPT("
108 .Q:'$L($G(ORNIFN))
109 .S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN) ; expiring meds notif
110 .I $D(XQAID) D DELETE^XQALERT
111 .I '$D(XQAID) S XQAID=$P($G(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN D DELETEA^XQALERT K XQAID
112 Q
113KILEXOI(Y,ORDFN,ORNIFN) ; -- Delete expiring flagged OI notification if no flagged expiring OI remaining
114 N ORDG,ORLST S ORDG=$$DG^ORQOR1("ALL")
115 D AGET^ORWORR(.ORLST,ORDFN,5,ORDG)
116 Q:+(@ORLST@(.1)) ;more left
117 N XQAKILL,ORVP
118 S ORVP=ORDFN_";DPT("
119 S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN) ; flagged expiring OI notifications
120 I $D(XQAID) D DELETE^XQALERT
121 I '$D(XQAID) S XQAID=$P($G(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN D DELETEA^XQALERT K XQAID
122 Q
123KILUNVOR(Y,ORDFN) ; -- Delete UNVERIFIED ORDER notification if none remaining within current admission/30 days
124 N DFN,ORDG,ORLST,ORBDT,OREDT,ORDDT S ORDG=$$DG^ORQOR1("ALL")
125 S OREDT=$$NOW^XLFDT
126 S ORDDT=$$FMADD^XLFDT(OREDT,"-90")
127 ;get current admission date/time:
128 S DFN=ORDFN,VA200="" D INP^VADPT
129 S ORBDT=$P($G(VAIN(7)),U)
130 S ORBDT=$S('$L($G(ORBDT)):$$FMADD^XLFDT(OREDT,"-30"),1:ORBDT) ;<= if no admission use past 30 days
131 S ORBDT=$S(ORDDT>ORBDT:ORDDT,1:ORBDT) ;max past days to use is 90 days
132 D AGET^ORWORR(.ORLST,ORDFN,9,ORDG,ORBDT,OREDT)
133 Q:+(@ORLST@(.1)) ;more left
134 N XQAKILL,ORVP,ORNIFN
135 S ORNIFN=$O(^ORD(100.9,"B","UNVERIFIED ORDER",0)),ORVP=ORDFN_";DPT("
136 S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN)
137 I $D(XQAID) D DELETE^XQALERT
138 I '$D(XQAID) S XQAID=$P($G(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN D DELETEA^XQALERT K XQAID
139 Q
140KILUNVMD(Y,ORDFN) ; -- Delete UNVERIFIED MEDS notification if none remaining within current admission/30 days
141 N DFN,ORDG,ORLST,ORBDT,OREDT,ORDDT S ORDG=$$DG^ORQOR1("RX")
142 S OREDT=$$NOW^XLFDT
143 S ORDDT=$$FMADD^XLFDT(OREDT,"-90")
144 ;get current admission date/time:
145 S DFN=ORDFN,VA200="" D INP^VADPT
146 S ORBDT=$P($G(VAIN(7)),U)
147 S ORBDT=$S('$L($G(ORBDT)):$$FMADD^XLFDT(OREDT,"-30"),1:ORBDT) ;<= if no admission use past 30 days
148 S ORBDT=$S(ORDDT>ORBDT:ORDDT,1:ORBDT) ;max past days to use is 90 days
149 D AGET^ORWORR(.ORLST,ORDFN,9,ORDG,ORBDT,OREDT)
150 Q:+(@ORLST@(.1)) ;more left
151 N XQAKILL,ORVP,ORNIFN
152 S ORNIFN=$O(^ORD(100.9,"B","UNVERIFIED MEDICATION ORDER",0)),ORVP=ORDFN_";DPT("
153 S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN)
154 I $D(XQAID) D DELETE^XQALERT
155 I '$D(XQAID) S XQAID=$P($G(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN D DELETEA^XQALERT K XQAID
156 Q
157ESORD(ORY,XQAID) ;order(s) requiring electronic signature follow-up
158 K XQAKILL
159 N ORPT,ORDG,ORBXQAID,ORY,ORX,ORZ,ORDERS,ORDNUM,ORQUIT,ORBLMDEL
160 S ORBXQAID=XQAID,ORDERS=0,ORQUIT=0
161 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
162 S ORDG=$$DG^ORQOR1("ALL")
163 ;the FLG code for UNSIGNED orders in ORQ1 is '11'
164 ;get unsigned orders - if none exist, delete alert then quit:
165 D EN^ORQ1(ORPT_";DPT(",ORDG,11,"","","",0,0)
166 S ORX="",ORX=$O(^TMP("ORR",$J,ORX)) Q:ORX="" I +$G(^TMP("ORR",$J,ORX,"TOT"))<1 D DEL^ORB3FUP1(.ORY,ORBXQAID) K ^TMP("ORR",$J) Q
167 ;
168 ;user does not have ORES key, delete user's alert:
169 I '$D(^XUSEC("ORES",DUZ)) S XQAKILL=1 D DEL^ORB3FUP1(.ORY,ORBXQAID) K ^TMP("ORR",$J) Q
170 ;
171 ;if prov is NOT linked to pt via attending, primary or teams:
172 I $$PPLINK^ORQPTQ1(DUZ,ORPT)=0 D
173 .S ORX="" F S ORX=$O(^TMP("ORR",$J,ORX)) Q:ORX=""!(ORDERS=1) D
174 ..S ORZ="" F S ORZ=$O(^TMP("ORR",$J,ORX,ORZ)) Q:+ORZ=0!(ORDERS=1) D
175 ...S ORDNUM=^TMP("ORR",$J,ORX,ORZ)
176 ...;quit if this unsigned order's last action was made by the user
177 ...I DUZ=+$$UNSIGNOR^ORQOR2(ORDNUM) S ORDERS=1
178 .I ORDERS'=1 D ;provider has no outstanding unsigned orders for pt
179 ..S XQAKILL=1 D DEL^ORB3FUP1(.ORY,ORBXQAID) ;delete alert for this user
180 K ^TMP("ORR",$J)
181 Q
182 ;
183TXTFUP(ROOT,DFN,NOTIF,XQADATA) ; Follow-up for text messages
184 ;
185 I NOTIF=67 D CHGRAD
186 Q
187 ;
188CHGRAD ;GUI follow-up for Imaging Request Changed (#67)
189 S ROOT=$NA(^TMP($J,"RAE4"))
190 K @ROOT
191 D SET1^RAO7PC4 ;DBIA #3563
192 Q
193 ;
194GETSORT(ORY) ;return notification sort method^direction for user/division/system/pkg
195 S ORY=$$GET^XPAR("ALL","ORB SORT METHOD",1,"I")_U_$$GET^XPAR("ALL","ORB SORT DIRECTION",1,"I")
196 Q
197 ;
198SETSORT(ORERR,SORT,DIR) ;set notification sort method^direction for user
199 D EN^XPAR(DUZ_";VA(200,","ORB SORT METHOD",1,SORT,.ORERR)
200 I $L($G(DIR)) D EN^XPAR(DUZ_";VA(200,","ORB SORT DIRECTION",1,DIR,.ORERR)
201 Q
Note: See TracBrowser for help on using the repository browser.