209 lines
8.1 KiB
Mathematica
209 lines
8.1 KiB
Mathematica
XMA3 ;ISC-SF/GMB-XMCLEAN, XMAUTOPURGE ;04/18/2002 07:09
|
|
;;8.0;MailMan;;Jun 28, 2002
|
|
; Was (WASH ISC)/CAP
|
|
;
|
|
; Entry points used by MailMan options (not covered by DBIA):
|
|
; CLEAN Option: XMCLEAN - Clean out waste baskets and
|
|
; Postmaster's ARRIVING basket
|
|
; EN Option: XMAUTOPURGE - Purge Unreferenced Messages
|
|
; SCAN Option: XMPURGE - Purge Unreferenced Messages, then STAT
|
|
; STAT Option: XMSTAT - Message Statistics
|
|
Q
|
|
EN ;
|
|
N XMPARM
|
|
D PURGEIT(.XMPARM)
|
|
S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q
|
|
STAT ;
|
|
D AUDIT^XMA30 ; Show purge audit records
|
|
D USERSTAT^XMA30 ; Show user mailbox info
|
|
Q
|
|
SCAN ; PURGE MESSAGES
|
|
I $D(ZTQUEUED) G EN
|
|
N DIR,XMPARM,XMTEXT
|
|
D AUDIT^XMA30 ; Show purge audit records
|
|
S DIR(0)="E" D ^DIR Q:$D(DIRUT) K DIR
|
|
D BLD^DIALOG(36425,"","","XMTEXT","F")
|
|
;I will purge messages which are not in anybody's Mailbox.
|
|
;This will be done by comparing the message numbers in the MESSAGE file
|
|
;(3.9) against the 'M' cross reference of the MAILBOX file (3.7).
|
|
;Because this is a real-time dynamic cross reference, it is
|
|
;RECOMMENDED that you run the INTEGRITY CHECKER with some
|
|
;frequency, to CORRECT problems, if any.
|
|
I '$P($G(^XMB(1,1,.12)),U) D
|
|
. D BLD^DIALOG(36426,"","","XMTEXT","SF")
|
|
. ;A Mailbox INTEGRITY CHECK will run before the PURGE.
|
|
E D
|
|
. D BLD^DIALOG(36427,"","","XMTEXT","SF")
|
|
. ;A Mailbox INTEGRITY CHECK will NOT run before the PURGE,
|
|
. ;because your site parameters indicate you do not want it to.
|
|
. ;You may want to do a BACK-UP just before this runs, and revert
|
|
. ;to it if many problems are discovered.
|
|
W !
|
|
D MSG^DIALOG("WM","","","","XMTEXT")
|
|
W !
|
|
D GETPARMS(.XMPARM)
|
|
D BLD^DIALOG(36428,"","","DIR(""A"")") ;Do you really want to purge all unreferenced messages
|
|
S DIR("B")=$$EZBLD^DIALOG(39053) ; NO
|
|
S DIR(0)="Y"
|
|
D ^DIR Q:'Y
|
|
D WAIT^DICD
|
|
D PURGEIT(.XMPARM)
|
|
K DIR S DIR(0)="E" D ^DIR Q:$D(DIRUT) K DIR
|
|
D STAT
|
|
Q
|
|
PURGEIT(XMPARM) ;
|
|
N XMKILL,XMIEN,XMCNT,XMCRE8,XMABORT
|
|
D INIT(.XMIEN,.XMPARM,.XMKILL,.XMABORT) Q:XMABORT
|
|
D MPURGE(.XMCRE8,.XMPARM,.XMKILL,.XMCNT,.XMABORT)
|
|
D FINISH(XMIEN,XMCRE8,.XMKILL,.XMCNT,XMABORT)
|
|
Q
|
|
INIT(XMIEN,XMPARM,XMKILL,XMABORT) ;
|
|
S XMABORT=0
|
|
D:'$D(XMPARM) GETPARMS(.XMPARM)
|
|
I '$P($G(^XMB(1,1,.12)),U) D MAILBOX^XMUT4(.XMABORT) Q:XMABORT ; Integrity check
|
|
S (XMKILL("MSG"),XMKILL("RESP"))=0
|
|
S XMKILL("START")=$P(^XMB(3.9,0),U,4)
|
|
D AUDTPURG^XMA32 ; purge audit records
|
|
D DONTPURG^XMA30 ; Note all messages which shouldn't be purged
|
|
D INITAUDT^XMA32A(.XMIEN,.XMPARM)
|
|
Q
|
|
GETPARMS(XMPARM) ;
|
|
N XMSBUF,XMBUFREC
|
|
S (XMPARM("TYPE"),XMPARM("START"))=0
|
|
; Set up a date buffer, beyond which we won't purge
|
|
S XMBUFREC=$G(^XMB(1,1,.14))
|
|
S XMPARM("END")=$$PDATE(+$P(XMBUFREC,U,1),2) ; purge thru this date
|
|
S XMPARM("PDATE")=$$PDATE(+$P(XMBUFREC,U,2),7) ; don't purge local messages sent on or after this date to remote sites.
|
|
; If today is Saturday, start purge at beginning.
|
|
; If not Saturday, check MailMan Site Parameter file for field 4.304 ...
|
|
I $$DOW^XLFDT(DT,1)'=6 D
|
|
. S XMSBUF=+$P($G(^XMB(1,1,"NOTOPURGE")),U)
|
|
. I XMSBUF=0,($G(^XMB("NETNAME"))="FORUM.VA.GOV"!$G(^XMB("NETNAME"))="FORUM.MED.VA.GOV") S XMSBUF=45
|
|
. Q:XMSBUF=0
|
|
. S XMPARM("START")=$$PDATE(XMSBUF,45)
|
|
Q:$D(ZTQUEUED)
|
|
N XMTEXT,XMVAR
|
|
S XMVAR(1)=$$FMTE^XLFDT($S(XMPARM("START")=0:$O(^XMB(3.9,"C",0)),1:XMPARM("START")),5)
|
|
S XMVAR(2)=$$FMTE^XLFDT(XMPARM("END"),5)
|
|
S XMVAR(3)=$$FMTE^XLFDT(XMPARM("PDATE"),5)
|
|
D BLD^DIALOG(36429,.XMVAR,"","XMTEXT","F")
|
|
D MSG^DIALOG("WM","","","","XMTEXT")
|
|
;Any unreferenced message will be purged if its local create date
|
|
;is from |1| to |2| inclusive.
|
|
;However, locally generated messages sent to remote sites will not be purged
|
|
;if they were sent on or after |3|.
|
|
;The following messages are considered 'referenced' and will not be purged:
|
|
;- Messages in users' baskets
|
|
;- Messages in transit (arriving or being sent)
|
|
;- Server messages
|
|
;- Messages being edited (includes aborted edits)
|
|
;- Later'd messages
|
|
Q
|
|
PDATE(XMDAYS,XMDEFALT) ; Subtract so many days from today and return that date.
|
|
S:+XMDAYS=0 XMDAYS=XMDEFALT ; use default if days is null
|
|
Q $$FMADD^XLFDT(DT,-XMDAYS)
|
|
FINISH(XMIEN,XMCRE8,XMKILL,XMCNT,XMABORT) ;
|
|
K ^TMP("XM",$J)
|
|
S XMKILL("TOTAL")=XMKILL("MSG")+XMKILL("RESP")
|
|
;I $G(ZTSTOP) W !!,"*** Stopping prematurely per user request ***"
|
|
I '$D(ZTQUEUED) D
|
|
. N XMVAR,XMTEXT
|
|
. S XMVAR(1)=$J(XMCNT,$L(XMKILL("START")))
|
|
. S XMVAR(2)=$J(XMKILL("TOTAL"),$L(XMKILL("START")))
|
|
. S XMVAR(3)=$J(XMKILL("START")-XMKILL("TOTAL"),$L(XMKILL("START")))
|
|
. W !
|
|
. D BLD^DIALOG(36430,.XMVAR,"","XMTEXT","F")
|
|
. D MSG^DIALOG("WM","","","","XMTEXT")
|
|
. ;|1| messages processed, |2| messages purged, |3| messages in file 3.9
|
|
D CHKAUDT^XMA32A(XMIEN,XMCRE8,.XMKILL)
|
|
Q
|
|
MPURGE(XMCRE8,XMPARM,XMKILL,XMCNT,XMABORT) ;
|
|
N XMZREC,XMZ
|
|
S XMZ="",XMCNT=0
|
|
S XMCRE8=$S(XMPARM("START")=0:0,1:$O(^XMB(3.9,"C",XMPARM("START")),-1))
|
|
F S XMCRE8=$O(^XMB(3.9,"C",XMCRE8)) Q:'XMCRE8 Q:XMCRE8>XMPARM("END") D
|
|
. F S XMZ=$O(^XMB(3.9,"C",XMCRE8,XMZ)) Q:'XMZ D
|
|
. . S XMCNT=XMCNT+1 I XMCNT#5000=0 D Q:XMABORT
|
|
. . . I '$D(ZTQUEUED) W:$X>40 ! W XMCNT,"." Q
|
|
. . . I $$S^%ZTLOAD S (XMABORT,ZTSTOP)=1 ; User asked the task to stop
|
|
. . I '$D(^XMB(3.9,XMZ)) K ^XMB(3.9,"C",XMCRE8,XMZ) Q
|
|
. . Q:$D(^XMB(3.7,"M",XMZ)) ; Msg is in someone's basket
|
|
. . Q:$D(^TMP("XM",$J,"NOP",XMZ)) ; Msg is one of "do not purge"
|
|
. . S XMZREC=$G(^XMB(3.9,XMZ,0))
|
|
. . Q:$P(XMZREC,U,8) ; Msg is a response
|
|
. . 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
|
|
. . D PURGE(XMZ,.XMKILL)
|
|
Q
|
|
PURGE(XMZ,XMKILL) ; Purge message and responses
|
|
N XMZR,XMIEN
|
|
S XMIEN=0
|
|
F S XMIEN=$O(^XMB(3.9,XMZ,3,XMIEN)) Q:XMIEN'>0 D
|
|
. S XMZR=$P($G(^XMB(3.9,XMZ,3,XMIEN,0)),U) Q:'XMZR
|
|
. D KILLRESP(XMZR,.XMKILL)
|
|
D KILLMSG(XMZ,.XMKILL)
|
|
Q
|
|
KILLRESP(XMZ,XMKILL) ; Kill response
|
|
Q:'$D(^XMB(3.9,XMZ)) ; Response does not exist
|
|
Q:$D(^XMB(3.7,"M",XMZ)) ; Someone has response in mailbox
|
|
D KILLMSG^XMXUTIL(XMZ)
|
|
S XMKILL("RESP")=XMKILL("RESP")+1
|
|
Q
|
|
KILLMSG(XMZ,XMKILL) ; Kill message
|
|
D KILLMSG^XMXUTIL(XMZ)
|
|
S XMKILL("MSG")=XMKILL("MSG")+1
|
|
Q
|
|
CLEAN ; Clean various files
|
|
D CSTAT ; Clean Message Statistics file
|
|
D CMBOX ; Clean WASTE baskets & Postmaster's ARRIVING basket
|
|
S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q
|
|
CSTAT ; Clean Statistics file audits - delete records more than 2 years old
|
|
N XMINST,XMAUDT,XMCUTOFF,DA,DIK
|
|
S XMCUTOFF=DT\100-200 ; 2 years ago, in yyymm format
|
|
S XMINST=0
|
|
F S XMINST=$O(^XMBS(4.2999,XMINST)) Q:XMINST'>0 D
|
|
. S DA(1)=XMINST,DIK="^XMBS(4.2999,"_DA(1)_",100,"
|
|
. S XMAUDT=0
|
|
. F S XMAUDT=$O(^XMBS(4.2999,XMINST,100,XMAUDT)) Q:XMAUDT'>0!(XMAUDT>XMCUTOFF) D
|
|
. . S DA=XMAUDT D ^DIK
|
|
Q
|
|
CMBOX ; Clean the mailbox file
|
|
N XMDUZ,XMCNT,XMABORT
|
|
D CARRIVE
|
|
S (XMDUZ,XMCNT,XMABORT)=0
|
|
F S XMDUZ=$O(^XMB(3.7,XMDUZ)) Q:XMDUZ'>0 D Q:XMABORT
|
|
. D CWASTE(XMDUZ,.XMCNT,.XMABORT)
|
|
W:'$D(ZTQUEUED) !,$$EZBLD^DIALOG(36431) ; Waste & Arriving Baskets Cleaned!
|
|
Q
|
|
CWASTE(XMDUZ,XMCNT,XMABORT) ; Clean a user's WASTE basket
|
|
S XMCNT=XMCNT+1 I XMCNT#100=0 D Q:XMABORT
|
|
. I '$D(ZTQUEUED) W:$X>40 ! W XMCNT,"." Q
|
|
. I $$S^%ZTLOAD S (XMABORT,ZTSTOP)=1 ; User asked the task to stop
|
|
L +^XMB(3.7,XMDUZ,2,.5):5 E Q
|
|
N XMZ
|
|
S XMZ=0
|
|
F S XMZ=$O(^XMB(3.7,XMDUZ,2,.5,1,XMZ)) Q:XMZ'>0 K ^XMB(3.7,"M",XMZ,XMDUZ,.5)
|
|
K ^XMB(3.7,XMDUZ,2,.5)
|
|
S ^XMB(3.7,XMDUZ,2,.5,0)=$$EZBLD^DIALOG(37004) ; "WASTE"
|
|
S ^XMB(3.7,XMDUZ,2,.5,1,0)="^3.702P^0^0"
|
|
L -^XMB(3.7,XMDUZ,2,.5)
|
|
Q
|
|
CARRIVE ; Clean the postmaster's ARRIVING basket
|
|
N XMZ,XMCNT,XMZLAST,XMDATE,XMPARM
|
|
S XMPARM("END")=$$PDATE(+$P($G(^XMB(1,1,.14)),U,1),2)
|
|
L +^XMB(3.7,.5,2,.95):5 E Q
|
|
S (XMZ,XMCNT,XMZLAST)=0
|
|
F S XMZ=$O(^XMB(3.7,.5,2,.95,1,XMZ)) Q:XMZ'>0 D
|
|
. I '$D(^XMB(3.9,XMZ,0)) D Q
|
|
. . S DA=XMZ,DA(1)=.95,DA(2)=.5,DIK="^XMB(3.7,.5,2,.95,1," D ^DIK
|
|
. ; If it's still arriving, its date will be a FileMan date.
|
|
. ; After it's finished arriving, its date will be an internet (text) date.
|
|
. S XMDATE=$P($G(^XMB(3.9,XMZ,0)),U,3)
|
|
. I XMDATE?7N1".".N,XMDATE'>XMPARM("END") D Q ; been arriving for over 24 hours
|
|
. . S DA=XMZ,DA(1)=.95,DA(2)=.5,DIK="^XMB(3.7,.5,2,.95,1," D ^DIK
|
|
. S XMCNT=XMCNT+1,XMZLAST=XMZ
|
|
S ^XMB(3.7,.5,2,.95,0)="ARRIVING",^(1,0)="^3.702P^"_XMZLAST_U_XMCNT
|
|
L -^XMB(3.7,.5,2,.95)
|
|
Q
|