| 1 | XMA3 ;ISC-SF/GMB-XMCLEAN, XMAUTOPURGE ;04/18/2002 07:09
|
|---|
| 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 | ; CLEAN Option: XMCLEAN - Clean out waste baskets and
|
|---|
| 7 | ; Postmaster's ARRIVING basket
|
|---|
| 8 | ; EN Option: XMAUTOPURGE - Purge Unreferenced Messages
|
|---|
| 9 | ; SCAN Option: XMPURGE - Purge Unreferenced Messages, then STAT
|
|---|
| 10 | ; STAT Option: XMSTAT - Message Statistics
|
|---|
| 11 | Q
|
|---|
| 12 | EN ;
|
|---|
| 13 | N XMPARM
|
|---|
| 14 | D PURGEIT(.XMPARM)
|
|---|
| 15 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 16 | Q
|
|---|
| 17 | STAT ;
|
|---|
| 18 | D AUDIT^XMA30 ; Show purge audit records
|
|---|
| 19 | D USERSTAT^XMA30 ; Show user mailbox info
|
|---|
| 20 | Q
|
|---|
| 21 | SCAN ; PURGE MESSAGES
|
|---|
| 22 | I $D(ZTQUEUED) G EN
|
|---|
| 23 | N DIR,XMPARM,XMTEXT
|
|---|
| 24 | D AUDIT^XMA30 ; Show purge audit records
|
|---|
| 25 | S DIR(0)="E" D ^DIR Q:$D(DIRUT) K DIR
|
|---|
| 26 | D BLD^DIALOG(36425,"","","XMTEXT","F")
|
|---|
| 27 | ;I will purge messages which are not in anybody's Mailbox.
|
|---|
| 28 | ;This will be done by comparing the message numbers in the MESSAGE file
|
|---|
| 29 | ;(3.9) against the 'M' cross reference of the MAILBOX file (3.7).
|
|---|
| 30 | ;Because this is a real-time dynamic cross reference, it is
|
|---|
| 31 | ;RECOMMENDED that you run the INTEGRITY CHECKER with some
|
|---|
| 32 | ;frequency, to CORRECT problems, if any.
|
|---|
| 33 | I '$P($G(^XMB(1,1,.12)),U) D
|
|---|
| 34 | . D BLD^DIALOG(36426,"","","XMTEXT","SF")
|
|---|
| 35 | . ;A Mailbox INTEGRITY CHECK will run before the PURGE.
|
|---|
| 36 | E D
|
|---|
| 37 | . D BLD^DIALOG(36427,"","","XMTEXT","SF")
|
|---|
| 38 | . ;A Mailbox INTEGRITY CHECK will NOT run before the PURGE,
|
|---|
| 39 | . ;because your site parameters indicate you do not want it to.
|
|---|
| 40 | . ;You may want to do a BACK-UP just before this runs, and revert
|
|---|
| 41 | . ;to it if many problems are discovered.
|
|---|
| 42 | W !
|
|---|
| 43 | D MSG^DIALOG("WM","","","","XMTEXT")
|
|---|
| 44 | W !
|
|---|
| 45 | D GETPARMS(.XMPARM)
|
|---|
| 46 | D BLD^DIALOG(36428,"","","DIR(""A"")") ;Do you really want to purge all unreferenced messages
|
|---|
| 47 | S DIR("B")=$$EZBLD^DIALOG(39053) ; NO
|
|---|
| 48 | S DIR(0)="Y"
|
|---|
| 49 | D ^DIR Q:'Y
|
|---|
| 50 | D WAIT^DICD
|
|---|
| 51 | D PURGEIT(.XMPARM)
|
|---|
| 52 | K DIR S DIR(0)="E" D ^DIR Q:$D(DIRUT) K DIR
|
|---|
| 53 | D STAT
|
|---|
| 54 | Q
|
|---|
| 55 | PURGEIT(XMPARM) ;
|
|---|
| 56 | N XMKILL,XMIEN,XMCNT,XMCRE8,XMABORT
|
|---|
| 57 | D INIT(.XMIEN,.XMPARM,.XMKILL,.XMABORT) Q:XMABORT
|
|---|
| 58 | D MPURGE(.XMCRE8,.XMPARM,.XMKILL,.XMCNT,.XMABORT)
|
|---|
| 59 | D FINISH(XMIEN,XMCRE8,.XMKILL,.XMCNT,XMABORT)
|
|---|
| 60 | Q
|
|---|
| 61 | INIT(XMIEN,XMPARM,XMKILL,XMABORT) ;
|
|---|
| 62 | S XMABORT=0
|
|---|
| 63 | D:'$D(XMPARM) GETPARMS(.XMPARM)
|
|---|
| 64 | I '$P($G(^XMB(1,1,.12)),U) D MAILBOX^XMUT4(.XMABORT) Q:XMABORT ; Integrity check
|
|---|
| 65 | S (XMKILL("MSG"),XMKILL("RESP"))=0
|
|---|
| 66 | S XMKILL("START")=$P(^XMB(3.9,0),U,4)
|
|---|
| 67 | D AUDTPURG^XMA32 ; purge audit records
|
|---|
| 68 | D DONTPURG^XMA30 ; Note all messages which shouldn't be purged
|
|---|
| 69 | D INITAUDT^XMA32A(.XMIEN,.XMPARM)
|
|---|
| 70 | Q
|
|---|
| 71 | GETPARMS(XMPARM) ;
|
|---|
| 72 | N XMSBUF,XMBUFREC
|
|---|
| 73 | S (XMPARM("TYPE"),XMPARM("START"))=0
|
|---|
| 74 | ; Set up a date buffer, beyond which we won't purge
|
|---|
| 75 | S XMBUFREC=$G(^XMB(1,1,.14))
|
|---|
| 76 | S XMPARM("END")=$$PDATE(+$P(XMBUFREC,U,1),2) ; purge thru this date
|
|---|
| 77 | S XMPARM("PDATE")=$$PDATE(+$P(XMBUFREC,U,2),7) ; don't purge local messages sent on or after this date to remote sites.
|
|---|
| 78 | ; If today is Saturday, start purge at beginning.
|
|---|
| 79 | ; If not Saturday, check MailMan Site Parameter file for field 4.304 ...
|
|---|
| 80 | I $$DOW^XLFDT(DT,1)'=6 D
|
|---|
| 81 | . S XMSBUF=+$P($G(^XMB(1,1,"NOTOPURGE")),U)
|
|---|
| 82 | . I XMSBUF=0,($G(^XMB("NETNAME"))="FORUM.VA.GOV"!$G(^XMB("NETNAME"))="FORUM.MED.VA.GOV") S XMSBUF=45
|
|---|
| 83 | . Q:XMSBUF=0
|
|---|
| 84 | . S XMPARM("START")=$$PDATE(XMSBUF,45)
|
|---|
| 85 | Q:$D(ZTQUEUED)
|
|---|
| 86 | N XMTEXT,XMVAR
|
|---|
| 87 | S XMVAR(1)=$$FMTE^XLFDT($S(XMPARM("START")=0:$O(^XMB(3.9,"C",0)),1:XMPARM("START")),5)
|
|---|
| 88 | S XMVAR(2)=$$FMTE^XLFDT(XMPARM("END"),5)
|
|---|
| 89 | S XMVAR(3)=$$FMTE^XLFDT(XMPARM("PDATE"),5)
|
|---|
| 90 | D BLD^DIALOG(36429,.XMVAR,"","XMTEXT","F")
|
|---|
| 91 | D MSG^DIALOG("WM","","","","XMTEXT")
|
|---|
| 92 | ;Any unreferenced message will be purged if its local create date
|
|---|
| 93 | ;is from |1| to |2| inclusive.
|
|---|
| 94 | ;However, locally generated messages sent to remote sites will not be purged
|
|---|
| 95 | ;if they were sent on or after |3|.
|
|---|
| 96 | ;The following messages are considered 'referenced' and will not be purged:
|
|---|
| 97 | ;- Messages in users' baskets
|
|---|
| 98 | ;- Messages in transit (arriving or being sent)
|
|---|
| 99 | ;- Server messages
|
|---|
| 100 | ;- Messages being edited (includes aborted edits)
|
|---|
| 101 | ;- Later'd messages
|
|---|
| 102 | Q
|
|---|
| 103 | PDATE(XMDAYS,XMDEFALT) ; Subtract so many days from today and return that date.
|
|---|
| 104 | S:+XMDAYS=0 XMDAYS=XMDEFALT ; use default if days is null
|
|---|
| 105 | Q $$FMADD^XLFDT(DT,-XMDAYS)
|
|---|
| 106 | FINISH(XMIEN,XMCRE8,XMKILL,XMCNT,XMABORT) ;
|
|---|
| 107 | K ^TMP("XM",$J)
|
|---|
| 108 | S XMKILL("TOTAL")=XMKILL("MSG")+XMKILL("RESP")
|
|---|
| 109 | ;I $G(ZTSTOP) W !!,"*** Stopping prematurely per user request ***"
|
|---|
| 110 | I '$D(ZTQUEUED) D
|
|---|
| 111 | . N XMVAR,XMTEXT
|
|---|
| 112 | . S XMVAR(1)=$J(XMCNT,$L(XMKILL("START")))
|
|---|
| 113 | . S XMVAR(2)=$J(XMKILL("TOTAL"),$L(XMKILL("START")))
|
|---|
| 114 | . S XMVAR(3)=$J(XMKILL("START")-XMKILL("TOTAL"),$L(XMKILL("START")))
|
|---|
| 115 | . W !
|
|---|
| 116 | . D BLD^DIALOG(36430,.XMVAR,"","XMTEXT","F")
|
|---|
| 117 | . D MSG^DIALOG("WM","","","","XMTEXT")
|
|---|
| 118 | . ;|1| messages processed, |2| messages purged, |3| messages in file 3.9
|
|---|
| 119 | D CHKAUDT^XMA32A(XMIEN,XMCRE8,.XMKILL)
|
|---|
| 120 | Q
|
|---|
| 121 | MPURGE(XMCRE8,XMPARM,XMKILL,XMCNT,XMABORT) ;
|
|---|
| 122 | N XMZREC,XMZ
|
|---|
| 123 | S XMZ="",XMCNT=0
|
|---|
| 124 | S XMCRE8=$S(XMPARM("START")=0:0,1:$O(^XMB(3.9,"C",XMPARM("START")),-1))
|
|---|
| 125 | F S XMCRE8=$O(^XMB(3.9,"C",XMCRE8)) Q:'XMCRE8 Q:XMCRE8>XMPARM("END") D
|
|---|
| 126 | . F S XMZ=$O(^XMB(3.9,"C",XMCRE8,XMZ)) Q:'XMZ D
|
|---|
| 127 | . . S XMCNT=XMCNT+1 I XMCNT#5000=0 D Q:XMABORT
|
|---|
| 128 | . . . I '$D(ZTQUEUED) W:$X>40 ! W XMCNT,"." Q
|
|---|
| 129 | . . . I $$S^%ZTLOAD S (XMABORT,ZTSTOP)=1 ; User asked the task to stop
|
|---|
| 130 | . . I '$D(^XMB(3.9,XMZ)) K ^XMB(3.9,"C",XMCRE8,XMZ) Q
|
|---|
| 131 | . . Q:$D(^XMB(3.7,"M",XMZ)) ; Msg is in someone's basket
|
|---|
| 132 | . . Q:$D(^TMP("XM",$J,"NOP",XMZ)) ; Msg is one of "do not purge"
|
|---|
| 133 | . . S XMZREC=$G(^XMB(3.9,XMZ,0))
|
|---|
| 134 | . . Q:$P(XMZREC,U,8) ; Msg is a response
|
|---|
| 135 | . . I $P($P(XMZREC,U,3),".")?7N,XMCRE8'<XMPARM("PDATE"),$O(^XMB(3.9,XMZ,1,"C",":"))'="" Q ; local msg recently sent to remote site
|
|---|
| 136 | . . D PURGE(XMZ,.XMKILL)
|
|---|
| 137 | Q
|
|---|
| 138 | PURGE(XMZ,XMKILL) ; Purge message and responses
|
|---|
| 139 | N XMZR,XMIEN
|
|---|
| 140 | S XMIEN=0
|
|---|
| 141 | F S XMIEN=$O(^XMB(3.9,XMZ,3,XMIEN)) Q:XMIEN'>0 D
|
|---|
| 142 | . S XMZR=$P($G(^XMB(3.9,XMZ,3,XMIEN,0)),U) Q:'XMZR
|
|---|
| 143 | . D KILLRESP(XMZR,.XMKILL)
|
|---|
| 144 | D KILLMSG(XMZ,.XMKILL)
|
|---|
| 145 | Q
|
|---|
| 146 | KILLRESP(XMZ,XMKILL) ; Kill response
|
|---|
| 147 | Q:'$D(^XMB(3.9,XMZ)) ; Response does not exist
|
|---|
| 148 | Q:$D(^XMB(3.7,"M",XMZ)) ; Someone has response in mailbox
|
|---|
| 149 | D KILLMSG^XMXUTIL(XMZ)
|
|---|
| 150 | S XMKILL("RESP")=XMKILL("RESP")+1
|
|---|
| 151 | Q
|
|---|
| 152 | KILLMSG(XMZ,XMKILL) ; Kill message
|
|---|
| 153 | D KILLMSG^XMXUTIL(XMZ)
|
|---|
| 154 | S XMKILL("MSG")=XMKILL("MSG")+1
|
|---|
| 155 | Q
|
|---|
| 156 | CLEAN ; Clean various files
|
|---|
| 157 | D CSTAT ; Clean Message Statistics file
|
|---|
| 158 | D CMBOX ; Clean WASTE baskets & Postmaster's ARRIVING basket
|
|---|
| 159 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 160 | Q
|
|---|
| 161 | CSTAT ; Clean Statistics file audits - delete records more than 2 years old
|
|---|
| 162 | N XMINST,XMAUDT,XMCUTOFF,DA,DIK
|
|---|
| 163 | S XMCUTOFF=DT\100-200 ; 2 years ago, in yyymm format
|
|---|
| 164 | S XMINST=0
|
|---|
| 165 | F S XMINST=$O(^XMBS(4.2999,XMINST)) Q:XMINST'>0 D
|
|---|
| 166 | . S DA(1)=XMINST,DIK="^XMBS(4.2999,"_DA(1)_",100,"
|
|---|
| 167 | . S XMAUDT=0
|
|---|
| 168 | . F S XMAUDT=$O(^XMBS(4.2999,XMINST,100,XMAUDT)) Q:XMAUDT'>0!(XMAUDT>XMCUTOFF) D
|
|---|
| 169 | . . S DA=XMAUDT D ^DIK
|
|---|
| 170 | Q
|
|---|
| 171 | CMBOX ; Clean the mailbox file
|
|---|
| 172 | N XMDUZ,XMCNT,XMABORT
|
|---|
| 173 | D CARRIVE
|
|---|
| 174 | S (XMDUZ,XMCNT,XMABORT)=0
|
|---|
| 175 | F S XMDUZ=$O(^XMB(3.7,XMDUZ)) Q:XMDUZ'>0 D Q:XMABORT
|
|---|
| 176 | . D CWASTE(XMDUZ,.XMCNT,.XMABORT)
|
|---|
| 177 | W:'$D(ZTQUEUED) !,$$EZBLD^DIALOG(36431) ; Waste & Arriving Baskets Cleaned!
|
|---|
| 178 | Q
|
|---|
| 179 | CWASTE(XMDUZ,XMCNT,XMABORT) ; Clean a user's WASTE basket
|
|---|
| 180 | S XMCNT=XMCNT+1 I XMCNT#100=0 D Q:XMABORT
|
|---|
| 181 | . I '$D(ZTQUEUED) W:$X>40 ! W XMCNT,"." Q
|
|---|
| 182 | . I $$S^%ZTLOAD S (XMABORT,ZTSTOP)=1 ; User asked the task to stop
|
|---|
| 183 | L +^XMB(3.7,XMDUZ,2,.5):5 E Q
|
|---|
| 184 | N XMZ
|
|---|
| 185 | S XMZ=0
|
|---|
| 186 | F S XMZ=$O(^XMB(3.7,XMDUZ,2,.5,1,XMZ)) Q:XMZ'>0 K ^XMB(3.7,"M",XMZ,XMDUZ,.5)
|
|---|
| 187 | K ^XMB(3.7,XMDUZ,2,.5)
|
|---|
| 188 | S ^XMB(3.7,XMDUZ,2,.5,0)=$$EZBLD^DIALOG(37004) ; "WASTE"
|
|---|
| 189 | S ^XMB(3.7,XMDUZ,2,.5,1,0)="^3.702P^0^0"
|
|---|
| 190 | L -^XMB(3.7,XMDUZ,2,.5)
|
|---|
| 191 | Q
|
|---|
| 192 | CARRIVE ; Clean the postmaster's ARRIVING basket
|
|---|
| 193 | N XMZ,XMCNT,XMZLAST,XMDATE,XMPARM
|
|---|
| 194 | S XMPARM("END")=$$PDATE(+$P($G(^XMB(1,1,.14)),U,1),2)
|
|---|
| 195 | L +^XMB(3.7,.5,2,.95):5 E Q
|
|---|
| 196 | S (XMZ,XMCNT,XMZLAST)=0
|
|---|
| 197 | F S XMZ=$O(^XMB(3.7,.5,2,.95,1,XMZ)) Q:XMZ'>0 D
|
|---|
| 198 | . I '$D(^XMB(3.9,XMZ,0)) D Q
|
|---|
| 199 | . . S DA=XMZ,DA(1)=.95,DA(2)=.5,DIK="^XMB(3.7,.5,2,.95,1," D ^DIK
|
|---|
| 200 | . ; If it's still arriving, its date will be a FileMan date.
|
|---|
| 201 | . ; After it's finished arriving, its date will be an internet (text) date.
|
|---|
| 202 | . S XMDATE=$P($G(^XMB(3.9,XMZ,0)),U,3)
|
|---|
| 203 | . I XMDATE?7N1".".N,XMDATE'>XMPARM("END") D Q ; been arriving for over 24 hours
|
|---|
| 204 | . . S DA=XMZ,DA(1)=.95,DA(2)=.5,DIK="^XMB(3.7,.5,2,.95,1," D ^DIK
|
|---|
| 205 | . S XMCNT=XMCNT+1,XMZLAST=XMZ
|
|---|
| 206 | S ^XMB(3.7,.5,2,.95,0)="ARRIVING",^(1,0)="^3.702P^"_XMZLAST_U_XMCNT
|
|---|
| 207 | L -^XMB(3.7,.5,2,.95)
|
|---|
| 208 | Q
|
|---|
