source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQALDEL.m@ 1718

Last change on this file since 1718 was 636, checked in by George Lilly, 15 years ago

WorldVistAEHR overlayed on FOIAVistA
File size: 8.6 KB
Line 
1XQALDEL ;ISC-SF.SEA/JLI - DELETE ALERTS ;6/28/04 11:02
2 ;;8.0;KERNEL;**6,24,65,114,174,285**;Jul 10, 1995
3 ;;
4 Q
5 ;
6DELETE ;
7 N XQAFOUND,XQADAT,XQX,XQK,XQXX,XQXY,XQJ,XQAID1
8 Q:'$D(XQAID) Q:XQAID="" S:'$D(XQAKILL) XQAKILL=0 S:$P(XQAID,";")="NO-ID" XQAKILL=1
9 S XQADAT=$$NOW^XLFDT()
10 I '$D(XQAUSER) N XQAUSER S XQAUSER=DUZ
11 S XQAFOUND=0 D
12 . 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
13 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
14 K XQXX,XQXY
15 I '$D(^XTV(8992,"AXQA",XQAID,XQAUSER)) D KILLOC
16 F XQX=0:0 S XQX=$O(^XTV(8992,"AXQA",XQAID,XQX)) Q:XQX'>0 D Q:XQAKILL
17 . I XQAKILL S XQX=XQAUSER ; Make sure XQAKILL gets only XQAUSER
18 . 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
19 K XQAID,XQX,XQJ,XQK,XQAID1,XQAKILL
20 Q
21 ;
22DELETEA ;
23 N XQA1,XQADAT,XQAFOUND,XQX,XQXX,XQXY,XQK,XQJ
24 Q:'$D(XQAID) Q:XQAID="" S XQA1=$P(XQAID,";")
25 S XQADAT=$$NOW^XLFDT()
26 I '$D(XQAUSER) N XQAUSER S XQAUSER=DUZ
27 S:'$D(XQAKILL) XQAKILL=0 G:$P(XQAID,";")="NO-ID" DELETE
28 S XQAFOUND=0 D
29 . 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
30 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
31 I '$D(^XTV(8992,"AXQAN",XQA1,XQAUSER)) D KILLOC
32 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
33 . I XQAKILL S XQX=XQAUSER
34 . 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
35 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
36 . I XQAKILL S XQX=XQAUSER
37 . 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
38 K XQAID,XQA1,XQX,XQK,XQAKILL
39 Q
40DELA ;
41 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)
42 D COUNT(-1,XQX)
43 K:XQAID'="" ^XTV(8992,"AXQAN",$P(XQAID,";"),XQX,XQK) K:XQDEL11'="" ^XTV(8992,XQX,"XQA","B",XQDEL11,XQK)
44 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
45 K XQXX,XQXY
46 Q
47 ;
48COUNT(%1,%2) ;Change the count on the zero node, (amount, user)
49 Q:$G(%2)'>0
50 L +^XTV(8992,%2):10
51 I %1 S %=$P($G(^XTV(8992,%2,"XQA",0)),U,4)+%1 S:%'<0 $P(^(0),U,4)=%
52 I '%1 D
53 . N % S %1=0,%=0 F S %=$O(^XTV(8992,%2,"XQA",%)) Q:%'>0 S %1=%1+1
54 . S $P(^XTV(8992,%2,"XQA",0),U,4)=%1
55 L -^XTV(8992,%2)
56 Q
57KILLOC ;
58 N XQX,XQK
59 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
60 . N XQAID D DELA
61 Q
62 ;
63OLDDEL ;
64 N XQADAT,X2,XQDAT,XQDEL1
65 S XQADAT=$$NOW^XLFDT()
66 S X2=-15 I $G(ZTQPARAM)>0 S X2=-ZTQPARAM
67 S XQDAT=$$FMADD^XLFDT(DT,X2)
68 ;Loop thru users (XQDEL1) levels
69 F XQDEL1=0:0 S XQDEL1=$O(^XTV(8992,XQDEL1)) Q:XQDEL1'>0 D OLDDEL1
70 D KILLARCH
71 K X1,X2,X,XQDEL1,XQDEL2,XQDAT,XQA,XQADAT
72 Q
73OLDDEL1 ;Loop thru the Alert (XQDEL2) level
74 L +^XTV(8992,XQDEL1):10
75 N XQAGLOB,KILLOLD,XQAZERO,XQAUSER,XQLIST,Y,XQAV,XQPRAMTY,XQDEL2,XQA
76 S XQAGLOB=$NA(^XTV(8992,XQDEL1,"XQA")),XQAUSER=XQDEL1
77 F XQDEL2=0:0 S XQDEL2=$O(@XQAGLOB@(XQDEL2)) Q:XQDEL2'>0 S XQAZERO=^(XQDEL2,0) D
78 . ; CHECK FOR BACKUP REVIEWER TO FORWARD ALERTS NEEDING ACTION -- P174
79 . 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
80 . . N XQA D GETBKUP(.XQA,XQDEL1)
81 . . 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
82 . . Q ; End of Backup Reviewer Code -- P174
83 . I $P(XQAZERO,U,13)>0 I $$FMADD^XLFDT(+XQAZERO,+$P(XQAZERO,U,13))\1=DT D Q:$D(KILLOLD) ; P174
84 . . 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
85 . . 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
86 . . Q
87 . I $P(XQAZERO,U,14)>0 I $$FMADD^XLFDT(+XQAZERO,+$P(XQAZERO,U,14))\1=DT D Q:$D(KILLOLD) ; P174
88 . . 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
89 . . 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
90 . . Q
91 . I XQDEL2'>XQDAT D OLDDEL2
92 . Q
93 K:$O(^XTV(8992,XQDEL1,"XQA",0))="" ^XTV(8992,XQDEL1,"XQA")
94 L -^XTV(8992,XQDEL1)
95 Q
96 ;
97OLDDEL2 ;
98 N XQA,XQXX,XQXY
99 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)
100 D COUNT(-1,XQDEL1)
101 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
102 Q
103 ;
104KILLARCH ;
105 ; Q ; turn off deletion from ALERT TRACKING file ; remove from XU*8*285 JLI 040624
106 N DA,DIK,XQDAT,XQDEL1,X1,X2,DA,DIK
107 S XQDAT=$$FMADD^XLFDT(DT,-30)
108 F XQDEL1=0:0 S XQDEL1=$O(^XTV(8992.1,XQDEL1)) Q:XQDEL1'>0 D
109 . S X1=$P(^XTV(8992.1,XQDEL1,0),U,2),X2=$P(^(0),U,8)
110 . S DA=XQDEL1 I X2="",X1>XQDAT Q
111 . I X2>0,DT<X2 Q
112 . S DIK="^XTV(8992.1," D ^DIK
113 Q
114 ;
115USERDEL ; Delete undesired alerts for a user
116 N DA,DIC,XQAUSERD
117 S DIC("A")="Select NEW PERSON entry for deletion of alerts: "
118 S DIC(0)="AEQM",DIC=200
119 D ^DIC K DIC Q:Y'>0 S XQAUSER=+Y
120 S XQALDELE=1
121 K XQX1
122 D DOIT^XQALERT1
123 K XQALDELE S XQAUSERD=1
124 I $D(XQX1),XQX1>0 D
125 . 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)
126 . . S XQAID=$P(^TMP("XQ",$J,"XQA1",DA),U,2),XQAKILL=1
127 . . I XQAID="" K ^XTV(8992,XQAUSER,"XQA",+^TMP("XQ",$J,"XQA1",DA,1))
128 . . I XQAID'="" D DELETE
129 . . K ^TMP("XQ",$J,"XQA1",DA),^TMP("XQ",$J,"XQA",(999999-DA))
130 K XQAUSER,XQX1
131 Q
132 ;
133GETBKUP(XQA,XQAUSER) ; JLI 030129 - REMOVED TO SEPARATE METHOD
134 N I,XQORY,XQENTITY,XQPARAM,XQERR,K,XQAV,XQLIST
135 S XQPARAM="XQAL BACKUP REVIEWER"
136 D GETLST^XPAR(.XQLIST,"USR.`"_XQAUSER,XQPARAM,"Q",.XQERR) S:$D(XQLIST)>1 XQPRAMTY=200 ; USER
137 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
138 I '($D(XQLIST)>1) D GETLST^XPAR(.XQLIST,$$DIVENTIT(XQAUSER),XQPARAM,"Q",.XQERR) S:$D(XQLIST)>1 XQPRAMTY=4 ; DIVISION
139 I '($D(XQLIST)>1) D GETLST^XPAR(.XQLIST,"SYS",XQPARAM,"Q",.XQERR) S:$D(XQLIST)>1 XQPRAMTY=4.2 ; SYSTEM
140 F I=0:0 S I=$O(XQLIST(I)) Q:I'>0 S XQAV=$P(XQLIST(I),U,2),XQA(XQAV)=XQAV
141 ; Removed Teams per Curtis Anderson with CPRS
142 ;I '$D(XQA) D ; NONE UNDER USER - CHECK FOR ENTRIES IN PARAMETER FILE FOR TEAMS
143 ;. I $T(TEAMPR^ORQPTQ1)]"" D TEAMPR^ORQPTQ1(.XQORY,XQAUSER) K:+$G(XQORY(1))<1 XQORY ; GET TEAM ID'S IF ANY ; CONTROLLED SUBSCRIPTION
144 ;. 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
145 ;. . N K F K=0:0 S K=$O(XQLIST(K)) Q:K'>0 S XQAV=$P(XQLIST(K),U,2),XQA(XQAV)=XQAV
146 ;. . Q`
147 ;. Q
148 ;I '$D(XQLIST) D ; NO TEAM ENTRIES, CHECK OTHER ENTITIES (SERVICE,DIVISION,SYSTEM)
149 ;. S XQENTITY="SYS"
150 ;. S I=$$GET1^DIQ(200,XQAUSER_",",16,"I") I I>0 S XQENTITY="DIV.`"_I_U_XQENTITY ; DIVISION
151 ;. S I=$$GET1^DIQ(200,XQAUSER_",",29,"I") I I>0 S XQENTITY="SRV.`"_I_U_XQENTITY ; SERVICE\SECTION
152 ;. 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
153 ;. Q
154 ;I '$D(XQA) D ; NO PARAMETERS ENTERED - USE LAST RESORT MAIL GROUP
155 ;. S XQJ="G.XQAL UNPROCESSED ALERTS" D GROUP^XQALSET1
156 ;. I '$D(XQA) S XQJ="G.PATCH" D GROUP^XQALSET1 ; REALLY LAST RESORT
157 ;. F I=0:0 S I=$O(XQA(I)) Q:I'>0 S XQA(I)=I
158 ;. Q
159 Q
160 ;
161DIVENTIT(XQAUSER) ;
162 N ENTITY,NCNT,DIVNAM,I
163 S ENTITY="" I DUZ=XQAUSER S ENTITY="DIV.`"_DUZ(2)
164 I ENTITY="" D
165 . 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)
166 . I NCNT'>0 Q
167 . I NCNT=1 S ENTITY="DIV.`"_DIVNAM(1) Q
168 . I $D(DIVNAM)#2 S ENTITY="DIV.`"_DIVNAM Q
169 . F I=1:1:NCNT S ENTITY="DIV.`"_DIVNAM(I)_$S(ENTITY'="":U,1:"")_ENTITY
170 I ENTITY="" S ENTITY="DIV.`"_$$GET1^DIQ(8989.3,"1,",217,"I")
171 Q ENTITY
172 ;
173BKUPREVW ;OPT - SET BACKUP REVIEWER(S) IN PARAMETER FILE
174 G BKUPREVW^XQALBUTL
175 ;
Note: See TracBrowser for help on using the repository browser.