source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMUPIN.m@ 1133

Last change on this file since 1133 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 6.0 KB
RevLine 
[613]1XMUPIN ;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
6ENTER ;
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
13TEST ;
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
19INIT(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
64PROCESS(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
97BASKET(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
124SENDMSG(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
Note: See TracBrowser for help on using the repository browser.