144 lines
5.5 KiB
Mathematica
144 lines
5.5 KiB
Mathematica
XMA32A ;ISC-SF/GMB-Purge Messages by Date (cont.) ;12/04/2002 13:42
|
|
;;8.0;MailMan;**10**;Jun 28, 2002
|
|
; Was (WASH ISC)/CAP
|
|
;
|
|
; XMPARM("PDATE") Purge all messages older than this date
|
|
; XMCNT Total messages processed
|
|
; XMKILL("START") Messages in ^XMB(3.9 before purge started
|
|
; XMKILL("MSG") Messages purged
|
|
; XMKILL("RESP") Responses killed
|
|
; XMDUZ Pointer to mailbox
|
|
; XMZ Current message being processed
|
|
ENT ;
|
|
N XMCRE8,XMIEN,XMCNT,XMKILL,XMHDR,XMABORT
|
|
D INIT(.XMIEN,.XMPARM,.XMKILL,.XMHDR,.XMABORT)
|
|
D PROCESS(XMIEN,.XMCRE8,.XMPARM,.XMKILL,.XMCNT,.XMHDR,.XMABORT)
|
|
D FINISH(XMIEN,XMCRE8,.XMPARM,.XMKILL,XMCNT,.XMHDR,.XMABORT)
|
|
Q
|
|
INIT(XMIEN,XMPARM,XMKILL,XMHDR,XMABORT) ;
|
|
I IO'=IO(0) U IO
|
|
S (XMHDR("PAGE"),XMKILL("MSG"),XMKILL("RESP"),XMABORT)=0
|
|
S XMKILL("START")=$P(^XMB(3.9,0),U,4)
|
|
D INITAUDT(.XMIEN,.XMPARM,.XMHDR)
|
|
S XMHDR("PDATE")=$$FMTE^XLFDT(XMPARM("PDATE"),5)
|
|
S XMHDR("NOW")=$$FMTE^XLFDT(XMHDR("NOW"),5)
|
|
Q:IO=""
|
|
W:$E(IOST,1,2)="C-" @IOF D PRTHDR(.XMPARM,.XMHDR)
|
|
Q
|
|
INITAUDT(XMIEN,XMPARM,XMHDR) ;
|
|
N XMFDA
|
|
S XMHDR("NOW")=$$NOW^XLFDT
|
|
S XMFDA(4.302,"+1,1,",.01)=XMHDR("NOW")
|
|
S:$D(XMPARM("START")) XMFDA(4.302,"+1,1,",3)=XMPARM("START")
|
|
S:$D(XMPARM("END")) XMFDA(4.302,"+1,1,",4)=XMPARM("END")
|
|
S XMFDA(4.302,"+1,1,",5)=$S(XMPARM("TYPE")=2:"1TEST",1:XMPARM("TYPE"))
|
|
S XMFDA(4.302,"+1,1,",6)=XMPARM("PDATE")
|
|
D UPDATE^DIE("","XMFDA","XMIEN")
|
|
S XMIEN=XMIEN(1)
|
|
Q
|
|
PROCESS(XMIEN,XMCRE8,XMPARM,XMKILL,XMCNT,XMHDR,XMABORT) ;
|
|
N XMZ,XMZREC
|
|
S (XMCRE8,XMZ)="",XMCNT=0
|
|
F S XMCRE8=$O(^XMB(3.9,"C",XMCRE8)) Q:'XMCRE8 Q:XMCRE8'<XMPARM("PDATE") D Q:XMABORT
|
|
. F S XMZ=$O(^XMB(3.9,"C",XMCRE8,XMZ)) Q:'XMZ D Q:XMABORT
|
|
. . S XMCNT=XMCNT+1 I XMCNT#5000=0 D CHK(XMIEN,XMCRE8,.XMPARM,.XMKILL,XMCNT,.XMHDR,.XMABORT)
|
|
. . I '$D(^XMB(3.9,XMZ)) K ^XMB(3.9,"C",XMCRE8,XMZ) Q
|
|
. . S XMZREC=$G(^XMB(3.9,XMZ,0))
|
|
. . Q:$P(XMZREC,U,8) ; Don't kill responses (they'll be purged when their original msg is)
|
|
. . I "^^^^^^^^"[XMZREC D KILL(XMZ,.XMKILL,.XMABORT,.XMPARM,.XMHDR) Q
|
|
. . Q:$D(^XMB(3.7,"M",XMZ,.6)) ; Do nothing if owned by SHARED,MAIL
|
|
. . Q:$O(^XMB(3.7,"M",XMZ,.5,999)) ; Do nothing if in Transmit queues or Server basket.
|
|
. . D KILL(XMZ,.XMKILL,.XMABORT,.XMPARM,.XMHDR)
|
|
. . ; Old msg; old response without original msg;
|
|
. . ; Old msg which thinks it's also a response;
|
|
. . ; Old response which thinks it's also the original msg.
|
|
Q
|
|
KILL(XMZ,XMKILL,XMABORT,XMPARM,XMHDR) ;
|
|
I $G(XMPARM("TEST")) D Q:XMABORT
|
|
. D HDR(2,.XMPARM,.XMHDR,.XMABORT) Q:XMABORT
|
|
. W !,XMZ,?20,$$EZBLD^DIALOG(36416),$$FMTE^XLFDT(XMCRE8,5) ; " <<< Purge! Date = "
|
|
D KBASKETS(XMZ,.XMKILL,.XMPARM,.XMHDR,.XMABORT) Q:XMABORT
|
|
D KMSG(XMZ,.XMKILL,.XMPARM,.XMHDR,.XMABORT) Q:XMABORT
|
|
D KLATER(XMZ,.XMPARM)
|
|
Q
|
|
KBASKETS(XMZ,XMKILL,XMPARM,XMHDR,XMABORT) ;
|
|
N XMDUZ,XMK
|
|
S XMDUZ="",XMKILL("MSG")=XMKILL("MSG")+1
|
|
F S XMDUZ=$O(^XMB(3.7,"M",XMZ,XMDUZ)) Q:XMDUZ=""!XMABORT D
|
|
. S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,0))
|
|
. Q:'XMK
|
|
. Q:'$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ))
|
|
. I $G(XMPARM("TEST")) D Q
|
|
. . D HDR(2,.XMPARM,.XMHDR,.XMABORT) Q:XMABORT
|
|
. . W !?25,$$EZBLD^DIALOG(36417),?50,$J(XMDUZ,12),?79 ; Message deleted for DUZ:
|
|
. D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) ; Delete from user's basket
|
|
Q
|
|
KMSG(XMZ,XMKILL,XMPARM,XMHDR,XMABORT) ;
|
|
N XMZR,XMIEN,X
|
|
S XMIEN=0
|
|
F S XMIEN=$O(^XMB(3.9,XMZ,3,XMIEN)) Q:XMIEN'>0!XMABORT D
|
|
. S XMZR=$P($G(^XMB(3.9,XMZ,3,XMIEN,0)),U)
|
|
. S XMKILL("RESP")=XMKILL("RESP")+1
|
|
. I $G(XMPARM("TEST")) D Q
|
|
. . D HDR(2,.XMPARM,.XMHDR,.XMABORT) Q:XMABORT
|
|
. . W !?25,$$EZBLD^DIALOG(36418),?50,$J(XMZR,20),?79 ; Response deleted:
|
|
. D KILLMSG^XMXUTIL(XMZR) ; Kill response
|
|
D:'$G(XMPARM("TEST")) KILLMSG^XMXUTIL(XMZ) ; Kill original message
|
|
Q
|
|
KLATER(XMZ,XMPARM) ;
|
|
Q:$G(XMPARM("TEST"))
|
|
N DIK,DA,XMDUZ
|
|
S DIK="^XMB(3.73,"
|
|
S (XMDUZ,DA)=""
|
|
F S XMDUZ=$O(^XMB(3.73,"AC",XMZ,XMDUZ)) Q:'XMDUZ D
|
|
. F S DA=$O(^XMB(3.73,"AC",XMZ,XMDUZ,DA)) Q:'DA D ^DIK
|
|
Q
|
|
HDR(XMLINES,XMPARM,XMHDR,XMABORT) ;
|
|
Q:$Y+XMLINES<IOSL
|
|
I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
|
|
W @IOF D PRTHDR(.XMPARM,.XMHDR)
|
|
Q
|
|
PRTHDR(XMPARM,XMHDR) ;
|
|
S XMHDR("PAGE")=XMHDR("PAGE")+1
|
|
W $$EZBLD^DIALOG(36419),XMHDR("PDATE") ; Message purge, local create date <
|
|
W ?70,$$EZBLD^DIALOG(34542,XMHDR("PAGE")) ; Page |1|
|
|
W !,$$EZBLD^DIALOG(36420),XMHDR("NOW") ; Started:
|
|
W:XMPARM("TEST") ?60,$$EZBLD^DIALOG(36421) ; *TEST RUN*
|
|
W !
|
|
Q
|
|
FINISH(XMIEN,XMCRE8,XMPARM,XMKILL,XMCNT,XMHDR,XMABORT) ;
|
|
I $D(ZTQUEUED) S ZTREQ="@"
|
|
I XMABORT,IO'="" W @IOF D PRTHDR(.XMPARM,.XMHDR)
|
|
D CHK(XMIEN,XMCRE8,.XMPARM,.XMKILL,XMCNT,.XMHDR,.XMABORT)
|
|
Q:IO=""!'XMCNT
|
|
D HDR(5+(2*$G(ZTSTOP)),.XMPARM,.XMHDR,.XMABORT)
|
|
I $G(ZTSTOP) W !,$$EZBLD^DIALOG(36422) ; *** Stopping prematurely per user request ***
|
|
N XMVAR,XMTEXT
|
|
S XMVAR(1)=$$FMTE^XLFDT($$NOW^XLFDT,5),XMVAR(2)=XMCNT
|
|
S XMVAR(3)=XMKILL("MSG"),XMVAR(4)=XMKILL("RESP")
|
|
W !
|
|
D BLD^DIALOG(36423,.XMVAR,"","XMTEXT","F")
|
|
D MSG^DIALOG("WM","","","","XMTEXT")
|
|
;Message purge finished on |1|.
|
|
;|2| messages processed.
|
|
;|3| original messages and |4| responses purged.
|
|
Q
|
|
CHK(XMIEN,XMCRE8,XMPARM,XMKILL,XMCNT,XMHDR,XMABORT) ;
|
|
D CHKAUDT(XMIEN,XMCRE8,.XMKILL)
|
|
I $D(ZTQUEUED),$$S^%ZTLOAD S (XMABORT,ZTSTOP)=1 Q ; User has asked the task to stop
|
|
Q:$E(IOST,1,2)'="C-"
|
|
I $X+$L(XMCNT)+1>IOM D
|
|
. D HDR(2,.XMPARM,.XMHDR,.XMABORT)
|
|
. W !
|
|
E W " "
|
|
W XMCNT
|
|
Q
|
|
CHKAUDT(XMIEN,XMCRE8,XMKILL) ;
|
|
N XMFDA
|
|
S XMFDA(4.302,XMIEN_",1,",1)=XMKILL("START")-XMKILL("MSG")-XMKILL("RESP")
|
|
S XMFDA(4.302,XMIEN_",1,",2)=XMKILL("MSG")+XMKILL("RESP")
|
|
S XMFDA(4.302,XMIEN_",1,",7)=$$NOW^XLFDT
|
|
S XMFDA(4.302,XMIEN_",1,",8)=XMCRE8
|
|
D FILE^DIE("","XMFDA")
|
|
Q
|