| 1 | XMA32 ;ISC-SF/GMB-Purge Messages by Date ;04/17/2002 07:20
|
|---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002
|
|---|
| 3 | ; Was (WASH ISC)/CAP
|
|---|
| 4 | ;
|
|---|
| 5 | ; Entry points used by MailMan options (not covered by DBIA):
|
|---|
| 6 | ; ENTER XMPURGE-BY-DATE - Purge messages by local create date.
|
|---|
| 7 | ENTER ;
|
|---|
| 8 | N XMABORT,XMPARM
|
|---|
| 9 | I $D(ZTQUEUED) S ZTREQ="@"
|
|---|
| 10 | S XMABORT=0
|
|---|
| 11 | D INIT(.XMPARM,.XMABORT) Q:XMABORT
|
|---|
| 12 | D SETUP(.XMPARM,.XMABORT) Q:XMABORT
|
|---|
| 13 | D PROCESS(.XMPARM)
|
|---|
| 14 | Q
|
|---|
| 15 | INIT(XMPARM,XMABORT) ;
|
|---|
| 16 | N XMKEY,XMTEXT
|
|---|
| 17 | F XMKEY="XMMGR","XMSTAR" D Q:XMABORT
|
|---|
| 18 | . Q:$D(^XUSEC(XMKEY,DUZ))
|
|---|
| 19 | . S XMABORT=1
|
|---|
| 20 | . ;You must hold the |1| key to run this option.
|
|---|
| 21 | . W !
|
|---|
| 22 | . D BLD^DIALOG(36400,XMKEY,"","XMTEXT","F")
|
|---|
| 23 | . D MSG^DIALOG("WE","","","","XMTEXT")
|
|---|
| 24 | Q:XMABORT
|
|---|
| 25 | N XMREC
|
|---|
| 26 | S XMREC=$G(^XMB(1,1,.18))
|
|---|
| 27 | S XMPARM("PDAYS")=$S($P(XMREC,U,1):$P(XMREC,U,1),1:730)
|
|---|
| 28 | I $D(ZTQUEUED),XMPARM("PDAYS")<365 S XMPARM("PDAYS")=730
|
|---|
| 29 | S XMPARM("GRACE")=+$P(XMREC,U,2)
|
|---|
| 30 | D AUDTPURG
|
|---|
| 31 | Q:$D(ZTQUEUED)
|
|---|
| 32 | W !
|
|---|
| 33 | D BLD^DIALOG(36401,"","","XMTEXT","F")
|
|---|
| 34 | D MSG^DIALOG("WM","","","","XMTEXT")
|
|---|
| 35 | ;This process REMOVES MESSAGES PERMANENTLY from the system.
|
|---|
| 36 | ; ***** BE VERY CAREFUL *****
|
|---|
| 37 | I $D(^XMB(1,1,.1,0)) D LAST(.XMPARM)
|
|---|
| 38 | Q
|
|---|
| 39 | LAST(XMPARM) ; Find the audit record for the last date purge
|
|---|
| 40 | N XMLIEN,XMREC,XMDIFF,XMTEXT,XMVAR
|
|---|
| 41 | S XMLIEN=":"
|
|---|
| 42 | F S XMLIEN=$O(^XMB(1,1,.1,XMLIEN),-1) Q:'XMLIEN Q:$P(^(XMLIEN,0),U,6)
|
|---|
| 43 | Q:'XMLIEN
|
|---|
| 44 | S XMREC=^XMB(1,1,.1,XMLIEN,0)
|
|---|
| 45 | D BLD^DIALOG($S($P(XMREC,U,6)["TEST":36402.1,1:36402),$$FMTE^XLFDT($P(XMREC,U),5),"","XMTEXT","F")
|
|---|
| 46 | ;This process was last run on |1| (in TEST mode).
|
|---|
| 47 | S XMDIFF=$$FMDIFF^XLFDT($P(XMREC,U,1),$P(XMREC,U,7),1) ; difference in days
|
|---|
| 48 | S XMVAR(1)=$$FMTE^XLFDT($P(XMREC,U,7),5),XMVAR(2)=XMDIFF
|
|---|
| 49 | W !
|
|---|
| 50 | D BLD^DIALOG(36403,.XMVAR,"","XMTEXT","FS")
|
|---|
| 51 | D MSG^DIALOG("WM","","","","XMTEXT")
|
|---|
| 52 | ;The PURGE DATE used was |1|.
|
|---|
| 53 | ;(Messages more than |2| days old were purged.)
|
|---|
| 54 | W !
|
|---|
| 55 | Q
|
|---|
| 56 | AUDTPURG ; Kill off the earliest purge entries, so that only a certain # remain.
|
|---|
| 57 | N XMREC,XMCNT,DA,DIK,XMMAX
|
|---|
| 58 | S XMMAX=20
|
|---|
| 59 | S XMREC=$G(^XMB(1,1,.1,0))
|
|---|
| 60 | S XMCNT=$P(XMREC,U,4)
|
|---|
| 61 | Q:XMCNT'>XMMAX
|
|---|
| 62 | S DA=0
|
|---|
| 63 | F S DA=$O(^XMB(1,1,.1,0)) Q:DA'>0 D Q:XMCNT'>XMMAX
|
|---|
| 64 | . S XMCNT=XMCNT-1
|
|---|
| 65 | . S DA(1)=1,DIK="^XMB(1,1,.1,"
|
|---|
| 66 | . D ^DIK
|
|---|
| 67 | Q
|
|---|
| 68 | SETUP(XMPARM,XMABORT) ;
|
|---|
| 69 | D PDATE(.XMPARM,.XMABORT) Q:XMABORT ; Purge date
|
|---|
| 70 | D TESTMODE(.XMPARM,.XMABORT) Q:XMABORT ; Test mode?
|
|---|
| 71 | D GRACE(.XMPARM,.XMABORT) Q:XMABORT ; Grace days
|
|---|
| 72 | Q
|
|---|
| 73 | PDATE(XMPARM,XMABORT) ;
|
|---|
| 74 | N DIR,X,Y,XMOK,XMOLDEST,XMCUTOFF,XMOLDP1,XMDIFF,XMVAR
|
|---|
| 75 | ; Find the oldest date. Kill any bogus xrefs.
|
|---|
| 76 | F S XMOLDEST=$O(^XMB(3.9,"C","")) Q:XMOLDEST?7N K ^XMB(3.9,"C",XMOLDEST)
|
|---|
| 77 | S XMOLDP1=$$FMADD^XLFDT(XMOLDEST,1)
|
|---|
| 78 | I $D(ZTQUEUED) D Q
|
|---|
| 79 | . S XMCUTOFF=$$FMADD^XLFDT(DT,XMPARM("GRACE")-XMPARM("PDAYS"))
|
|---|
| 80 | . I XMOLDP1>XMCUTOFF S XMABORT=1 Q ; Abort if no messages that old.
|
|---|
| 81 | . S XMPARM("PDATE")=XMCUTOFF
|
|---|
| 82 | S XMCUTOFF=$$FMADD^XLFDT(DT,-XMPARM("PDAYS"))
|
|---|
| 83 | I XMOLDP1>XMCUTOFF S XMCUTOFF=XMOLDP1
|
|---|
| 84 | S XMOK=0
|
|---|
| 85 | F D Q:XMOK!XMABORT
|
|---|
| 86 | . S DIR(0)="D^"_XMOLDP1_":DT:E"
|
|---|
| 87 | . D BLD^DIALOG(36404,$$FMTE^XLFDT(XMOLDEST,5),"","DIR(""A"")")
|
|---|
| 88 | . ;The oldest message on the system is from |1|.
|
|---|
| 89 | . ;Purge all messages originating before
|
|---|
| 90 | . S DIR("B")=$$FMTE^XLFDT(XMCUTOFF,5)
|
|---|
| 91 | . D BLD^DIALOG(36405,"","","DIR(""?"")")
|
|---|
| 92 | . ;All messages whose 'local create date' is prior to the
|
|---|
| 93 | . ;'purge date' you enter will be deleted from the system,
|
|---|
| 94 | . ;except those which are in one of SHARED,MAIL's baskets,
|
|---|
| 95 | . ;OR in POSTMASTER's server baskets or remote transmit queues.
|
|---|
| 96 | . S DIR("??")="^N %DT S %DT=0 D HELP^%DTC"
|
|---|
| 97 | . D ^DIR I $D(DIRUT) S XMABORT=1 Q
|
|---|
| 98 | . S XMPARM("PDATE")=Y
|
|---|
| 99 | . I DT-Y>10000 S XMOK=1 Q
|
|---|
| 100 | . D ZIS^XM
|
|---|
| 101 | . ;The date you entered is less than 1 year ago.
|
|---|
| 102 | . W !!,$S($D(IORVON):IORVON,1:""),$S($D(IOBON):IOBON,1:""),$$EZBLD^DIALOG(36406),$S($D(IOBOFF):IOBOFF,1:""),$C(7),$S($D(IORVOFF):IORVOFF,1:"")
|
|---|
| 103 | . K DIR
|
|---|
| 104 | . S DIR(0)="Y"
|
|---|
| 105 | . S DIR("A")=$$EZBLD^DIALOG(36407) ; Are you sure about this date
|
|---|
| 106 | . S DIR("B")=$$EZBLD^DIALOG(39053) ; No
|
|---|
| 107 | . D ^DIR I $D(DIRUT) S XMABORT=1 Q
|
|---|
| 108 | . S XMOK=Y
|
|---|
| 109 | . K DIR
|
|---|
| 110 | Q:XMABORT
|
|---|
| 111 | S XMDIFF=$$FMDIFF^XLFDT(DT,XMPARM("PDATE"),1)
|
|---|
| 112 | I XMDIFF=XMPARM("PDAYS")!(XMDIFF<365)!(XMDIFF>9999) Q
|
|---|
| 113 | W !
|
|---|
| 114 | K DIR,X,Y
|
|---|
| 115 | S XMVAR(1)=XMDIFF,XMVAR(2)=XMPARM("PDAYS")
|
|---|
| 116 | S DIR(0)="Y"
|
|---|
| 117 | ;You have chosen to purge messages older than |1| days old,
|
|---|
| 118 | ;which is different from the current default of |2|.
|
|---|
| 119 | ;Do you want |1| to be the new default
|
|---|
| 120 | D BLD^DIALOG(36408,.XMVAR,"","DIR(""A"")")
|
|---|
| 121 | S DIR("B")=$$EZBLD^DIALOG(39053) ; No
|
|---|
| 122 | D BLD^DIALOG(36409,.XMVAR,"","DIR(""?"")")
|
|---|
| 123 | ;Answer YES if you want field 10.03, DATE PURGE CUTOFF DAYS,
|
|---|
| 124 | ;in file 4.3, MAILMAN SITE PARAMETERS, to be set to |1|.
|
|---|
| 125 | ;Answer NO if you want that field to remain |2|.
|
|---|
| 126 | ;You can also edit this field using option XMKSP."
|
|---|
| 127 | D ^DIR I $D(DIRUT) S XMABORT=1 Q
|
|---|
| 128 | I Y S $P(^XMB(1,1,.18),U,1)=XMDIFF
|
|---|
| 129 | S XMPARM("PDAYS")=XMDIFF
|
|---|
| 130 | Q
|
|---|
| 131 | TESTMODE(XMPARM,XMABORT) ;
|
|---|
| 132 | I $D(ZTQUEUED) D Q
|
|---|
| 133 | . S XMPARM("TEST")=0
|
|---|
| 134 | . S XMPARM("TYPE")=1
|
|---|
| 135 | W !
|
|---|
| 136 | N DIR,X,Y
|
|---|
| 137 | S DIR(0)="Y",DIR("A")=$$EZBLD^DIALOG(36410) ; TEST mode
|
|---|
| 138 | S DIR("B")=$$EZBLD^DIALOG(39054) ; YES
|
|---|
| 139 | D BLD^DIALOG(36411,"","","DIR(""?"")")
|
|---|
| 140 | ;Test mode will not kill off messages.
|
|---|
| 141 | ;Test mode gives you a list of what would happen in 'real' mode.
|
|---|
| 142 | ;If you do not run in test mode, messages will be KILLED!
|
|---|
| 143 | ;Enter YES to run in 'test' mode; NO, 'real' mode.
|
|---|
| 144 | D ^DIR I $D(DIRUT) S XMABORT=1 Q
|
|---|
| 145 | S XMPARM("TEST")=Y
|
|---|
| 146 | S XMPARM("TYPE")=$S(XMPARM("TEST"):2,1:1)
|
|---|
| 147 | Q
|
|---|
| 148 | GRACE(XMPARM,XMABORT) ;
|
|---|
| 149 | Q:$D(ZTQUEUED)
|
|---|
| 150 | N XMTEXT
|
|---|
| 151 | W !
|
|---|
| 152 | I XMPARM("TEST") D Q
|
|---|
| 153 | . S XMPARM("GRACE")=0
|
|---|
| 154 | . D BLD^DIALOG(36412,"","","XMTEXT","F")
|
|---|
| 155 | . D MSG^DIALOG("WM","","","","XMTEXT")
|
|---|
| 156 | . ;Since we are running in test mode, no warning bulletin will be sent.
|
|---|
| 157 | D BLD^DIALOG(36412.1,"","","XMTEXT","F")
|
|---|
| 158 | D MSG^DIALOG("WM","","","","XMTEXT")
|
|---|
| 159 | ;If you queue this purge to run 3 or more days from now, I will send
|
|---|
| 160 | ;a bulletin, XM DATE PURGE WARNING, to all users to warn them of the
|
|---|
| 161 | ;coming date purge and tell them how to identify all of the messages
|
|---|
| 162 | ;in their mailbox, which may be affected.
|
|---|
| 163 | Q
|
|---|
| 164 | PROCESS(XMPARM) ;
|
|---|
| 165 | N ZTSAVE,ZTRTN,ZTDESC,ZTSK,XMHNOW
|
|---|
| 166 | S ZTSAVE("XMPARM*")=""
|
|---|
| 167 | S ZTDESC=$$EZBLD^DIALOG(36413) ;MailMan: MESSAGE PURGE by DATE
|
|---|
| 168 | S ZTRTN="ENT^XMA32A"
|
|---|
| 169 | I '$D(ZTQUEUED) D Q:'$D(ZTSK)
|
|---|
| 170 | . S XMHNOW=$H
|
|---|
| 171 | . D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,,1)
|
|---|
| 172 | E D
|
|---|
| 173 | . S ZTDTH=$$HADD^XLFDT(ZTDTH,XMPARM("GRACE"))
|
|---|
| 174 | . D ^%ZTLOAD
|
|---|
| 175 | I '$D(ZTQUEUED),$$HDIFF^XLFDT(ZTSK("D"),XMHNOW,1)<3 D Q
|
|---|
| 176 | . N XMTEXT
|
|---|
| 177 | . W !
|
|---|
| 178 | . D BLD^DIALOG(36414,"","","XMTEXT","F")
|
|---|
| 179 | . D MSG^DIALOG("WM","","","","XMTEXT")
|
|---|
| 180 | . ;Since you scheduled the date purge less than 3 days from now,
|
|---|
| 181 | . ;no warning bulletin has been sent.
|
|---|
| 182 | N XMP,XMINSTR
|
|---|
| 183 | S XMINSTR("VAPOR")=$$HTFM^XLFDT($$HADD^XLFDT(ZTSK("D"),,-1)) ; Vaporize 1 hr before purge
|
|---|
| 184 | S XMINSTR("FROM")=.5
|
|---|
| 185 | S XMP(1)=$$HTE^XLFDT(ZTSK("D"),5)
|
|---|
| 186 | S XMP(2)=$$FMTE^XLFDT($$FMADD^XLFDT(XMPARM("PDATE"),-1),5)
|
|---|
| 187 | S XMP(3)=$E("==========",1,$L(XMP(2)))
|
|---|
| 188 | D TASKBULL^XMXAPI(DUZ,"XM DATE PURGE WARNING",.XMP,,"*",.XMINSTR)
|
|---|
| 189 | Q:$D(ZTQUEUED)
|
|---|
| 190 | W !
|
|---|
| 191 | W $$EZBLD^DIALOG(36415) ;The warning bulletin has been sent.
|
|---|
| 192 | Q
|
|---|
