| 1 | XMA32A ;ISC-SF/GMB-Purge Messages by Date (cont.) ;12/04/2002 13:42
|
---|
| 2 | ;;8.0;MailMan;**10**;Jun 28, 2002
|
---|
| 3 | ; Was (WASH ISC)/CAP
|
---|
| 4 | ;
|
---|
| 5 | ; XMPARM("PDATE") Purge all messages older than this date
|
---|
| 6 | ; XMCNT Total messages processed
|
---|
| 7 | ; XMKILL("START") Messages in ^XMB(3.9 before purge started
|
---|
| 8 | ; XMKILL("MSG") Messages purged
|
---|
| 9 | ; XMKILL("RESP") Responses killed
|
---|
| 10 | ; XMDUZ Pointer to mailbox
|
---|
| 11 | ; XMZ Current message being processed
|
---|
| 12 | ENT ;
|
---|
| 13 | N XMCRE8,XMIEN,XMCNT,XMKILL,XMHDR,XMABORT
|
---|
| 14 | D INIT(.XMIEN,.XMPARM,.XMKILL,.XMHDR,.XMABORT)
|
---|
| 15 | D PROCESS(XMIEN,.XMCRE8,.XMPARM,.XMKILL,.XMCNT,.XMHDR,.XMABORT)
|
---|
| 16 | D FINISH(XMIEN,XMCRE8,.XMPARM,.XMKILL,XMCNT,.XMHDR,.XMABORT)
|
---|
| 17 | Q
|
---|
| 18 | INIT(XMIEN,XMPARM,XMKILL,XMHDR,XMABORT) ;
|
---|
| 19 | I IO'=IO(0) U IO
|
---|
| 20 | S (XMHDR("PAGE"),XMKILL("MSG"),XMKILL("RESP"),XMABORT)=0
|
---|
| 21 | S XMKILL("START")=$P(^XMB(3.9,0),U,4)
|
---|
| 22 | D INITAUDT(.XMIEN,.XMPARM,.XMHDR)
|
---|
| 23 | S XMHDR("PDATE")=$$FMTE^XLFDT(XMPARM("PDATE"),5)
|
---|
| 24 | S XMHDR("NOW")=$$FMTE^XLFDT(XMHDR("NOW"),5)
|
---|
| 25 | Q:IO=""
|
---|
| 26 | W:$E(IOST,1,2)="C-" @IOF D PRTHDR(.XMPARM,.XMHDR)
|
---|
| 27 | Q
|
---|
| 28 | INITAUDT(XMIEN,XMPARM,XMHDR) ;
|
---|
| 29 | N XMFDA
|
---|
| 30 | S XMHDR("NOW")=$$NOW^XLFDT
|
---|
| 31 | S XMFDA(4.302,"+1,1,",.01)=XMHDR("NOW")
|
---|
| 32 | S:$D(XMPARM("START")) XMFDA(4.302,"+1,1,",3)=XMPARM("START")
|
---|
| 33 | S:$D(XMPARM("END")) XMFDA(4.302,"+1,1,",4)=XMPARM("END")
|
---|
| 34 | S XMFDA(4.302,"+1,1,",5)=$S(XMPARM("TYPE")=2:"1TEST",1:XMPARM("TYPE"))
|
---|
| 35 | S XMFDA(4.302,"+1,1,",6)=XMPARM("PDATE")
|
---|
| 36 | D UPDATE^DIE("","XMFDA","XMIEN")
|
---|
| 37 | S XMIEN=XMIEN(1)
|
---|
| 38 | Q
|
---|
| 39 | PROCESS(XMIEN,XMCRE8,XMPARM,XMKILL,XMCNT,XMHDR,XMABORT) ;
|
---|
| 40 | N XMZ,XMZREC
|
---|
| 41 | S (XMCRE8,XMZ)="",XMCNT=0
|
---|
| 42 | F S XMCRE8=$O(^XMB(3.9,"C",XMCRE8)) Q:'XMCRE8 Q:XMCRE8'<XMPARM("PDATE") D Q:XMABORT
|
---|
| 43 | . F S XMZ=$O(^XMB(3.9,"C",XMCRE8,XMZ)) Q:'XMZ D Q:XMABORT
|
---|
| 44 | . . S XMCNT=XMCNT+1 I XMCNT#5000=0 D CHK(XMIEN,XMCRE8,.XMPARM,.XMKILL,XMCNT,.XMHDR,.XMABORT)
|
---|
| 45 | . . I '$D(^XMB(3.9,XMZ)) K ^XMB(3.9,"C",XMCRE8,XMZ) Q
|
---|
| 46 | . . S XMZREC=$G(^XMB(3.9,XMZ,0))
|
---|
| 47 | . . Q:$P(XMZREC,U,8) ; Don't kill responses (they'll be purged when their original msg is)
|
---|
| 48 | . . I "^^^^^^^^"[XMZREC D KILL(XMZ,.XMKILL,.XMABORT,.XMPARM,.XMHDR) Q
|
---|
| 49 | . . Q:$D(^XMB(3.7,"M",XMZ,.6)) ; Do nothing if owned by SHARED,MAIL
|
---|
| 50 | . . Q:$O(^XMB(3.7,"M",XMZ,.5,999)) ; Do nothing if in Transmit queues or Server basket.
|
---|
| 51 | . . D KILL(XMZ,.XMKILL,.XMABORT,.XMPARM,.XMHDR)
|
---|
| 52 | . . ; Old msg; old response without original msg;
|
---|
| 53 | . . ; Old msg which thinks it's also a response;
|
---|
| 54 | . . ; Old response which thinks it's also the original msg.
|
---|
| 55 | Q
|
---|
| 56 | KILL(XMZ,XMKILL,XMABORT,XMPARM,XMHDR) ;
|
---|
| 57 | I $G(XMPARM("TEST")) D Q:XMABORT
|
---|
| 58 | . D HDR(2,.XMPARM,.XMHDR,.XMABORT) Q:XMABORT
|
---|
| 59 | . W !,XMZ,?20,$$EZBLD^DIALOG(36416),$$FMTE^XLFDT(XMCRE8,5) ; " <<< Purge! Date = "
|
---|
| 60 | D KBASKETS(XMZ,.XMKILL,.XMPARM,.XMHDR,.XMABORT) Q:XMABORT
|
---|
| 61 | D KMSG(XMZ,.XMKILL,.XMPARM,.XMHDR,.XMABORT) Q:XMABORT
|
---|
| 62 | D KLATER(XMZ,.XMPARM)
|
---|
| 63 | Q
|
---|
| 64 | KBASKETS(XMZ,XMKILL,XMPARM,XMHDR,XMABORT) ;
|
---|
| 65 | N XMDUZ,XMK
|
---|
| 66 | S XMDUZ="",XMKILL("MSG")=XMKILL("MSG")+1
|
---|
| 67 | F S XMDUZ=$O(^XMB(3.7,"M",XMZ,XMDUZ)) Q:XMDUZ=""!XMABORT D
|
---|
| 68 | . S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,0))
|
---|
| 69 | . Q:'XMK
|
---|
| 70 | . Q:'$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ))
|
---|
| 71 | . I $G(XMPARM("TEST")) D Q
|
---|
| 72 | . . D HDR(2,.XMPARM,.XMHDR,.XMABORT) Q:XMABORT
|
---|
| 73 | . . W !?25,$$EZBLD^DIALOG(36417),?50,$J(XMDUZ,12),?79 ; Message deleted for DUZ:
|
---|
| 74 | . D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) ; Delete from user's basket
|
---|
| 75 | Q
|
---|
| 76 | KMSG(XMZ,XMKILL,XMPARM,XMHDR,XMABORT) ;
|
---|
| 77 | N XMZR,XMIEN,X
|
---|
| 78 | S XMIEN=0
|
---|
| 79 | F S XMIEN=$O(^XMB(3.9,XMZ,3,XMIEN)) Q:XMIEN'>0!XMABORT D
|
---|
| 80 | . S XMZR=$P($G(^XMB(3.9,XMZ,3,XMIEN,0)),U)
|
---|
| 81 | . S XMKILL("RESP")=XMKILL("RESP")+1
|
---|
| 82 | . I $G(XMPARM("TEST")) D Q
|
---|
| 83 | . . D HDR(2,.XMPARM,.XMHDR,.XMABORT) Q:XMABORT
|
---|
| 84 | . . W !?25,$$EZBLD^DIALOG(36418),?50,$J(XMZR,20),?79 ; Response deleted:
|
---|
| 85 | . D KILLMSG^XMXUTIL(XMZR) ; Kill response
|
---|
| 86 | D:'$G(XMPARM("TEST")) KILLMSG^XMXUTIL(XMZ) ; Kill original message
|
---|
| 87 | Q
|
---|
| 88 | KLATER(XMZ,XMPARM) ;
|
---|
| 89 | Q:$G(XMPARM("TEST"))
|
---|
| 90 | N DIK,DA,XMDUZ
|
---|
| 91 | S DIK="^XMB(3.73,"
|
---|
| 92 | S (XMDUZ,DA)=""
|
---|
| 93 | F S XMDUZ=$O(^XMB(3.73,"AC",XMZ,XMDUZ)) Q:'XMDUZ D
|
---|
| 94 | . F S DA=$O(^XMB(3.73,"AC",XMZ,XMDUZ,DA)) Q:'DA D ^DIK
|
---|
| 95 | Q
|
---|
| 96 | HDR(XMLINES,XMPARM,XMHDR,XMABORT) ;
|
---|
| 97 | Q:$Y+XMLINES<IOSL
|
---|
| 98 | I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
|
---|
| 99 | W @IOF D PRTHDR(.XMPARM,.XMHDR)
|
---|
| 100 | Q
|
---|
| 101 | PRTHDR(XMPARM,XMHDR) ;
|
---|
| 102 | S XMHDR("PAGE")=XMHDR("PAGE")+1
|
---|
| 103 | W $$EZBLD^DIALOG(36419),XMHDR("PDATE") ; Message purge, local create date <
|
---|
| 104 | W ?70,$$EZBLD^DIALOG(34542,XMHDR("PAGE")) ; Page |1|
|
---|
| 105 | W !,$$EZBLD^DIALOG(36420),XMHDR("NOW") ; Started:
|
---|
| 106 | W:XMPARM("TEST") ?60,$$EZBLD^DIALOG(36421) ; *TEST RUN*
|
---|
| 107 | W !
|
---|
| 108 | Q
|
---|
| 109 | FINISH(XMIEN,XMCRE8,XMPARM,XMKILL,XMCNT,XMHDR,XMABORT) ;
|
---|
| 110 | I $D(ZTQUEUED) S ZTREQ="@"
|
---|
| 111 | I XMABORT,IO'="" W @IOF D PRTHDR(.XMPARM,.XMHDR)
|
---|
| 112 | D CHK(XMIEN,XMCRE8,.XMPARM,.XMKILL,XMCNT,.XMHDR,.XMABORT)
|
---|
| 113 | Q:IO=""!'XMCNT
|
---|
| 114 | D HDR(5+(2*$G(ZTSTOP)),.XMPARM,.XMHDR,.XMABORT)
|
---|
| 115 | I $G(ZTSTOP) W !,$$EZBLD^DIALOG(36422) ; *** Stopping prematurely per user request ***
|
---|
| 116 | N XMVAR,XMTEXT
|
---|
| 117 | S XMVAR(1)=$$FMTE^XLFDT($$NOW^XLFDT,5),XMVAR(2)=XMCNT
|
---|
| 118 | S XMVAR(3)=XMKILL("MSG"),XMVAR(4)=XMKILL("RESP")
|
---|
| 119 | W !
|
---|
| 120 | D BLD^DIALOG(36423,.XMVAR,"","XMTEXT","F")
|
---|
| 121 | D MSG^DIALOG("WM","","","","XMTEXT")
|
---|
| 122 | ;Message purge finished on |1|.
|
---|
| 123 | ;|2| messages processed.
|
---|
| 124 | ;|3| original messages and |4| responses purged.
|
---|
| 125 | Q
|
---|
| 126 | CHK(XMIEN,XMCRE8,XMPARM,XMKILL,XMCNT,XMHDR,XMABORT) ;
|
---|
| 127 | D CHKAUDT(XMIEN,XMCRE8,.XMKILL)
|
---|
| 128 | I $D(ZTQUEUED),$$S^%ZTLOAD S (XMABORT,ZTSTOP)=1 Q ; User has asked the task to stop
|
---|
| 129 | Q:$E(IOST,1,2)'="C-"
|
---|
| 130 | I $X+$L(XMCNT)+1>IOM D
|
---|
| 131 | . D HDR(2,.XMPARM,.XMHDR,.XMABORT)
|
---|
| 132 | . W !
|
---|
| 133 | E W " "
|
---|
| 134 | W XMCNT
|
---|
| 135 | Q
|
---|
| 136 | CHKAUDT(XMIEN,XMCRE8,XMKILL) ;
|
---|
| 137 | N XMFDA
|
---|
| 138 | S XMFDA(4.302,XMIEN_",1,",1)=XMKILL("START")-XMKILL("MSG")-XMKILL("RESP")
|
---|
| 139 | S XMFDA(4.302,XMIEN_",1,",2)=XMKILL("MSG")+XMKILL("RESP")
|
---|
| 140 | S XMFDA(4.302,XMIEN_",1,",7)=$$NOW^XLFDT
|
---|
| 141 | S XMFDA(4.302,XMIEN_",1,",8)=XMCRE8
|
---|
| 142 | D FILE^DIE("","XMFDA")
|
---|
| 143 | Q
|
---|