XQALERT ;ISF/JLI,ISD/HGW - ALERT HANDLER ;05/29/13 11:21
;;8.0;KERNEL;**1,65,125,173,285,366,513,602,632**;Jul 10, 1995;Build 3
;Per VA Directive 6402, this routine should not be modified.
Q
;
SETUP ;SR.
D SETUP^XQALSET
Q
;
SETUP1() ;SR.
N I S I=$$SETUP1^XQALSET()
Q I
;
DISPLAY ;SR. Display recent new alerts
; ZEXCEPT: XQAUSER - global variable
N X1,X2,XQACNT,XQJ
I '$D(XQAUSER) S XQAUSER=DUZ
I $$ACTVSURO^XQALSURO(XQAUSER)'>0 D RETURN^XQALSUR1(XQAUSER) ; P513
Q:$O(^XTV(8992,DUZ,"XQA",0))'>0
N X,XQI,XQX,XQX1,DIR,XQA,Y,XQON,XQOFF,XQ1ON,XQ1OFF,XQXDAT S XQX=0,XQX1=0,Y=1,DIR(0)="E" ; P285
S XQACNT=0 D SORT
F XQJ=0:0 D:XQX1&'(XQX1#20) ^DIR Q:'Y S XQJ=$O(^TMP("XQ",$J,"XQA",XQJ)) Q:XQJ'>0 S XQI=^TMP("XQ",$J,"XQA",XQJ),XQX=XQX+1,X=$G(^XTV(8992,XQAUSER,"XQA",XQI,0)) I $P(X,U,4) D
. N XQXXX,XQXX,XQXY
. S XQXXX=X,(XQXX,XQXY)=0,XQXX=$P(X,U,2) I XQXX'="" S XQXX=$O(^XTV(8992.1,"B",$E(XQXX,1,50),0)) I XQXX>0 S XQXY=$O(^XTV(8992.1,XQXX,20,"B",XQAUSER,0)) I XQXY>0 S XQXDAT=$$NOW^XLFDT(),$P(^XTV(8992.1,XQXX,20,XQXY,0),U,2)=XQXDAT ; P173
. S XQON="$C(0)",XQOFF="$C(0)"
. I $$CHKCRIT^XQALSUR2(XQXXX) D:'$D(XQ1ON) SETREV S XQON=XQ1ON,XQOFF=XQ1OFF ; P513 modified to add use data from file 8992.3 for identifying critical alerts
. S X=XQXXX W:XQX1=0 $C(7) W !,@XQON,$P(X,U,3),@XQOFF S XQX1=XQX1+1,$P(^XTV(8992,XQAUSER,"XQA",XQI,0),U,4)="" I $D(^(2)) S X1=^(2) D ; P285
. . S X2=$P(X1,U,3)
. . W !?5,"*** FORWARDED BY: ",$P(^VA(200,+X1,0),U)," Generated: " S X1=$P($P(X,U,2),";",3) W $$DAT8(X1,1)
. . I X2'="" W !?5,X2
. I $P(X,U,5)="D" S XQA=$P(X,U,2) K ^XTV(8992,XQAUSER,"XQA",XQI) D S XQX=XQX-1 D:XQA'="" D
. . I $G(XQXX)>0,$G(XQXY)>0 S $P(^XTV(8992.1,XQXX,20,XQXY,0),U,5)=XQXDAT
. K XQXX,XQXY
I XQX>0 W:XQX1=0 !!,"You have PENDING ALERTS" W !?10,"Enter ""VA to jump to VIEW ALERTS option",! ; ISL-0898-51279
W:XQX1>0 !
K XQI,XQX,XQX1,DIR,XQA,Y
Q
;
SORT ;SR. Sort alerts
; ZEXCEPT: XQAUSER,XQACNT - global variable
N XQI,XQJ,XQX
Q:$O(^XTV(8992,XQAUSER,"XQA",0))'>0
K ^TMP("XQ",$J,"XQA")
F XQI=9999999.999999:0 S XQI=$O(^XTV(8992,XQAUSER,"XQA",XQI),-1) Q:(XQI'>0)!(XQACNT>100) D ; P632 sort recent alerts
. S XQX=^XTV(8992,XQAUSER,"XQA",XQI,0) ; zero node for the alert
. S XQACNT=XQACNT+1
. I $$CHKCRIT^XQALSUR2(XQX) D
. . S XQJ=XQACNT ; critical alert
. E D
. . S XQJ=500000+XQACNT ; normal alert
. S ^TMP("XQ",$J,"XQA",XQJ)=XQI ; IEN of the alert
Q
;
D ;
; ZEXCEPT: XQA
K ^XTV(8992,"AXQA",XQA,DUZ),^XTV(8992,"AXQAN",$P(XQA,";"),DUZ)
Q
;
DAT8(FMDAT,TFLG) ;
N X
S X=$E(FMDAT,4,5)_"/"_$E(FMDAT,6,7)_"/"_$E(FMDAT,2,3)
I $G(TFLG)>0 S FMDAT=FMDAT_"0000000",X=X_" "_$E(FMDAT,9,10)_":"_$E(FMDAT,11,12)_":"_$E(FMDAT,13,14)
Q X
;
DOIT ;OPT. Process Alerts [XQALERT]
N XQALAST,XQALFWD,XQAUSER
S XQAUSER=DUZ D DOIT^XQALERT1,COUNT^XQALDEL(0,XQAUSER)
Q
;
DELETE ;
D DELETE^XQALDEL
Q
;
DELETEA ;
D DELETEA^XQALDEL
Q
;
OLDDEL ;OPT.
D OLDDEL^XQALDEL
Q
;
USERDEL ;OPT.
D USERDEL^XQALDEL
Q
;
USER(ROOT,XQAUSER,FRSTDATE,LASTDATE) ; Returns current alerts for the user in an array located under root
I '$D(XQAUSER) S XQAUSER=DUZ
I $$ACTVSURO^XQALSURO(XQAUSER)'>0 D RETURN^XQALSUR1(XQAUSER) ; P366
D GETUSER^XQALDATA(ROOT,XQAUSER,$G(FRSTDATE),$G(LASTDATE))
Q
;
PATIENT(ROOT,PATIENT,FRSTDATE,LASTDATE) ;
I $G(PATIENT)'>0 Q
D GETPAT^XQALDATA(ROOT,PATIENT,$G(FRSTDATE),$G(LASTDATE))
Q
;
ACTION(ALERTID) ;
D ACTION^XQALDOIT(ALERTID)
Q
;
GETACT(ALERTID) ; Return to calling routine the information needed to act on the specified alert.
; On return the following variables are defined:
; XQAID = the full alert id
; XQADATA = Any data passed as XQADATA at the time the alert was generated
; XQAROU = Indicates routine to be run (includes tag if necessary)
; This value may have three meanings
; 1. A null value indicates no routine to be used (XQAOPT contains option name to be run)
; 2. A value of ^<space> indicates that the alert is information only (no routine or option action involved).
; 3. The name of the routine as ^ROUTINE or TAG^ROUTINE
; XQAOPT = Indicates the name of the option to be run if not null.
;
; ZEXCEPT: XQADATA,XQAID,XQAOPT,XQAROU
N XQX,XQZ,XQAGETAC
S XQAGETAC=1,XQX="",XQZ=""
D ACTION^XQALDOIT(ALERTID)
S XQAID=$P(XQX,U,2)
S XQADATA=$S(XQZ'="":XQZ,1:$P(XQX,U,9,99))
S XQAROU=$S($P(XQX,U,8)="":"",1:$P(XQX,U,7,8))
S XQAOPT=$S($P(XQX,U,8)="":$P(XQX,U,7),1:"")
Q
;
SETREV ; Set on (XQ1ON) and off (XQ1OFF) variables for Reverse video ; P285
; ZEXCEPT: IOST,XQ1OFF,XQ1ON - global variables
N XQ1ON1,XQ1OFF1
S XQ1ON="$C(0)",XQ1OFF="$C(0)" I IOST(0)>0 D
. S XQ1ON1=$$GET1^DIQ(3.2,IOST(0)_",",14) I XQ1ON1'="" S XQ1ON=XQ1ON1
. S XQ1OFF1=$$GET1^DIQ(3.2,IOST(0)_",",15) I XQ1OFF1'="" S XQ1OFF=XQ1OFF1
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQALERT 4874 printed Oct 16, 2024@18:06:10 Page 2
XQALERT ;ISF/JLI,ISD/HGW - ALERT HANDLER ;05/29/13 11:21
+1 ;;8.0;KERNEL;**1,65,125,173,285,366,513,602,632**;Jul 10, 1995;Build 3
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
SETUP ;SR.
+1 DO SETUP^XQALSET
+2 QUIT
+3 ;
SETUP1() ;SR.
+1 NEW I
SET I=$$SETUP1^XQALSET()
+2 QUIT I
+3 ;
DISPLAY ;SR. Display recent new alerts
+1 ; ZEXCEPT: XQAUSER - global variable
+2 NEW X1,X2,XQACNT,XQJ
+3 IF '$DATA(XQAUSER)
SET XQAUSER=DUZ
+4 ; P513
IF $$ACTVSURO^XQALSURO(XQAUSER)'>0
DO RETURN^XQALSUR1(XQAUSER)
+5 if $ORDER(^XTV(8992,DUZ,"XQA",0))'>0
QUIT
+6 ; P285
NEW X,XQI,XQX,XQX1,DIR,XQA,Y,XQON,XQOFF,XQ1ON,XQ1OFF,XQXDAT
SET XQX=0
SET XQX1=0
SET Y=1
SET DIR(0)="E"
+7 SET XQACNT=0
DO SORT
+8 FOR XQJ=0:0
if XQX1&'(XQX1#20)
DO ^DIR
if 'Y
QUIT
SET XQJ=$ORDER(^TMP("XQ",$JOB,"XQA",XQJ))
if XQJ'>0
QUIT
SET XQI=^TMP("XQ",$JOB,"XQA",XQJ)
SET XQX=XQX+1
SET X=$GET(^XTV(8992,XQAUSER,"XQA",XQI,0))
IF $PIECE(X,U,4)
Begin DoDot:1
+9 NEW XQXXX,XQXX,XQXY
+10 ; P173
SET XQXXX=X
SET (XQXX,XQXY)=0
SET XQXX=$PIECE(X,U,2)
IF XQXX'=""
SET XQXX=$ORDER(^XTV(8992.1,"B",$EXTRACT(XQXX,1,50),0))
IF XQXX>0
SET XQXY=$ORDER(^XTV(8992.1,XQXX,20,"B",XQAUSER,0))
IF XQXY>0
SET XQXDAT=$$NOW^XLFDT()
SET $PIECE(^XTV(8992.1,XQXX,20,XQXY,0),U,2)=XQXDAT
+11 SET XQON="$C(0)"
SET XQOFF="$C(0)"
+12 ; P513 modified to add use data from file 8992.3 for identifying critical alerts
IF $$CHKCRIT^XQALSUR2(XQXXX)
if '$DATA(XQ1ON)
DO SETREV
SET XQON=XQ1ON
SET XQOFF=XQ1OFF
+13 ; P285
SET X=XQXXX
if XQX1=0
WRITE $CHAR(7)
WRITE !,@XQON,$PIECE(X,U,3),@XQOFF
SET XQX1=XQX1+1
SET $PIECE(^XTV(8992,XQAUSER,"XQA",XQI,0),U,4)=""
IF $DATA(^(2))
SET X1=^(2)
Begin DoDot:2
+14 SET X2=$PIECE(X1,U,3)
+15 WRITE !?5,"*** FORWARDED BY: ",$PIECE(^VA(200,+X1,0),U)," Generated: "
SET X1=$PIECE($PIECE(X,U,2),";",3)
WRITE $$DAT8(X1,1)
+16 IF X2'=""
WRITE !?5,X2
End DoDot:2
+17 IF $PIECE(X,U,5)="D"
SET XQA=$PIECE(X,U,2)
KILL ^XTV(8992,XQAUSER,"XQA",XQI)
Begin DoDot:2
+18 IF $GET(XQXX)>0
IF $GET(XQXY)>0
SET $PIECE(^XTV(8992.1,XQXX,20,XQXY,0),U,5)=XQXDAT
End DoDot:2
SET XQX=XQX-1
if XQA'=""
DO D
+19 KILL XQXX,XQXY
End DoDot:1
+20 ; ISL-0898-51279
IF XQX>0
if XQX1=0
WRITE !!,"You have PENDING ALERTS"
WRITE !?10,"Enter ""VA to jump to VIEW ALERTS option",!
+21 if XQX1>0
WRITE !
+22 KILL XQI,XQX,XQX1,DIR,XQA,Y
+23 QUIT
+24 ;
SORT ;SR. Sort alerts
+1 ; ZEXCEPT: XQAUSER,XQACNT - global variable
+2 NEW XQI,XQJ,XQX
+3 if $ORDER(^XTV(8992,XQAUSER,"XQA",0))'>0
QUIT
+4 KILL ^TMP("XQ",$JOB,"XQA")
+5 ; P632 sort recent alerts
FOR XQI=9999999.999999:0
SET XQI=$ORDER(^XTV(8992,XQAUSER,"XQA",XQI),-1)
if (XQI'>0)!(XQACNT>100)
QUIT
Begin DoDot:1
+6 ; zero node for the alert
SET XQX=^XTV(8992,XQAUSER,"XQA",XQI,0)
+7 SET XQACNT=XQACNT+1
+8 IF $$CHKCRIT^XQALSUR2(XQX)
Begin DoDot:2
+9 ; critical alert
SET XQJ=XQACNT
End DoDot:2
+10 IF '$TEST
Begin DoDot:2
+11 ; normal alert
SET XQJ=500000+XQACNT
End DoDot:2
+12 ; IEN of the alert
SET ^TMP("XQ",$JOB,"XQA",XQJ)=XQI
End DoDot:1
+13 QUIT
+14 ;
D ;
+1 ; ZEXCEPT: XQA
+2 KILL ^XTV(8992,"AXQA",XQA,DUZ),^XTV(8992,"AXQAN",$PIECE(XQA,";"),DUZ)
+3 QUIT
+4 ;
DAT8(FMDAT,TFLG) ;
+1 NEW X
+2 SET X=$EXTRACT(FMDAT,4,5)_"/"_$EXTRACT(FMDAT,6,7)_"/"_$EXTRACT(FMDAT,2,3)
+3 IF $GET(TFLG)>0
SET FMDAT=FMDAT_"0000000"
SET X=X_" "_$EXTRACT(FMDAT,9,10)_":"_$EXTRACT(FMDAT,11,12)_":"_$EXTRACT(FMDAT,13,14)
+4 QUIT X
+5 ;
DOIT ;OPT. Process Alerts [XQALERT]
+1 NEW XQALAST,XQALFWD,XQAUSER
+2 SET XQAUSER=DUZ
DO DOIT^XQALERT1
DO COUNT^XQALDEL(0,XQAUSER)
+3 QUIT
+4 ;
DELETE ;
+1 DO DELETE^XQALDEL
+2 QUIT
+3 ;
DELETEA ;
+1 DO DELETEA^XQALDEL
+2 QUIT
+3 ;
OLDDEL ;OPT.
+1 DO OLDDEL^XQALDEL
+2 QUIT
+3 ;
USERDEL ;OPT.
+1 DO USERDEL^XQALDEL
+2 QUIT
+3 ;
USER(ROOT,XQAUSER,FRSTDATE,LASTDATE) ; Returns current alerts for the user in an array located under root
+1 IF '$DATA(XQAUSER)
SET XQAUSER=DUZ
+2 ; P366
IF $$ACTVSURO^XQALSURO(XQAUSER)'>0
DO RETURN^XQALSUR1(XQAUSER)
+3 DO GETUSER^XQALDATA(ROOT,XQAUSER,$GET(FRSTDATE),$GET(LASTDATE))
+4 QUIT
+5 ;
PATIENT(ROOT,PATIENT,FRSTDATE,LASTDATE) ;
+1 IF $GET(PATIENT)'>0
QUIT
+2 DO GETPAT^XQALDATA(ROOT,PATIENT,$GET(FRSTDATE),$GET(LASTDATE))
+3 QUIT
+4 ;
ACTION(ALERTID) ;
+1 DO ACTION^XQALDOIT(ALERTID)
+2 QUIT
+3 ;
GETACT(ALERTID) ; Return to calling routine the information needed to act on the specified alert.
+1 ; On return the following variables are defined:
+2 ; XQAID = the full alert id
+3 ; XQADATA = Any data passed as XQADATA at the time the alert was generated
+4 ; XQAROU = Indicates routine to be run (includes tag if necessary)
+5 ; This value may have three meanings
+6 ; 1. A null value indicates no routine to be used (XQAOPT contains option name to be run)
+7 ; 2. A value of ^<space> indicates that the alert is information only (no routine or option action involved).
+8 ; 3. The name of the routine as ^ROUTINE or TAG^ROUTINE
+9 ; XQAOPT = Indicates the name of the option to be run if not null.
+10 ;
+11 ; ZEXCEPT: XQADATA,XQAID,XQAOPT,XQAROU
+12 NEW XQX,XQZ,XQAGETAC
+13 SET XQAGETAC=1
SET XQX=""
SET XQZ=""
+14 DO ACTION^XQALDOIT(ALERTID)
+15 SET XQAID=$PIECE(XQX,U,2)
+16 SET XQADATA=$SELECT(XQZ'="":XQZ,1:$PIECE(XQX,U,9,99))
+17 SET XQAROU=$SELECT($PIECE(XQX,U,8)="":"",1:$PIECE(XQX,U,7,8))
+18 SET XQAOPT=$SELECT($PIECE(XQX,U,8)="":$PIECE(XQX,U,7),1:"")
+19 QUIT
+20 ;
SETREV ; Set on (XQ1ON) and off (XQ1OFF) variables for Reverse video ; P285
+1 ; ZEXCEPT: IOST,XQ1OFF,XQ1ON - global variables
+2 NEW XQ1ON1,XQ1OFF1
+3 SET XQ1ON="$C(0)"
SET XQ1OFF="$C(0)"
IF IOST(0)>0
Begin DoDot:1
+4 SET XQ1ON1=$$GET1^DIQ(3.2,IOST(0)_",",14)
IF XQ1ON1'=""
SET XQ1ON=XQ1ON1
+5 SET XQ1OFF1=$$GET1^DIQ(3.2,IOST(0)_",",15)
IF XQ1OFF1'=""
SET XQ1OFF=XQ1OFF1
+6 QUIT
End DoDot:1
+7 QUIT
