- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWORB.m
r613 r623 1 ORWORB 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,148,173,190,215,243**;Dec 17, 1997;Build 242 3 4 URGENLST(ORY) 5 6 7 8 9 10 FASTUSER(ORY) 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 GETDATA(ORY,XQAID) 71 72 73 74 75 76 77 78 79 80 81 82 KILUNSNO(Y,ORVP) 83 84 85 86 87 UNFLORD( ORY,DFN,XQAID); -- auto-unflag orders?/delete alert88 89 90 91 92 93 94 95 96 97 98 . . I ORIFN,$D(^OR(100,+ORIFN,0)) S $P(^(8,ORA,3),U)=0,$P(^(3),U,6,8)=ORUNF D MSG^ORCFLAG(ORIFN); unflag99 100 101 KILEXMED(Y,ORDFN) 102 103 104 105 106 107 108 109 110 111 112 113 KILEXOI(Y,ORDFN,ORNIFN) 114 115 116 117 118 119 120 121 122 123 KILUNVOR(Y,ORDFN) 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 KILUNVMD(Y,ORDFN) 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 ESORD(ORY,XQAID) 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 TXTFUP(ROOT,DFN,NOTIF,XQADATA) 184 185 186 187 188 CHGRAD 189 190 191 192 193 194 GETSORT(ORY) 195 196 197 198 SETSORT(ORERR,SORT,DIR) 199 200 201 1 ORWORB ; 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 ; 4 URGENLST(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 ; 10 FASTUSER(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 ; 70 GETDATA(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 ; 82 KILUNSNO(Y,ORVP) ; Delete unsigned order alerts if no unsigned orders remaining 83 S ORVP=ORVP_";DPT(" 84 D UNOTIF^ORCSIGN 85 Q 86 ; 87 UNFLORD(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 101 KILEXMED(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 113 KILEXOI(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 123 KILUNVOR(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 140 KILUNVMD(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 157 ESORD(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 ; 183 TXTFUP(ROOT,DFN,NOTIF,XQADATA) ; Follow-up for text messages 184 ; 185 I NOTIF=67 D CHGRAD 186 Q 187 ; 188 CHGRAD ;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 ; 194 GETSORT(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 ; 198 SETSORT(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 TracChangeset
for help on using the changeset viewer.
