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