XMUTPUR0 ;(KVAMC)/XXX-Purge "AI" X-ref ;01/21/2003 07:50
;;8.0;MailMan;**10**;Jun 28, 2002
; Entry points used by MailMan options (not covered by DBIA):
; PURGE XMMGR-PURGE-AI-XREF
PURGE ;
N XMQUIET,XMABORT,XMDT
S XMABORT=0,XMQUIET=$D(ZTQUEUED)!($E(IOST,1,2)'="C-")
D INIT(.XMDT,XMQUIET,.XMABORT)
I XMABORT W:'XMQUIET !,"Process aborted." Q
D PROCESS(XMDT,XMQUIET)
Q
INIT(XMDT,XMQUIET,XMABORT) ;
I $D(^XMBX(3.9,"AI"))<10 S XMABORT=1 W:'XMQUIET !,"XMBX Global 'AI' Node empty!" Q
S XMDT=$$FMADD^XLFDT(DT,-730)
Q:XMQUIET
N DIR,X,Y
S DIR(0)="D^:"_$$FMADD^XLFDT(DT,-1)_":EP"
S DIR("A")="Kill all XMBX 'AI' nodes older than"
S DIR("B")=$$FMTE^XLFDT(XMDT)
D ^DIR I $D(DIRUT) S XMABORT=1 Q
I XMDT'=Y D Q:XMABORT
. S XMDT=Y
. K DIR,X,Y
. S DIR(0)="Y"
. S DIR("A")="Are you sure"
. S DIR("B")="NO"
. D ^DIR I 'Y!$D(DIRUT) S XMABORT=1
W !,"We will kill all nodes older than ",$$FMTE^XLFDT(XMDT),"."
W !!,"***** Starting at ",$P($$HTE^XLFDT($H),"@",2),!
Q
PROCESS(XMDT,XMQUIET) ;
N XMS,XMI,XMZ,XMXDT,XMCNT,XMKILL
S (XMCNT,XMKILL)=0 ; XMCNT=#nodes, XMKILL=#killed
S (XMS,XMI,XMZ)="" ; XMS=Site, XMI=Msg ID, XMZ=Msg # here at this site
F S XMS=$O(^XMBX(3.9,"AI",XMS)) Q:XMS="" D
. F S XMI=$O(^XMBX(3.9,"AI",XMS,XMI)) Q:XMI="" D
. . S XMZ=$O(^XMBX(3.9,"AI",XMS,XMI,""))
. . I XMZ="" K ^XMBX(3.9,"AI",XMS,XMI) Q
. . S XMXDT=$G(^XMBX(3.9,"AI",XMS,XMI,XMZ))
. . S XMCNT=XMCNT+1
. . I 'XMQUIET,XMCNT#1000=0 W:$X>70 ! W ".",XMCNT
. . I 'XMXDT S ^XMBX(3.9,"AI",XMS,XMI,XMZ)=DT Q
. . I XMXDT<XMDT K ^XMBX(3.9,"AI",XMS,XMI,XMZ) S XMKILL=XMKILL+1
Q:XMQUIET
W !,"Nodes Reviewed:",?16,$J($FN(XMCNT,","),10),!,"Nodes Killed:",?16,$J($FN(XMKILL,","),10),!,"Nodes Remaining:",?16,$J($FN(XMCNT-XMKILL,","),10)
W !,"***** Finished at ",$P($$HTE^XLFDT($H),"@",2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMUTPUR0 1831 printed Apr 09, 2024@21:14:14 Page 2
XMUTPUR0 ;(KVAMC)/XXX-Purge "AI" X-ref ;01/21/2003 07:50
+1 ;;8.0;MailMan;**10**;Jun 28, 2002
+2 ; Entry points used by MailMan options (not covered by DBIA):
+3 ; PURGE XMMGR-PURGE-AI-XREF
PURGE ;
+1 NEW XMQUIET,XMABORT,XMDT
+2 SET XMABORT=0
SET XMQUIET=$DATA(ZTQUEUED)!($EXTRACT(IOST,1,2)'="C-")
+3 DO INIT(.XMDT,XMQUIET,.XMABORT)
+4 IF XMABORT
if 'XMQUIET
WRITE !,"Process aborted."
QUIT
+5 DO PROCESS(XMDT,XMQUIET)
+6 QUIT
INIT(XMDT,XMQUIET,XMABORT) ;
+1 IF $DATA(^XMBX(3.9,"AI"))<10
SET XMABORT=1
if 'XMQUIET
WRITE !,"XMBX Global 'AI' Node empty!"
QUIT
+2 SET XMDT=$$FMADD^XLFDT(DT,-730)
+3 if XMQUIET
QUIT
+4 NEW DIR,X,Y
+5 SET DIR(0)="D^:"_$$FMADD^XLFDT(DT,-1)_":EP"
+6 SET DIR("A")="Kill all XMBX 'AI' nodes older than"
+7 SET DIR("B")=$$FMTE^XLFDT(XMDT)
+8 DO ^DIR
IF $DATA(DIRUT)
SET XMABORT=1
QUIT
+9 IF XMDT'=Y
Begin DoDot:1
+10 SET XMDT=Y
+11 KILL DIR,X,Y
+12 SET DIR(0)="Y"
+13 SET DIR("A")="Are you sure"
+14 SET DIR("B")="NO"
+15 DO ^DIR
IF 'Y!$DATA(DIRUT)
SET XMABORT=1
End DoDot:1
if XMABORT
QUIT
+16 WRITE !,"We will kill all nodes older than ",$$FMTE^XLFDT(XMDT),"."
+17 WRITE !!,"***** Starting at ",$PIECE($$HTE^XLFDT($HOROLOG),"@",2),!
+18 QUIT
PROCESS(XMDT,XMQUIET) ;
+1 NEW XMS,XMI,XMZ,XMXDT,XMCNT,XMKILL
+2 ; XMCNT=#nodes, XMKILL=#killed
SET (XMCNT,XMKILL)=0
+3 ; XMS=Site, XMI=Msg ID, XMZ=Msg # here at this site
SET (XMS,XMI,XMZ)=""
+4 FOR
SET XMS=$ORDER(^XMBX(3.9,"AI",XMS))
if XMS=""
QUIT
Begin DoDot:1
+5 FOR
SET XMI=$ORDER(^XMBX(3.9,"AI",XMS,XMI))
if XMI=""
QUIT
Begin DoDot:2
+6 SET XMZ=$ORDER(^XMBX(3.9,"AI",XMS,XMI,""))
+7 IF XMZ=""
KILL ^XMBX(3.9,"AI",XMS,XMI)
QUIT
+8 SET XMXDT=$GET(^XMBX(3.9,"AI",XMS,XMI,XMZ))
+9 SET XMCNT=XMCNT+1
+10 IF 'XMQUIET
IF XMCNT#1000=0
if $X>70
WRITE !
WRITE ".",XMCNT
+11 IF 'XMXDT
SET ^XMBX(3.9,"AI",XMS,XMI,XMZ)=DT
QUIT
+12 IF XMXDT<XMDT
KILL ^XMBX(3.9,"AI",XMS,XMI,XMZ)
SET XMKILL=XMKILL+1
End DoDot:2
End DoDot:1
+13 if XMQUIET
QUIT
+14 WRITE !,"Nodes Reviewed:",?16,$JUSTIFY($FNUMBER(XMCNT,","),10),!,"Nodes Killed:",?16,$JUSTIFY($FNUMBER(XMKILL,","),10),!,"Nodes Remaining:",?16,$JUSTIFY($FNUMBER(XMCNT-XMKILL,","),10)
+15 WRITE !,"***** Finished at ",$PIECE($$HTE^XLFDT($HOROLOG),"@",2)
+16 QUIT
