XQALDEL ;ISC-SF.SEA/JLI - DELETE ALERTS ;6/28/04  11:02
 ;;8.0;KERNEL;**6,24,65,114,174,285**;Jul 10, 1995
 ;;
 Q
 ;
DELETE ;
 N XQAFOUND,XQADAT,XQX,XQK,XQXX,XQXY,XQJ,XQAID1
 Q:'$D(XQAID)  Q:XQAID=""  S:'$D(XQAKILL) XQAKILL=0 S:$P(XQAID,";")="NO-ID" XQAKILL=1
 S XQADAT=$$NOW^XLFDT()
 I '$D(XQAUSER) N XQAUSER S XQAUSER=DUZ
 S XQAFOUND=0 D
 . S XQX=XQAUSER F XQK=0:0 S XQK=$O(^XTV(8992,XQAUSER,"XQA",XQK)) Q:XQK'>0  I $P(^(XQK,0),U,2)=XQAID S XQAFOUND=1 Q
 S XQXX=$O(^XTV(8992.1,"B",XQAID,0)) I XQXX>0 S XQXY=$O(^XTV(8992.1,XQXX,20,"B",XQAUSER,0)) I XQXY>0,XQAFOUND,'$G(XQAUSERD) S $P(^XTV(8992.1,XQXX,20,XQXY,0),U,4)=XQADAT
 K XQXX,XQXY
 I '$D(^XTV(8992,"AXQA",XQAID,XQAUSER)) D KILLOC
 F XQX=0:0 S XQX=$O(^XTV(8992,"AXQA",XQAID,XQX)) Q:XQX'>0  D  Q:XQAKILL
 . I XQAKILL S XQX=XQAUSER ; Make sure XQAKILL gets only XQAUSER
 . F XQK=0:0 S XQK=$O(^XTV(8992,"AXQA",XQAID,XQX,XQK)) Q:XQK'>0  K ^(XQK),^XTV(8992,"AXQAN",$P(XQAID,";"),XQX,XQK) S XQAID1=XQAID D:$D(^XTV(8992,XQX,"XQA",XQK,0)) DELA S XQAID=XQAID1
 K XQAID,XQX,XQJ,XQK,XQAID1,XQAKILL
 Q
 ;
