Changeset 623 for WorldVistAEHR/trunk/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
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/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
r613 r623 1 XQALDEL ;ISC-SF.SEA/JLI - DELETE ALERTS ;4/9/07 15:132 ;;8.0;KERNEL;**6,24,65,114,174,285,443**;Jul 10, 1995;Build 4 3 4 5 6 DELETE 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 DELETEA 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 DELA 41 42 43 44 45 46 47 48 COUNT(%1,%2) 49 50 51 52 53 54 55 56 57 KILLOC 58 59 60 61 62 63 OLDDEL 64 65 66 67 68 69 70 71 72 73 OLDDEL1 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 OLDDEL2 98 99 100 101 102 103 104 KILLARCH 105 106 107 108 109 . S X1=$P($G(^XTV(8992.1,XQDEL1,0)),U,2),X2=$P($G(^(0)),U,8)110 111 112 113 114 115 USERDEL 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 GETBKUP(XQA,XQAUSER) 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 DIVENTIT(XQAUSER) 162 163 164 165 166 167 168 169 170 171 172 173 BKUPREVW 174 175 1 XQALDEL ;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 ; 6 DELETE ; 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 ; 22 DELETEA ; 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 40 DELA ; 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 ; 48 COUNT(%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 57 KILLOC ; 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 ; 63 OLDDEL ; 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 73 OLDDEL1 ;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 ; 97 OLDDEL2 ; 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 ; 104 KILLARCH ; 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 ; 115 USERDEL ; 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 ; 133 GETBKUP(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 ; 161 DIVENTIT(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 ; 173 BKUPREVW ;OPT - SET BACKUP REVIEWER(S) IN PARAMETER FILE 174 G BKUPREVW^XQALBUTL 175 ;
Note:
See TracChangeset
for help on using the changeset viewer.
