XQALERT1 ;ISC-SF.SEA/JLI - ALERT HANDLER ;07/05/12 11:27
;;8.0;KERNEL;**20,65,114,123,125,164,173,285,366,443,513,602**;Jul 10, 1995;Build 10
;Per VHA Directive 2004-038, this routine should not be modified
Q
;
DOIT ;SR.
; ZEXCEPT: IOF,XQAID,XQAUSER,XQX1 - global variables
; ZEXCEPT: XQACNT,XQADATA,XQAKILL,XQALDELE,XQALFWD,XQAQ,XQAREV,XQAROU,XQAROUX,XQI,XQII,XQK,XQX,XQXOUT,XQZ4
N DIR,DIRUT,DUOUT,Y
I $D(XQX1),XQX1'>0 K XQX1
I $D(XQAID) D I '$D(XQAID) G EXIT
. N XQACHOIC,REASK S REASK=0
. I '$D(XQX1),$O(^XTV(8992,XQAUSER,"XQA",+$O(^XTV(8992,XQAUSER,"XQA",0))))'>0,$G(XQAROUX)="^ " S XQAROU=""
AGAIN . S XQACHOIC="Y:YES;N:NO;C:CONTINUE;",XQAQ("?")="Enter Y (or C) to continue, N to exit alert processing"
. S XQACHOIC=$G(XQACHOIC)_"F:FORWARD ALERT;R:RENEW(MAKE NEW AGAIN);" S XQAQ("?",1)="Enter F to forward this alert to someone else",XQAQ("?",2)="Enter R to Renew (Make New) this alert"
. D I REASK=1 G AGAIN
. . S REASK=0 W !! K DIR S DIR(0)="SA^"_XQACHOIC,DIR("A")=$S(XQACHOIC["F:":"Continue (Y/N) or F(orward) or R(enew) ",1:"Continue Processing (Y/N) "),DIR("B")="YES" M DIR("?")=XQAQ("?") D ^DIR K DIR
. . I $D(DUOUT)!$D(DIRUT) S Y="N" K DUOUT,DIRUT
. . I Y="N" D:$D(XQAKILL) DELETEA^XQALERT K XQAID
. . I Y="R" S REASK=REASK+1 K XQAKILL I '$D(^XTV(8992,"AXQA",XQAID,DUZ)) D RESTORE
. . I Y="F" D:'$D(^XTV(8992,"AXQA",XQAID,DUZ)) RESTORE D FRWRDONE S REASK=REASK+1
. . Q
. Q
I $D(XQAKILL) D DELETEA^XQALERT
S XQAREV=1,XQXOUT=0,XQK=0,XQACNT=0 K XQADATA,XQAID,XQAROU,XQAKILL,XQAROUX
I '$D(XQX1) S XQX1=0 K ^TMP("XQ",$J,"XQA"),^("XQA1"),^("XQA2") I $O(^XTV(8992,XQAUSER,"XQA",0))'>0 K XQX1 D:'$G(^TMP("XQALERT1",$J,"NOTFIRST")) CHKSURO G:$O(^XTV(8992,XQAUSER,"XQA",0))'>0 EXIT S XQX1=0 ; P366
I $$ACTVSURO^XQALSURO(XQAUSER)'>0 D RETURN^XQALSUR1(XQAUSER) ; P366
S ^TMP("XQALERT1",$J,"NOTFIRST")=1 ; Added 2/2/99 jli to clear flag for initial entry
;Sort and remove display only
I 'XQX1 W !!! D
. D SORT
; Now display them.
SUBLOOP W @IOF
N XQZ1,XQZ
S XQK=0 F XQI=0:0 Q:XQX1!XQXOUT S XQI=$O(^TMP("XQ",$J,"XQA",XQI)) Q:XQI'>0 S XQX=^(XQI),XQII=^(XQI,1),XQZ=^(2),XQZ1=^(3),XQZ4=^(4) D I XQX'="" D DOIT1
. I '$D(^XTV(8992,XQAUSER,"XQA",XQII)) S XQX="" K ^TMP("XQ",$J,"XQA",XQI),^TMP("XQ",$J,"XQA1",(XQI))
. Q
S:'$D(XQXOUT) XQXOUT=0 G:XQXOUT EXIT G:XQK'>0&'XQX1 EXIT I 'XQX1 D ASK G:XQXOUT EXIT
G:+XQX1=0 EXIT I XQX1<0 S XQX1=0 G DOIT
I $D(XQALDELE)!$D(XQALFWD) Q
G:XQXOUT EXIT
G EN^XQALDOIT
;
RESTORE ; SR. ICR #4100 (controlled subscription)
; Restore a deleted message for use
; ZEXCEPT: XQAID
N ALERTREF,XTVGLOB,ADUZ,X,X0,X1,X2,TIME,MESG,OPT,TAG,ROU,X4,LONG
S XTVGLOB=$NA(^XTV(8992,DUZ,"XQA"))
S ADUZ=$O(^XTV(8992,"AXQA",XQAID,0)) I ADUZ>0 S TIME=$O(^(ADUZ,0)) D I 1
. M @XTVGLOB@(TIME)=^XTV(8992,ADUZ,"XQA",TIME) K @XTVGLOB@(TIME,2) ; copy alert, kill comment if any
E S ALERTREF=$O(^XTV(8992.1,"B",XQAID,0)) Q:ALERTREF'>0 D ; otherwise rebuild from alert tracking file if possible
. S X0=^XTV(8992.1,ALERTREF,0),X1=$G(^(1)),X2=$G(^(2)),X4=$O(^(4,0))
. S TIME=$P($P(X0,U),";",3),MESG=$P(X1,U),OPT=$P(X1,U,2),TAG=$P(X1,U,3),ROU=$P(X1,U,4),LONG=(X4>0)
. S X=TIME_U_XQAID_U_MESG_U_U_$S(OPT'=""!(ROU'=""):"R",LONG:"L",1:"I")_U_U_$S(OPT'="":OPT,TAG'="":TAG,1:"")_U_$S(OPT'="":"",ROU'="":ROU,1:" ")
. S @XTVGLOB@(TIME,0)=X I $G(X2)'="" S ^(1)=X2
S ^XTV(8992,"AXQA",XQAID,DUZ,TIME)="",^XTV(8992,"AXQAN",$E($P(XQAID,";"),1,30),DUZ,TIME)=""
Q
;
EXIT ;
; ZEXCEPT: %ZIS,XQ1,XQ1OFF,XQ1ON,XQA1,XQACNT,XQALAST,XQALDELE,XQALFWD,XQAQ,XQAREV,XQAROU,XQAROUX,XQI,XQII,XQJ,XQK,XQOFF,XQON,XQOUT,XQX,XQX1,XQX2,XQXOUT
I $G(XQALAST)="I",$G(DUZ("AUTO")) D WAIT2
I $D(XQALDELE)!$D(XQALFWD) Q
K ^TMP("XQ",$J,"XQA"),^("XQA1"),^("XQA2"),XQI,XQX,XQJ,XQK,XQX1,XQX2,XQXOUT,XQ1,XQII,XQACNT,XQA1,XQAREV,%ZIS,XQAROU,XQALAST,XQAROUX,XQON,XQOFF,XQ1ON,XQ1OFF,XQOUT,XQAQ
K ^TMP("XQALERT1",$J)
Q
;
CHKSURO ; If user selects process alerts with no alerts present, give him/her the opportunity to add or delete a surrogate
; P366 - list currently established surrogates if any
I '$G(^TMP("XQALERT1",$J,"NOTFIRST")) W !!,"You have no alerts for processing.",!
D SURROGAT^XQALSURO ; XU*8*17
Q
;
DOIT1 ;
; ZEXCEPT: IOF,IOSL,XQ1OFF,XQ1ON,XQALFWD,XQALINFO,XQI,XQII,XQK,XQOFF,XQON,XQX,XQZ,XQZ1,XQZ4
I XQK=0 S XQALINFO=0 I '$D(XQALFWD) W @IOF
S XQON="$C(0)",XQOFF="$C(0)" I $$CHKCRIT^XQALSUR2(XQX) D:'$D(XQ1ON) SETREV^XQALERT S XQON=XQ1ON,XQOFF=XQ1OFF ; P513 modified to add use data from file 8992.3 for identifying critical alerts
S XQK=XQK+1 W !,$J(XQK,2),".",$S(XQZ4:"L",$P(XQX,U,8)=" ":"I",1:" ")," ",@XQON,$E($P(XQX,U,3),1,70),@XQOFF S:$P(XQX,U,8)=" " XQALINFO=XQALINFO+1 D:XQZ1'="" ; P285
. W !?8,"Forwarded by: ",$P(^VA(200,+XQZ1,0),U)," Generated: ",$$DAT8^XQALERT(+$P($P(XQX,U,2),";",3),1)
. I $P(XQZ1,U,3)'="" W !?8,$P(XQZ1,U,3)
S ^TMP("XQ",$J,"XQA1",XQK)=XQX,^(XQK,1)=XQII,^(2)=XQZ,^(3)=XQZ1
I ($Y+6)>IOSL N XQKVALUE S XQKVALUE=XQK D ASK0(XQI) S:'$D(XQK) XQK=XQKVALUE Q:XQX1!(XQXOUT) W @IOF
Q
;
ASK0(XQI) ;Stack XQI
; ZEXCEPT: DIR,X,XQ1,XQACNT,XQALAST,XQALDELE,XQALFWD,XQAUSER,XQII,XQK,XQX1,XQX2,XQXOUT,Y
ASK ;
N XQALNEWF K XQALAST
S XQ1=0,XQXOUT=0 W !?10,"Select from 1 to ",XQK W:$D(XQALDELE) " to DELETE" W:$D(XQALFWD) " to FORWARD"
W !?10,"or enter ?, A, " W:'$D(XQALDELE)&'$D(XQALFWD)&(XQALINFO>0) "I, D, " W:'$D(XQALDELE)&'$D(XQALFWD) "F, S, P, M, R, " W "or ^ to exit" I XQI>0,$O(^XTV(8992,XQAUSER,"XQA",XQI))>0 W !?10,"or RETURN to continue" S XQ1=1
R ": ",XQII:DTIME S:'$T!(XQII[U)!(XQII=""&'XQ1) XQXOUT=1 Q:XQXOUT
I '$D(XQALDELE)&'$D(XQALFWD),"PpMm"[$E(XQII_".") D MORP^XQALDOIT D:"Pp"[$E(XQII_".") PRINT^XQALDOIT D:"Mm"[$E(XQII_".") MAIL^XQALDOIT K ^TMP("XQ",$J,"XQA2") G ASK
I XQII'="",XQII["?" D HELP G ASK
I XQII=""&XQ1 Q
I "IiAaFfRrSsDd"'[$E(XQII_"."),$L(XQII)>31,$E(XQII,1,32)?1N.N W !,$C(7)," ?? Invalid number entered",! G ASK
I "IiAaFfRrSsDd"'[$E(XQII_"."),(XQII<1)!(XQII>XQK) W $C(7)," ??",! G ASK
I '$D(XQALDELE)&'$D(XQALFWD),"Ff"[$E(XQII) D FWRD^XQALFWD S XQX1=-2 Q ; MODIFIED 7-6
I '$D(XQALDELE)&'$D(XQALFWD),"Ss"[$E(XQII) D CHKSURO S XQX1=-1 Q
I '$D(XQALDELE)&'$D(XQALFWD),"Dd"[$E(XQII) D ASKDEL S XQX1=-2 Q ; MODIFIED 7-6
I '$D(XQALDELE),"Rr"[$E(XQII) S XQX1=-2 Q
I "Aa"[$E(XQII) S X="1-"_XQACNT,DIR(0)="LV^1:"_XQACNT D ^DIR K DIR,XQX1 M XQX1=Y S XQII="" K Y ;Merge list from Y
I XQII'="","Ii"[$E(XQII) S XQX1(0)="",XQX2=0,XQII="" F XQK=0:0 S XQK=$O(^TMP("XQ",$J,"XQA1",XQK)) S:XQK'>0 XQX1=XQX1(0) Q:XQK'>0 I $P(^(XQK),U,7,8)="^ " S XQX1(XQX2)=XQX1(XQX2)_XQK_"," S:$L(XQX1(XQX2))>240 XQX2=XQX2+1,XQX1(XQX2)=""
I XQII="" Q
S X=XQII,DIR(0)="LV^1:"_XQK D ^DIR I '$D(Y) W $C(7)," ??" D HELP G ASK ;Use of 'LV' is special
K XQX1 M XQX1=Y K Y S Y=XQX1 ;Merge list from Y
Q
;
WAIT(IFN) ;Wait for user input if last alert is INFO and next isn't.
; ZEXCEPT: IOF,IOSL,XQALAST
N X,YY Q:$G(XQXOUT)
S X=$G(^TMP("XQ",$J,"XQA1",IFN)),YY=$P(X,U,7,8),YY=$S(YY="^ ":"I",YY="^":"O",1:"R")
I $G(XQALAST)="I","OR"[YY D WAIT2
I YY="I",$Y+4>IOSL D WAIT2 W @IOF
S XQALAST=YY
Q
;
WAIT2 ;Wait for user input before continuing
; ZEXCEPT: XQXOUT
N DIR,Y,DIROUT,DIRUT S DIR(0)="E",DIR("?")="The next ALERT may cause the loss of info on the screen."
D ^DIR S:$D(DIRUT) XQXOUT=1
Q
;
HELP ;
; ZEXCEPT: XQALDELE,XQALFWD,XQI,XQK
W !!,"YOU MAY ENTER:",!?3,$S(XQK>1:"One or more numbers",1:"A number")," in the range 1 to ",XQK," to select specific alert(s)"
W !?6,"for "_$S($D(XQALDELE):"DELETION.",$D(XQALFWD):"FORWARDING",1:"processing.") W:XQK>1 " This may be a series of numbers, e.g., 2,3,6-9"
W !?3,"A to "_$S($D(XQALDELE):"DELETE",$D(XQALFWD):"FORWARD",1:"process")," all of the pending alerts in the order shown."
W:'$D(XQALDELE)&'$D(XQALFWD) !?3,"I to process all of the INFORMATION ONLY alerts, if any, without further ado."
W:'$D(XQALDELE)&'$D(XQALFWD) !?3,"S to add or remove a surrogate to receive alerts for you"
W:'$D(XQALDELE)&'$D(XQALFWD) !?3,"F to forward one or more specific alerts. Forwarding may be as an ALERT",!,"to specific user(s) and/or mail group(s), or as a MAIL MESSAGE, or to a",!,"specific PRINTER."
W:'$D(XQALDELE)&'$D(XQALFWD) !?3,"D to delete specific alerts (some alerts may not be deleted)"
W:'$D(XQALDELE)&'$D(XQALFWD) !?3,"P to print a copy of the pending alerts on a printer"
W:'$D(XQALDELE)&'$D(XQALFWD) !?3,"M to receive a MailMan message containing a copy of these pending alerts"
W:'$D(XQALDELE) !?3,"R to Redisplay the available alerts"
W !?3,"^ to exit"
I XQI W !?5,"or RETURN to see additional pending ALERTS"
W !!
Q
;
SORT ;Sort and remove display only
; ZEXCEPT: XQAUSER,XQACNT,XQAREV - global variable
; Unit test: P602T3^ZZUTXQA6
N XQZ,XQZ1,XQZ4,XQI,XQK,XQX,XQJ
K ^TMP("XQ",$J,"XQA")
K ^TMP("XQ",$J,"XQA1")
F XQI=0:0 S XQI=$O(^XTV(8992,XQAUSER,"XQA",XQI)) Q:(XQI'>0)!(XQACNT>10000) D
. S XQX=^XTV(8992,XQAUSER,"XQA",XQI,0) ; zero node for the alert
. S XQZ=$G(^XTV(8992,XQAUSER,"XQA",XQI,1)) ; data for alert
. S XQZ1=$G(^XTV(8992,XQAUSER,"XQA",XQI,2)) ; comment for display
. S XQZ4=$O(^XTV(8992,XQAUSER,"XQA",XQI,4,0)) ; long info text
. S XQJ=$P(XQX,U,7,8) K:XQJ=U ^XTV(8992,XQAUSER,"XQA",XQI) I XQJ'=U D
. . S XQACNT=XQACNT+1
. . I $$CHKCRIT^XQALSUR2(XQX) D
. . . S XQJ=$S(XQAREV:499999-XQACNT,1:XQACNT) ; critical alert
. . E D
. . . S XQJ=$S(XQAREV:999999-XQACNT,1:500000+XQACNT) ; normal alert
. . S ^TMP("XQ",$J,"XQA",XQJ)=XQX ; zero node for the alert
. . S ^TMP("XQ",$J,"XQA",XQJ,1)=XQI ; IEN of the alert
. . S ^TMP("XQ",$J,"XQA",XQJ,2)=XQZ ; data for the alert
. . S ^TMP("XQ",$J,"XQA",XQJ,3)=XQZ1 ; comment for display
. . S ^TMP("XQ",$J,"XQA",XQJ,4)=XQZ4 ; long info text
S XQK=0 F XQI=0:0 S XQI=$O(^TMP("XQ",$J,"XQA",XQI)) Q:XQI'>0 S XQK=XQK+1 M ^TMP("XQ",$J,"XQA1",XQK)=^TMP("XQ",$J,"XQA",XQI)
K ^TMP("XQ",$J,"XQA")
S XQK=0 F XQI=0:0 S XQI=$O(^TMP("XQ",$J,"XQA1",XQI)) Q:XQI'>0 S XQK=XQK+1 M ^TMP("XQ",$J,"XQA",XQK)=^TMP("XQ",$J,"XQA1",XQI)
Q
;
ASKDEL ;
; ZEXCEPT: XQAUSER,XQX1 - global variables
N DIR,XQALDELE,XQX1COPY,XQAID,DA,XQAKILL,XQXOUT,XQAUSERD,XQALVALU,Y
S XQALDELE=1
K XQX1
D DOIT^XQALERT1
K XQALDELE S XQAUSERD=1
I $D(XQX1),XQX1>0 D
. M XQX1COPY=XQX1
. F Q:XQX1="" S DA=+XQX1,XQX1=$P(XQX1,",",2,99) D I XQX1="" S Y=$O(XQX1(0)) I Y>0 S XQX1=XQX1(Y) K XQX1(Y)
. . S XQAID=$P(^TMP("XQ",$J,"XQA1",DA),U,2),XQALVALU=^(DA),XQAKILL=1
. . I $P(XQALVALU,U,8)=" "!$P(XQALVALU,U,10) D
. . . I XQAID="" K ^XTV(8992,XQAUSER,"XQA",+^TMP("XQ",$J,"XQA1",DA,1))
. . . I XQAID'="" D DELETE^XQALDEL
. . . K ^TMP("XQ",$J,"XQA1",DA),^TMP("XQ",$J,"XQA",(999999-DA))
. K XQX1 M XQX1=XQX1COPY S XQAID=0
. F Q:XQX1="" S DA=+XQX1,XQX1=$P(XQX1,",",2,99) D I XQX1="" S Y=$O(XQX1(0)) I Y>0 S XQX1=XQX1(Y) K XQX1(Y)
. . I $D(^TMP("XQ",$J,"XQA1",DA)) W:'XQAID !!,"Unable to delete alerts which require action: ",DA W:XQAID ",",DA S XQAID=1
. I XQAID=1 K DIR S DIR(0)="E" D ^DIR K DIR
K XQX1,XQAKILL
Q
;
FRWRDONE ;
; ZEXCEPT: XQAID - global variable
N XQX1,XQALFWDL S XQALFWDL(1)=XQAID
N XQAID
D FWDONE^XQALFWD
Q
XQALERT1 ;ISC-SF.SEA/JLI - ALERT HANDLER ;07/05/12 11:27
+1 ;;8.0;KERNEL;**20,65,114,123,125,164,173,285,366,443,513,602**;Jul 10, 1995;Build 10
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 QUIT
+4 ;
DOIT ;SR.
+1 ; ZEXCEPT: IOF,XQAID,XQAUSER,XQX1 - global variables
+2 ; ZEXCEPT: XQACNT,XQADATA,XQAKILL,XQALDELE,XQALFWD,XQAQ,XQAREV,XQAROU,XQAROUX,XQI,XQII,XQK,XQX,XQXOUT,XQZ4
+3 NEW DIR,DIRUT,DUOUT,Y
+4 IF $DATA(XQX1)
IF XQX1'>0
KILL XQX1
+5 IF $DATA(XQAID)
Begin DoDot:1
+6 NEW XQACHOIC,REASK
SET REASK=0
+7 IF '$DATA(XQX1)
IF $ORDER(^XTV(8992,XQAUSER,"XQA",+$ORDER(^XTV(8992,XQAUSER,"XQA",0))))'>0
IF $GET(XQAROUX)="^ "
SET XQAROU=""
AGAIN SET XQACHOIC="Y:YES;N:NO;C:CONTINUE;"
SET XQAQ("?")="Enter Y (or C) to continue, N to exit alert processing"
+1 SET XQACHOIC=$GET(XQACHOIC)_"F:FORWARD ALERT;R:RENEW(MAKE NEW AGAIN);"
SET XQAQ("?",1)="Enter F to forward this alert to someone else"
SET XQAQ("?",2)="Enter R to Renew (Make New) this alert"
+2 Begin DoDot:2
+3 SET REASK=0
WRITE !!
KILL DIR
SET DIR(0)="SA^"_XQACHOIC
SET DIR("A")=$SELECT(XQACHOIC["F:":"Continue (Y/N) or F(orward) or R(enew) ",1:"Continue Processing (Y/N) ")
SET DIR("B")="YES"
MERGE DIR("?")=XQAQ("?")
DO ^DIR
KILL DIR
+4 IF $DATA(DUOUT)!$DATA(DIRUT)
SET Y="N"
KILL DUOUT,DIRUT
+5 IF Y="N"
IF $DATA(XQAKILL)
DO DELETEA^XQALERT
KILL XQAID
+6 IF Y="R"
SET REASK=REASK+1
KILL XQAKILL
IF '$DATA(^XTV(8992,"AXQA",XQAID,DUZ))
DO RESTORE
+7 IF Y="F"
IF '$DATA(^XTV(8992,"AXQA",XQAID,DUZ))
DO RESTORE
DO FRWRDONE
SET REASK=REASK+1
+8 QUIT
End DoDot:2
IF REASK=1
GOTO AGAIN
+9 QUIT
End DoDot:1
IF '$DATA(XQAID)
GOTO EXIT
+10 IF $DATA(XQAKILL)
DO DELETEA^XQALERT
+11 SET XQAREV=1
SET XQXOUT=0
SET XQK=0
SET XQACNT=0
KILL XQADATA,XQAID,XQAROU,XQAKILL,XQAROUX
+12 ; P366
IF '$DATA(XQX1)
SET XQX1=0
KILL ^TMP("XQ",$JOB,"XQA"),^("XQA1"),^("XQA2")
IF $ORDER(^XTV(8992,XQAUSER,"XQA",0))'>0
KILL XQX1
IF '$GET(^TMP("XQALERT1",$JOB,"NOTFIRST"))
DO CHKSURO
IF $ORDER(^XTV(8992,XQAUSER,"XQA",0))'>0
GOTO EXIT
SET XQX1=0
+13 ; P366
IF $$ACTVSURO^XQALSURO(XQAUSER)'>0
DO RETURN^XQALSUR1(XQAUSER)
+14 ; Added 2/2/99 jli to clear flag for initial entry
SET ^TMP("XQALERT1",$JOB,"NOTFIRST")=1
+15 ;Sort and remove display only
+16 IF 'XQX1
WRITE !!!
Begin DoDot:1
+17 DO SORT
End DoDot:1
+18 ; Now display them.
SUBLOOP WRITE @IOF
+1 NEW XQZ1,XQZ
+2 SET XQK=0
FOR XQI=0:0
IF XQX1!XQXOUT
QUIT
SET XQI=$ORDER(^TMP("XQ",$JOB,"XQA",XQI))
IF XQI'>0
QUIT
SET XQX=^(XQI)
SET XQII=^(XQI,1)
SET XQZ=^(2)
SET XQZ1=^(3)
SET XQZ4=^(4)
Begin DoDot:1
+3 IF '$DATA(^XTV(8992,XQAUSER,"XQA",XQII))
SET XQX=""
KILL ^TMP("XQ",$JOB,"XQA",XQI),^TMP("XQ",$JOB,"XQA1",(XQI))
+4 QUIT
End DoDot:1
IF XQX'=""
DO DOIT1
+5 IF '$DATA(XQXOUT)
SET XQXOUT=0
IF XQXOUT
GOTO EXIT
IF XQK'>0&'XQX1
GOTO EXIT
IF 'XQX1
DO ASK
IF XQXOUT
GOTO EXIT
+6 IF +XQX1=0
GOTO EXIT
IF XQX1<0
SET XQX1=0
GOTO DOIT
+7 IF $DATA(XQALDELE)!$DATA(XQALFWD)
QUIT
+8 IF XQXOUT
GOTO EXIT
+9 GOTO EN^XQALDOIT
+10 ;
RESTORE ; SR. ICR #4100 (controlled subscription)
+1 ; Restore a deleted message for use
+2 ; ZEXCEPT: XQAID
+3 NEW ALERTREF,XTVGLOB,ADUZ,X,X0,X1,X2,TIME,MESG,OPT,TAG,ROU,X4,LONG
+4 SET XTVGLOB=$NAME(^XTV(8992,DUZ,"XQA"))
+5 SET ADUZ=$ORDER(^XTV(8992,"AXQA",XQAID,0))
IF ADUZ>0
SET TIME=$ORDER(^(ADUZ,0))
Begin DoDot:1
+6 ; copy alert, kill comment if any
MERGE @XTVGLOB@(TIME)=^XTV(8992,ADUZ,"XQA",TIME)
KILL @XTVGLOB@(TIME,2)
End DoDot:1
IF 1
+7 ; otherwise rebuild from alert tracking file if possible
IF '$TEST
SET ALERTREF=$ORDER(^XTV(8992.1,"B",XQAID,0))
IF ALERTREF'>0
QUIT
Begin DoDot:1
+8 SET X0=^XTV(8992.1,ALERTREF,0)
SET X1=$GET(^(1))
SET X2=$GET(^(2))
SET X4=$ORDER(^(4,0))
+9 SET TIME=$PIECE($PIECE(X0,U),";",3)
SET MESG=$PIECE(X1,U)
SET OPT=$PIECE(X1,U,2)
SET TAG=$PIECE(X1,U,3)
SET ROU=$PIECE(X1,U,4)
SET LONG=(X4>0)
+10 SET X=TIME_U_XQAID_U_MESG_U_U_$SELECT(OPT'=""!(ROU'=""):"R",LONG:"L",1:"I")_U_U_$SELECT(OPT'="":OPT,TAG'="":TAG,1:"")_U_$SELECT(OPT'="":"",ROU'="":ROU,1:" ")
+11 SET @XTVGLOB@(TIME,0)=X
IF $GET(X2)'=""
SET ^(1)=X2
End DoDot:1
+12 SET ^XTV(8992,"AXQA",XQAID,DUZ,TIME)=""
SET ^XTV(8992,"AXQAN",$EXTRACT($PIECE(XQAID,";"),1,30),DUZ,TIME)=""
+13 QUIT
+14 ;
EXIT ;
+1 ; ZEXCEPT: %ZIS,XQ1,XQ1OFF,XQ1ON,XQA1,XQACNT,XQALAST,XQALDELE,XQALFWD,XQAQ,XQAREV,XQAROU,XQAROUX,XQI,XQII,XQJ,XQK,XQOFF,XQON,XQOUT,XQX,XQX1,XQX2,XQXOUT
+2 IF $GET(XQALAST)="I"
IF $GET(DUZ("AUTO"))
DO WAIT2
+3 IF $DATA(XQALDELE)!$DATA(XQALFWD)
QUIT
+4 KILL ^TMP("XQ",$JOB,"XQA"),^("XQA1"),^("XQA2"),XQI,XQX,XQJ,XQK,XQX1,XQX2,XQXOUT,XQ1,XQII,XQACNT,XQA1,XQAREV,%ZIS,XQAROU,XQALAST,XQAROUX,XQON,XQOFF,XQ1ON,XQ1OFF,XQOUT,XQAQ
+5 KILL ^TMP("XQALERT1",$JOB)
+6 QUIT
+7 ;
CHKSURO ; If user selects process alerts with no alerts present, give him/her the opportunity to add or delete a surrogate
+1 ; P366 - list currently established surrogates if any
+2 IF '$GET(^TMP("XQALERT1",$JOB,"NOTFIRST"))
WRITE !!,"You have no alerts for processing.",!
+3 ; XU*8*17
DO SURROGAT^XQALSURO
+4 QUIT
+5 ;
DOIT1 ;
+1 ; ZEXCEPT: IOF,IOSL,XQ1OFF,XQ1ON,XQALFWD,XQALINFO,XQI,XQII,XQK,XQOFF,XQON,XQX,XQZ,XQZ1,XQZ4
+2 IF XQK=0
SET XQALINFO=0
IF '$DATA(XQALFWD)
WRITE @IOF
+3 ; P513 modified to add use data from file 8992.3 for identifying critical alerts
SET XQON="$C(0)"
SET XQOFF="$C(0)"
IF $$CHKCRIT^XQALSUR2(XQX)
IF '$DATA(XQ1ON)
DO SETREV^XQALERT
SET XQON=XQ1ON
SET XQOFF=XQ1OFF
+4 ; P285
SET XQK=XQK+1
WRITE !,$JUSTIFY(XQK,2),".",$SELECT(XQZ4:"L",$PIECE(XQX,U,8)=" ":"I",1:" ")," ",@XQON,$EXTRACT($PIECE(XQX,U,3),1,70),@XQOFF
IF $PIECE(XQX,U,8)=" "
SET XQALINFO=XQALINFO+1
IF XQZ1'=""
Begin DoDot:1
+5 WRITE !?8,"Forwarded by: ",$PIECE(^VA(200,+XQZ1,0),U)," Generated: ",$$DAT8^XQALERT(+$PIECE($PIECE(XQX,U,2),";",3),1)
+6 IF $PIECE(XQZ1,U,3)'=""
WRITE !?8,$PIECE(XQZ1,U,3)
End DoDot:1
+7 SET ^TMP("XQ",$JOB,"XQA1",XQK)=XQX
SET ^(XQK,1)=XQII
SET ^(2)=XQZ
SET ^(3)=XQZ1
+8 IF ($Y+6)>IOSL
NEW XQKVALUE
SET XQKVALUE=XQK
DO ASK0(XQI)
IF '$DATA(XQK)
SET XQK=XQKVALUE
IF XQX1!(XQXOUT)
QUIT
WRITE @IOF
+9 QUIT
+10 ;
ASK0(XQI) ;Stack XQI
+1 ; ZEXCEPT: DIR,X,XQ1,XQACNT,XQALAST,XQALDELE,XQALFWD,XQAUSER,XQII,XQK,XQX1,XQX2,XQXOUT,Y
ASK ;
+1 NEW XQALNEWF
KILL XQALAST
+2 SET XQ1=0
SET XQXOUT=0
WRITE !?10,"Select from 1 to ",XQK
IF $DATA(XQALDELE)
WRITE " to DELETE"
IF $DATA(XQALFWD)
WRITE " to FORWARD"
+3 WRITE !?10,"or enter ?, A, "
IF '$DATA(XQALDELE)&'$DATA(XQALFWD)&(XQALINFO>0)
WRITE "I, D, "
IF '$DATA(XQALDELE)&'$DATA(XQALFWD)
WRITE "F, S, P, M, R, "
WRITE "or ^ to exit"
IF XQI>0
IF $ORDER(^XTV(8992,XQAUSER,"XQA",XQI))>0
WRITE !?10,"or RETURN to continue"
SET XQ1=1
+4 READ ": ",XQII:DTIME
IF '$TEST!(XQII[U)!(XQII=""&'XQ1)
SET XQXOUT=1
IF XQXOUT
QUIT
+5 IF '$DATA(XQALDELE)&'$DATA(XQALFWD)
IF "PpMm"[$EXTRACT(XQII_".")
DO MORP^XQALDOIT
IF "Pp"[$EXTRACT(XQII_".")
DO PRINT^XQALDOIT
IF "Mm"[$EXTRACT(XQII_".")
DO MAIL^XQALDOIT
KILL ^TMP("XQ",$JOB,"XQA2")
GOTO ASK
+6 IF XQII'=""
IF XQII["?"
DO HELP
GOTO ASK
+7 IF XQII=""&XQ1
QUIT
+8 IF "IiAaFfRrSsDd"'[$EXTRACT(XQII_".")
IF $LENGTH(XQII)>31
IF $EXTRACT(XQII,1,32)?1N.N
WRITE !,$CHAR(7)," ?? Invalid number entered",!
GOTO ASK
+9 IF "IiAaFfRrSsDd"'[$EXTRACT(XQII_".")
IF (XQII<1)!(XQII>XQK)
WRITE $CHAR(7)," ??",!
GOTO ASK
+10 ; MODIFIED 7-6
IF '$DATA(XQALDELE)&'$DATA(XQALFWD)
IF "Ff"[$EXTRACT(XQII)
DO FWRD^XQALFWD
SET XQX1=-2
QUIT
+11 IF '$DATA(XQALDELE)&'$DATA(XQALFWD)
IF "Ss"[$EXTRACT(XQII)
DO CHKSURO
SET XQX1=-1
QUIT
+12 ; MODIFIED 7-6
IF '$DATA(XQALDELE)&'$DATA(XQALFWD)
IF "Dd"[$EXTRACT(XQII)
DO ASKDEL
SET XQX1=-2
QUIT
+13 IF '$DATA(XQALDELE)
IF "Rr"[$EXTRACT(XQII)
SET XQX1=-2
QUIT
+14 ;Merge list from Y
IF "Aa"[$EXTRACT(XQII)
SET X="1-"_XQACNT
SET DIR(0)="LV^1:"_XQACNT
DO ^DIR
KILL DIR,XQX1
MERGE XQX1=Y
SET XQII=""
KILL Y
+15 IF XQII'=""
IF "Ii"[$EXTRACT(XQII)
SET XQX1(0)=""
SET XQX2=0
SET XQII=""
FOR XQK=0:0
SET XQK=$ORDER(^TMP("XQ",$JOB,"XQA1",XQK))
IF XQK'>0
SET XQX1=XQX1(0)
IF XQK'>0
QUIT
IF $PIECE(^(XQK),U,7,8)="^ "
SET XQX1(XQX2)=XQX1(XQX2)_XQK_","
IF $LENGTH(XQX1(XQX2))>240
SET XQX2=XQX2+1
SET XQX1(XQX2)=""
+16 IF XQII=""
QUIT
+17 ;Use of 'LV' is special
SET X=XQII
SET DIR(0)="LV^1:"_XQK
DO ^DIR
IF '$DATA(Y)
WRITE $CHAR(7)," ??"
DO HELP
GOTO ASK
+18 ;Merge list from Y
KILL XQX1
MERGE XQX1=Y
KILL Y
SET Y=XQX1
+19 QUIT
+20 ;
WAIT(IFN) ;Wait for user input if last alert is INFO and next isn't.
+1 ; ZEXCEPT: IOF,IOSL,XQALAST
+2 NEW X,YY
IF $GET(XQXOUT)
QUIT
+3 SET X=$GET(^TMP("XQ",$JOB,"XQA1",IFN))
SET YY=$PIECE(X,U,7,8)
SET YY=$SELECT(YY="^ ":"I",YY="^":"O",1:"R")
+4 IF $GET(XQALAST)="I"
IF "OR"[YY
DO WAIT2
+5 IF YY="I"
IF $Y+4>IOSL
DO WAIT2
WRITE @IOF
+6 SET XQALAST=YY
+7 QUIT
+8 ;
WAIT2 ;Wait for user input before continuing
+1 ; ZEXCEPT: XQXOUT
+2 NEW DIR,Y,DIROUT,DIRUT
SET DIR(0)="E"
SET DIR("?")="The next ALERT may cause the loss of info on the screen."
+3 DO ^DIR
IF $DATA(DIRUT)
SET XQXOUT=1
+4 QUIT
+5 ;
HELP ;
+1 ; ZEXCEPT: XQALDELE,XQALFWD,XQI,XQK
+2 WRITE !!,"YOU MAY ENTER:",!?3,$SELECT(XQK>1:"One or more numbers",1:"A number")," in the range 1 to ",XQK," to select specific alert(s)"
+3 WRITE !?6,"for "_$SELECT($DATA(XQALDELE):"DELETION.",$DATA(XQALFWD):"FORWARDING",1:"processing.")
IF XQK>1
WRITE " This may be a series of numbers, e.g., 2,3,6-9"
+4 WRITE !?3,"A to "_$SELECT($DATA(XQALDELE):"DELETE",$DATA(XQALFWD):"FORWARD",1:"process")," all of the pending alerts in the order shown."
+5 IF '$DATA(XQALDELE)&'$DATA(XQALFWD)
WRITE !?3,"I to process all of the INFORMATION ONLY alerts, if any, without further ado."
+6 IF '$DATA(XQALDELE)&'$DATA(XQALFWD)
WRITE !?3,"S to add or remove a surrogate to receive alerts for you"
+7 IF '$DATA(XQALDELE)&'$DATA(XQALFWD)
WRITE !?3,"F to forward one or more specific alerts. Forwarding may be as an ALERT",!,"to specific user(s) and/or mail group(s), or as a MAIL MESSAGE, or to a",!,"specific PRINTER."
+8 IF '$DATA(XQALDELE)&'$DATA(XQALFWD)
WRITE !?3,"D to delete specific alerts (some alerts may not be deleted)"
+9 IF '$DATA(XQALDELE)&'$DATA(XQALFWD)
WRITE !?3,"P to print a copy of the pending alerts on a printer"
+10 IF '$DATA(XQALDELE)&'$DATA(XQALFWD)
WRITE !?3,"M to receive a MailMan message containing a copy of these pending alerts"
+11 IF '$DATA(XQALDELE)
WRITE !?3,"R to Redisplay the available alerts"
+12 WRITE !?3,"^ to exit"
+13 IF XQI
WRITE !?5,"or RETURN to see additional pending ALERTS"
+14 WRITE !!
+15 QUIT
+16 ;
SORT ;Sort and remove display only
+1 ; ZEXCEPT: XQAUSER,XQACNT,XQAREV - global variable
+2 ; Unit test: P602T3^ZZUTXQA6
+3 NEW XQZ,XQZ1,XQZ4,XQI,XQK,XQX,XQJ
+4 KILL ^TMP("XQ",$JOB,"XQA")
+5 KILL ^TMP("XQ",$JOB,"XQA1")
+6 FOR XQI=0:0
SET XQI=$ORDER(^XTV(8992,XQAUSER,"XQA",XQI))
IF (XQI'>0)!(XQACNT>10000)
QUIT
Begin DoDot:1
+7 ; zero node for the alert
SET XQX=^XTV(8992,XQAUSER,"XQA",XQI,0)
+8 ; data for alert
SET XQZ=$GET(^XTV(8992,XQAUSER,"XQA",XQI,1))
+9 ; comment for display
SET XQZ1=$GET(^XTV(8992,XQAUSER,"XQA",XQI,2))
+10 ; long info text
SET XQZ4=$ORDER(^XTV(8992,XQAUSER,"XQA",XQI,4,0))
+11 SET XQJ=$PIECE(XQX,U,7,8)
IF XQJ=U
KILL ^XTV(8992,XQAUSER,"XQA",XQI)
IF XQJ'=U
Begin DoDot:2
+12 SET XQACNT=XQACNT+1
+13 IF $$CHKCRIT^XQALSUR2(XQX)
Begin DoDot:3
+14 ; critical alert
SET XQJ=$SELECT(XQAREV:499999-XQACNT,1:XQACNT)
End DoDot:3
+15 IF '$TEST
Begin DoDot:3
+16 ; normal alert
SET XQJ=$SELECT(XQAREV:999999-XQACNT,1:500000+XQACNT)
End DoDot:3
+17 ; zero node for the alert
SET ^TMP("XQ",$JOB,"XQA",XQJ)=XQX
+18 ; IEN of the alert
SET ^TMP("XQ",$JOB,"XQA",XQJ,1)=XQI
+19 ; data for the alert
SET ^TMP("XQ",$JOB,"XQA",XQJ,2)=XQZ
+20 ; comment for display
SET ^TMP("XQ",$JOB,"XQA",XQJ,3)=XQZ1
+21 ; long info text
SET ^TMP("XQ",$JOB,"XQA",XQJ,4)=XQZ4
End DoDot:2
End DoDot:1
+22 SET XQK=0
FOR XQI=0:0
SET XQI=$ORDER(^TMP("XQ",$JOB,"XQA",XQI))
IF XQI'>0
QUIT
SET XQK=XQK+1
MERGE ^TMP("XQ",$JOB,"XQA1",XQK)=^TMP("XQ",$JOB,"XQA",XQI)
+23 KILL ^TMP("XQ",$JOB,"XQA")
+24 SET XQK=0
FOR XQI=0:0
SET XQI=$ORDER(^TMP("XQ",$JOB,"XQA1",XQI))
IF XQI'>0
QUIT
SET XQK=XQK+1
MERGE ^TMP("XQ",$JOB,"XQA",XQK)=^TMP("XQ",$JOB,"XQA1",XQI)
+25 QUIT
+26 ;
ASKDEL ;
+1 ; ZEXCEPT: XQAUSER,XQX1 - global variables
+2 NEW DIR,XQALDELE,XQX1COPY,XQAID,DA,XQAKILL,XQXOUT,XQAUSERD,XQALVALU,Y
+3 SET XQALDELE=1
+4 KILL XQX1
+5 DO DOIT^XQALERT1
+6 KILL XQALDELE
SET XQAUSERD=1
+7 IF $DATA(XQX1)
IF XQX1>0
Begin DoDot:1
+8 MERGE XQX1COPY=XQX1
+9 FOR
IF XQX1=""
QUIT
SET DA=+XQX1
SET XQX1=$PIECE(XQX1,",",2,99)
Begin DoDot:2
+10 SET XQAID=$PIECE(^TMP("XQ",$JOB,"XQA1",DA),U,2)
SET XQALVALU=^(DA)
SET XQAKILL=1
+11 IF $PIECE(XQALVALU,U,8)=" "!$PIECE(XQALVALU,U,10)
Begin DoDot:3
+12 IF XQAID=""
KILL ^XTV(8992,XQAUSER,"XQA",+^TMP("XQ",$JOB,"XQA1",DA,1))
+13 IF XQAID'=""
DO DELETE^XQALDEL
+14 KILL ^TMP("XQ",$JOB,"XQA1",DA),^TMP("XQ",$JOB,"XQA",(999999-DA))
End DoDot:3
End DoDot:2
IF XQX1=""
SET Y=$ORDER(XQX1(0))
IF Y>0
SET XQX1=XQX1(Y)
KILL XQX1(Y)
+15 KILL XQX1
MERGE XQX1=XQX1COPY
SET XQAID=0
+16 FOR
IF XQX1=""
QUIT
SET DA=+XQX1
SET XQX1=$PIECE(XQX1,",",2,99)
Begin DoDot:2
+17 IF $DATA(^TMP("XQ",$JOB,"XQA1",DA))
IF 'XQAID
WRITE !!,"Unable to delete alerts which require action: ",DA
IF XQAID
WRITE ",",DA
SET XQAID=1
End DoDot:2
IF XQX1=""
SET Y=$ORDER(XQX1(0))
IF Y>0
SET XQX1=XQX1(Y)
KILL XQX1(Y)
+18 IF XQAID=1
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+19 KILL XQX1,XQAKILL
+20 QUIT
+21 ;
FRWRDONE ;
+1 ; ZEXCEPT: XQAID - global variable
+2 NEW XQX1,XQALFWDL
SET XQALFWDL(1)=XQAID
+3 NEW XQAID
+4 DO FWDONE^XQALFWD
+5 QUIT