DELETEA ;
 N XQA1,XQADAT,XQAFOUND,XQX,XQXX,XQXY,XQK,XQJ
 Q:'$D(XQAID)  Q:XQAID=""  S XQA1=$P(XQAID,";")
 S XQADAT=$$NOW^XLFDT()
 I '$D(XQAUSER) N XQAUSER S XQAUSER=DUZ
 S:'$D(XQAKILL) XQAKILL=0 G:$P(XQAID,";")="NO-ID" DELETE
 S XQAFOUND=0 D
 . S XQX=XQAUSER F XQK=0:0 S XQK=$O(^XTV(8992,XQAUSER,"XQA",XQK)) Q:XQK'>0  I $P($G(^(XQK,0)),U,2)=XQAID S XQAFOUND=1 Q
 S XQXX=$O(^XTV(8992.1,"B",XQAID,0)) I XQXX>0 S XQXY=$O(^XTV(8992.1,XQXX,20,"B",XQAUSER,0)) I XQXY>0,XQAFOUND,'$G(XQAUSERD) S $P(^XTV(8992.1,XQXX,20,XQXY,0),U,4)=XQADAT
 I '$D(^XTV(8992,"AXQAN",XQA1,XQAUSER)) D KILLOC
 I $P(XQAID,",",2)'=""!($P(XQAID,";",2)="") F XQX=0:0 S XQX=$O(^XTV(8992,"AXQAN",XQA1,XQX)) Q:XQX'>0  D  Q:XQAKILL
 . I XQAKILL S XQX=XQAUSER
 . F XQK=0:0 S XQK=$O(^XTV(8992,"AXQAN",XQA1,XQX,XQK)) Q:XQK'>0  K ^(XQK) I $D(^XTV(8992,XQX,"XQA",XQK,0)) D DELA
 I $P(XQAID,",",2)=""&($P(XQAID,";",2)'="") F XQX=0:0 S XQX=$O(^XTV(8992,"AXQA",XQAID,XQX)) Q:XQX'>0  D  Q:XQAKILL
 . I XQAKILL S XQX=XQAUSER
 . S XQK=$O(^XTV(8992,"AXQA",XQAID,XQX,0)) Q:XQK'>0  K ^(XQK),^XTV(8992,"AXQAN",XQA1,XQX,XQK) I $D(^XTV(8992,XQX,"XQA",XQK,0)) D DELA
 K XQAID,XQA1,XQX,XQK,XQAKILL
 Q
DELA ;
 N XQDEL11 S XQAID=$P($G(^XTV(8992,XQX,"XQA",XQK,0)),U,2),XQDEL11=$P($G(^(0)),U) K ^XTV(8992,XQX,"XQA",XQK) K:XQAID'="" ^XTV(8992,"AXQA",XQAID,XQX,XQK)
 D COUNT(-1,XQX)
 K:XQAID'="" ^XTV(8992,"AXQAN",$P(XQAID,";"),XQX,XQK) K:XQDEL11'="" ^XTV(8992,XQX,"XQA","B",XQDEL11,XQK)
 S XQXX=$S(XQAID'="":$O(^XTV(8992.1,"B",XQAID,0)),1:0) I XQXX>0 S XQXY=$O(^XTV(8992.1,XQXX,20,"B",XQX,0)) I XQXY>0,$P(^XTV(8992.1,XQXX,20,XQXY,0),U,5)'>0 S $P(^(0),U,5)=XQADAT I $G(XQAUSERD) S $P(^(0),U,9)=DUZ
 K XQXX,XQXY
 Q
 ;
COUNT(%1,%2) ;Change the count on the zero node, (amount, user)
 Q:$G(%2)'>0
 L +^XTV(8992,%2):10
 I %1 S %=$P($G(^XTV(8992,%2,"XQA",0)),U,4)+%1 S:%'<0 $P(^(0),U,4)=%
 I '%1 D
 . N % S %1=0,%=0 F  S %=$O(^XTV(8992,%2,"XQA",%)) Q:%'>0  S %1=%1+1
 . S $P(^XTV(8992,%2,"XQA",0),U,4)=%1
 L -^XTV(8992,%2)
 Q
KILLOC ;
 N XQX,XQK
 S XQX=XQAUSER F XQK=0:0 S XQK=$O(^XTV(8992,XQAUSER,"XQA",XQK)) Q:XQK'>0  I $P(^(XQK,0),U,2)=XQAID D
 . N XQAID D DELA
 Q
 ;
OLDDEL ;
 N XQADAT,X2,XQDAT,XQDEL1
 S XQADAT=$$NOW^XLFDT()
 S X2=-15 I $G(ZTQPARAM)>0 S X2=-ZTQPARAM
 S XQDAT=$$FMADD^XLFDT(DT,X2)
 ;Loop thru users (XQDEL1) levels
 F XQDEL1=0:0 S XQDEL1=$O(^XTV(8992,XQDEL1)) Q:XQDEL1'>0  D OLDDEL1
 D KILLARCH
 K X1,X2,X,XQDEL1,XQDEL2,XQDAT,XQA,XQADAT
 Q
OLDDEL1 ;Loop thru the Alert (XQDEL2) level
 L +^XTV(8992,XQDEL1):10
 N XQAGLOB,KILLOLD,XQAZERO,XQAUSER,XQLIST,Y,XQAV,XQPRAMTY,XQDEL2,XQA
 S XQAGLOB=$NA(^XTV(8992,XQDEL1,"XQA")),XQAUSER=XQDEL1
 F XQDEL2=0:0 S XQDEL2=$O(@XQAGLOB@(XQDEL2)) Q:XQDEL2'>0  S XQAZERO=^(XQDEL2,0) D
 . ; CHECK FOR BACKUP REVIEWER TO FORWARD ALERTS NEEDING ACTION -- P174
 . I $P(XQAZERO,U,15)>0 I $$FMADD^XLFDT(+XQAZERO,+$P(XQAZERO,U,15))\1=DT D  Q:$D(KILLOLD)  ; changed '>DT to =DT so only send once without killing
 . . N XQA D GETBKUP(.XQA,XQDEL1)
 . . I $D(XQA) S XQALTYPE="BACKUP REVIEWER" D FORWARD^XQALFWD($P(XQAZERO,U,2),.XQA,"A","ALERT NOT PROCESSED BY "_$$GET1^DIQ(200,XQDEL1_",",.01)) S KILLOLD=1
 . . Q  ;  End of Backup Reviewer Code -- P174
 . I $P(XQAZERO,U,13)>0 I $$FMADD^XLFDT(+XQAZERO,+$P(XQAZERO,U,13))\1=DT D  Q:$D(KILLOLD)  ; P174
 . . N XQA,I F I=0:0 S I=$O(^XMB(3.7,XQAUSER,9,I)) Q:I'>0  S XQAV=+^(I,0),XQA(XQAV)=XQAV
 . . I $D(XQA) S XQALTYPE="EMAIL SURROGATE" D FORWARD^XQALFWD($P(XQAZERO,U,2),.XQA,"A","ALERT NOT PROCESSED BY "_$$GET1^DIQ(200,XQDEL1_",",.01)) S KILLOLD=1
 . . Q
 . I $P(XQAZERO,U,14)>0 I $$FMADD^XLFDT(+XQAZERO,+$P(XQAZERO,U,14))\1=DT D  Q:$D(KILLOLD)  ; P174
 . . N XQA,I S I=$P($G(^VA(200,XQAUSER,5)),U) I I>0 S I=$P($G(^DIC(49,+I,0)),U,3) I I>0,$D(^VA(200,+I,0)) S XQA(+I)=+I
 . . I $D(XQA) S XQALTYPE="CHIEF/SUPERVISOR" D FORWARD^XQALFWD($P(XQAZERO,U,2),.XQA,"A","ALERT NOT PROCESSED BY "_$$GET1^DIQ(200,XQDEL1_",",.01)) S KILLOLD=1
 . . Q
 . I XQDEL2'>XQDAT  D OLDDEL2
 . Q
 K:$O(^XTV(8992,XQDEL1,"XQA",0))="" ^XTV(8992,XQDEL1,"XQA")
 L -^XTV(8992,XQDEL1)
 Q
 ;
OLDDEL2 ;
 N XQA,XQXX,XQXY
 S XQA=$P(^XTV(8992,XQDEL1,"XQA",XQDEL2,0),U,2) K ^XTV(8992,XQDEL1,"XQA",XQDEL2) K:XQA'="" ^XTV(8992,"AXQA",XQA,XQDEL1),^XTV(8992,"AXQAN",$P(XQA,";"),XQDEL1)
 D COUNT(-1,XQDEL1)
 I XQA'="" S XQXX=$O(^XTV(8992.1,"B",XQA,0)) I XQXX>0 S XQXY=$O(^XTV(8992.1,XQXX,20,"B",XQDEL1,0)) I XQXY>0 S $P(^XTV(8992.1,XQXX,20,XQXY,0),U,6)=XQADAT
 Q
 ;
KILLARCH ;
 ;  Q  ; turn off deletion from ALERT TRACKING file ; remove from XU*8*285  JLI 040624
 N DA,DIK,XQDAT,XQDEL1,X1,X2,DA,DIK
 S XQDAT=$$FMADD^XLFDT(DT,-30)
 F XQDEL1=0:0 S XQDEL1=$O(^XTV(8992.1,XQDEL1)) Q:XQDEL1'>0  D
 . S X1=$P(^XTV(8992.1,XQDEL1,0),U,2),X2=$P(^(0),U,8)
 . S DA=XQDEL1 I X2="",X1>XQDAT Q
 . I X2>0,DT<X2 Q
 . S DIK="^XTV(8992.1," D ^DIK
 Q
 ;
USERDEL ; Delete undesired alerts for a user
 N DA,DIC,XQAUSERD
 S DIC("A")="Select NEW PERSON entry for deletion of alerts: "
 S DIC(0)="AEQM",DIC=200
 D ^DIC K DIC Q:Y'>0  S XQAUSER=+Y
 S XQALDELE=1
 K XQX1
 D DOIT^XQALERT1
 K XQALDELE S XQAUSERD=1
 I $D(XQX1),XQX1>0 D
 . 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),XQAKILL=1
 . . I XQAID="" K ^XTV(8992,XQAUSER,"XQA",+^TMP("XQ",$J,"XQA1",DA,1))
 . . I XQAID'="" D DELETE
 . . K ^TMP("XQ",$J,"XQA1",DA),^TMP("XQ",$J,"XQA",(999999-DA))
 K XQAUSER,XQX1
 Q
 ;
GETBKUP(XQA,XQAUSER) ;  JLI 030129 - REMOVED TO SEPARATE METHOD
 N I,XQORY,XQENTITY,XQPARAM,XQERR,K,XQAV,XQLIST
 S XQPARAM="XQAL BACKUP REVIEWER"
 D GETLST^XPAR(.XQLIST,"USR.`"_XQAUSER,XQPARAM,"Q",.XQERR) S:$D(XQLIST)>1 XQPRAMTY=200 ; USER
 I '($D(XQLIST)>1) S I=$$GET1^DIQ(200,XQAUSER_",",29,"I") I I>0 D GETLST^XPAR(.XQLIST,"SRV.`"_I,XQPARAM,"Q",.XQERR) S:$D(XQLIST)>1 XQPRAMTY=49 ; SERVICE
 I '($D(XQLIST)>1) D GETLST^XPAR(.XQLIST,$$DIVENTIT(XQAUSER),XQPARAM,"Q",.XQERR) S:$D(XQLIST)>1 XQPRAMTY=4 ; DIVISION
 I '($D(XQLIST)>1) D GETLST^XPAR(.XQLIST,"SYS",XQPARAM,"Q",.XQERR) S:$D(XQLIST)>1 XQPRAMTY=4.2 ; SYSTEM
 F I=0:0 S I=$O(XQLIST(I)) Q:I'>0  S XQAV=$P(XQLIST(I),U,2),XQA(XQAV)=XQAV
 ; Removed Teams per Curtis Anderson with CPRS
 ;I '$D(XQA) D  ; NONE UNDER USER - CHECK FOR ENTRIES IN PARAMETER FILE FOR TEAMS
 ;. I $T(TEAMPR^ORQPTQ1)]"" D TEAMPR^ORQPTQ1(.XQORY,XQAUSER) K:+$G(XQORY(1))<1 XQORY ; GET TEAM ID'S IF ANY ; CONTROLLED SUBSCRIPTION
 ;. S I=0 F  S I=$O(XQORY(I)) Q:I'>0  K XQLIST D GETLST^XPAR(.XQLIST,$P(XQORY(I),U,2)_";OR(100.21,",XQPARAM,"Q",.ERR) I $D(XQTEAM) D
 ;. . N K F K=0:0 S K=$O(XQLIST(K)) Q:K'>0  S XQAV=$P(XQLIST(K),U,2),XQA(XQAV)=XQAV
 ;. . Q`
 ;. Q
 ;I '$D(XQLIST) D  ; NO TEAM ENTRIES, CHECK OTHER ENTITIES (SERVICE,DIVISION,SYSTEM)
 ;. S XQENTITY="SYS"
 ;. S I=$$GET1^DIQ(200,XQAUSER_",",16,"I") I I>0 S XQENTITY="DIV.`"_I_U_XQENTITY ; DIVISION
 ;. S I=$$GET1^DIQ(200,XQAUSER_",",29,"I") I I>0 S XQENTITY="SRV.`"_I_U_XQENTITY ; SERVICE\SECTION
 ;. D GETLST^XPAR(.XQLIST,XQENTITY,XQPARAM,"Q",.XQERR) F I=0:0 S I=$O(XQLIST(I)) Q:I'>0  S XQAV=+$P(XQLIST(I),U,2),XQA(XQAV)=XQAV
 ;. Q
 ;I '$D(XQA) D  ; NO PARAMETERS ENTERED - USE LAST RESORT MAIL GROUP
 ;. S XQJ="G.XQAL UNPROCESSED ALERTS" D GROUP^XQALSET1
 ;. I '$D(XQA) S XQJ="G.PATCH" D GROUP^XQALSET1 ; REALLY LAST RESORT
 ;. F I=0:0 S I=$O(XQA(I)) Q:I'>0  S XQA(I)=I
 ;. Q
 Q
 ;
DIVENTIT(XQAUSER) ;
 N ENTITY,NCNT,DIVNAM,I
 S ENTITY="" I DUZ=XQAUSER S ENTITY="DIV.`"_DUZ(2)
 I ENTITY="" D
 . K NCNT,DIVNAM S NCNT=0 F I=0:0 S I=$O(^VA(200,XQAUSER,2,I)) Q:I'>0  S NCNT=NCNT+1,DIVNAM(NCNT)=+^(I,0) I $P(^(0),U,2) S DIVNAM=+^(0)
 . I NCNT'>0 Q
 . I NCNT=1 S ENTITY="DIV.`"_DIVNAM(1) Q
 . I $D(DIVNAM)#2 S ENTITY="DIV.`"_DIVNAM Q
 . F I=1:1:NCNT S ENTITY="DIV.`"_DIVNAM(I)_$S(ENTITY'="":U,1:"")_ENTITY
 I ENTITY="" S ENTITY="DIV.`"_$$GET1^DIQ(8989.3,"1,",217,"I")
 Q ENTITY
 ;
BKUPREVW ;OPT - SET BACKUP REVIEWER(S) IN PARAMETER FILE
 G BKUPREVW^XQALBUTL
 ;