ORWORB ; SLC/DEE,REV,CLA,WAT - RPC FUNCTIONS WHICH RETURN USER ALERT ;03/01/23 12:43
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,148,173,190,215,243,296,329,334,410,377,498,405,596**;Dec 17, 1997;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified
;
; External reference to ^DPT( supported by IA 10035
; External reference to ^XTV(8992 supported by IA 2689
; External reference to ^XTV(8992.1 supported by IA 7063
; External reference to ^VA(200,5 supported by IA 4329
; External reference to ^XUSEC( supported by IA 10076
; External reference to RAO7PC4 supported by IA 3563
; External reference to TIUSRVLO supported by IA 2834
; External reference to VADPT supported by IA 10061
; External reference to XLFDT supported by IA 10103
; External reference to XPAR supported by IA 2263
; External reference to XQALDATA supported by IA 4834
; External reference to XQALERT supported by IA 10081
; External reference to XQALBUTL supported by IA 2788
;
Q
GETLTXT(ORY,ORAID) ;get the long text for an alert
N ORDATA
D ALERTDAT^XQALBUTL(ORAID,"ORDATA")
S ORY(1)=""
I $D(ORDATA(4,1)) N ORI S ORI=0 F S ORI=$O(ORDATA(4,ORI)) Q:'ORI D
.S ORY(ORI)=ORDATA(4,ORI)
Q
;
URGENLST(ORY) ;return array of the urgency for the notification
N ORSRV,ORERROR
S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
D GETLST^XPAR(.ORY,"USR^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG","ORB URGENCY","I",.ORERROR)
Q
;
FASTUSER(ORY,ORDEFFLG) ;return current user's notifications across all patients
; ORDEFFLG: setting this to 1 causes the alerts API to exclude deferred alerts for this user
; defaults to 1 if not passed in
N STRTDATE,STOPDATE,ORTOT,I,ORURG,URG,ORN,SORT,ORN0,URGLIST,REMLIST,REM,NONORLST,NONOR
N ALRT,ALRTDT,ALRTPT,ALRTMSG,ALRTI,ALRTLOC,ALRTXQA,J,FWDBY,PRE,ALRTDFN,FROMFAST
K ^TMP("ORB",$J),^TMP("ORBG",$J)
S STRTDATE="",STOPDATE="",FWDBY="Forwarded by: ",FROMFAST=1
D GETUSER1^XQALDATA("^TMP(""ORB"",$J)",DUZ,STRTDATE,STOPDATE,$G(ORDEFFLG,1))
D USERLIST(.ORY,STRTDATE,STOPDATE)
Q
;
PROUSER(ORY,STRTDATE,STOPDATE,MAXRET,PROONLY) ;return current user's processed notifications for a specified date range
Q:'$$GET^XPAR("SYS","OR RTN PROCESSED ALERTS")
N FWDBY
K ^TMP("ORB",$J),^TMP("ORBG",$J)
S FWDBY="Forwarded by: "
D GETUSER2^XQALDATA("^TMP(""ORB"",$J)",DUZ,STRTDATE,STOPDATE,MAXRET,PROONLY)
D USERLIST(.ORY,STRTDATE,STOPDATE)
Q
USERLIST(ORY,STRTDATE,STOPDATE) ;process for obtaining user's notifications
N ORTOT,I,ORURG,URG,ORN,SORT,ORN0,URGLIST,REMLIST,REM,NONORLST,NONOR
N ALRT,ALRTDT,ALRTPT,ALRTMSG,ALRTI,ALRTLOC,ALRTXQA,J,PRE,ALRTDFN,ORRMVD
S ORTOT=^TMP("ORB",$J)
D URGLIST^ORQORB(.URGLIST)
D REMLIST^ORQORB(.REMLIST)
D REMNONOR^ORQORB(.NONORLST)
S J=0
F I=1:1:ORTOT D
.N ORPROV,ORBIRAD
.S ALRTDFN="",REM=""
.S ALRT=^TMP("ORB",$J,I)
.S PRE=$E(ALRT,1,1)
.S ALRTXQA=$P(ALRT,U,2) Q:ALRTXQA="" ; XQAID expected
.S NONOR="" F S NONOR=$O(NONORLST(NONOR)) Q:NONOR="" D
..I ALRTXQA[NONOR S REM=1 ;allow this type of alert to be Removed
.S ALRTMSG=$P($P(ALRT,U),PRE_" ",2)
.;S ALRTMSG=$P($P(ALRT,U),PRE,2,99),ALRTMSG=$$TRIM^XLFSTR(ALRTMSG,"L")
.I $E(ALRT,4,8)'="-----" D ;not forwarded alert info/comment
..S ORRMVD=0
..S ORURG="n/a"
..S ALRTI=$P(ALRT," ")
..S ALRTPT=""
..S ALRTLOC=""
.. ; *596 ajb
. . I $E($P(ALRTXQA,";"),1,3)="TIU" D Q
. . . N ALRT,NODE,X,XTVDA,Y S XTVDA=$O(^XTV(8992.1,"B",ALRTXQA,0)) Q:'XTVDA
. . . S NODE=$G(^XTV(8992.1,XTVDA,1)) Q:NODE="" ; full text of alert data
. . . S $P(ALRT,U,2)=$P($P(NODE,U),":"),$P(ALRT,U,4)=$S(ALRT[" STAT ":"HIGH",1:"Moderate")
. . . S X=$P(ALRTXQA,";",3),$P(Y,"/",1)=$E(X,4,5),$P(Y,"/",2)=$E(X,6,7),$P(Y,"/",3)=(1700+$E(X,1,3))
. . . S X=$E($P(X,".",2)_"0000",1,4),$P(Y,"@",2)=$E(X,1,2)_":"_$E(X,3,4),$P(ALRT,U,5)=Y
. . . S $P(ALRT,U,6)=$P($P(NODE,U),": ",2),$P(ALRT,U,8)=ALRTXQA,$P(ALRT,U,9)=REM_U
. . . S J=J+1,^TMP("ORBG",$J,J)=ALRT
.. ; *596 ajb
..I $P(ALRTXQA,",")="OR" D
... N ALRTIEN,ORIEN,P04,ORPOUT
... S ALRTIEN=$O(^XTV(8992.1,"B",ALRTXQA,0)) Q:ALRTIEN'>0 ; direct read ICR #7063
... S ORIEN=+$G(^XTV(8992.1,ALRTIEN,2)) ; Q:ORIEN'>0 ; direct read ICR #7063
... S P04=$P($G(^OR(100,ORIEN,0)),U,4) I +P04 S ORPROV=$$GET1^DIQ(200,P04,.01)
...S ORN=$P($P(ALRTXQA,";"),",",3)
...S URG=$G(URGLIST(ORN))
...S ORURG=$S(URG=1:"HIGH",URG=2:"Moderate",1:"low")
...S REM=$G(REMLIST(ORN))
...S ORN0=^ORD(100.9,ORN,0)
...S ALRTI=$S(ORN=90:"L",$P(ORN0,U,6)="INFODEL":"I",1:"")
...S ALRTDFN=$P(ALRTXQA,",",2)
...S ALRTLOC=$G(^DPT(+$G(ALRTDFN),.1))
...I $$ISSMIEN^ORBSMART(ORN) D
....N ORSMBY
....D ALTDATA^PXRMCALT(.ORPOUT,ALRTDFN,ALRTXQA)
....I $G(ORPOUT("DATA","RADIOLOGY REPORT FOUND"))=0 D DEL^ORB3FUP1(.ORSMBY,ALRTXQA,0) S ORRMVD=1 Q
....I $L($G(ORPOUT("DATA",1,"DIAGNOSIS")))>0 S ORBIRAD=$G(ORPOUT("DATA",1,"DIAGNOSIS"))
..I ORRMVD Q
..S ALRTI=$S(ALRTI="I":"I",ALRTI="L":"L",1:"")
..I (ALRT["): ")!($G(ORN)=27&(ALRT[") CV")) D ;WAT
...S ALRTPT=$P(ALRT,": ")
...S ALRTPT=$E(ALRTPT,4,$L(ALRTPT))
...;S ALRTPT=$P(ALRTPT,PRE,2,99),ALRTPT=$$TRIM^XLFSTR(ALRTPT,"L")
...I $G(ORN)=27&(ALRT[") CV") S ALRTMSG=$P($P(ALRT,U),": ",2) ;WAT
...E S ALRTMSG=$P($P(ALRT,U),"): ",2) ;WAT
...I $E(ALRTMSG,1,1)="[" D
....S:'$L(ALRTLOC) ALRTLOC=$P($P(ALRTMSG,"]"),"[",2)
....S ALRTMSG=$P(ALRTMSG,"] ",2)
..I '$L($G(ALRTPT)) S ALRTPT="no patient"
..S ALRTDT=$P(ALRTXQA,";",3)
..S ALRTDT=$P(ALRTDT,".")_"."_$E($P(ALRTDT,".",2)_"0000",1,4)
..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)
..;if SMART alert, append BIRAD results to ALRTMSG
..I $G(ORBIRAD)'="" S ALRTMSG=ALRTMSG_" - RESULTS: "_ORBIRAD
..S J=J+1,^TMP("ORBG",$J,J)=ALRTI_U_ALRTPT_U_ALRTLOC_U_ORURG_U_ALRTDT_U
..S ^TMP("ORBG",$J,J)=^TMP("ORBG",$J,J)_ALRTMSG_U_U_ALRTXQA_U_$G(REM)_U
.I ORRMVD Q
.;if alert forward info/comment:
.I $E(ALRTMSG,1,5)="-----" D
..S ALRTMSG=$P(ALRTMSG,"-----",2)
..I $E(ALRTMSG,1,14)=FWDBY D
...S J=J+1,^TMP("ORBG",$J,J)=FWDBY_U_$P($P(ALRTMSG,FWDBY,2),"Generated: ")_$P($P(ALRTMSG,FWDBY,2),"Generated: ",2)
..E S ^TMP("ORBG",$J,J)=^TMP("ORBG",$J,J)_U_""""_ALRTMSG_""""
.;I $G(ORPROV)'="" S ^TMP("ORBG",$J,J)=^TMP("ORBG",$J,J)_U_ORPROV ; ajb
.;if this is for processed alerts, add additional data into pieces 15 through 22
.I $D(^TMP("ORB",$J,J,"PROCESSED")) D
..S $P(^TMP("ORBG",$J,J),U,15)=^TMP("ORB",$J,J,"PROCESSED")
.;if this is for pending alerts, add "surrogate for" into piece 15
.I $G(FROMFAST) N ALRTIEN,DUZIEN,SURRFOR D
..S ALRTIEN=$O(^XTV(8992.1,"B",ALRTXQA,0)) Q:'ALRTIEN
..S DUZIEN=$O(^XTV(8992.1,ALRTIEN,20,"B",DUZ,"")) Q:'DUZIEN
..S SURRFOR=+$G(^XTV(8992.1,ALRTIEN,20,DUZIEN,3,1,0)) ; get first "surrogate for" and return returns 0 if empty
..I SURRFOR S $P(^TMP("ORBG",$J,J),U,15)=$P(^VA(200,SURRFOR,0),U)
S ^TMP("ORBG",$J)=""
S ORY=$NA(^TMP("ORBG",$J))
K ^TMP("ORB",$J)
Q
;
GETDATA(ORY,XQAID,PFLAG) ; return XQADATA for an alert
N SHOWADD
S ORY=""
Q:$G(XQAID)=""!('$D(^XTV(8992,"AXQA",XQAID)))
I +$G(PFLAG) S XQADATA=$$GETACT2(XQAID) I 1
E D GETACT^XQALERT(XQAID)
S ORY=XQADATA
I ($E(XQAID,1,3)="TIU"),(+ORY>0) D
. S SHOWADD=1
. S ORY=ORY_$$RESOLVE^TIUSRVLO(+ORY)
K XQAID,XQADATA,XQAOPT,XQAROU
Q
;
GETACT2(ALERTID) ; Returns first XQADATA found, for alerts for other users
N XQADATA,XDUZ,XQI,XQX,XQZ,DONE
S XQADATA="",XDUZ="",DONE=0
F Q:DONE S XDUZ=$O(^XTV(8992,"AXQA",ALERTID,XDUZ)) Q:'XDUZ D
. S XQI=$O(^XTV(8992,"AXQA",ALERTID,XDUZ,0))
. Q:XQI'>0
. S XQX=$G(^XTV(8992,XDUZ,"XQA",XQI,0)) Q:XQX=""
. S XQZ=$G(^XTV(8992,XDUZ,"XQA",XQI,1))
. S XQADATA=$S(XQZ'="":XQZ,1:$P(XQX,U,9,99))
. I XQADATA'="" S DONE=1
Q XQADATA
;
KILUNSNO(Y,ORVP) ; Delete unsigned order alerts if no unsigned orders remaining
S ORVP=ORVP_";DPT("
D UNOTIF^ORCSIGN
Q
;
UNFLORD(ORY,DFN,XQAID) ; -- auto-unflag orders?/delete alert
Q
;*334/VMP-DJE Auto unflag has been disabled
;Q:'$L(DFN)!('$L(XQAID))
;N ORI,ORIFN,ORA,XQAKILL,ORN,ORBY,ORAUTO,ORUNF
;S ORN=+$O(^ORD(100.9,"B","FLAGGED ORDERS",0))
;;S XQAKILL=$$XQAKILL^ORB3F1(ORN)
;D LIST^ORQOR1(.ORBY,DFN,"ALL",12,"","")
;S ORAUTO=+$$GET^XPAR("ALL","ORPF AUTO UNFLAG")
;S ORI=0 F S ORI=$O(ORBY(ORI)) Q:ORI'>0 D
;. I ORAUTO D ; unflag
;. . ;DJE-VM *329 - use GUI RPC call to make it run the proper code, only run it if the user sees it.
;. . ;S ORUNF=+$E($$NOW^XLFDT,1,12)_U_DUZ_"^Auto-Unflagged"
;. . ;S ORIFN=$P(ORBY(ORI),U),ORA=+$P(ORIFN,";",2)
;. . ;I ORIFN,$D(^OR(100,+ORIFN,0)) S $P(^(8,ORA,3),U)=0,$P(^(3),U,6,8)=ORUNF D MSG^ORCFLAG(ORIFN) ; unflag
;. . S ORIFN=+ORBY(ORI)
;. . I $D(^OR(100,ORIFN,0)),'$$FLAGRULE^ORWORR1(ORIFN) D UNFLAG^ORWDXA(.ORUNF,$P(ORBY(ORI),U),"Auto-Unflagged")
;;DJE-VM *329 - ORWDXA is smarter and deletes the appropriate alert(s)
;;I (ORAUTO)!(+$G(ORBY(1))=0) D DELETE^XQALERT
;Q
KILEXMED(Y,ORDFN) ; -- Delete expiring meds notification if no expiring meds remaining
N ORDG,ORLST,OROI,LIST S ORDG=$$DG^ORQOR1("RX")
N XQAKILL,ORNIFN,ORVP
S LIST("INPT")=1
S LIST("OUTPT")=1
D AGET^ORWORR(.ORLST,ORDFN,5,ORDG)
;selected code copied from EXPIR^ORB3TIM2
I +(@ORLST@(.1)) D ;if there are orders
. K LIST("OUTPT")
. S OROI=.5
. N ORSCHFIL,ORBZ
. S ORSCHFIL=$$TERMLKUP^ORB31(.ORBZ,"ONE TIME MED")
. F S OROI=$O(@ORLST@(OROI)) Q:'OROI D Q:'$G(LIST("INPT"))
.. N EXORN S EXORN=+@ORLST@(OROI)
.. ;skip outpt meds
.. Q:$$DGRX^ORQOR2(EXORN)="OUTPATIENT MEDICATIONS"
.. ;skip one time meds
.. N ONETIME,ORSCH,ORBI S ONETIME=0
.. I $D(ORBZ),(+$G(ORSCHFIL)=51.1) F ORBI=1:1:ORBZ D
... S ORSCH=$P(ORBZ(ORBI),U,2)
... I ORSCH=$$VALUE^ORCSAVE2(EXORN,"SCHEDULE") S ONETIME=1 Q
.. Q:+$G(ONETIME)=1
.. ;don't delete notification if there are valid inpt orders
.. K LIST("INPT")
S OROI=""
F S OROI=$O(LIST(OROI)) Q:'$L(OROI) D
.S ORNIFN=$O(^ORD(100.9,"B","MEDICATIONS EXPIRING - "_OROI,0)),ORVP=ORDFN_";DPT("
.Q:'$L($G(ORNIFN))
.S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN) ; expiring meds notif
.I $D(XQAID) D DELETE^XQALERT
.I '$D(XQAID) S XQAID=$P($G(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN D DELETEA^XQALERT K XQAID
Q
KILEXOI(Y,ORDFN,ORNIFN) ; -- Delete expiring flagged OI notification if no flagged expiring OI remaining
N ORDG,ORLST S ORDG=$$DG^ORQOR1("ALL")
D AGET^ORWORR(.ORLST,ORDFN,5,ORDG)
Q:+(@ORLST@(.1)) ;more left
N XQAKILL,ORVP
S ORVP=ORDFN_";DPT("
S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN) ; flagged expiring OI notifications
I $D(XQAID) D DELETE^XQALERT
I '$D(XQAID) S XQAID=$P($G(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN D DELETEA^XQALERT K XQAID
Q
KILUNVOR(Y,ORDFN) ; -- Delete UNVERIFIED ORDER notification if none remaining within current admission/30 days
N DFN,ORDG,ORLST,ORBDT,OREDT,ORDDT,VAIN,VAERR,VA200 S ORDG=$$DG^ORQOR1("ALL")
S OREDT=$$NOW^XLFDT
S ORDDT=$$FMADD^XLFDT(OREDT,"-90")
;get current admission date/time:
S DFN=ORDFN,VA200="" D INP^VADPT
S ORBDT=$P($G(VAIN(7)),U)
S ORBDT=$S('$L($G(ORBDT)):$$FMADD^XLFDT(OREDT,"-30"),1:ORBDT) ;<= if no admission use past 30 days
S ORBDT=$S(ORDDT>ORBDT:ORDDT,1:ORBDT) ;max past days to use is 90 days
D AGET^ORWORR(.ORLST,ORDFN,9,ORDG,ORBDT,OREDT)
Q:+(@ORLST@(.1)) ;more left
N XQAKILL,ORVP,ORNIFN
S ORNIFN=$O(^ORD(100.9,"B","UNVERIFIED ORDER",0)),ORVP=ORDFN_";DPT("
S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN)
I $D(XQAID) D DELETE^XQALERT
I '$D(XQAID) S XQAID=$P($G(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN D DELETEA^XQALERT K XQAID
Q
KILUNVMD(Y,ORDFN) ; -- Delete UNVERIFIED MEDS notification if none remaining within current admission/30 days
N DFN,ORDG,ORLST,ORBDT,OREDT,ORDDT S ORDG=$$DG^ORQOR1("RX")
S OREDT=$$NOW^XLFDT
S ORDDT=$$FMADD^XLFDT(OREDT,"-90")
;get current admission date/time:
S DFN=ORDFN,VA200="" D INP^VADPT
S ORBDT=$P($G(VAIN(7)),U)
S ORBDT=$S('$L($G(ORBDT)):$$FMADD^XLFDT(OREDT,"-30"),1:ORBDT) ;<= if no admission use past 30 days
S ORBDT=$S(ORDDT>ORBDT:ORDDT,1:ORBDT) ;max past days to use is 90 days
D AGET^ORWORR(.ORLST,ORDFN,9,ORDG,ORBDT,OREDT)
Q:+(@ORLST@(.1)) ;more left
N XQAKILL,ORVP,ORNIFN
S ORNIFN=$O(^ORD(100.9,"B","UNVERIFIED MEDICATION ORDER",0)),ORVP=ORDFN_";DPT("
S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN)
I $D(XQAID) D DELETE^XQALERT
I '$D(XQAID) S XQAID=$P($G(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN D DELETEA^XQALERT K XQAID
Q
ESORD(ORY,XQAID) ;order(s) requiring electronic signature follow-up
K XQAKILL
N ORPT,ORDG,ORBXQAID,ORY,ORX,ORZ,ORDERS,ORDNUM,ORQUIT,ORBLMDEL
S ORBXQAID=XQAID,ORDERS=0,ORQUIT=0
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
S ORDG=$$DG^ORQOR1("ALL")
;the FLG code for UNSIGNED orders in ORQ1 is '11'
;get unsigned orders - if none exist, delete alert then quit:
D EN^ORQ1(ORPT_";DPT(",ORDG,11,"","","",0,0)
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
;
;user does not have ORES key, delete user's alert:
I '$D(^XUSEC("ORES",DUZ)) S XQAKILL=1 D DEL^ORB3FUP1(.ORY,ORBXQAID) K ^TMP("ORR",$J) Q
;
;if prov is NOT linked to pt via attending, primary or teams:
I $$PPLINK^ORQPTQ1(DUZ,ORPT)=0 D
.S ORX="" F S ORX=$O(^TMP("ORR",$J,ORX)) Q:ORX=""!(ORDERS=1) D
..S ORZ="" F S ORZ=$O(^TMP("ORR",$J,ORX,ORZ)) Q:+ORZ=0!(ORDERS=1) D
...S ORDNUM=^TMP("ORR",$J,ORX,ORZ)
...;quit if this unsigned order's last action was made by the user
...I DUZ=+$$UNSIGNOR^ORQOR2(ORDNUM) S ORDERS=1
.I ORDERS'=1 D ;provider has no outstanding unsigned orders for pt
..S XQAKILL=1 D DEL^ORB3FUP1(.ORY,ORBXQAID) ;delete alert for this user
K ^TMP("ORR",$J)
Q
;
TXTFUP(ROOT,DFN,NOTIF,XQADATA) ; Follow-up for text messages
;
I NOTIF=67 D CHGRAD
Q
;
CHGRAD ;GUI follow-up for Imaging Request Changed (#67)
S ROOT=$NA(^TMP($J,"RAE4"))
K @ROOT
D SET1^RAO7PC4 ;DBIA #3563
Q
;
GETSORT(ORY) ;return notification sort method^direction for user/division/system/pkg
S ORY=$$GET^XPAR("ALL","ORB SORT METHOD",1,"I")_U_$$GET^XPAR("ALL","ORB SORT DIRECTION",1,"I")
Q
;
SETSORT(ORERR,SORT,DIR) ;set notification sort method^direction for user
D EN^XPAR(DUZ_";VA(200,","ORB SORT METHOD",1,SORT,.ORERR)
I $L($G(DIR)) D EN^XPAR(DUZ_";VA(200,","ORB SORT DIRECTION",1,DIR,.ORERR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWORB 14375 printed Oct 16, 2024@18:37:26 Page 2
ORWORB ; SLC/DEE,REV,CLA,WAT - RPC FUNCTIONS WHICH RETURN USER ALERT ;03/01/23 12:43
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,148,173,190,215,243,296,329,334,410,377,498,405,596**;Dec 17, 1997;Build 7
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
+4 ; External reference to ^DPT( supported by IA 10035
+5 ; External reference to ^XTV(8992 supported by IA 2689
+6 ; External reference to ^XTV(8992.1 supported by IA 7063
+7 ; External reference to ^VA(200,5 supported by IA 4329
+8 ; External reference to ^XUSEC( supported by IA 10076
+9 ; External reference to RAO7PC4 supported by IA 3563
+10 ; External reference to TIUSRVLO supported by IA 2834
+11 ; External reference to VADPT supported by IA 10061
+12 ; External reference to XLFDT supported by IA 10103
+13 ; External reference to XPAR supported by IA 2263
+14 ; External reference to XQALDATA supported by IA 4834
+15 ; External reference to XQALERT supported by IA 10081
+16 ; External reference to XQALBUTL supported by IA 2788
+17 ;
+18 QUIT
GETLTXT(ORY,ORAID) ;get the long text for an alert
+1 NEW ORDATA
+2 DO ALERTDAT^XQALBUTL(ORAID,"ORDATA")
+3 SET ORY(1)=""
+4 IF $DATA(ORDATA(4,1))
NEW ORI
SET ORI=0
FOR
SET ORI=$ORDER(ORDATA(4,ORI))
if 'ORI
QUIT
Begin DoDot:1
+5 SET ORY(ORI)=ORDATA(4,ORI)
End DoDot:1
+6 QUIT
+7 ;
URGENLST(ORY) ;return array of the urgency for the notification
+1 NEW ORSRV,ORERROR
+2 SET ORSRV=$GET(^VA(200,DUZ,5))
IF +ORSRV>0
SET ORSRV=$PIECE(ORSRV,U)
+3 DO GETLST^XPAR(.ORY,"USR^SRV.`"_$GET(ORSRV)_"^DIV^SYS^PKG","ORB URGENCY","I",.ORERROR)
+4 QUIT
+5 ;
FASTUSER(ORY,ORDEFFLG) ;return current user's notifications across all patients
+1 ; ORDEFFLG: setting this to 1 causes the alerts API to exclude deferred alerts for this user
+2 ; defaults to 1 if not passed in
+3 NEW STRTDATE,STOPDATE,ORTOT,I,ORURG,URG,ORN,SORT,ORN0,URGLIST,REMLIST,REM,NONORLST,NONOR
+4 NEW ALRT,ALRTDT,ALRTPT,ALRTMSG,ALRTI,ALRTLOC,ALRTXQA,J,FWDBY,PRE,ALRTDFN,FROMFAST
+5 KILL ^TMP("ORB",$JOB),^TMP("ORBG",$JOB)
+6 SET STRTDATE=""
SET STOPDATE=""
SET FWDBY="Forwarded by: "
SET FROMFAST=1
+7 DO GETUSER1^XQALDATA("^TMP(""ORB"",$J)",DUZ,STRTDATE,STOPDATE,$GET(ORDEFFLG,1))
+8 DO USERLIST(.ORY,STRTDATE,STOPDATE)
+9 QUIT
+10 ;
PROUSER(ORY,STRTDATE,STOPDATE,MAXRET,PROONLY) ;return current user's processed notifications for a specified date range
+1 if '$$GET^XPAR("SYS","OR RTN PROCESSED ALERTS")
QUIT
+2 NEW FWDBY
+3 KILL ^TMP("ORB",$JOB),^TMP("ORBG",$JOB)
+4 SET FWDBY="Forwarded by: "
+5 DO GETUSER2^XQALDATA("^TMP(""ORB"",$J)",DUZ,STRTDATE,STOPDATE,MAXRET,PROONLY)
+6 DO USERLIST(.ORY,STRTDATE,STOPDATE)
+7 QUIT
USERLIST(ORY,STRTDATE,STOPDATE) ;process for obtaining user's notifications
+1 NEW ORTOT,I,ORURG,URG,ORN,SORT,ORN0,URGLIST,REMLIST,REM,NONORLST,NONOR
+2 NEW ALRT,ALRTDT,ALRTPT,ALRTMSG,ALRTI,ALRTLOC,ALRTXQA,J,PRE,ALRTDFN,ORRMVD
+3 SET ORTOT=^TMP("ORB",$JOB)
+4 DO URGLIST^ORQORB(.URGLIST)
+5 DO REMLIST^ORQORB(.REMLIST)
+6 DO REMNONOR^ORQORB(.NONORLST)
+7 SET J=0
+8 FOR I=1:1:ORTOT
Begin DoDot:1
+9 NEW ORPROV,ORBIRAD
+10 SET ALRTDFN=""
SET REM=""
+11 SET ALRT=^TMP("ORB",$JOB,I)
+12 SET PRE=$EXTRACT(ALRT,1,1)
+13 ; XQAID expected
SET ALRTXQA=$PIECE(ALRT,U,2)
if ALRTXQA=""
QUIT
+14 SET NONOR=""
FOR
SET NONOR=$ORDER(NONORLST(NONOR))
if NONOR=""
QUIT
Begin DoDot:2
+15 ;allow this type of alert to be Removed
IF ALRTXQA[NONOR
SET REM=1
End DoDot:2
+16 SET ALRTMSG=$PIECE($PIECE(ALRT,U),PRE_" ",2)
+17 ;S ALRTMSG=$P($P(ALRT,U),PRE,2,99),ALRTMSG=$$TRIM^XLFSTR(ALRTMSG,"L")
+18 ;not forwarded alert info/comment
IF $EXTRACT(ALRT,4,8)'="-----"
Begin DoDot:2
+19 SET ORRMVD=0
+20 SET ORURG="n/a"
+21 SET ALRTI=$PIECE(ALRT," ")
+22 SET ALRTPT=""
+23 SET ALRTLOC=""
+24 ; *596 ajb
+25 IF $EXTRACT($PIECE(ALRTXQA,";"),1,3)="TIU"
Begin DoDot:3
+26 NEW ALRT,NODE,X,XTVDA,Y
SET XTVDA=$ORDER(^XTV(8992.1,"B",ALRTXQA,0))
if 'XTVDA
QUIT
+27 ; full text of alert data
SET NODE=$GET(^XTV(8992.1,XTVDA,1))
if NODE=""
QUIT
+28 SET $PIECE(ALRT,U,2)=$PIECE($PIECE(NODE,U),":")
SET $PIECE(ALRT,U,4)=$SELECT(ALRT[" STAT ":"HIGH",1:"Moderate")
+29 SET X=$PIECE(ALRTXQA,";",3)
SET $PIECE(Y,"/",1)=$EXTRACT(X,4,5)
SET $PIECE(Y,"/",2)=$EXTRACT(X,6,7)
SET $PIECE(Y,"/",3)=(1700+$EXTRACT(X,1,3))
+30 SET X=$EXTRACT($PIECE(X,".",2)_"0000",1,4)
SET $PIECE(Y,"@",2)=$EXTRACT(X,1,2)_":"_$EXTRACT(X,3,4)
SET $PIECE(ALRT,U,5)=Y
+31 SET $PIECE(ALRT,U,6)=$PIECE($PIECE(NODE,U),": ",2)
SET $PIECE(ALRT,U,8)=ALRTXQA
SET $PIECE(ALRT,U,9)=REM_U
+32 SET J=J+1
SET ^TMP("ORBG",$JOB,J)=ALRT
End DoDot:3
QUIT
+33 ; *596 ajb
+34 IF $PIECE(ALRTXQA,",")="OR"
Begin DoDot:3
+35 NEW ALRTIEN,ORIEN,P04,ORPOUT
+36 ; direct read ICR #7063
SET ALRTIEN=$ORDER(^XTV(8992.1,"B",ALRTXQA,0))
if ALRTIEN'>0
QUIT
+37 ; Q:ORIEN'>0 ; direct read ICR #7063
SET ORIEN=+$GET(^XTV(8992.1,ALRTIEN,2))
+38 SET P04=$PIECE($GET(^OR(100,ORIEN,0)),U,4)
IF +P04
SET ORPROV=$$GET1^DIQ(200,P04,.01)
+39 SET ORN=$PIECE($PIECE(ALRTXQA,";"),",",3)
+40 SET URG=$GET(URGLIST(ORN))
+41 SET ORURG=$SELECT(URG=1:"HIGH",URG=2:"Moderate",1:"low")
+42 SET REM=$GET(REMLIST(ORN))
+43 SET ORN0=^ORD(100.9,ORN,0)
+44 SET ALRTI=$SELECT(ORN=90:"L",$PIECE(ORN0,U,6)="INFODEL":"I",1:"")
+45 SET ALRTDFN=$PIECE(ALRTXQA,",",2)
+46 SET ALRTLOC=$GET(^DPT(+$GET(ALRTDFN),.1))
+47 IF $$ISSMIEN^ORBSMART(ORN)
Begin DoDot:4
+48 NEW ORSMBY
+49 DO ALTDATA^PXRMCALT(.ORPOUT,ALRTDFN,ALRTXQA)
+50 IF $GET(ORPOUT("DATA","RADIOLOGY REPORT FOUND"))=0
DO DEL^ORB3FUP1(.ORSMBY,ALRTXQA,0)
SET ORRMVD=1
QUIT
+51 IF $LENGTH($GET(ORPOUT("DATA",1,"DIAGNOSIS")))>0
SET ORBIRAD=$GET(ORPOUT("DATA",1,"DIAGNOSIS"))
End DoDot:4
End DoDot:3
+52 IF ORRMVD
QUIT
+53 SET ALRTI=$SELECT(ALRTI="I":"I",ALRTI="L":"L",1:"")
+54 ;WAT
IF (ALRT["): ")!($GET(ORN)=27&(ALRT[") CV"))
Begin DoDot:3
+55 SET ALRTPT=$PIECE(ALRT,": ")
+56 SET ALRTPT=$EXTRACT(ALRTPT,4,$LENGTH(ALRTPT))
+57 ;S ALRTPT=$P(ALRTPT,PRE,2,99),ALRTPT=$$TRIM^XLFSTR(ALRTPT,"L")
+58 ;WAT
IF $GET(ORN)=27&(ALRT[") CV")
SET ALRTMSG=$PIECE($PIECE(ALRT,U),": ",2)
+59 ;WAT
IF '$TEST
SET ALRTMSG=$PIECE($PIECE(ALRT,U),"): ",2)
+60 IF $EXTRACT(ALRTMSG,1,1)="["
Begin DoDot:4
+61 if '$LENGTH(ALRTLOC)
SET ALRTLOC=$PIECE($PIECE(ALRTMSG,"]"),"[",2)
+62 SET ALRTMSG=$PIECE(ALRTMSG,"] ",2)
End DoDot:4
End DoDot:3
+63 IF '$LENGTH($GET(ALRTPT))
SET ALRTPT="no patient"
+64 SET ALRTDT=$PIECE(ALRTXQA,";",3)
+65 SET ALRTDT=$PIECE(ALRTDT,".")_"."_$EXTRACT($PIECE(ALRTDT,".",2)_"0000",1,4)
+66 SET ALRTDT=$EXTRACT(ALRTDT,4,5)_"/"_$EXTRACT(ALRTDT,6,7)_"/"_($EXTRACT(ALRTDT,1,3)+1700)_"@"_$EXTRACT($PIECE(ALRTDT,".",2),1,2)_":"_$EXTRACT($PIECE(ALRTDT,".",2),3,4)
+67 ;if SMART alert, append BIRAD results to ALRTMSG
+68 IF $GET(ORBIRAD)'=""
SET ALRTMSG=ALRTMSG_" - RESULTS: "_ORBIRAD
+69 SET J=J+1
SET ^TMP("ORBG",$JOB,J)=ALRTI_U_ALRTPT_U_ALRTLOC_U_ORURG_U_ALRTDT_U
+70 SET ^TMP("ORBG",$JOB,J)=^TMP("ORBG",$JOB,J)_ALRTMSG_U_U_ALRTXQA_U_$GET(REM)_U
End DoDot:2
+71 IF ORRMVD
QUIT
+72 ;if alert forward info/comment:
+73 IF $EXTRACT(ALRTMSG,1,5)="-----"
Begin DoDot:2
+74 SET ALRTMSG=$PIECE(ALRTMSG,"-----",2)
+75 IF $EXTRACT(ALRTMSG,1,14)=FWDBY
Begin DoDot:3
+76 SET J=J+1
SET ^TMP("ORBG",$JOB,J)=FWDBY_U_$PIECE($PIECE(ALRTMSG,FWDBY,2),"Generated: ")_$PIECE($PIECE(ALRTMSG,FWDBY,2),"Generated: ",2)
End DoDot:3
+77 IF '$TEST
SET ^TMP("ORBG",$JOB,J)=^TMP("ORBG",$JOB,J)_U_""""_ALRTMSG_""""
End DoDot:2
+78 ;I $G(ORPROV)'="" S ^TMP("ORBG",$J,J)=^TMP("ORBG",$J,J)_U_ORPROV ; ajb
+79 ;if this is for processed alerts, add additional data into pieces 15 through 22
+80 IF $DATA(^TMP("ORB",$JOB,J,"PROCESSED"))
Begin DoDot:2
+81 SET $PIECE(^TMP("ORBG",$JOB,J),U,15)=^TMP("ORB",$JOB,J,"PROCESSED")
End DoDot:2
+82 ;if this is for pending alerts, add "surrogate for" into piece 15
+83 IF $GET(FROMFAST)
NEW ALRTIEN,DUZIEN,SURRFOR
Begin DoDot:2
+84 SET ALRTIEN=$ORDER(^XTV(8992.1,"B",ALRTXQA,0))
if 'ALRTIEN
QUIT
+85 SET DUZIEN=$ORDER(^XTV(8992.1,ALRTIEN,20,"B",DUZ,""))
if 'DUZIEN
QUIT
+86 ; get first "surrogate for" and return returns 0 if empty
SET SURRFOR=+$GET(^XTV(8992.1,ALRTIEN,20,DUZIEN,3,1,0))
+87 IF SURRFOR
SET $PIECE(^TMP("ORBG",$JOB,J),U,15)=$PIECE(^VA(200,SURRFOR,0),U)
End DoDot:2
End DoDot:1
+88 SET ^TMP("ORBG",$JOB)=""
+89 SET ORY=$NAME(^TMP("ORBG",$JOB))
+90 KILL ^TMP("ORB",$JOB)
+91 QUIT
+92 ;
GETDATA(ORY,XQAID,PFLAG) ; return XQADATA for an alert
+1 NEW SHOWADD
+2 SET ORY=""
+3 if $GET(XQAID)=""!('$DATA(^XTV(8992,"AXQA",XQAID)))
QUIT
+4 IF +$GET(PFLAG)
SET XQADATA=$$GETACT2(XQAID)
IF 1
+5 IF '$TEST
DO GETACT^XQALERT(XQAID)
+6 SET ORY=XQADATA
+7 IF ($EXTRACT(XQAID,1,3)="TIU")
IF (+ORY>0)
Begin DoDot:1
+8 SET SHOWADD=1
+9 SET ORY=ORY_$$RESOLVE^TIUSRVLO(+ORY)
End DoDot:1
+10 KILL XQAID,XQADATA,XQAOPT,XQAROU
+11 QUIT
+12 ;
GETACT2(ALERTID) ; Returns first XQADATA found, for alerts for other users
+1 NEW XQADATA,XDUZ,XQI,XQX,XQZ,DONE
+2 SET XQADATA=""
SET XDUZ=""
SET DONE=0
+3 FOR
if DONE
QUIT
SET XDUZ=$ORDER(^XTV(8992,"AXQA",ALERTID,XDUZ))
if 'XDUZ
QUIT
Begin DoDot:1
+4 SET XQI=$ORDER(^XTV(8992,"AXQA",ALERTID,XDUZ,0))
+5 if XQI'>0
QUIT
+6 SET XQX=$GET(^XTV(8992,XDUZ,"XQA",XQI,0))
if XQX=""
QUIT
+7 SET XQZ=$GET(^XTV(8992,XDUZ,"XQA",XQI,1))
+8 SET XQADATA=$SELECT(XQZ'="":XQZ,1:$PIECE(XQX,U,9,99))
+9 IF XQADATA'=""
SET DONE=1
End DoDot:1
+10 QUIT XQADATA
+11 ;
KILUNSNO(Y,ORVP) ; Delete unsigned order alerts if no unsigned orders remaining
+1 SET ORVP=ORVP_";DPT("
+2 DO UNOTIF^ORCSIGN
+3 QUIT
+4 ;
UNFLORD(ORY,DFN,XQAID) ; -- auto-unflag orders?/delete alert
+1 QUIT
+2 ;*334/VMP-DJE Auto unflag has been disabled
+3 ;Q:'$L(DFN)!('$L(XQAID))
+4 ;N ORI,ORIFN,ORA,XQAKILL,ORN,ORBY,ORAUTO,ORUNF
+5 ;S ORN=+$O(^ORD(100.9,"B","FLAGGED ORDERS",0))
+6 ;;S XQAKILL=$$XQAKILL^ORB3F1(ORN)
+7 ;D LIST^ORQOR1(.ORBY,DFN,"ALL",12,"","")
+8 ;S ORAUTO=+$$GET^XPAR("ALL","ORPF AUTO UNFLAG")
+9 ;S ORI=0 F S ORI=$O(ORBY(ORI)) Q:ORI'>0 D
+10 ;. I ORAUTO D ; unflag
+11 ;. . ;DJE-VM *329 - use GUI RPC call to make it run the proper code, only run it if the user sees it.
+12 ;. . ;S ORUNF=+$E($$NOW^XLFDT,1,12)_U_DUZ_"^Auto-Unflagged"
+13 ;. . ;S ORIFN=$P(ORBY(ORI),U),ORA=+$P(ORIFN,";",2)
+14 ;. . ;I ORIFN,$D(^OR(100,+ORIFN,0)) S $P(^(8,ORA,3),U)=0,$P(^(3),U,6,8)=ORUNF D MSG^ORCFLAG(ORIFN) ; unflag
+15 ;. . S ORIFN=+ORBY(ORI)
+16 ;. . I $D(^OR(100,ORIFN,0)),'$$FLAGRULE^ORWORR1(ORIFN) D UNFLAG^ORWDXA(.ORUNF,$P(ORBY(ORI),U),"Auto-Unflagged")
+17 ;;DJE-VM *329 - ORWDXA is smarter and deletes the appropriate alert(s)
+18 ;;I (ORAUTO)!(+$G(ORBY(1))=0) D DELETE^XQALERT
+19 ;Q
KILEXMED(Y,ORDFN) ; -- Delete expiring meds notification if no expiring meds remaining
+1 NEW ORDG,ORLST,OROI,LIST
SET ORDG=$$DG^ORQOR1("RX")
+2 NEW XQAKILL,ORNIFN,ORVP
+3 SET LIST("INPT")=1
+4 SET LIST("OUTPT")=1
+5 DO AGET^ORWORR(.ORLST,ORDFN,5,ORDG)
+6 ;selected code copied from EXPIR^ORB3TIM2
+7 ;if there are orders
IF +(@ORLST@(.1))
Begin DoDot:1
+8 KILL LIST("OUTPT")
+9 SET OROI=.5
+10 NEW ORSCHFIL,ORBZ
+11 SET ORSCHFIL=$$TERMLKUP^ORB31(.ORBZ,"ONE TIME MED")
+12 FOR
SET OROI=$ORDER(@ORLST@(OROI))
if 'OROI
QUIT
Begin DoDot:2
+13 NEW EXORN
SET EXORN=+@ORLST@(OROI)
+14 ;skip outpt meds
+15 if $$DGRX^ORQOR2(EXORN)="OUTPATIENT MEDICATIONS"
QUIT
+16 ;skip one time meds
+17 NEW ONETIME,ORSCH,ORBI
SET ONETIME=0
+18 IF $DATA(ORBZ)
IF (+$GET(ORSCHFIL)=51.1)
FOR ORBI=1:1:ORBZ
Begin DoDot:3
+19 SET ORSCH=$PIECE(ORBZ(ORBI),U,2)
+20 IF ORSCH=$$VALUE^ORCSAVE2(EXORN,"SCHEDULE")
SET ONETIME=1
QUIT
End DoDot:3
+21 if +$GET(ONETIME)=1
QUIT
+22 ;don't delete notification if there are valid inpt orders
+23 KILL LIST("INPT")
End DoDot:2
if '$GET(LIST("INPT"))
QUIT
End DoDot:1
+24 SET OROI=""
+25 FOR
SET OROI=$ORDER(LIST(OROI))
if '$LENGTH(OROI)
QUIT
Begin DoDot:1
+26 SET ORNIFN=$ORDER(^ORD(100.9,"B","MEDICATIONS EXPIRING - "_OROI,0))
SET ORVP=ORDFN_";DPT("
+27 if '$LENGTH($GET(ORNIFN))
QUIT
+28 ; expiring meds notif
SET XQAKILL=$$XQAKILL^ORB3F1(ORNIFN)
+29 IF $DATA(XQAID)
DO DELETE^XQALERT
+30 IF '$DATA(XQAID)
SET XQAID=$PIECE($GET(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN
DO DELETEA^XQALERT
KILL XQAID
End DoDot:1
+31 QUIT
KILEXOI(Y,ORDFN,ORNIFN) ; -- Delete expiring flagged OI notification if no flagged expiring OI remaining
+1 NEW ORDG,ORLST
SET ORDG=$$DG^ORQOR1("ALL")
+2 DO AGET^ORWORR(.ORLST,ORDFN,5,ORDG)
+3 ;more left
if +(@ORLST@(.1))
QUIT
+4 NEW XQAKILL,ORVP
+5 SET ORVP=ORDFN_";DPT("
+6 ; flagged expiring OI notifications
SET XQAKILL=$$XQAKILL^ORB3F1(ORNIFN)
+7 IF $DATA(XQAID)
DO DELETE^XQALERT
+8 IF '$DATA(XQAID)
SET XQAID=$PIECE($GET(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN
DO DELETEA^XQALERT
KILL XQAID
+9 QUIT
KILUNVOR(Y,ORDFN) ; -- Delete UNVERIFIED ORDER notification if none remaining within current admission/30 days
+1 NEW DFN,ORDG,ORLST,ORBDT,OREDT,ORDDT,VAIN,VAERR,VA200
SET ORDG=$$DG^ORQOR1("ALL")
+2 SET OREDT=$$NOW^XLFDT
+3 SET ORDDT=$$FMADD^XLFDT(OREDT,"-90")
+4 ;get current admission date/time:
+5 SET DFN=ORDFN
SET VA200=""
DO INP^VADPT
+6 SET ORBDT=$PIECE($GET(VAIN(7)),U)
+7 ;<= if no admission use past 30 days
SET ORBDT=$SELECT('$LENGTH($GET(ORBDT)):$$FMADD^XLFDT(OREDT,"-30"),1:ORBDT)
+8 ;max past days to use is 90 days
SET ORBDT=$SELECT(ORDDT>ORBDT:ORDDT,1:ORBDT)
+9 DO AGET^ORWORR(.ORLST,ORDFN,9,ORDG,ORBDT,OREDT)
+10 ;more left
if +(@ORLST@(.1))
QUIT
+11 NEW XQAKILL,ORVP,ORNIFN
+12 SET ORNIFN=$ORDER(^ORD(100.9,"B","UNVERIFIED ORDER",0))
SET ORVP=ORDFN_";DPT("
+13 SET XQAKILL=$$XQAKILL^ORB3F1(ORNIFN)
+14 IF $DATA(XQAID)
DO DELETE^XQALERT
+15 IF '$DATA(XQAID)
SET XQAID=$PIECE($GET(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN
DO DELETEA^XQALERT
KILL XQAID
+16 QUIT
KILUNVMD(Y,ORDFN) ; -- Delete UNVERIFIED MEDS notification if none remaining within current admission/30 days
+1 NEW DFN,ORDG,ORLST,ORBDT,OREDT,ORDDT
SET ORDG=$$DG^ORQOR1("RX")
+2 SET OREDT=$$NOW^XLFDT
+3 SET ORDDT=$$FMADD^XLFDT(OREDT,"-90")
+4 ;get current admission date/time:
+5 SET DFN=ORDFN
SET VA200=""
DO INP^VADPT
+6 SET ORBDT=$PIECE($GET(VAIN(7)),U)
+7 ;<= if no admission use past 30 days
SET ORBDT=$SELECT('$LENGTH($GET(ORBDT)):$$FMADD^XLFDT(OREDT,"-30"),1:ORBDT)
+8 ;max past days to use is 90 days
SET ORBDT=$SELECT(ORDDT>ORBDT:ORDDT,1:ORBDT)
+9 DO AGET^ORWORR(.ORLST,ORDFN,9,ORDG,ORBDT,OREDT)
+10 ;more left
if +(@ORLST@(.1))
QUIT
+11 NEW XQAKILL,ORVP,ORNIFN
+12 SET ORNIFN=$ORDER(^ORD(100.9,"B","UNVERIFIED MEDICATION ORDER",0))
SET ORVP=ORDFN_";DPT("
+13 SET XQAKILL=$$XQAKILL^ORB3F1(ORNIFN)
+14 IF $DATA(XQAID)
DO DELETE^XQALERT
+15 IF '$DATA(XQAID)
SET XQAID=$PIECE($GET(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN
DO DELETEA^XQALERT
KILL XQAID
+16 QUIT
ESORD(ORY,XQAID) ;order(s) requiring electronic signature follow-up
+1 KILL XQAKILL
+2 NEW ORPT,ORDG,ORBXQAID,ORY,ORX,ORZ,ORDERS,ORDNUM,ORQUIT,ORBLMDEL
+3 SET ORBXQAID=XQAID
SET ORDERS=0
SET ORQUIT=0
+4 ;get pt dfn from xqaid
SET ORPT=$PIECE($PIECE(XQAID,";"),",",2)
+5 SET ORDG=$$DG^ORQOR1("ALL")
+6 ;the FLG code for UNSIGNED orders in ORQ1 is '11'
+7 ;get unsigned orders - if none exist, delete alert then quit:
+8 DO EN^ORQ1(ORPT_";DPT(",ORDG,11,"","","",0,0)
+9 SET ORX=""
SET ORX=$ORDER(^TMP("ORR",$JOB,ORX))
if ORX=""
QUIT
IF +$GET(^TMP("ORR",$JOB,ORX,"TOT"))<1
DO DEL^ORB3FUP1(.ORY,ORBXQAID)
KILL ^TMP("ORR",$JOB)
QUIT
+10 ;
+11 ;user does not have ORES key, delete user's alert:
+12 IF '$DATA(^XUSEC("ORES",DUZ))
SET XQAKILL=1
DO DEL^ORB3FUP1(.ORY,ORBXQAID)
KILL ^TMP("ORR",$JOB)
QUIT
+13 ;
+14 ;if prov is NOT linked to pt via attending, primary or teams:
+15 IF $$PPLINK^ORQPTQ1(DUZ,ORPT)=0
Begin DoDot:1
+16 SET ORX=""
FOR
SET ORX=$ORDER(^TMP("ORR",$JOB,ORX))
if ORX=""!(ORDERS=1)
QUIT
Begin DoDot:2
+17 SET ORZ=""
FOR
SET ORZ=$ORDER(^TMP("ORR",$JOB,ORX,ORZ))
if +ORZ=0!(ORDERS=1)
QUIT
Begin DoDot:3
+18 SET ORDNUM=^TMP("ORR",$JOB,ORX,ORZ)
+19 ;quit if this unsigned order's last action was made by the user
+20 IF DUZ=+$$UNSIGNOR^ORQOR2(ORDNUM)
SET ORDERS=1
End DoDot:3
End DoDot:2
+21 ;provider has no outstanding unsigned orders for pt
IF ORDERS'=1
Begin DoDot:2
+22 ;delete alert for this user
SET XQAKILL=1
DO DEL^ORB3FUP1(.ORY,ORBXQAID)
End DoDot:2
End DoDot:1
+23 KILL ^TMP("ORR",$JOB)
+24 QUIT
+25 ;
TXTFUP(ROOT,DFN,NOTIF,XQADATA) ; Follow-up for text messages
+1 ;
+2 IF NOTIF=67
DO CHGRAD
+3 QUIT
+4 ;
CHGRAD ;GUI follow-up for Imaging Request Changed (#67)
+1 SET ROOT=$NAME(^TMP($JOB,"RAE4"))
+2 KILL @ROOT
+3 ;DBIA #3563
DO SET1^RAO7PC4
+4 QUIT
+5 ;
GETSORT(ORY) ;return notification sort method^direction for user/division/system/pkg
+1 SET ORY=$$GET^XPAR("ALL","ORB SORT METHOD",1,"I")_U_$$GET^XPAR("ALL","ORB SORT DIRECTION",1,"I")
+2 QUIT
+3 ;
SETSORT(ORERR,SORT,DIR) ;set notification sort method^direction for user
+1 DO EN^XPAR(DUZ_";VA(200,","ORB SORT METHOD",1,SORT,.ORERR)
+2 IF $LENGTH($GET(DIR))
DO EN^XPAR(DUZ_";VA(200,","ORB SORT DIRECTION",1,DIR,.ORERR)
+3 QUIT
