- 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 Feb 18, 2025@23:31:47 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