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

XMUPIN.m

Go to the documentation of this file. 
  1. XMUPIN ;ISC-SF/GMB-IN Basket Purge ;04/11/2002  08:33
  1.  ;;8.0;MailMan;;Jun 28, 2002
  1.  ; Replaces ^XMAI,^XMAI0,^XMAI1 (ISC-WASH/CAP)
  1.  ; Entry points used by MailMan options (not covered by DBIA):
  1.  ; ENTER  XMMGR-IN-BASKET-PURGE
  1. ENTER ;
  1.  ; XMIDAYS  If msg hasn't been read for this many days, flag for deletion
  1.  ; XMDDAYS  If flagged msg hasn't been read after this many days, delete it
  1.  N XMIDAYS,XMDDAYS,XMKALL,XMEXEMPT,XMABORT,XMTEST
  1.  D INIT(.XMDUZ,.XMTEST,.XMDDAYS,.XMIDAYS,.XMKALL,.XMABORT) Q:XMABORT
  1.  D PROCESS(XMTEST,XMDDAYS,XMIDAYS,XMKALL,.XMEXEMPT)
  1.  Q
  1. TEST ;
  1.  N XMIDAYS,XMDDAYS,XMKALL,XMEXEMPT,XMABORT,XMTEST
  1.  S XMTEST=1
  1.  D INIT(.XMDUZ,.XMTEST,.XMDDAYS,.XMIDAYS,.XMKALL,.XMABORT) Q:XMABORT
  1.  D PROCESS(XMTEST,XMDDAYS,XMIDAYS,XMKALL,.XMEXEMPT)
  1.  Q
  1. INIT(XMDUZ,XMTEST,XMDDAYS,XMIDAYS,XMKALL,XMABORT) ;
  1.  I '$G(DUZ) W $C(7),!!,$$EZBLD^DIALOG(38105) G H^XUS ; You do not have a DUZ.
  1.  I '$D(XMDUZ) S XMDUZ=.5
  1.  D DT^DICRW ; Set up required FM variables
  1.  S:'$D(XMTEST) XMTEST=0
  1.  S XMDDAYS=30,XMABORT=0
  1.  S XMIDAYS=+$P($G(^XMB(1,1,0)),U,9)
  1.  S:'XMIDAYS XMIDAYS=30
  1.  S XMKALL=+$P($G(^XMB(1,1,.15)),U)
  1.  Q:$D(ZTQUEUED)
  1.  N DIR,Y,DIRUT,XMPARM
  1.  W !
  1.  S XMPARM(1)=XMIDAYS,XMPARM(2)=XMDDAYS
  1.  ;This process cleans out old messages from user mailboxes.
  1.  ;
  1.  ;Fields in the MAILMAN SITE PARAMETERS file 4.3 let you fine-tune:
  1.  ; - field 10:    Number of days since the messages have been read
  1.  ; - field 10.01: Examine ALL baskets or just the IN basket.
  1.  ;
  1.  ;Messages that are not 'NEW' and have NOT been READ for |1| days are
  1.  ;marked for automatic deletion.  Messages so marked, which have not been
  1.  ;read nor saved into another Basket within |2| days, will be deleted
  1.  ;automatically from users' mailboxes.
  1.  ;
  1.  ;Each user will receive a message listing messages that are marked
  1.  ;for deletion.  The |2| day grace period allows users to receive
  1.  ;this message and have time to prevent messages they want to keep from
  1.  ;being deleted from their Mail Baskets.
  1.  ;
  1.  ;Even then many of the messages may still be recalled via the
  1.  ;search process that can be invoked to search for messages that
  1.  ;the user is a recipient of.  As long as the 'AUTOPURGE' has not
  1.  ;been run or another user has kept a copy, messages can be recovered.
  1.  D BLD^DIALOG(36610,.XMPARM,"","XMTEXT","F")
  1.  D MSG^DIALOG("WM","","","","XMTEXT")
  1.  W ! ;This may take some time.  Do you wish to continue
  1.  D BLD^DIALOG(36611,"","","DIR(""A"")")
  1.  S DIR(0)="Y",DIR("B")=$$EZBLD^DIALOG(39053) ;No
  1.  S DIR("??")="XM-IN-BASKET-PURGE"
  1.  D ^DIR I 'Y S XMABORT=1 Q
  1.  W !
  1.  D BLD^DIALOG($S(XMKALL:36612,1:36613),XMDDAYS,"","XMTEXT","F")
  1.  D MSG^DIALOG("WM","","","","XMTEXT")
  1.  ;Compiling lists of messages to PURGE in |1| days from *all*/IN baskets
  1.  Q
  1. PROCESS(XMTEST,XMDDAYS,XMIDAYS,XMKALL,XMEXEMPT) ;
  1.  ; XMDDATE  Deletion date for inactive messages (FM format)
  1.  ; XMDDATEX Deletion date for inactive messages (external format)
  1.  ; XMIDATE  Date beyond which message has had no activity (and thus
  1.  ;          becomes candidate for deletion).
  1.  ; XMKALL   1=all baskets; 0=IN basket only
  1.  ; XMEXEMPT Users exempt from purge (":duz1:duz2:...:duzn:")
  1.  N XMDDATE,XMDDATEX,XMIDATE,XMUSER,XMK,XMI,XMLEN,XMLEFT,XMHDR
  1.  S XMLEFT=79
  1.  S XMLEN("XMZ")=$L($O(^XMB(3.9,":"),-1))+2
  1.  S XMLEN("DATE")=$L($$MMDT^XMXUTIL1(DT))
  1.  S XMLEFT=XMLEFT-XMLEN("XMZ")-(2*XMLEN("DATE"))-6
  1.  S XMLEN("SUBJ")=XMLEFT*2\3
  1.  S XMLEN("FROM")=XMLEFT-XMLEN("SUBJ")
  1.  S XMHDR(1)=$$LJ^XLFSTR($$EZBLD^DIALOG(34633),XMLEN("XMZ")+1)_$$LJ^XLFSTR($$EZBLD^DIALOG(34632),XMLEN("DATE")+1)_$$LJ^XLFSTR($$EZBLD^DIALOG(34002),XMLEN("SUBJ")+2) ;Msg ID / Date / Subject
  1.  S XMHDR(1)=XMHDR(1)_$$LJ^XLFSTR($$EZBLD^DIALOG(34006),XMLEN("FROM")+2)_$$EZBLD^DIALOG(36614) ;From  / Last Read
  1.  S XMHDR(2)=$$REPEAT^XLFSTR("-",XMLEN("XMZ"))_" "_$$REPEAT^XLFSTR("-",XMLEN("DATE"))_" "_$$REPEAT^XLFSTR("-",XMLEN("SUBJ"))_"  "_$$REPEAT^XLFSTR("-",XMLEN("FROM"))_"  "_$$REPEAT^XLFSTR("-",XMLEN("DATE"))
  1.  S XMDDATE=$$FMADD^XLFDT(DT,30)
  1.  S XMDDATEX=$$MMDT^XMXUTIL1(XMDDATE)
  1.  S XMIDATE=$$FMADD^XLFDT(DT,-XMIDAYS)
  1.  S XMUSER=.999
  1.  K ^TMP("XM",$J)
  1.  F  S XMUSER=$O(^XMB(3.7,XMUSER)) Q:XMUSER'>0  D
  1.  . Q:$G(XMEXEMPT)[(":"_XMUSER_":")
  1.  . S XMI=0
  1.  . I XMKALL D
  1.  . . S XMK=.99
  1.  . . F  S XMK=$O(^XMB(3.7,XMUSER,2,XMK)) Q:XMK'>0  D BASKET(XMTEST,XMK,$P($G(^(XMK,0),"NO NAME"),U),XMIDATE,XMDDATE,.XMLEN,.XMHDR,.XMI)
  1.  . E  D BASKET(XMTEST,1,$$EZBLD^DIALOG(37005),XMIDATE,XMDDATE,.XMLEN,.XMHDR,.XMI) ;IN
  1.  . Q:'$D(^TMP("XM",$J))
  1.  . D SENDMSG(XMTEST,XMKALL,XMIDAYS,XMDDATEX,XMUSER)
  1.  . K ^TMP("XM",$J)
  1.  Q
  1. BASKET(XMTEST,XMK,XMKN,XMIDATE,XMDDATE,XMLEN,XMHDR,XMI) ; Process Basket
  1.  N XMZ,XMZDATE,XMREC,XMZREC,XMFDA,XMIENS,XMFIRST,XMIREC
  1.  S XMZ=0,XMFIRST=1
  1.  F  S XMZ=$O(^XMB(3.7,XMUSER,2,XMK,1,XMZ)) Q:XMZ'>0  S XMREC=$G(^(XMZ,0)) D
  1.  . ; Quit if no data OR new msg OR already scheduled for deletion
  1.  . ; OR activity after the cutoff date
  1.  . Q:XMREC=""!$P(XMREC,U,3)!$P(XMREC,U,5)!($P(XMREC,U,4)>XMIDATE)
  1.  . S XMZREC=$G(^XMB(3.9,XMZ,0))
  1.  . S XMZDATE=$P(XMZREC,U,3)
  1.  . S:XMZDATE'?7N1".".N XMZDATE=$$CONVERT^XMXUTIL1(XMZDATE)
  1.  . I $P(XMREC,U,4)="" Q:XMZDATE>XMIDATE
  1.  . I 'XMTEST D  ; Mark message w/delete date ("AC" x-ref created by trigger)
  1.  . . S XMIENS=XMZ_","_XMK_","_XMUSER_","
  1.  . . S XMFDA(3.702,XMIENS,5)=XMDDATE
  1.  . . S XMFDA(3.702,XMIENS,7)=1
  1.  . . D FILE^DIE("","XMFDA")
  1.  . I XMFIRST D
  1.  . . S XMFIRST=0
  1.  . . S XMI=XMI+1,^TMP("XM",$J,XMI)=""
  1.  . . S XMI=XMI+1,^TMP("XM",$J,XMI)=$$EZBLD^DIALOG(34656,XMKN) ;Basket: |1|
  1.  . . S XMI=XMI+1,^TMP("XM",$J,XMI)=""
  1.  . . S XMI=XMI+1,^TMP("XM",$J,XMI)=XMHDR(1)
  1.  . . S XMI=XMI+1,^TMP("XM",$J,XMI)=XMHDR(2)
  1.  . S XMIREC=$J("["_XMZ_"]",XMLEN("XMZ"))_" "_$E($$MMDT^XMXUTIL1(XMZDATE),1,XMLEN("DATE"))_" "_$$LJ^XLFSTR($E($$SUBJ^XMXUTIL2(XMZREC),1,XMLEN("SUBJ")),XMLEN("SUBJ"))
  1.  . S XMIREC=XMIREC_"  "_$$LJ^XLFSTR($E($$NAME^XMXUTIL($P(XMZREC,U,2)),1,XMLEN("FROM")),XMLEN("FROM"))_"  "_$$MMDT^XMXUTIL1($P($P(XMREC,U,4),".",1))
  1.  . S XMI=XMI+1,^TMP("XM",$J,XMI)=XMIREC
  1.  Q
  1. SENDMSG(XMTEST,XMKALL,XMIDAYS,XMDDATEX,XMTO) ; Send a message to the user
  1.  N XMINSTR,XMPARM,XMBULL
  1.  S XMINSTR("FLAGS")="I" ; Info only
  1.  S XMINSTR("FROM")=.5
  1.  S XMPARM(1)=XMIDAYS,XMPARM(2)=XMDDATEX
  1.  S XMBULL=$S(XMTEST:"XM IN BASKET PURGE REQUEST",1:"XM IN BASKET PURGE WARNING")
  1.  D TASKBULL^XMXBULL(.5,XMBULL,.XMPARM,"^TMP(""XM"",$J)",XMTO,.XMINSTR)
  1.  Q