Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORWORB

ORWORB.m

Go to the documentation of this file.
  1. ORWORB ; SLC/DEE,REV,CLA,WAT - RPC FUNCTIONS WHICH RETURN USER ALERT ;Aug 13, 2024@09:39:58
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,148,173,190,215,243,296,329,334,410,377,498,405,596,535**;Dec 17, 1997;Build 20
  1. ;;Per VHA Directive 2004-038, this routine should not be modified
  1. ;
  1. ; Reference to ^DPT( in ICR #10035
  1. ; Reference to ^XTV(8992 in ICR #2689
  1. ; Reference to ^VA(200,5 in ICR #4329
  1. ; Reference to ^XUSEC( in ICR #10076
  1. ; Reference to SET1^RAO7PC4 in ICR #3563
  1. ; Reference to $$RESOLVE^TIUSRVLO in ICR #2834
  1. ; Reference to INP^VADPT in ICR #10061
  1. ; Reference to $$NOW^XLFDT,$$FMADD^XLFDT in ICR #10103
  1. ; Reference to $$GET^XPAR,EN^XPAR,GETLST^XPAR in ICR #2263
  1. ; Reference to GETUSER1^XQALDATA,GETUSER2^XQALDATA in ICR #4834
  1. ; Reference to DELETE^XQALERT,DELETEA^XQALERT,GETACT^XQALERT in ICR #10081
  1. ; Reference to ALERTDAT^XQALBUTL,AHISTORY^XQALBUTL in ICR #2788
  1. ; Reference to ALTDATA^PXRMCALT in ICR #7258
  1. ; Reference to ^TIU(8925 in ICR #2937
  1. ; Reference to ^GMR(123 in ICR #2586
  1. ; Reference to ^SRF( in ICR #7436
  1. ; Reference to ^PSRX( in ICR #6149
  1. ; Reference to ^PS(52.41 in ICR #6148
  1. ; Reference to ^LRO(69,D0,1 in ICR #2407
  1. ; Reference to ^RAO(75.1 in ICR #3074
  1. ; Reference to ^RADPT(D0,'DT',D1,'P' in ICR #65
  1. ; Reference to ^LR( in ICR #525
  1. ; Reference to $$GET1^DIQ in ICR #2056
  1. ;
  1. Q
  1. GETLTXT(ORY,ORAID) ;get the long text for an alert
  1. N ORDATA
  1. D ALERTDAT^XQALBUTL(ORAID,"ORDATA")
  1. S ORY(1)=""
  1. I $D(ORDATA(4,1)) N ORI S ORI=0 F S ORI=$O(ORDATA(4,ORI)) Q:'ORI D
  1. .S ORY(ORI)=ORDATA(4,ORI)
  1. Q
  1. ;
  1. URGENLST(ORY) ;return array of the urgency for the notification
  1. N ORSRV,ORERROR
  1. S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
  1. D GETLST^XPAR(.ORY,"USR^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG","ORB URGENCY","I",.ORERROR)
  1. Q
  1. ;
  1. 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
  1. ; defaults to 1 if not passed in
  1. N STRTDATE,STOPDATE,ORTOT,I,ORURG,URG,ORN,SORT,ORN0,URGLIST,REMLIST,REM,NONORLST,NONOR
  1. N ALRT,ALRTDT,ALRTPT,ALRTMSG,ALRTI,ALRTLOC,ALRTXQA,J,FWDBY,PRE,ALRTDFN,FROMFAST
  1. K ^TMP("ORB",$J),^TMP("ORBG",$J)
  1. S STRTDATE="",STOPDATE="",FWDBY="Forwarded by: ",FROMFAST=1
  1. D GETUSER1^XQALDATA("^TMP(""ORB"",$J)",DUZ,STRTDATE,STOPDATE,$G(ORDEFFLG,1))
  1. D USERLIST(.ORY,STRTDATE,STOPDATE)
  1. Q
  1. ;
  1. PROUSER(ORY,STRTDATE,STOPDATE,MAXRET,PROONLY) ;return current user's processed notifications for a specified date range
  1. Q:'$$GET^XPAR("SYS","OR RTN PROCESSED ALERTS")
  1. N FWDBY
  1. K ^TMP("ORB",$J),^TMP("ORBG",$J)
  1. S FWDBY="Forwarded by: "
  1. D GETUSER2^XQALDATA("^TMP(""ORB"",$J)",DUZ,STRTDATE,STOPDATE,MAXRET,PROONLY)
  1. D USERLIST(.ORY,STRTDATE,STOPDATE)
  1. Q
  1. USERLIST(ORY,STRTDATE,STOPDATE) ;process for obtaining user's notifications
  1. N ORTOT,I,ORURG,URG,ORN,SORT,ORN0,URGLIST,REMLIST,REM,NONORLST,NONOR
  1. N ALRT,ALRTDT,ALRTPT,ALRTMSG,ALRTI,ALRTLOC,ALRTXQA,J,PRE,ALRTDFN,ORRMVD
  1. S ORTOT=^TMP("ORB",$J)
  1. D URGLIST^ORQORB(.URGLIST)
  1. D REMLIST^ORQORB(.REMLIST)
  1. D REMNONOR^ORQORB(.NONORLST)
  1. S J=0
  1. F I=1:1:ORTOT D
  1. .N ORPROV,ORBIRAD,ORALRTDAT,ORALRTXT
  1. .S ALRTDFN="",REM=""
  1. .S ALRT=^TMP("ORB",$J,I)
  1. .S PRE=$E(ALRT,1,1)
  1. .S ALRTXQA=$P(ALRT,U,2) Q:ALRTXQA="" ; XQAID expected
  1. .D ALERTDAT^XQALBUTL(ALRTXQA,"ORALRTDAT")
  1. .S ORALRTXT=$G(ORALRTDAT(1.01))
  1. .S NONOR="" F S NONOR=$O(NONORLST(NONOR)) Q:NONOR="" D
  1. ..I ALRTXQA[NONOR S REM=1 ;allow this type of alert to be Removed
  1. .S ALRTMSG=$P($P(ALRT,U),PRE_" ",2)
  1. .;S ALRTMSG=$P($P(ALRT,U),PRE,2,99),ALRTMSG=$$TRIM^XLFSTR(ALRTMSG,"L")
  1. .I $E(ALRT,4,8)'="-----" D ;not forwarded alert info/comment
  1. ..S ORRMVD=0
  1. ..S ORURG="n/a"
  1. ..S ALRTI=$P(ALRT," ")
  1. ..S ALRTPT=""
  1. ..S ALRTLOC=""
  1. .. ; *596 ajb
  1. . . I $E($P(ALRTXQA,";"),1,3)="TIU" D Q
  1. . . . N ALRT,NODE,ORIEN,ORREF,ORTIU,X,Y
  1. . . . S ORPROV="N/A"
  1. . . . I ORALRTXT="" Q ; full text of alert data
  1. . . . S $P(ALRT,U,2)=$P(ORALRTXT,":"),$P(ALRT,U,4)=$S(ALRT[" STAT ":"HIGH",1:"Moderate")
  1. . . . 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))
  1. . . . 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
  1. . . . S $P(ALRT,U,6)=$P(ORALRTXT,": ",2),$P(ALRT,U,8)=ALRTXQA,$P(ALRT,U,9)=REM_U
  1. . . . S J=J+1,^TMP("ORBG",$J,J)=ALRT
  1. . . . S ORTIU=+$G(ORALRTDAT(2)) D Q:'ORTIU
  1. . . . . N ORTIUTXT,ORTIUTXT6
  1. . . . . I ORTIU Q
  1. . . . . S ORTIUTXT=$P(ALRTXQA,";"),ORTIUTXT6=$E(ORTIUTXT,1,6)
  1. . . . . I "^TIUADD^TIUERR^"[ORTIUTXT6 S ORTIU=$E(ORTIUTXT,7,999) Q
  1. . . . . I ORTIUTXT?3A1.99999999N S ORTIU=$E(ORTIUTXT,4,999)
  1. . . . S ORIEN=+$P($G(^TIU(8925,ORTIU,12)),U,10) I 'ORIEN D
  1. . . . . S ORPROV="UNKNOWN"
  1. . . . . S ORREF=$P($G(^TIU(8925,ORTIU,14)),U,5) Q:ORREF=""
  1. . . . . I $P(ORREF,";",2)="GMR(123," S ORIEN=$P($G(^GMR(123,+ORREF,0)),U,3) I ORIEN="" S ORPROV="UNKNOWN"
  1. . . . . I $P(ORREF,";",2)="SRF(" S ORIEN=$P($G(^SRF(+ORREF,0)),U,14) I ORIEN="" S ORPROV="UNKNOWN"
  1. . . . I +ORIEN>0 S ORPROV=$$GETPRVNM(ORIEN)
  1. .. ; *596 ajb
  1. ..I $P(ALRTXQA,",")="OR" D
  1. ... N NOPROV,P04,ORPOUT
  1. ... S NOPROV=0
  1. ...S ORN=$P($P(ALRTXQA,";"),",",3)
  1. ...S URG=$G(URGLIST(ORN))
  1. ...S ORURG=$S(URG=1:"HIGH",URG=2:"Moderate",1:"low")
  1. ...S REM=$G(REMLIST(ORN))
  1. ...S ORN0=^ORD(100.9,ORN,0)
  1. ...S ALRTI=$S(ORN=90:"L",$P(ORN0,U,6)="INFODEL":"I",1:"")
  1. ...S ALRTDFN=$P(ALRTXQA,",",2)
  1. ...S ALRTLOC=$G(^DPT(+$G(ALRTDFN),.1))
  1. ...I $G(ORN)=6,$P(ALRT,U)["Your task #" S ALRTMSG=$E($P(ALRT,U),2,999),NOPROV=1,ORPROV="N/A"
  1. ...I 'NOPROV S ORPROV=$$GETPROV(ORN,ALRTDFN,.ORALRTDAT)
  1. ...I $$ISSMIEN^ORBSMART(ORN) D
  1. ....N ORSMBY
  1. ....D ALTDATA^PXRMCALT(.ORPOUT,ALRTDFN,ALRTXQA)
  1. ....I $G(ORPOUT("DATA","RADIOLOGY REPORT FOUND"))=0 D DEL^ORB3FUP1(.ORSMBY,ALRTXQA,0) S ORRMVD=1 Q
  1. ....I $L($G(ORPOUT("DATA",1,"DIAGNOSIS")))>0 S ORBIRAD=$G(ORPOUT("DATA",1,"DIAGNOSIS"))
  1. ..I ORRMVD Q
  1. ..S ALRTI=$S(ALRTI="I":"I",ALRTI="L":"L",1:"")
  1. ..I (ALRT["): ")!($G(ORN)=27&(ALRT[") CV")) D ;WAT
  1. ...S ALRTPT=$P(ALRT,": ")
  1. ...S ALRTPT=$E(ALRTPT,4,$L(ALRTPT))
  1. ...;S ALRTPT=$P(ALRTPT,PRE,2,99),ALRTPT=$$TRIM^XLFSTR(ALRTPT,"L")
  1. ...I $G(ORN)=27&(ALRT[") CV") S ALRTMSG=$P($P(ALRT,U),": ",2) ;WAT
  1. ...E S ALRTMSG=$P($P(ALRT,U),"): ",2) ;WAT
  1. ...I $E(ALRTMSG,1,1)="[" D
  1. ....S:'$L(ALRTLOC) ALRTLOC=$P($P(ALRTMSG,"]"),"[",2)
  1. ....S ALRTMSG=$P(ALRTMSG,"] ",2)
  1. ..I '$L($G(ALRTPT)) S ALRTPT="no patient"
  1. ..S ALRTDT=$P(ALRTXQA,";",3)
  1. ..S ALRTDT=$P(ALRTDT,".")_"."_$E($P(ALRTDT,".",2)_"0000",1,4)
  1. ..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)
  1. ..;if SMART alert, append BIRAD results to ALRTMSG
  1. ..I $G(ORBIRAD)'="" S ALRTMSG=ALRTMSG_" - RESULTS: "_ORBIRAD
  1. ..S J=J+1,^TMP("ORBG",$J,J)=ALRTI_U_ALRTPT_U_ALRTLOC_U_ORURG_U_ALRTDT_U
  1. ..S ^TMP("ORBG",$J,J)=^TMP("ORBG",$J,J)_ALRTMSG_U_U_ALRTXQA_U_$G(REM)_U
  1. .I ORRMVD Q
  1. .;if alert forward info/comment:
  1. .I $E(ALRTMSG,1,5)="-----" D
  1. ..S ALRTMSG=$P(ALRTMSG,"-----",2)
  1. ..I $E(ALRTMSG,1,14)=FWDBY D
  1. ...S J=J+1,^TMP("ORBG",$J,J)=FWDBY_U_$P($P(ALRTMSG,FWDBY,2),"Generated: ")_$P($P(ALRTMSG,FWDBY,2),"Generated: ",2)
  1. ..E S ^TMP("ORBG",$J,J)=^TMP("ORBG",$J,J)_U_""""_ALRTMSG_""""
  1. .I $G(ORPROV)'="" S ^TMP("ORBG",$J,J)=^TMP("ORBG",$J,J)_U_ORPROV ; ajb
  1. .;if this is for processed alerts, add additional data into pieces 15 through 22
  1. .I $D(^TMP("ORB",$J,J,"PROCESSED")) D
  1. ..S $P(^TMP("ORBG",$J,J),U,15)=^TMP("ORB",$J,J,"PROCESSED")
  1. .;if this is for pending alerts, add "surrogate for" into piece 15
  1. .I $G(FROMFAST) N DUZIEN,SURRFOR,ORALRTHST D
  1. ..D AHISTORY^XQALBUTL(ALRTXQA,"ORALRTHST")
  1. ..S DUZIEN=$O(ORALRTHST(20,"B",DUZ,"")) Q:'DUZIEN
  1. ..S SURRFOR=+$G(ORALRTHST(20,DUZIEN,3,1,0)) ; get first "surrogate for" and return returns 0 if empty
  1. ..I SURRFOR S $P(^TMP("ORBG",$J,J),U,15)=$P(^VA(200,SURRFOR,0),U)
  1. S ^TMP("ORBG",$J)=""
  1. S ORY=$NA(^TMP("ORBG",$J))
  1. K ^TMP("ORB",$J)
  1. Q
  1. ;
  1. GETDATA(ORY,XQAID,PFLAG) ; return XQADATA for an alert
  1. N SHOWADD
  1. S ORY=""
  1. Q:$G(XQAID)=""!('$D(^XTV(8992,"AXQA",XQAID)))
  1. I +$G(PFLAG) S XQADATA=$$GETACT2(XQAID) I 1
  1. E D GETACT^XQALERT(XQAID)
  1. S ORY=XQADATA
  1. I ($E(XQAID,1,3)="TIU"),(+ORY>0) D
  1. . S SHOWADD=1
  1. . S ORY=ORY_$$RESOLVE^TIUSRVLO(+ORY)
  1. K XQAID,XQADATA,XQAOPT,XQAROU
  1. Q
  1. ;
  1. GETACT2(ALERTID) ; Returns first XQADATA found, for alerts for other users
  1. N XQADATA,XDUZ,XQI,XQX,XQZ,DONE
  1. S XQADATA="",XDUZ="",DONE=0
  1. F Q:DONE S XDUZ=$O(^XTV(8992,"AXQA",ALERTID,XDUZ)) Q:'XDUZ D
  1. . S XQI=$O(^XTV(8992,"AXQA",ALERTID,XDUZ,0))
  1. . Q:XQI'>0
  1. . S XQX=$G(^XTV(8992,XDUZ,"XQA",XQI,0)) Q:XQX=""
  1. . S XQZ=$G(^XTV(8992,XDUZ,"XQA",XQI,1))
  1. . S XQADATA=$S(XQZ'="":XQZ,1:$P(XQX,U,9,99))
  1. . I XQADATA'="" S DONE=1
  1. Q XQADATA
  1. ;
  1. KILUNSNO(Y,ORVP) ; Delete unsigned order alerts if no unsigned orders remaining
  1. S ORVP=ORVP_";DPT("
  1. D UNOTIF^ORCSIGN
  1. Q
  1. ;
  1. UNFLORD(ORY,DFN,XQAID) ; -- auto-unflag orders?/delete alert
  1. Q
  1. ;*334/VMP-DJE Auto unflag has been disabled
  1. ;Q:'$L(DFN)!('$L(XQAID))
  1. ;N ORI,ORIFN,ORA,XQAKILL,ORN,ORBY,ORAUTO,ORUNF
  1. ;S ORN=+$O(^ORD(100.9,"B","FLAGGED ORDERS",0))
  1. ;;S XQAKILL=$$XQAKILL^ORB3F1(ORN)
  1. ;D LIST^ORQOR1(.ORBY,DFN,"ALL",12,"","")
  1. ;S ORAUTO=+$$GET^XPAR("ALL","ORPF AUTO UNFLAG")
  1. ;S ORI=0 F S ORI=$O(ORBY(ORI)) Q:ORI'>0 D
  1. ;. I ORAUTO D ; unflag
  1. ;. . ;DJE-VM *329 - use GUI RPC call to make it run the proper code, only run it if the user sees it.
  1. ;. . ;S ORUNF=+$E($$NOW^XLFDT,1,12)_U_DUZ_"^Auto-Unflagged"
  1. ;. . ;S ORIFN=$P(ORBY(ORI),U),ORA=+$P(ORIFN,";",2)
  1. ;. . ;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
  1. ;. . S ORIFN=+ORBY(ORI)
  1. ;. . I $D(^OR(100,ORIFN,0)),'$$FLAGRULE^ORWORR1(ORIFN) D UNFLAG^ORWDXA(.ORUNF,$P(ORBY(ORI),U),"Auto-Unflagged")
  1. ;;DJE-VM *329 - ORWDXA is smarter and deletes the appropriate alert(s)
  1. ;;I (ORAUTO)!(+$G(ORBY(1))=0) D DELETE^XQALERT
  1. ;Q
  1. KILEXMED(Y,ORDFN) ; -- Delete expiring meds notification if no expiring meds remaining
  1. N ORDG,ORLST,OROI,LIST S ORDG=$$DG^ORQOR1("RX")
  1. N XQAKILL,ORNIFN,ORVP
  1. S LIST("INPT")=1
  1. S LIST("OUTPT")=1
  1. D AGET^ORWORR(.ORLST,ORDFN,5,ORDG)
  1. ;selected code copied from EXPIR^ORB3TIM2
  1. I +(@ORLST@(.1)) D ;if there are orders
  1. . K LIST("OUTPT")
  1. . S OROI=.5
  1. . N ORSCHFIL,ORBZ
  1. . S ORSCHFIL=$$TERMLKUP^ORB31(.ORBZ,"ONE TIME MED")
  1. . F S OROI=$O(@ORLST@(OROI)) Q:'OROI D Q:'$G(LIST("INPT"))
  1. .. N EXORN S EXORN=+@ORLST@(OROI)
  1. .. ;skip outpt meds
  1. .. Q:$$DGRX^ORQOR2(EXORN)="OUTPATIENT MEDICATIONS"
  1. .. ;skip one time meds
  1. .. N ONETIME,ORSCH,ORBI S ONETIME=0
  1. .. I $D(ORBZ),(+$G(ORSCHFIL)=51.1) F ORBI=1:1:ORBZ D
  1. ... S ORSCH=$P(ORBZ(ORBI),U,2)
  1. ... I ORSCH=$$VALUE^ORCSAVE2(EXORN,"SCHEDULE") S ONETIME=1 Q
  1. .. Q:+$G(ONETIME)=1
  1. .. ;don't delete notification if there are valid inpt orders
  1. .. K LIST("INPT")
  1. S OROI=""
  1. F S OROI=$O(LIST(OROI)) Q:'$L(OROI) D
  1. .S ORNIFN=$O(^ORD(100.9,"B","MEDICATIONS EXPIRING - "_OROI,0)),ORVP=ORDFN_";DPT("
  1. .Q:'$L($G(ORNIFN))
  1. .S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN) ; expiring meds notif
  1. .I $D(XQAID) D DELETE^XQALERT
  1. .I '$D(XQAID) S XQAID=$P($G(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN D DELETEA^XQALERT K XQAID
  1. Q
  1. KILEXOI(Y,ORDFN,ORNIFN) ; -- Delete expiring flagged OI notification if no flagged expiring OI remaining
  1. N ORDG,ORLST S ORDG=$$DG^ORQOR1("ALL")
  1. D AGET^ORWORR(.ORLST,ORDFN,5,ORDG)
  1. Q:+(@ORLST@(.1)) ;more left
  1. N XQAKILL,ORVP
  1. S ORVP=ORDFN_";DPT("
  1. S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN) ; flagged expiring OI notifications
  1. I $D(XQAID) D DELETE^XQALERT
  1. I '$D(XQAID) S XQAID=$P($G(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN D DELETEA^XQALERT K XQAID
  1. Q
  1. KILUNVOR(Y,ORDFN) ; -- Delete UNVERIFIED ORDER notification if none remaining within current admission/30 days
  1. N DFN,ORDG,ORLST,ORBDT,OREDT,ORDDT,VAIN,VAERR,VA200 S ORDG=$$DG^ORQOR1("ALL")
  1. S OREDT=$$NOW^XLFDT
  1. S ORDDT=$$FMADD^XLFDT(OREDT,"-90")
  1. ;get current admission date/time:
  1. S DFN=ORDFN,VA200="" D INP^VADPT
  1. S ORBDT=$P($G(VAIN(7)),U)
  1. S ORBDT=$S('$L($G(ORBDT)):$$FMADD^XLFDT(OREDT,"-30"),1:ORBDT) ;<= if no admission use past 30 days
  1. S ORBDT=$S(ORDDT>ORBDT:ORDDT,1:ORBDT) ;max past days to use is 90 days
  1. D AGET^ORWORR(.ORLST,ORDFN,9,ORDG,ORBDT,OREDT)
  1. Q:+(@ORLST@(.1)) ;more left
  1. N XQAKILL,ORVP,ORNIFN
  1. S ORNIFN=$O(^ORD(100.9,"B","UNVERIFIED ORDER",0)),ORVP=ORDFN_";DPT("
  1. S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN)
  1. I $D(XQAID) D DELETE^XQALERT
  1. I '$D(XQAID) S XQAID=$P($G(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN D DELETEA^XQALERT K XQAID
  1. Q
  1. KILUNVMD(Y,ORDFN) ; -- Delete UNVERIFIED MEDS notification if none remaining within current admission/30 days
  1. N DFN,ORDG,ORLST,ORBDT,OREDT,ORDDT S ORDG=$$DG^ORQOR1("RX")
  1. S OREDT=$$NOW^XLFDT
  1. S ORDDT=$$FMADD^XLFDT(OREDT,"-90")
  1. ;get current admission date/time:
  1. S DFN=ORDFN,VA200="" D INP^VADPT
  1. S ORBDT=$P($G(VAIN(7)),U)
  1. S ORBDT=$S('$L($G(ORBDT)):$$FMADD^XLFDT(OREDT,"-30"),1:ORBDT) ;<= if no admission use past 30 days
  1. S ORBDT=$S(ORDDT>ORBDT:ORDDT,1:ORBDT) ;max past days to use is 90 days
  1. D AGET^ORWORR(.ORLST,ORDFN,9,ORDG,ORBDT,OREDT)
  1. Q:+(@ORLST@(.1)) ;more left
  1. N XQAKILL,ORVP,ORNIFN
  1. S ORNIFN=$O(^ORD(100.9,"B","UNVERIFIED MEDICATION ORDER",0)),ORVP=ORDFN_";DPT("
  1. S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN)
  1. I $D(XQAID) D DELETE^XQALERT
  1. I '$D(XQAID) S XQAID=$P($G(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN D DELETEA^XQALERT K XQAID
  1. Q
  1. ESORD(ORY,XQAID) ;order(s) requiring electronic signature follow-up
  1. K XQAKILL
  1. N ORPT,ORDG,ORBXQAID,ORY,ORX,ORZ,ORDERS,ORDNUM,ORQUIT,ORBLMDEL
  1. S ORBXQAID=XQAID,ORDERS=0,ORQUIT=0
  1. S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
  1. S ORDG=$$DG^ORQOR1("ALL")
  1. ;the FLG code for UNSIGNED orders in ORQ1 is '11'
  1. ;get unsigned orders - if none exist, delete alert then quit:
  1. D EN^ORQ1(ORPT_";DPT(",ORDG,11,"","","",0,0)
  1. 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
  1. ;
  1. ;user does not have ORES key, delete user's alert:
  1. I '$D(^XUSEC("ORES",DUZ)) S XQAKILL=1 D DEL^ORB3FUP1(.ORY,ORBXQAID) K ^TMP("ORR",$J) Q
  1. ;
  1. ;if prov is NOT linked to pt via attending, primary or teams:
  1. I $$PPLINK^ORQPTQ1(DUZ,ORPT)=0 D
  1. .S ORX="" F S ORX=$O(^TMP("ORR",$J,ORX)) Q:ORX=""!(ORDERS=1) D
  1. ..S ORZ="" F S ORZ=$O(^TMP("ORR",$J,ORX,ORZ)) Q:+ORZ=0!(ORDERS=1) D
  1. ...S ORDNUM=^TMP("ORR",$J,ORX,ORZ)
  1. ...;quit if this unsigned order's last action was made by the user
  1. ...I DUZ=+$$UNSIGNOR^ORQOR2(ORDNUM) S ORDERS=1
  1. .I ORDERS'=1 D ;provider has no outstanding unsigned orders for pt
  1. ..S XQAKILL=1 D DEL^ORB3FUP1(.ORY,ORBXQAID) ;delete alert for this user
  1. K ^TMP("ORR",$J)
  1. Q
  1. ;
  1. TXTFUP(ROOT,DFN,NOTIF,XQADATA) ; Follow-up for text messages
  1. ;
  1. I NOTIF=67 D CHGRAD
  1. Q
  1. ;
  1. CHGRAD ;GUI follow-up for Imaging Request Changed (#67)
  1. S ROOT=$NA(^TMP($J,"RAE4"))
  1. K @ROOT
  1. D SET1^RAO7PC4 ;DBIA #3563
  1. Q
  1. ;
  1. GETSORT(ORY) ;return notification sort method^direction for user/division/system/pkg
  1. S ORY=$$GET^XPAR("ALL","ORB SORT METHOD",1,"I")_U_$$GET^XPAR("ALL","ORB SORT DIRECTION",1,"I")
  1. Q
  1. ;
  1. SETSORT(ORERR,SORT,DIR) ;set notification sort method^direction for user
  1. D EN^XPAR(DUZ_";VA(200,","ORB SORT METHOD",1,SORT,.ORERR)
  1. I $L($G(DIR)) D EN^XPAR(DUZ_";VA(200,","ORB SORT DIRECTION",1,DIR,.ORERR)
  1. Q
  1. ;
  1. GETPROV(ORN,ORDFN,ORALRTDAT) ;Find Ordering Provider
  1. ; ORN = NOTIFICATION IEN
  1. ; ORDFN = ALERT PATIENT DFN
  1. ; ORALRTDAT = ALERT DATA IN FILE 8992.1
  1. S ORN=+ORN
  1. I ORN=0 Q ""
  1. I +ORDFN=0 Q ""
  1. N ORDATA,ORIEN,ORIEN1,ORIENLNG,ORIENS,ORNTMP,ORPRV,ORQUIT,P04
  1. S ORNTMP=U_ORN_U
  1. S (ORIEN,ORPRV)=""
  1. S ORDATA=$G(ORALRTDAT(2)) ;data for processing
  1. ;Notifications with order number at beginning of data
  1. I "^3^5^6^8^12^14^24^26^31^33^42^43^44^45^47^48^52^55^57^58^59^60^62^68^72^74^82^"[ORNTMP S ORIEN=+ORDATA
  1. ;Notifications with order number as 2nd ";" piece
  1. I "^73^88^91^"[ORNTMP S ORIEN=+$P(ORDATA,";",2)
  1. ;Possible Multiple Order Numbers (Lapsed Unsigned Order and Preg/Lact Unsafe Orders)
  1. I ORN=78!(ORN=79) S ORIENS=$P(ORDATA,";",2) D
  1. . N ORIEN1,ORIENLNG,ORPROV1,X,P04
  1. . S P04=0
  1. . S ORIEN=+ORIENS
  1. . S ORIENLNG=$L(ORIENS,U)
  1. . I ORIENLNG=1 Q
  1. . S ORQUIT=0
  1. . F X=1:1:$L(ORIENS,U) D Q:ORIEN=""
  1. .. S ORIEN1=$P(ORIENS,U,X)
  1. .. I +P04=0 S P04=$P($G(^OR(100,ORIEN1,0)),U,4) Q
  1. .. I P04'=$P($G(^OR(100,ORIEN1,0)),U,4) S ORIEN=""
  1. .. Q
  1. ;New Orders (format of data varies)
  1. I ORN=50 S ORIEN=+ORDATA I ORIEN=0 D I +ORIEN=0 Q "N/A"
  1. . ;New Orders alerts in GUI may display any number of new orders and not
  1. . ;specifically just the one associated with this alert. Therefore, we
  1. . ;will quit at next line and not calculate the provider.
  1. . Q
  1. . N ORDATA1,ORDT,ORP2,ORPKG,ORSPCMN,PSIEN
  1. . S ORP2=$P(ORDATA,"|",2)
  1. . S ORDATA1=$P(ORP2,"@")
  1. . S ORPKG=$P(ORP2,"@",2)
  1. . I ORPKG="PS" D
  1. .. S PSIEN=ORDATA1
  1. .. I +PSIEN=PSIEN S ORIEN=$P(^PSRX(PSIEN,"OR1"),U,2) Q
  1. .. S ORIEN=$$GET1^DIQ(52.41,+PSIEN_",",.01)
  1. . I $E(ORPKG,1,2)="LR" D
  1. .. S ORDT=$P(ORDATA1,";",2),ORSPCMN=$P(ORDATA1,";",3)
  1. .. S ORIEN=$P(^LRO(69,ORDT,1,ORSPCMN,0),U,11)
  1. . I ORPKG="RA" D
  1. .. N ORIMG
  1. .. S ORIMG=ORDATA1
  1. .. I +ORIMG S ORIEN=$$GET1^DIQ(75.1,+ORIMG_",",7)
  1. . ;I ORPKG="FH" D
  1. . ;OR,13,50;4546;2990419.100747
  1. . ;|D;1635;1;2990419.100737;0;;;C;0;1;;;;@FH
  1. .;. S TEVNT=$P(ORDATA1,";",1)
  1. .;. S ADM=$P(ORDATA1,";",2)
  1. .;. S DT=$P(ORDATA1,";",4)
  1. .;. F S DIET=$O(^FH(119.8,"AP",ORDFN,DT,"")) Q:DIET="" D Q:ORQUIT
  1. .;.. ;Need to find a way to link to ORDER
  1. ;Imaging Notifications with format RADTI~RACNI
  1. I "^21^22^25^32^51^53^67^69^84^"[ORNTMP D
  1. . N ORACNI,ORADPT0,ORADTI,ORDATA1,ORDATA2,ORIMG,QUIT
  1. . S QUIT=0
  1. . I ORDATA?1.N1"@" S ORIEN=+ORDATA Q
  1. . I ORDATA["|" D Q:+ORIEN>0
  1. .. S ORDATA1=$P(ORDATA,"|",1)
  1. .. I $P(ORDATA1,"@",2)="OR",+ORDATA1>0 S ORIEN=+ORDATA1 Q
  1. .. S ORDATA2=$P(ORDATA,"|",2)
  1. .. I $L(ORDATA2,"~")=3 I +ORDATA2>0 S ORIMG=+$P(ORDATA2,"~",1) Q
  1. .. S ORADTI=$P(ORDATA,"~",2) S:ORADTI="" QUIT=1 Q
  1. .. S ORACNI=+$P(ORDATA,"~",3) S:ORACNI=0 QUIT=1
  1. . I ORDATA'["|" D Q:QUIT=1
  1. .. I ORDATA["~" D Q:QUIT=1
  1. ... S ORADTI=$P(ORDATA,"~",1) S:ORADTI="" QUIT=1 Q
  1. ... S ORACNI=$P(ORDATA,"~",2) S:ORACNI="" QUIT=1
  1. .. I ORDATA'["~" D Q:QUIT=1
  1. ... S ORADTI=$P(ORDATA,"/",2) S:ORADTI="" QUIT=1 Q
  1. ... S ORACNI=$P(ORDATA,"/",3) S:ORACNI="" QUIT=1
  1. . I +$G(ORIMG)=0,$G(ORADTI)'="",$G(ORACNI)'="" S ORIMG=+$P($G(^RADPT(ORDFN,"DT",ORADTI,"P",ORACNI,0)),U,11) I ORIMG=0 Q
  1. . I +$G(ORIMG)>0 S ORIEN=$$GET1^DIQ(75.1,ORIMG_",",7)
  1. ;Consult/Request Notifications that begin with the request (Consult) ien
  1. I "^23^27^30^63^66^89^"[ORNTMP D
  1. . I +ORDATA>0 S ORIEN=$P($G(^GMR(123,+ORDATA,0)),U,3)
  1. ;ORDERER-FLAGGED RESULTS (placed in the notifications with order number in first part of data
  1. ;I "^33^"[ORNTMP D
  1. ;. N ORDATA1,ORDATA2
  1. ;. I ORDATA["|" D Q:+ORIEN>0
  1. ;.. S ORDATA1=$P(ORDATA,"|",1)
  1. ;.. I $P(ORDATA1,"@",2)="OR",+ORDATA1>0 S ORIEN=+ORDATA1 Q
  1. ;.. Q
  1. ;.. ;The 2nd vertical bar piece may be of several different order types
  1. ;.. ;(consult and lab (chemistry) to name a couple). For now we will only
  1. ;.. ;use the OR data if available.
  1. ;.. S ORDATA2=$P(ORDATA,"|",2)
  1. ;.. I +ORDATA2>0 S ORIEN=$P($G(^GMR(123,+ORDATA2,0)),U,3)
  1. ;Laboratory entries
  1. I ORN=70!(ORN=71) D
  1. . N ORLRDFN,ORLRDT,ORLRTYP
  1. . S ORLRDFN=$G(^DPT(ORDFN,"LR")) Q:+ORLRDFN=0
  1. . S ORLRTYP=$P(ORDATA,U,1),ORLRDT=$P(ORDATA,U,3)
  1. . S ORIEN=$P($G(^LR(ORLRDFN,ORLRTYP,ORLRDT,"ORUT",1,0)),U,3)
  1. ;No data to find linked order
  1. I "^18^19^20^35^36^41^54^56^61^64^65^75^76^77^80^81^83^85^86^87^90^97^"[ORNTMP Q "N/A"
  1. ;Documentation states these are "Inactive"
  1. ;I "^28^37^46^"[ORNTMP Q "TBD"
  1. Q $$GETPRVNM(ORIEN)
  1. ;
  1. GETPRVNM(ORIEN) ;
  1. N ORPRV,P04
  1. S ORPRV=""
  1. I +ORIEN=0 Q "UNKNOWN"
  1. S P04=$P($G(^OR(100,ORIEN,0)),U,4)
  1. I +P04 S ORPRV=$$GET1^DIQ(200,P04,.01)
  1. I ORPRV="" S ORPRV="UNKNOWN"
  1. Q ORPRV