Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMA3

XMA3.m

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