XMUTPUR0.m

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 ---XMUTPUR0   1831     printed  Mar 13, 2025@21:18:25                                                                                                                                                                                                    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