[628] | 1 | XMUPIN ;ISC-SF/GMB-IN Basket Purge ;04/11/2002 08:33
|
---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002
|
---|
| 3 | ; Replaces ^XMAI,^XMAI0,^XMAI1 (ISC-WASH/CAP)
|
---|
| 4 | ; Entry points used by MailMan options (not covered by DBIA):
|
---|
| 5 | ; ENTER XMMGR-IN-BASKET-PURGE
|
---|
| 6 | ENTER ;
|
---|
| 7 | ; XMIDAYS If msg hasn't been read for this many days, flag for deletion
|
---|
| 8 | ; XMDDAYS If flagged msg hasn't been read after this many days, delete it
|
---|
| 9 | N XMIDAYS,XMDDAYS,XMKALL,XMEXEMPT,XMABORT,XMTEST
|
---|
| 10 | D INIT(.XMDUZ,.XMTEST,.XMDDAYS,.XMIDAYS,.XMKALL,.XMABORT) Q:XMABORT
|
---|
| 11 | D PROCESS(XMTEST,XMDDAYS,XMIDAYS,XMKALL,.XMEXEMPT)
|
---|
| 12 | Q
|
---|
| 13 | TEST ;
|
---|
| 14 | N XMIDAYS,XMDDAYS,XMKALL,XMEXEMPT,XMABORT,XMTEST
|
---|
| 15 | S XMTEST=1
|
---|
| 16 | D INIT(.XMDUZ,.XMTEST,.XMDDAYS,.XMIDAYS,.XMKALL,.XMABORT) Q:XMABORT
|
---|
| 17 | D PROCESS(XMTEST,XMDDAYS,XMIDAYS,XMKALL,.XMEXEMPT)
|
---|
| 18 | Q
|
---|
| 19 | INIT(XMDUZ,XMTEST,XMDDAYS,XMIDAYS,XMKALL,XMABORT) ;
|
---|
| 20 | I '$G(DUZ) W $C(7),!!,$$EZBLD^DIALOG(38105) G H^XUS ; You do not have a DUZ.
|
---|
| 21 | I '$D(XMDUZ) S XMDUZ=.5
|
---|
| 22 | D DT^DICRW ; Set up required FM variables
|
---|
| 23 | S:'$D(XMTEST) XMTEST=0
|
---|
| 24 | S XMDDAYS=30,XMABORT=0
|
---|
| 25 | S XMIDAYS=+$P($G(^XMB(1,1,0)),U,9)
|
---|
| 26 | S:'XMIDAYS XMIDAYS=30
|
---|
| 27 | S XMKALL=+$P($G(^XMB(1,1,.15)),U)
|
---|
| 28 | Q:$D(ZTQUEUED)
|
---|
| 29 | N DIR,Y,DIRUT,XMPARM
|
---|
| 30 | W !
|
---|
| 31 | S XMPARM(1)=XMIDAYS,XMPARM(2)=XMDDAYS
|
---|
| 32 | ;This process cleans out old messages from user mailboxes.
|
---|
| 33 | ;
|
---|
| 34 | ;Fields in the MAILMAN SITE PARAMETERS file 4.3 let you fine-tune:
|
---|
| 35 | ; - field 10: Number of days since the messages have been read
|
---|
| 36 | ; - field 10.01: Examine ALL baskets or just the IN basket.
|
---|
| 37 | ;
|
---|
| 38 | ;Messages that are not 'NEW' and have NOT been READ for |1| days are
|
---|
| 39 | ;marked for automatic deletion. Messages so marked, which have not been
|
---|
| 40 | ;read nor saved into another Basket within |2| days, will be deleted
|
---|
| 41 | ;automatically from users' mailboxes.
|
---|
| 42 | ;
|
---|
| 43 | ;Each user will receive a message listing messages that are marked
|
---|
| 44 | ;for deletion. The |2| day grace period allows users to receive
|
---|
| 45 | ;this message and have time to prevent messages they want to keep from
|
---|
| 46 | ;being deleted from their Mail Baskets.
|
---|
| 47 | ;
|
---|
| 48 | ;Even then many of the messages may still be recalled via the
|
---|
| 49 | ;search process that can be invoked to search for messages that
|
---|
| 50 | ;the user is a recipient of. As long as the 'AUTOPURGE' has not
|
---|
| 51 | ;been run or another user has kept a copy, messages can be recovered.
|
---|
| 52 | D BLD^DIALOG(36610,.XMPARM,"","XMTEXT","F")
|
---|
| 53 | D MSG^DIALOG("WM","","","","XMTEXT")
|
---|
| 54 | W ! ;This may take some time. Do you wish to continue
|
---|
| 55 | D BLD^DIALOG(36611,"","","DIR(""A"")")
|
---|
| 56 | S DIR(0)="Y",DIR("B")=$$EZBLD^DIALOG(39053) ;No
|
---|
| 57 | S DIR("??")="XM-IN-BASKET-PURGE"
|
---|
| 58 | D ^DIR I 'Y S XMABORT=1 Q
|
---|
| 59 | W !
|
---|
| 60 | D BLD^DIALOG($S(XMKALL:36612,1:36613),XMDDAYS,"","XMTEXT","F")
|
---|
| 61 | D MSG^DIALOG("WM","","","","XMTEXT")
|
---|
| 62 | ;Compiling lists of messages to PURGE in |1| days from *all*/IN baskets
|
---|
| 63 | Q
|
---|
| 64 | PROCESS(XMTEST,XMDDAYS,XMIDAYS,XMKALL,XMEXEMPT) ;
|
---|
| 65 | ; XMDDATE Deletion date for inactive messages (FM format)
|
---|
| 66 | ; XMDDATEX Deletion date for inactive messages (external format)
|
---|
| 67 | ; XMIDATE Date beyond which message has had no activity (and thus
|
---|
| 68 | ; becomes candidate for deletion).
|
---|
| 69 | ; XMKALL 1=all baskets; 0=IN basket only
|
---|
| 70 | ; XMEXEMPT Users exempt from purge (":duz1:duz2:...:duzn:")
|
---|
| 71 | N XMDDATE,XMDDATEX,XMIDATE,XMUSER,XMK,XMI,XMLEN,XMLEFT,XMHDR
|
---|
| 72 | S XMLEFT=79
|
---|
| 73 | S XMLEN("XMZ")=$L($O(^XMB(3.9,":"),-1))+2
|
---|
| 74 | S XMLEN("DATE")=$L($$MMDT^XMXUTIL1(DT))
|
---|
| 75 | S XMLEFT=XMLEFT-XMLEN("XMZ")-(2*XMLEN("DATE"))-6
|
---|
| 76 | S XMLEN("SUBJ")=XMLEFT*2\3
|
---|
| 77 | S XMLEN("FROM")=XMLEFT-XMLEN("SUBJ")
|
---|
| 78 | 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
|
---|
| 79 | S XMHDR(1)=XMHDR(1)_$$LJ^XLFSTR($$EZBLD^DIALOG(34006),XMLEN("FROM")+2)_$$EZBLD^DIALOG(36614) ;From / Last Read
|
---|
| 80 | S XMHDR(2)=$$REPEAT^XLFSTR("-",XMLEN("XMZ"))_" "_$$REPEAT^XLFSTR("-",XMLEN("DATE"))_" "_$$REPEAT^XLFSTR("-",XMLEN("SUBJ"))_" "_$$REPEAT^XLFSTR("-",XMLEN("FROM"))_" "_$$REPEAT^XLFSTR("-",XMLEN("DATE"))
|
---|
| 81 | S XMDDATE=$$FMADD^XLFDT(DT,30)
|
---|
| 82 | S XMDDATEX=$$MMDT^XMXUTIL1(XMDDATE)
|
---|
| 83 | S XMIDATE=$$FMADD^XLFDT(DT,-XMIDAYS)
|
---|
| 84 | S XMUSER=.999
|
---|
| 85 | K ^TMP("XM",$J)
|
---|
| 86 | F S XMUSER=$O(^XMB(3.7,XMUSER)) Q:XMUSER'>0 D
|
---|
| 87 | . Q:$G(XMEXEMPT)[(":"_XMUSER_":")
|
---|
| 88 | . S XMI=0
|
---|
| 89 | . I XMKALL D
|
---|
| 90 | . . S XMK=.99
|
---|
| 91 | . . 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)
|
---|
| 92 | . E D BASKET(XMTEST,1,$$EZBLD^DIALOG(37005),XMIDATE,XMDDATE,.XMLEN,.XMHDR,.XMI) ;IN
|
---|
| 93 | . Q:'$D(^TMP("XM",$J))
|
---|
| 94 | . D SENDMSG(XMTEST,XMKALL,XMIDAYS,XMDDATEX,XMUSER)
|
---|
| 95 | . K ^TMP("XM",$J)
|
---|
| 96 | Q
|
---|
| 97 | BASKET(XMTEST,XMK,XMKN,XMIDATE,XMDDATE,XMLEN,XMHDR,XMI) ; Process Basket
|
---|
| 98 | N XMZ,XMZDATE,XMREC,XMZREC,XMFDA,XMIENS,XMFIRST,XMIREC
|
---|
| 99 | S XMZ=0,XMFIRST=1
|
---|
| 100 | F S XMZ=$O(^XMB(3.7,XMUSER,2,XMK,1,XMZ)) Q:XMZ'>0 S XMREC=$G(^(XMZ,0)) D
|
---|
| 101 | . ; Quit if no data OR new msg OR already scheduled for deletion
|
---|
| 102 | . ; OR activity after the cutoff date
|
---|
| 103 | . Q:XMREC=""!$P(XMREC,U,3)!$P(XMREC,U,5)!($P(XMREC,U,4)>XMIDATE)
|
---|
| 104 | . S XMZREC=$G(^XMB(3.9,XMZ,0))
|
---|
| 105 | . S XMZDATE=$P(XMZREC,U,3)
|
---|
| 106 | . S:XMZDATE'?7N1".".N XMZDATE=$$CONVERT^XMXUTIL1(XMZDATE)
|
---|
| 107 | . I $P(XMREC,U,4)="" Q:XMZDATE>XMIDATE
|
---|
| 108 | . I 'XMTEST D ; Mark message w/delete date ("AC" x-ref created by trigger)
|
---|
| 109 | . . S XMIENS=XMZ_","_XMK_","_XMUSER_","
|
---|
| 110 | . . S XMFDA(3.702,XMIENS,5)=XMDDATE
|
---|
| 111 | . . S XMFDA(3.702,XMIENS,7)=1
|
---|
| 112 | . . D FILE^DIE("","XMFDA")
|
---|
| 113 | . I XMFIRST D
|
---|
| 114 | . . S XMFIRST=0
|
---|
| 115 | . . S XMI=XMI+1,^TMP("XM",$J,XMI)=""
|
---|
| 116 | . . S XMI=XMI+1,^TMP("XM",$J,XMI)=$$EZBLD^DIALOG(34656,XMKN) ;Basket: |1|
|
---|
| 117 | . . S XMI=XMI+1,^TMP("XM",$J,XMI)=""
|
---|
| 118 | . . S XMI=XMI+1,^TMP("XM",$J,XMI)=XMHDR(1)
|
---|
| 119 | . . S XMI=XMI+1,^TMP("XM",$J,XMI)=XMHDR(2)
|
---|
| 120 | . S XMIREC=$J("["_XMZ_"]",XMLEN("XMZ"))_" "_$E($$MMDT^XMXUTIL1(XMZDATE),1,XMLEN("DATE"))_" "_$$LJ^XLFSTR($E($$SUBJ^XMXUTIL2(XMZREC),1,XMLEN("SUBJ")),XMLEN("SUBJ"))
|
---|
| 121 | . 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))
|
---|
| 122 | . S XMI=XMI+1,^TMP("XM",$J,XMI)=XMIREC
|
---|
| 123 | Q
|
---|
| 124 | SENDMSG(XMTEST,XMKALL,XMIDAYS,XMDDATEX,XMTO) ; Send a message to the user
|
---|
| 125 | N XMINSTR,XMPARM,XMBULL
|
---|
| 126 | S XMINSTR("FLAGS")="I" ; Info only
|
---|
| 127 | S XMINSTR("FROM")=.5
|
---|
| 128 | S XMPARM(1)=XMIDAYS,XMPARM(2)=XMDDATEX
|
---|
| 129 | S XMBULL=$S(XMTEST:"XM IN BASKET PURGE REQUEST",1:"XM IN BASKET PURGE WARNING")
|
---|
| 130 | D TASKBULL^XMXBULL(.5,XMBULL,.XMPARM,"^TMP(""XM"",$J)",XMTO,.XMINSTR)
|
---|
| 131 | Q
|
---|