- ORWORB ; SLC/DEE,REV,CLA,WAT - RPC FUNCTIONS WHICH RETURN USER ALERT ;Aug 13, 2024@09:39:58
- ;;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
- ;;Per VHA Directive 2004-038, this routine should not be modified
- ;
- ; Reference to ^DPT( in ICR #10035
- ; Reference to ^XTV(8992 in ICR #2689
- ; Reference to ^VA(200,5 in ICR #4329
- ; Reference to ^XUSEC( in ICR #10076
- ; Reference to SET1^RAO7PC4 in ICR #3563
- ; Reference to $$RESOLVE^TIUSRVLO in ICR #2834
- ; Reference to INP^VADPT in ICR #10061
- ; Reference to $$NOW^XLFDT,$$FMADD^XLFDT in ICR #10103
- ; Reference to $$GET^XPAR,EN^XPAR,GETLST^XPAR in ICR #2263
- ; Reference to GETUSER1^XQALDATA,GETUSER2^XQALDATA in ICR #4834
- ; Reference to DELETE^XQALERT,DELETEA^XQALERT,GETACT^XQALERT in ICR #10081
- ; Reference to ALERTDAT^XQALBUTL,AHISTORY^XQALBUTL in ICR #2788
- ; Reference to ALTDATA^PXRMCALT in ICR #7258
- ; Reference to ^TIU(8925 in ICR #2937
- ; Reference to ^GMR(123 in ICR #2586
- ; Reference to ^SRF( in ICR #7436
- ; Reference to ^PSRX( in ICR #6149
- ; Reference to ^PS(52.41 in ICR #6148
- ; Reference to ^LRO(69,D0,1 in ICR #2407
- ; Reference to ^RAO(75.1 in ICR #3074
- ; Reference to ^RADPT(D0,'DT',D1,'P' in ICR #65
- ; Reference to ^LR( in ICR #525
- ; Reference to $$GET1^DIQ in ICR #2056
- ;
- 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,ORALRTDAT,ORALRTXT
- .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
- .D ALERTDAT^XQALBUTL(ALRTXQA,"ORALRTDAT")
- .S ORALRTXT=$G(ORALRTDAT(1.01))
- .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,ORIEN,ORREF,ORTIU,X,Y
- . . . S ORPROV="N/A"
- . . . I ORALRTXT="" Q ; full text of alert data
- . . . S $P(ALRT,U,2)=$P(ORALRTXT,":"),$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(ORALRTXT,": ",2),$P(ALRT,U,8)=ALRTXQA,$P(ALRT,U,9)=REM_U
- . . . S J=J+1,^TMP("ORBG",$J,J)=ALRT
- . . . S ORTIU=+$G(ORALRTDAT(2)) D Q:'ORTIU
- . . . . N ORTIUTXT,ORTIUTXT6
- . . . . I ORTIU Q
- . . . . S ORTIUTXT=$P(ALRTXQA,";"),ORTIUTXT6=$E(ORTIUTXT,1,6)
- . . . . I "^TIUADD^TIUERR^"[ORTIUTXT6 S ORTIU=$E(ORTIUTXT,7,999) Q
- . . . . I ORTIUTXT?3A1.99999999N S ORTIU=$E(ORTIUTXT,4,999)
- . . . S ORIEN=+$P($G(^TIU(8925,ORTIU,12)),U,10) I 'ORIEN D
- . . . . S ORPROV="UNKNOWN"
- . . . . S ORREF=$P($G(^TIU(8925,ORTIU,14)),U,5) Q:ORREF=""
- . . . . I $P(ORREF,";",2)="GMR(123," S ORIEN=$P($G(^GMR(123,+ORREF,0)),U,3) I ORIEN="" S ORPROV="UNKNOWN"
- . . . . I $P(ORREF,";",2)="SRF(" S ORIEN=$P($G(^SRF(+ORREF,0)),U,14) I ORIEN="" S ORPROV="UNKNOWN"
- . . . I +ORIEN>0 S ORPROV=$$GETPRVNM(ORIEN)
- .. ; *596 ajb
- ..I $P(ALRTXQA,",")="OR" D
- ... N NOPROV,P04,ORPOUT
- ... S NOPROV=0
- ...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 $G(ORN)=6,$P(ALRT,U)["Your task #" S ALRTMSG=$E($P(ALRT,U),2,999),NOPROV=1,ORPROV="N/A"
- ...I 'NOPROV S ORPROV=$$GETPROV(ORN,ALRTDFN,.ORALRTDAT)
- ...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 DUZIEN,SURRFOR,ORALRTHST D
- ..D AHISTORY^XQALBUTL(ALRTXQA,"ORALRTHST")
- ..S DUZIEN=$O(ORALRTHST(20,"B",DUZ,"")) Q:'DUZIEN
- ..S SURRFOR=+$G(ORALRTHST(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
- ;
- GETPROV(ORN,ORDFN,ORALRTDAT) ;Find Ordering Provider
- ; ORN = NOTIFICATION IEN
- ; ORDFN = ALERT PATIENT DFN
- ; ORALRTDAT = ALERT DATA IN FILE 8992.1
- S ORN=+ORN
- I ORN=0 Q ""
- I +ORDFN=0 Q ""
- N ORDATA,ORIEN,ORIEN1,ORIENLNG,ORIENS,ORNTMP,ORPRV,ORQUIT,P04
- S ORNTMP=U_ORN_U
- S (ORIEN,ORPRV)=""
- S ORDATA=$G(ORALRTDAT(2)) ;data for processing
- ;Notifications with order number at beginning of data
- 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
- ;Notifications with order number as 2nd ";" piece
- I "^73^88^91^"[ORNTMP S ORIEN=+$P(ORDATA,";",2)
- ;Possible Multiple Order Numbers (Lapsed Unsigned Order and Preg/Lact Unsafe Orders)
- I ORN=78!(ORN=79) S ORIENS=$P(ORDATA,";",2) D
- . N ORIEN1,ORIENLNG,ORPROV1,X,P04
- . S P04=0
- . S ORIEN=+ORIENS
- . S ORIENLNG=$L(ORIENS,U)
- . I ORIENLNG=1 Q
- . S ORQUIT=0
- . F X=1:1:$L(ORIENS,U) D Q:ORIEN=""
- .. S ORIEN1=$P(ORIENS,U,X)
- .. I +P04=0 S P04=$P($G(^OR(100,ORIEN1,0)),U,4) Q
- .. I P04'=$P($G(^OR(100,ORIEN1,0)),U,4) S ORIEN=""
- .. Q
- ;New Orders (format of data varies)
- I ORN=50 S ORIEN=+ORDATA I ORIEN=0 D I +ORIEN=0 Q "N/A"
- . ;New Orders alerts in GUI may display any number of new orders and not
- . ;specifically just the one associated with this alert. Therefore, we
- . ;will quit at next line and not calculate the provider.
- . Q
- . N ORDATA1,ORDT,ORP2,ORPKG,ORSPCMN,PSIEN
- . S ORP2=$P(ORDATA,"|",2)
- . S ORDATA1=$P(ORP2,"@")
- . S ORPKG=$P(ORP2,"@",2)
- . I ORPKG="PS" D
- .. S PSIEN=ORDATA1
- .. I +PSIEN=PSIEN S ORIEN=$P(^PSRX(PSIEN,"OR1"),U,2) Q
- .. S ORIEN=$$GET1^DIQ(52.41,+PSIEN_",",.01)
- . I $E(ORPKG,1,2)="LR" D
- .. S ORDT=$P(ORDATA1,";",2),ORSPCMN=$P(ORDATA1,";",3)
- .. S ORIEN=$P(^LRO(69,ORDT,1,ORSPCMN,0),U,11)
- . I ORPKG="RA" D
- .. N ORIMG
- .. S ORIMG=ORDATA1
- .. I +ORIMG S ORIEN=$$GET1^DIQ(75.1,+ORIMG_",",7)
- . ;I ORPKG="FH" D
- . ;OR,13,50;4546;2990419.100747
- . ;|D;1635;1;2990419.100737;0;;;C;0;1;;;;@FH
- .;. S TEVNT=$P(ORDATA1,";",1)
- .;. S ADM=$P(ORDATA1,";",2)
- .;. S DT=$P(ORDATA1,";",4)
- .;. F S DIET=$O(^FH(119.8,"AP",ORDFN,DT,"")) Q:DIET="" D Q:ORQUIT
- .;.. ;Need to find a way to link to ORDER
- ;Imaging Notifications with format RADTI~RACNI
- I "^21^22^25^32^51^53^67^69^84^"[ORNTMP D
- . N ORACNI,ORADPT0,ORADTI,ORDATA1,ORDATA2,ORIMG,QUIT
- . S QUIT=0
- . I ORDATA?1.N1"@" S ORIEN=+ORDATA Q
- . I ORDATA["|" D Q:+ORIEN>0
- .. S ORDATA1=$P(ORDATA,"|",1)
- .. I $P(ORDATA1,"@",2)="OR",+ORDATA1>0 S ORIEN=+ORDATA1 Q
- .. S ORDATA2=$P(ORDATA,"|",2)
- .. I $L(ORDATA2,"~")=3 I +ORDATA2>0 S ORIMG=+$P(ORDATA2,"~",1) Q
- .. S ORADTI=$P(ORDATA,"~",2) S:ORADTI="" QUIT=1 Q
- .. S ORACNI=+$P(ORDATA,"~",3) S:ORACNI=0 QUIT=1
- . I ORDATA'["|" D Q:QUIT=1
- .. I ORDATA["~" D Q:QUIT=1
- ... S ORADTI=$P(ORDATA,"~",1) S:ORADTI="" QUIT=1 Q
- ... S ORACNI=$P(ORDATA,"~",2) S:ORACNI="" QUIT=1
- .. I ORDATA'["~" D Q:QUIT=1
- ... S ORADTI=$P(ORDATA,"/",2) S:ORADTI="" QUIT=1 Q
- ... S ORACNI=$P(ORDATA,"/",3) S:ORACNI="" QUIT=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
- . I +$G(ORIMG)>0 S ORIEN=$$GET1^DIQ(75.1,ORIMG_",",7)
- ;Consult/Request Notifications that begin with the request (Consult) ien
- I "^23^27^30^63^66^89^"[ORNTMP D
- . I +ORDATA>0 S ORIEN=$P($G(^GMR(123,+ORDATA,0)),U,3)
- ;ORDERER-FLAGGED RESULTS (placed in the notifications with order number in first part of data
- ;I "^33^"[ORNTMP D
- ;. N ORDATA1,ORDATA2
- ;. I ORDATA["|" D Q:+ORIEN>0
- ;.. S ORDATA1=$P(ORDATA,"|",1)
- ;.. I $P(ORDATA1,"@",2)="OR",+ORDATA1>0 S ORIEN=+ORDATA1 Q
- ;.. Q
- ;.. ;The 2nd vertical bar piece may be of several different order types
- ;.. ;(consult and lab (chemistry) to name a couple). For now we will only
- ;.. ;use the OR data if available.
- ;.. S ORDATA2=$P(ORDATA,"|",2)
- ;.. I +ORDATA2>0 S ORIEN=$P($G(^GMR(123,+ORDATA2,0)),U,3)
- ;Laboratory entries
- I ORN=70!(ORN=71) D
- . N ORLRDFN,ORLRDT,ORLRTYP
- . S ORLRDFN=$G(^DPT(ORDFN,"LR")) Q:+ORLRDFN=0
- . S ORLRTYP=$P(ORDATA,U,1),ORLRDT=$P(ORDATA,U,3)
- . S ORIEN=$P($G(^LR(ORLRDFN,ORLRTYP,ORLRDT,"ORUT",1,0)),U,3)
- ;No data to find linked order
- 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"
- ;Documentation states these are "Inactive"
- ;I "^28^37^46^"[ORNTMP Q "TBD"
- Q $$GETPRVNM(ORIEN)
- ;
- GETPRVNM(ORIEN) ;
- N ORPRV,P04
- S ORPRV=""
- I +ORIEN=0 Q "UNKNOWN"
- S P04=$P($G(^OR(100,ORIEN,0)),U,4)
- I +P04 S ORPRV=$$GET1^DIQ(200,P04,.01)
- I ORPRV="" S ORPRV="UNKNOWN"
- Q ORPRV
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWORB 19928 printed Jan 18, 2025@03:38 Page 2
- 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
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified
- +3 ;
- +4 ; Reference to ^DPT( in ICR #10035
- +5 ; Reference to ^XTV(8992 in ICR #2689
- +6 ; Reference to ^VA(200,5 in ICR #4329
- +7 ; Reference to ^XUSEC( in ICR #10076
- +8 ; Reference to SET1^RAO7PC4 in ICR #3563
- +9 ; Reference to $$RESOLVE^TIUSRVLO in ICR #2834
- +10 ; Reference to INP^VADPT in ICR #10061
- +11 ; Reference to $$NOW^XLFDT,$$FMADD^XLFDT in ICR #10103
- +12 ; Reference to $$GET^XPAR,EN^XPAR,GETLST^XPAR in ICR #2263
- +13 ; Reference to GETUSER1^XQALDATA,GETUSER2^XQALDATA in ICR #4834
- +14 ; Reference to DELETE^XQALERT,DELETEA^XQALERT,GETACT^XQALERT in ICR #10081
- +15 ; Reference to ALERTDAT^XQALBUTL,AHISTORY^XQALBUTL in ICR #2788
- +16 ; Reference to ALTDATA^PXRMCALT in ICR #7258
- +17 ; Reference to ^TIU(8925 in ICR #2937
- +18 ; Reference to ^GMR(123 in ICR #2586
- +19 ; Reference to ^SRF( in ICR #7436
- +20 ; Reference to ^PSRX( in ICR #6149
- +21 ; Reference to ^PS(52.41 in ICR #6148
- +22 ; Reference to ^LRO(69,D0,1 in ICR #2407
- +23 ; Reference to ^RAO(75.1 in ICR #3074
- +24 ; Reference to ^RADPT(D0,'DT',D1,'P' in ICR #65
- +25 ; Reference to ^LR( in ICR #525
- +26 ; Reference to $$GET1^DIQ in ICR #2056
- +27 ;
- +28 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,ORALRTDAT,ORALRTXT
- +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 DO ALERTDAT^XQALBUTL(ALRTXQA,"ORALRTDAT")
- +15 SET ORALRTXT=$GET(ORALRTDAT(1.01))
- +16 SET NONOR=""
- FOR
- SET NONOR=$ORDER(NONORLST(NONOR))
- if NONOR=""
- QUIT
- Begin DoDot:2
- +17 ;allow this type of alert to be Removed
- IF ALRTXQA[NONOR
- SET REM=1
- End DoDot:2
- +18 SET ALRTMSG=$PIECE($PIECE(ALRT,U),PRE_" ",2)
- +19 ;S ALRTMSG=$P($P(ALRT,U),PRE,2,99),ALRTMSG=$$TRIM^XLFSTR(ALRTMSG,"L")
- +20 ;not forwarded alert info/comment
- IF $EXTRACT(ALRT,4,8)'="-----"
- Begin DoDot:2
- +21 SET ORRMVD=0
- +22 SET ORURG="n/a"
- +23 SET ALRTI=$PIECE(ALRT," ")
- +24 SET ALRTPT=""
- +25 SET ALRTLOC=""
- +26 ; *596 ajb
- +27 IF $EXTRACT($PIECE(ALRTXQA,";"),1,3)="TIU"
- Begin DoDot:3
- +28 NEW ALRT,NODE,ORIEN,ORREF,ORTIU,X,Y
- +29 SET ORPROV="N/A"
- +30 ; full text of alert data
- IF ORALRTXT=""
- QUIT
- +31 SET $PIECE(ALRT,U,2)=$PIECE(ORALRTXT,":")
- SET $PIECE(ALRT,U,4)=$SELECT(ALRT[" STAT ":"HIGH",1:"Moderate")
- +32 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))
- +33 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
- +34 SET $PIECE(ALRT,U,6)=$PIECE(ORALRTXT,": ",2)
- SET $PIECE(ALRT,U,8)=ALRTXQA
- SET $PIECE(ALRT,U,9)=REM_U
- +35 SET J=J+1
- SET ^TMP("ORBG",$JOB,J)=ALRT
- +36 SET ORTIU=+$GET(ORALRTDAT(2))
- Begin DoDot:4
- +37 NEW ORTIUTXT,ORTIUTXT6
- +38 IF ORTIU
- QUIT
- +39 SET ORTIUTXT=$PIECE(ALRTXQA,";")
- SET ORTIUTXT6=$EXTRACT(ORTIUTXT,1,6)
- +40 IF "^TIUADD^TIUERR^"[ORTIUTXT6
- SET ORTIU=$EXTRACT(ORTIUTXT,7,999)
- QUIT
- +41 IF ORTIUTXT?3A1.99999999N
- SET ORTIU=$EXTRACT(ORTIUTXT,4,999)
- End DoDot:4
- if 'ORTIU
- QUIT
- +42 SET ORIEN=+$PIECE($GET(^TIU(8925,ORTIU,12)),U,10)
- IF 'ORIEN
- Begin DoDot:4
- +43 SET ORPROV="UNKNOWN"
- +44 SET ORREF=$PIECE($GET(^TIU(8925,ORTIU,14)),U,5)
- if ORREF=""
- QUIT
- +45 IF $PIECE(ORREF,";",2)="GMR(123,"
- SET ORIEN=$PIECE($GET(^GMR(123,+ORREF,0)),U,3)
- IF ORIEN=""
- SET ORPROV="UNKNOWN"
- +46 IF $PIECE(ORREF,";",2)="SRF("
- SET ORIEN=$PIECE($GET(^SRF(+ORREF,0)),U,14)
- IF ORIEN=""
- SET ORPROV="UNKNOWN"
- End DoDot:4
- +47 IF +ORIEN>0
- SET ORPROV=$$GETPRVNM(ORIEN)
- End DoDot:3
- QUIT
- +48 ; *596 ajb
- +49 IF $PIECE(ALRTXQA,",")="OR"
- Begin DoDot:3
- +50 NEW NOPROV,P04,ORPOUT
- +51 SET NOPROV=0
- +52 SET ORN=$PIECE($PIECE(ALRTXQA,";"),",",3)
- +53 SET URG=$GET(URGLIST(ORN))
- +54 SET ORURG=$SELECT(URG=1:"HIGH",URG=2:"Moderate",1:"low")
- +55 SET REM=$GET(REMLIST(ORN))
- +56 SET ORN0=^ORD(100.9,ORN,0)
- +57 SET ALRTI=$SELECT(ORN=90:"L",$PIECE(ORN0,U,6)="INFODEL":"I",1:"")
- +58 SET ALRTDFN=$PIECE(ALRTXQA,",",2)
- +59 SET ALRTLOC=$GET(^DPT(+$GET(ALRTDFN),.1))
- +60 IF $GET(ORN)=6
- IF $PIECE(ALRT,U)["Your task #"
- SET ALRTMSG=$EXTRACT($PIECE(ALRT,U),2,999)
- SET NOPROV=1
- SET ORPROV="N/A"
- +61 IF 'NOPROV
- SET ORPROV=$$GETPROV(ORN,ALRTDFN,.ORALRTDAT)
- +62 IF $$ISSMIEN^ORBSMART(ORN)
- Begin DoDot:4
- +63 NEW ORSMBY
- +64 DO ALTDATA^PXRMCALT(.ORPOUT,ALRTDFN,ALRTXQA)
- +65 IF $GET(ORPOUT("DATA","RADIOLOGY REPORT FOUND"))=0
- DO DEL^ORB3FUP1(.ORSMBY,ALRTXQA,0)
- SET ORRMVD=1
- QUIT
- +66 IF $LENGTH($GET(ORPOUT("DATA",1,"DIAGNOSIS")))>0
- SET ORBIRAD=$GET(ORPOUT("DATA",1,"DIAGNOSIS"))
- End DoDot:4
- End DoDot:3
- +67 IF ORRMVD
- QUIT
- +68 SET ALRTI=$SELECT(ALRTI="I":"I",ALRTI="L":"L",1:"")
- +69 ;WAT
- IF (ALRT["): ")!($GET(ORN)=27&(ALRT[") CV"))
- Begin DoDot:3
- +70 SET ALRTPT=$PIECE(ALRT,": ")
- +71 SET ALRTPT=$EXTRACT(ALRTPT,4,$LENGTH(ALRTPT))
- +72 ;S ALRTPT=$P(ALRTPT,PRE,2,99),ALRTPT=$$TRIM^XLFSTR(ALRTPT,"L")
- +73 ;WAT
- IF $GET(ORN)=27&(ALRT[") CV")
- SET ALRTMSG=$PIECE($PIECE(ALRT,U),": ",2)
- +74 ;WAT
- IF '$TEST
- SET ALRTMSG=$PIECE($PIECE(ALRT,U),"): ",2)
- +75 IF $EXTRACT(ALRTMSG,1,1)="["
- Begin DoDot:4
- +76 if '$LENGTH(ALRTLOC)
- SET ALRTLOC=$PIECE($PIECE(ALRTMSG,"]"),"[",2)
- +77 SET ALRTMSG=$PIECE(ALRTMSG,"] ",2)
- End DoDot:4
- End DoDot:3
- +78 IF '$LENGTH($GET(ALRTPT))
- SET ALRTPT="no patient"
- +79 SET ALRTDT=$PIECE(ALRTXQA,";",3)
- +80 SET ALRTDT=$PIECE(ALRTDT,".")_"."_$EXTRACT($PIECE(ALRTDT,".",2)_"0000",1,4)
- +81 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)
- +82 ;if SMART alert, append BIRAD results to ALRTMSG
- +83 IF $GET(ORBIRAD)'=""
- SET ALRTMSG=ALRTMSG_" - RESULTS: "_ORBIRAD
- +84 SET J=J+1
- SET ^TMP("ORBG",$JOB,J)=ALRTI_U_ALRTPT_U_ALRTLOC_U_ORURG_U_ALRTDT_U
- +85 SET ^TMP("ORBG",$JOB,J)=^TMP("ORBG",$JOB,J)_ALRTMSG_U_U_ALRTXQA_U_$GET(REM)_U
- End DoDot:2
- +86 IF ORRMVD
- QUIT
- +87 ;if alert forward info/comment:
- +88 IF $EXTRACT(ALRTMSG,1,5)="-----"
- Begin DoDot:2
- +89 SET ALRTMSG=$PIECE(ALRTMSG,"-----",2)
- +90 IF $EXTRACT(ALRTMSG,1,14)=FWDBY
- Begin DoDot:3
- +91 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
- +92 IF '$TEST
- SET ^TMP("ORBG",$JOB,J)=^TMP("ORBG",$JOB,J)_U_""""_ALRTMSG_""""
- End DoDot:2
- +93 ; ajb
- IF $GET(ORPROV)'=""
- SET ^TMP("ORBG",$JOB,J)=^TMP("ORBG",$JOB,J)_U_ORPROV
- +94 ;if this is for processed alerts, add additional data into pieces 15 through 22
- +95 IF $DATA(^TMP("ORB",$JOB,J,"PROCESSED"))
- Begin DoDot:2
- +96 SET $PIECE(^TMP("ORBG",$JOB,J),U,15)=^TMP("ORB",$JOB,J,"PROCESSED")
- End DoDot:2
- +97 ;if this is for pending alerts, add "surrogate for" into piece 15
- +98 IF $GET(FROMFAST)
- NEW DUZIEN,SURRFOR,ORALRTHST
- Begin DoDot:2
- +99 DO AHISTORY^XQALBUTL(ALRTXQA,"ORALRTHST")
- +100 SET DUZIEN=$ORDER(ORALRTHST(20,"B",DUZ,""))
- if 'DUZIEN
- QUIT
- +101 ; get first "surrogate for" and return returns 0 if empty
- SET SURRFOR=+$GET(ORALRTHST(20,DUZIEN,3,1,0))
- +102 IF SURRFOR
- SET $PIECE(^TMP("ORBG",$JOB,J),U,15)=$PIECE(^VA(200,SURRFOR,0),U)
- End DoDot:2
- End DoDot:1
- +103 SET ^TMP("ORBG",$JOB)=""
- +104 SET ORY=$NAME(^TMP("ORBG",$JOB))
- +105 KILL ^TMP("ORB",$JOB)
- +106 QUIT
- +107 ;
- 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
+4 ;
GETPROV(ORN,ORDFN,ORALRTDAT) ;Find Ordering Provider
+1 ; ORN = NOTIFICATION IEN
+2 ; ORDFN = ALERT PATIENT DFN
+3 ; ORALRTDAT = ALERT DATA IN FILE 8992.1
+4 SET ORN=+ORN
+5 IF ORN=0
QUIT ""
+6 IF +ORDFN=0
QUIT ""
+7 NEW ORDATA,ORIEN,ORIEN1,ORIENLNG,ORIENS,ORNTMP,ORPRV,ORQUIT,P04
+8 SET ORNTMP=U_ORN_U
+9 SET (ORIEN,ORPRV)=""
+10 ;data for processing
SET ORDATA=$GET(ORALRTDAT(2))
+11 ;Notifications with order number at beginning of data
+12 IF "^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
SET ORIEN=+ORDATA
+13 ;Notifications with order number as 2nd ";" piece
+14 IF "^73^88^91^"[ORNTMP
SET ORIEN=+$PIECE(ORDATA,";",2)
+15 ;Possible Multiple Order Numbers (Lapsed Unsigned Order and Preg/Lact Unsafe Orders)
+16 IF ORN=78!(ORN=79)
SET ORIENS=$PIECE(ORDATA,";",2)
Begin DoDot:1
+17 NEW ORIEN1,ORIENLNG,ORPROV1,X,P04
+18 SET P04=0
+19 SET ORIEN=+ORIENS
+20 SET ORIENLNG=$LENGTH(ORIENS,U)
+21 IF ORIENLNG=1
QUIT
+22 SET ORQUIT=0
+23 FOR X=1:1:$LENGTH(ORIENS,U)
Begin DoDot:2
+24 SET ORIEN1=$PIECE(ORIENS,U,X)
+25 IF +P04=0
SET P04=$PIECE($GET(^OR(100,ORIEN1,0)),U,4)
QUIT
+26 IF P04'=$PIECE($GET(^OR(100,ORIEN1,0)),U,4)
SET ORIEN=""
+27 QUIT
End DoDot:2
if ORIEN=""
QUIT
End DoDot:1
+28 ;New Orders (format of data varies)
+29 IF ORN=50
SET ORIEN=+ORDATA
IF ORIEN=0
Begin DoDot:1
+30 ;New Orders alerts in GUI may display any number of new orders and not
+31 ;specifically just the one associated with this alert. Therefore, we
+32 ;will quit at next line and not calculate the provider.
+33 QUIT
+34 NEW ORDATA1,ORDT,ORP2,ORPKG,ORSPCMN,PSIEN
+35 SET ORP2=$PIECE(ORDATA,"|",2)
+36 SET ORDATA1=$PIECE(ORP2,"@")
+37 SET ORPKG=$PIECE(ORP2,"@",2)
+38 IF ORPKG="PS"
Begin DoDot:2
+39 SET PSIEN=ORDATA1
+40 IF +PSIEN=PSIEN
SET ORIEN=$PIECE(^PSRX(PSIEN,"OR1"),U,2)
QUIT
+41 SET ORIEN=$$GET1^DIQ(52.41,+PSIEN_",",.01)
End DoDot:2
+42 IF $EXTRACT(ORPKG,1,2)="LR"
Begin DoDot:2
+43 SET ORDT=$PIECE(ORDATA1,";",2)
SET ORSPCMN=$PIECE(ORDATA1,";",3)
+44 SET ORIEN=$PIECE(^LRO(69,ORDT,1,ORSPCMN,0),U,11)
End DoDot:2
+45 IF ORPKG="RA"
Begin DoDot:2
+46 NEW ORIMG
+47 SET ORIMG=ORDATA1
+48 IF +ORIMG
SET ORIEN=$$GET1^DIQ(75.1,+ORIMG_",",7)
End DoDot:2
+49 ;I ORPKG="FH" D
+50 ;OR,13,50;4546;2990419.100747
+51 ;|D;1635;1;2990419.100737;0;;;C;0;1;;;;@FH
+52 ;. S TEVNT=$P(ORDATA1,";",1)
+53 ;. S ADM=$P(ORDATA1,";",2)
+54 ;. S DT=$P(ORDATA1,";",4)
+55 ;. F S DIET=$O(^FH(119.8,"AP",ORDFN,DT,"")) Q:DIET="" D Q:ORQUIT
+56 ;.. ;Need to find a way to link to ORDER
End DoDot:1
IF +ORIEN=0
QUIT "N/A"
+57 ;Imaging Notifications with format RADTI~RACNI
+58 IF "^21^22^25^32^51^53^67^69^84^"[ORNTMP
Begin DoDot:1
+59 NEW ORACNI,ORADPT0,ORADTI,ORDATA1,ORDATA2,ORIMG,QUIT
+60 SET QUIT=0
+61 IF ORDATA?1.N1"@"
SET ORIEN=+ORDATA
QUIT
+62 IF ORDATA["|"
Begin DoDot:2
+63 SET ORDATA1=$PIECE(ORDATA,"|",1)
+64 IF $PIECE(ORDATA1,"@",2)="OR"
IF +ORDATA1>0
SET ORIEN=+ORDATA1
QUIT
+65 SET ORDATA2=$PIECE(ORDATA,"|",2)
+66 IF $LENGTH(ORDATA2,"~")=3
IF +ORDATA2>0
SET ORIMG=+$PIECE(ORDATA2,"~",1)
QUIT
+67 SET ORADTI=$PIECE(ORDATA,"~",2)
if ORADTI=""
SET QUIT=1
QUIT
+68 SET ORACNI=+$PIECE(ORDATA,"~",3)
if ORACNI=0
SET QUIT=1
End DoDot:2
if +ORIEN>0
QUIT
+69 IF ORDATA'["|"
Begin DoDot:2
+70 IF ORDATA["~"
Begin DoDot:3
+71 SET ORADTI=$PIECE(ORDATA,"~",1)
if ORADTI=""
SET QUIT=1
QUIT
+72 SET ORACNI=$PIECE(ORDATA,"~",2)
if ORACNI=""
SET QUIT=1
End DoDot:3
if QUIT=1
QUIT
+73 IF ORDATA'["~"
Begin DoDot:3
+74 SET ORADTI=$PIECE(ORDATA,"/",2)
if ORADTI=""
SET QUIT=1
QUIT
+75 SET ORACNI=$PIECE(ORDATA,"/",3)
if ORACNI=""
SET QUIT=1
End DoDot:3
if QUIT=1
QUIT
End DoDot:2
if QUIT=1
QUIT
+76 IF +$GET(ORIMG)=0
IF $GET(ORADTI)'=""
IF $GET(ORACNI)'=""
SET ORIMG=+$PIECE($GET(^RADPT(ORDFN,"DT",ORADTI,"P",ORACNI,0)),U,11)
IF ORIMG=0
QUIT
+77 IF +$GET(ORIMG)>0
SET ORIEN=$$GET1^DIQ(75.1,ORIMG_",",7)
End DoDot:1
+78 ;Consult/Request Notifications that begin with the request (Consult) ien
+79 IF "^23^27^30^63^66^89^"[ORNTMP
Begin DoDot:1
+80 IF +ORDATA>0
SET ORIEN=$PIECE($GET(^GMR(123,+ORDATA,0)),U,3)
End DoDot:1
+81 ;ORDERER-FLAGGED RESULTS (placed in the notifications with order number in first part of data
+82 ;I "^33^"[ORNTMP D
+83 ;. N ORDATA1,ORDATA2
+84 ;. I ORDATA["|" D Q:+ORIEN>0
+85 ;.. S ORDATA1=$P(ORDATA,"|",1)
+86 ;.. I $P(ORDATA1,"@",2)="OR",+ORDATA1>0 S ORIEN=+ORDATA1 Q
+87 ;.. Q
+88 ;.. ;The 2nd vertical bar piece may be of several different order types
+89 ;.. ;(consult and lab (chemistry) to name a couple). For now we will only
+90 ;.. ;use the OR data if available.
+91 ;.. S ORDATA2=$P(ORDATA,"|",2)
+92 ;.. I +ORDATA2>0 S ORIEN=$P($G(^GMR(123,+ORDATA2,0)),U,3)
+93 ;Laboratory entries
+94 IF ORN=70!(ORN=71)
Begin DoDot:1
+95 NEW ORLRDFN,ORLRDT,ORLRTYP
+96 SET ORLRDFN=$GET(^DPT(ORDFN,"LR"))
if +ORLRDFN=0
QUIT
+97 SET ORLRTYP=$PIECE(ORDATA,U,1)
SET ORLRDT=$PIECE(ORDATA,U,3)
+98 SET ORIEN=$PIECE($GET(^LR(ORLRDFN,ORLRTYP,ORLRDT,"ORUT",1,0)),U,3)
End DoDot:1
+99 ;No data to find linked order
+100 IF "^18^19^20^35^36^41^54^56^61^64^65^75^76^77^80^81^83^85^86^87^90^97^"[ORNTMP
QUIT "N/A"
+101 ;Documentation states these are "Inactive"
+102 ;I "^28^37^46^"[ORNTMP Q "TBD"
+103 QUIT $$GETPRVNM(ORIEN)
+104 ;
GETPRVNM(ORIEN) ;
+1 NEW ORPRV,P04
+2 SET ORPRV=""
+3 IF +ORIEN=0
QUIT "UNKNOWN"
+4 SET P04=$PIECE($GET(^OR(100,ORIEN,0)),U,4)
+5 IF +P04
SET ORPRV=$$GET1^DIQ(200,P04,.01)
+6 IF ORPRV=""
SET ORPRV="UNKNOWN"
+7 QUIT ORPRV