source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMA32A.m@ 632

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

initial load of WorldVistAEHR
File size: 5.5 KB
RevLine 
[613]1XMA32A ;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
12ENT ;
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
18INIT(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
28INITAUDT(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
39PROCESS(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
56KILL(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
64KBASKETS(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
76KMSG(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
88KLATER(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
96HDR(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
101PRTHDR(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
109FINISH(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
126CHK(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
136CHKAUDT(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
Note: See TracBrowser for help on using the repository browser.