XQALDOIT ;ISC-SF.SEA/JLI - ALERT HANDLER ;07/05/12 12:19
;;8.0;KERNEL;**1,6,65,114,128,129,207,602**;Jul 10, 1995;Build 9
;Per VHA Directive 2004-038, this routine should not be modified
;
EN ;
S XQAEXIT="DOIT^XQALERT1"
S XQX=^TMP("XQ",$J,"XQA1",+XQX1),XQI=^(+XQX1,1),XQZ=^(2)
EN1 ;
S XQADATA=$S(XQZ'="":XQZ,1:$P(XQX,U,9,99)),XQAID=$P(XQX,U,2),XQA1=$P(XQAID,";"),XQX2=+XQX1,XQX1=$P(XQX1,",",2,200) I XQX1'>0 S XQK=$O(XQX1(0)) I XQK>0 S XQX1=XQX1(XQK) K XQX1(XQK)
S XQAROU=""
S XQAKILL=1 I XQX2,$P(XQX,U,8)'="" S XQAROU=$P(XQX,U,7,8) K:XQA1="" ^XTV(8992,DUZ,"XQA",XQI)
I XQAID'="" D
. S XQXX=$O(^XTV(8992.1,"B",XQAID,0)),XQXY=0,XQADAT=$$NOW^XLFDT()
. I XQXX>0 S XQXY=$O(^XTV(8992.1,XQXX,20,"B",DUZ,0)) I XQXY>0,$P(^XTV(8992.1,XQXX,20,XQXY,0),U,3)="" S $P(^XTV(8992.1,XQXX,20,XQXY,0),U,3)=XQADAT
. K XQXX,XQXY
I XQAROU'="",XQAROU'="^ " S XQAROUX=XQAROU D G @XQAEXIT
. N XQAROUX D @XQAROU
. Q
I XQAROU'="" S XQAROUX="^ " D W !!,"Processed Alert Number ",XQX2,!?4,$P(XQX,U,3),! G @XQAEXIT
. I $O(^XTV(8992,DUZ,"XQA",XQI,4,0))>0 D EN^DDIOL("",$NA(^XTV(8992,DUZ,"XQA",XQI,4)))
. Q
I XQX2 S XQAROUX=$P(XQX,U,7),XQMM("J")=XQAROUX_";"_$P(^DIC(19,XQY,0),U),XQRB=0 K:XQA1="" ^XTV(8992,DUZ,"XQA",XQI)
K XQI,XQX,XQJ,XQK,XQXOUT,XQ1,XQII,XQA1,XQAREV,XQACNT,XQX2,%ZIS
;Need to reset count in zero node
Q
;
ACTION(ALERTID) ;
N XQAUSER
S XQI=$O(^XTV(8992,"AXQA",ALERTID,DUZ,0))
Q:XQI'>0
S XQX=$G(^XTV(8992,DUZ,"XQA",XQI,0)) Q:XQX="" S XQAUSER=DUZ
S XQZ=$G(^XTV(8992,DUZ,"XQA",XQI,1))
I $D(XQAGETAC) Q ; just get data to return
S XQAEXIT="ENDACT",XQX1=XQI
I $P(XQX,U,8)'="" G EN1
D EN1
ENDACT ;
I $D(XQMM("J")) S XQMM("J")=$P(XQMM("J"),";")_";",XQALEXIT=1 D D ^XQ74 K XQALEXIT,XQALMENU
. K XQALMENU
. N X S X=$P(XQMM("J"),";")
. I X=+X S:$P(^DIC(19,X,0),U,4)="M" XQALMENU="" Q
. S X=$O(^DIC(19,"B",X,0)) S:$P($G(^DIC(19,+X,0)),U,4)="M" XQALMENU=""
I $D(XQX1),XQX1'>0 K XQX1
I $D(XQAKILL) D DELETEA^XQALERT
K XQAKILL,XQAROU,XQAID,XQADATA
Q
;
DOOPT(OPTION) ;
N XQX1,XQAKILL,XQAROU,XQADATA,XQAID,XQMM
S XQMM("J")=OPTION
D ENDACT
Q
;
PRINT ;
S XQIJ=$$NOW^XLFDT(),%ZIS="MQ" D ^%ZIS Q:POP I $D(IO("Q")) K IO("Q") S ZTRTN="DQ^XQALDOIT",ZTIO=ION,ZTSAVE("XQIJ")="",ZTSAVE("^TMP(""XQ"",$J,""XQA2"",")="" D ^%ZTLOAD K ZTSK,ZTRTN,ZTIO,ZTSAVE Q
DQ ;
U IO W @IOF,!!?10,"PENDING ALERTS "_$P(^VA(200,+^XTV(8992,DUZ,0),0),U)_" "_$E(XQIJ,4,5)_"/"_$E(XQIJ,6,7)_"/"_$E(XQIJ,2,3)_" "_$E($P(XQIJ,".",2)_"00",1,2)_":"_$E($P(XQIJ,".",2)_"0000",3,4),!!
F XQIJ=0:0 S XQIJ=$O(^TMP("XQ",$J,"XQA2",XQIJ)) Q:XQIJ'>0 W !,^(XQIJ,0)
D ^%ZISC K XQIJ W:'$D(ZTQUEUED) !!
Q
MORP K ^TMP("XQ",$J,"XQA2") S XQIK=0 F XQIJ=0:0 S XQIJ=$O(^TMP("XQ",$J,"XQA",XQIJ)) Q:XQIJ'>0 S XQIK=XQIK+1,XQIX=^(XQIJ),^TMP("XQ",$J,"XQA2",XQIK,0)=$J(XQIK,3)_". "_$P(XQIX,U,3)
K XQIK,XQIX,XQIJ
Q
MAIL ;
S XMTEXT="^TMP(""XQ"",$J,""XQA2"",",XMSUB="LIST OF PENDING ALERTS",XMY(DUZ)="",XMDUZ=.5 D ^XMD K XMTEXT,XMSUB,XMDUZ,XMY W !!,"Message will be delivered as NEW mail to YOU.",!!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQALDOIT 3035 printed Dec 13, 2024@02:05:21 Page 2
XQALDOIT ;ISC-SF.SEA/JLI - ALERT HANDLER ;07/05/12 12:19
+1 ;;8.0;KERNEL;**1,6,65,114,128,129,207,602**;Jul 10, 1995;Build 9
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
EN ;
+1 SET XQAEXIT="DOIT^XQALERT1"
+2 SET XQX=^TMP("XQ",$JOB,"XQA1",+XQX1)
SET XQI=^(+XQX1,1)
SET XQZ=^(2)
EN1 ;
+1 SET XQADATA=$SELECT(XQZ'="":XQZ,1:$PIECE(XQX,U,9,99))
SET XQAID=$PIECE(XQX,U,2)
SET XQA1=$PIECE(XQAID,";")
SET XQX2=+XQX1
SET XQX1=$PIECE(XQX1,",",2,200)
IF XQX1'>0
SET XQK=$ORDER(XQX1(0))
IF XQK>0
SET XQX1=XQX1(XQK)
KILL XQX1(XQK)
+2 SET XQAROU=""
+3 SET XQAKILL=1
IF XQX2
IF $PIECE(XQX,U,8)'=""
SET XQAROU=$PIECE(XQX,U,7,8)
if XQA1=""
KILL ^XTV(8992,DUZ,"XQA",XQI)
+4 IF XQAID'=""
Begin DoDot:1
+5 SET XQXX=$ORDER(^XTV(8992.1,"B",XQAID,0))
SET XQXY=0
SET XQADAT=$$NOW^XLFDT()
+6 IF XQXX>0
SET XQXY=$ORDER(^XTV(8992.1,XQXX,20,"B",DUZ,0))
IF XQXY>0
IF $PIECE(^XTV(8992.1,XQXX,20,XQXY,0),U,3)=""
SET $PIECE(^XTV(8992.1,XQXX,20,XQXY,0),U,3)=XQADAT
+7 KILL XQXX,XQXY
End DoDot:1
+8 IF XQAROU'=""
IF XQAROU'="^ "
SET XQAROUX=XQAROU
Begin DoDot:1
+9 NEW XQAROUX
DO @XQAROU
+10 QUIT
End DoDot:1
GOTO @XQAEXIT
+11 IF XQAROU'=""
SET XQAROUX="^ "
Begin DoDot:1
+12 IF $ORDER(^XTV(8992,DUZ,"XQA",XQI,4,0))>0
DO EN^DDIOL("",$NAME(^XTV(8992,DUZ,"XQA",XQI,4)))
+13 QUIT
End DoDot:1
WRITE !!,"Processed Alert Number ",XQX2,!?4,$PIECE(XQX,U,3),!
GOTO @XQAEXIT
+14 IF XQX2
SET XQAROUX=$PIECE(XQX,U,7)
SET XQMM("J")=XQAROUX_";"_$PIECE(^DIC(19,XQY,0),U)
SET XQRB=0
if XQA1=""
KILL ^XTV(8992,DUZ,"XQA",XQI)
+15 KILL XQI,XQX,XQJ,XQK,XQXOUT,XQ1,XQII,XQA1,XQAREV,XQACNT,XQX2,%ZIS
+16 ;Need to reset count in zero node
+17 QUIT
+18 ;
ACTION(ALERTID) ;
+1 NEW XQAUSER
+2 SET XQI=$ORDER(^XTV(8992,"AXQA",ALERTID,DUZ,0))
+3 if XQI'>0
QUIT
+4 SET XQX=$GET(^XTV(8992,DUZ,"XQA",XQI,0))
if XQX=""
QUIT
SET XQAUSER=DUZ
+5 SET XQZ=$GET(^XTV(8992,DUZ,"XQA",XQI,1))
+6 ; just get data to return
IF $DATA(XQAGETAC)
QUIT
+7 SET XQAEXIT="ENDACT"
SET XQX1=XQI
+8 IF $PIECE(XQX,U,8)'=""
GOTO EN1
+9 DO EN1
ENDACT ;
+1 IF $DATA(XQMM("J"))
SET XQMM("J")=$PIECE(XQMM("J"),";")_";"
SET XQALEXIT=1
Begin DoDot:1
+2 KILL XQALMENU
+3 NEW X
SET X=$PIECE(XQMM("J"),";")
+4 IF X=+X
if $PIECE(^DIC(19,X,0),U,4)="M"
SET XQALMENU=""
QUIT
+5 SET X=$ORDER(^DIC(19,"B",X,0))
if $PIECE($GET(^DIC(19,+X,0)),U,4)="M"
SET XQALMENU=""
End DoDot:1
DO ^XQ74
KILL XQALEXIT,XQALMENU
+6 IF $DATA(XQX1)
IF XQX1'>0
KILL XQX1
+7 IF $DATA(XQAKILL)
DO DELETEA^XQALERT
+8 KILL XQAKILL,XQAROU,XQAID,XQADATA
+9 QUIT
+10 ;
DOOPT(OPTION) ;
+1 NEW XQX1,XQAKILL,XQAROU,XQADATA,XQAID,XQMM
+2 SET XQMM("J")=OPTION
+3 DO ENDACT
+4 QUIT
+5 ;
PRINT ;
+1 SET XQIJ=$$NOW^XLFDT()
SET %ZIS="MQ"
DO ^%ZIS
if POP
QUIT
IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="DQ^XQALDOIT"
SET ZTIO=ION
SET ZTSAVE("XQIJ")=""
SET ZTSAVE("^TMP(""XQ"",$J,""XQA2"",")=""
DO ^%ZTLOAD
KILL ZTSK,ZTRTN,ZTIO,ZTSAVE
QUIT
DQ ;
+1 USE IO
WRITE @IOF,!!?10,"PENDING ALERTS "_$PIECE(^VA(200,+^XTV(8992,DUZ,0),0),U)_" "_$EXTRACT(XQIJ,4,5)_"/"_$EXTRACT(XQIJ,6,7)_"/"_$EXTRACT(XQIJ,2,3)_" "_$EXTRACT($PIECE(XQIJ,".",2)_"00",1,2)_":"_$EXTRACT($PIECE(XQIJ,".",2)_"0000",3,4),!!
+2 FOR XQIJ=0:0
SET XQIJ=$ORDER(^TMP("XQ",$JOB,"XQA2",XQIJ))
if XQIJ'>0
QUIT
WRITE !,^(XQIJ,0)
+3 DO ^%ZISC
KILL XQIJ
if '$DATA(ZTQUEUED)
WRITE !!
+4 QUIT
MORP KILL ^TMP("XQ",$JOB,"XQA2")
SET XQIK=0
FOR XQIJ=0:0
SET XQIJ=$ORDER(^TMP("XQ",$JOB,"XQA",XQIJ))
if XQIJ'>0
QUIT
SET XQIK=XQIK+1
SET XQIX=^(XQIJ)
SET ^TMP("XQ",$JOB,"XQA2",XQIK,0)=$JUSTIFY(XQIK,3)_". "_$PIECE(XQIX,U,3)
+1 KILL XQIK,XQIX,XQIJ
+2 QUIT
MAIL ;
+1 SET XMTEXT="^TMP(""XQ"",$J,""XQA2"","
SET XMSUB="LIST OF PENDING ALERTS"
SET XMY(DUZ)=""
SET XMDUZ=.5
DO ^XMD
KILL XMTEXT,XMSUB,XMDUZ,XMY
WRITE !!,"Message will be delivered as NEW mail to YOU.",!!
+2 QUIT
