source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMUTPUR0.m@ 862

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

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1XMUTPUR0 ;(KVAMC)/XXX-Purge "AI" X-ref ;01/21/2003 07:50
2 ;;8.0;MailMan;**10**;Jun 28, 2002
3 ; Entry points used by MailMan options (not covered by DBIA):
4 ; PURGE XMMGR-PURGE-AI-XREF
5PURGE ;
6 N XMQUIET,XMABORT,XMDT
7 S XMABORT=0,XMQUIET=$D(ZTQUEUED)!($E(IOST,1,2)'="C-")
8 D INIT(.XMDT,XMQUIET,.XMABORT)
9 I XMABORT W:'XMQUIET !,"Process aborted." Q
10 D PROCESS(XMDT,XMQUIET)
11 Q
12INIT(XMDT,XMQUIET,XMABORT) ;
13 I $D(^XMBX(3.9,"AI"))<10 S XMABORT=1 W:'XMQUIET !,"XMBX Global 'AI' Node empty!" Q
14 S XMDT=$$FMADD^XLFDT(DT,-730)
15 Q:XMQUIET
16 N DIR,X,Y
17 S DIR(0)="D^:"_$$FMADD^XLFDT(DT,-1)_":EP"
18 S DIR("A")="Kill all XMBX 'AI' nodes older than"
19 S DIR("B")=$$FMTE^XLFDT(XMDT)
20 D ^DIR I $D(DIRUT) S XMABORT=1 Q
21 I XMDT'=Y D Q:XMABORT
22 . S XMDT=Y
23 . K DIR,X,Y
24 . S DIR(0)="Y"
25 . S DIR("A")="Are you sure"
26 . S DIR("B")="NO"
27 . D ^DIR I 'Y!$D(DIRUT) S XMABORT=1
28 W !,"We will kill all nodes older than ",$$FMTE^XLFDT(XMDT),"."
29 W !!,"***** Starting at ",$P($$HTE^XLFDT($H),"@",2),!
30 Q
31PROCESS(XMDT,XMQUIET) ;
32 N XMS,XMI,XMZ,XMXDT,XMCNT,XMKILL
33 S (XMCNT,XMKILL)=0 ; XMCNT=#nodes, XMKILL=#killed
34 S (XMS,XMI,XMZ)="" ; XMS=Site, XMI=Msg ID, XMZ=Msg # here at this site
35 F S XMS=$O(^XMBX(3.9,"AI",XMS)) Q:XMS="" D
36 . F S XMI=$O(^XMBX(3.9,"AI",XMS,XMI)) Q:XMI="" D
37 . . S XMZ=$O(^XMBX(3.9,"AI",XMS,XMI,""))
38 . . I XMZ="" K ^XMBX(3.9,"AI",XMS,XMI) Q
39 . . S XMXDT=$G(^XMBX(3.9,"AI",XMS,XMI,XMZ))
40 . . S XMCNT=XMCNT+1
41 . . I 'XMQUIET,XMCNT#1000=0 W:$X>70 ! W ".",XMCNT
42 . . I 'XMXDT S ^XMBX(3.9,"AI",XMS,XMI,XMZ)=DT Q
43 . . I XMXDT<XMDT K ^XMBX(3.9,"AI",XMS,XMI,XMZ) S XMKILL=XMKILL+1
44 Q:XMQUIET
45 W !,"Nodes Reviewed:",?16,$J($FN(XMCNT,","),10),!,"Nodes Killed:",?16,$J($FN(XMKILL,","),10),!,"Nodes Remaining:",?16,$J($FN(XMCNT-XMKILL,","),10)
46 W !,"***** Finished at ",$P($$HTE^XLFDT($H),"@",2)
47 Q
Note: See TracBrowser for help on using the repository browser.