- 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 Jan 18, 2025@03:06:34 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