source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMA30.m@ 1005

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

initial load of WorldVistAEHR
File size: 6.7 KB
Line 
1XMA30 ;ISC-SF/GMB-XMCLEAN, XMAUTOPURGE (cont.) ;01/08/2003 10:04
2 ;;8.0;MailMan;**10,13**;Jun 28, 2002
3 ; Was (WASH ISC)/CAP
4AUDIT ; Lists data from previous purges
5 N XMLIEN,XMREC,XMSTART,XMEND,XMLEFT,XMPURGE,XMTYPE,XMABORT
6 S XMABORT=0
7 W @IOF
8 D BLD^DIALOG(36432,"","","XMTEXT","F")
9 D MSG^DIALOG("WM","","","","XMTEXT")
10 ;It's a good idea to look these over.
11 ;Look for multiple purges running concurrently and missing purge dates.
12 ;Check the times the purge ended - do they conflict with user activity?
13 W !
14 D AHDR
15 S XMLIEN=0
16 F S XMLIEN=$O(^XMB(1,1,.1,XMLIEN)) Q:XMLIEN'>0 D Q:XMABORT
17 . I $Y+3>IOSL D Q:XMABORT
18 . . I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
19 . . W @IOF D AHDR
20 . S XMREC=^XMB(1,1,.1,XMLIEN,0)
21 . S XMSTART=$E($P(XMREC,U),1,12)
22 . S XMLEFT=$P(XMREC,U,2)
23 . S XMPURGE=$P(XMREC,U,3)
24 . S XMTYPE=$P(XMREC,U,6)
25 . S XMEND=$E($P(XMREC,U,8),1,12)
26 . I XMTYPE="",'XMEND D ; To handle old data before XM*7.1*37
27 . . S XMEND=XMSTART
28 . . K XMSTART
29 . W !,$$EZBLD^DIALOG($S(+XMTYPE=0:36433,XMTYPE=1:36434,1:36435)) ; "Unref Msg" / "Date" / "Test Date"
30 . W ?12,$S($D(XMSTART):$J($$FMTE^XLFDT(XMSTART,5),16),1:""),$J($$FMTE^XLFDT(XMEND,5),18)
31 . I $D(XMSTART),XMEND>XMSTART W $J($$FMDIFF^XLFDT(XMEND,XMSTART,3),10)
32 . W ?58,$J(XMPURGE,9),$J(XMLEFT,12)
33 Q
34AHDR ;
35 N XMTEXT
36 D BLD^DIALOG(36436,"","","XMTEXT","F")
37 D MSG^DIALOG("WM","",IOM,"","XMTEXT")
38 W !
39 ;MailMan Purge History
40 ;Type Start End Duration Purged Kept
41 Q
42USERSTAT ; Display statistics
43 N DIR,Y,XMTYPE,ZTSAVE,XMVAR,XMTEXT,XMDIALOG,XMI
44 W !
45 S XMVAR(2)=$O(^XMB(3.9,":"),-1) ; highest
46 S XMVAR(1)=$J($O(^XMB(3.9,0)),$L(XMVAR(2))) ; lowest
47 S XMVAR(3)=$J($P($G(^XMB(3.9,0)),U,4),$L(XMVAR(2))) ; how many
48 D BLD^DIALOG(36437,.XMVAR,"","XMTEXT","F")
49 D MSG^DIALOG("WM","","","","XMTEXT")
50 ;Lowest numbered message: |1|
51 ;Highest numbered message: |2|
52 ;Number of messages: |3|
53 D BLD^DIALOG(36438,"","","DIR(""A"")") ; Scan Option
54 ;A:Active Mailboxes;I:Inactive Mailboxes;M:All Mailboxes"
55 S DIR(0)="S^"
56 F XMI=36439.1,36439.2,36439.3 D
57 . S XMDIALOG(XMI)=$$EZBLD^DIALOG(XMI)
58 . S DIR(0)=DIR(0)_XMDIALOG(XMI)_";"
59 S DIR(0)=$E(DIR(0),1,$L(DIR(0))-1)
60 S DIR("B")=$P(XMDIALOG(36439.1),":",2) ; Active Mailboxes
61 D ^DIR Q:$D(DIRUT)
62 S XMI=0 F S XMI=$O(XMDIALOG(XMI)) Q:$P(XMDIALOG(XMI),":",1)=Y
63 S XMTYPE=$S(XMI=36439.1:"A",XMI=36439.2:"I",1:"M")
64 S XMTYPE("DESC")=$P(XMDIALOG(XMI),":",2)
65 S ZTSAVE("XMTYPE")="",ZTSAVE("XMTYPE(")=""
66 D EN^XUTMDEVQ("DOSTATS^XMA30",$$EZBLD^DIALOG(36440),.ZTSAVE) ; MailMan: User Mailbox Statistics
67 Q
68DOSTATS ;
69 N XMTODAY,XMPAGE,XMABORT,XMDUZ,XMK,XMINCNT,XMZCNT,XMKCNT,XMBOXCNT,XMLMAIL,XMNAME,XMREC,XMSTAT,XMLSIGN,XMINACT
70 S XMTODAY=$$FMTE^XLFDT(DT,5),(XMPAGE,XMABORT,XMBOXCNT)=0
71 S:$D(ZTQUEUED) ZTREQ="@"
72 W:$E(IOST,1,2)="C-" @IOF D SHDR(XMTODAY,.XMPAGE)
73 S XMNAME="",XMINACT=$$EZBLD^DIALOG(36441) ; "Inactive"
74 F S XMNAME=$O(^VA(200,"B",XMNAME)) Q:XMNAME="" D Q:XMABORT
75 . S XMDUZ=0
76 . F S XMDUZ=$O(^VA(200,"B",XMNAME,XMDUZ)) Q:XMDUZ="" D Q:XMABORT
77 . . Q:'$D(^XMB(3.7,XMDUZ))
78 . . S XMREC=$G(^VA(200,XMDUZ,0))
79 . . I $P(XMREC,U,3)="" Q:XMTYPE="A" S XMSTAT=XMINACT
80 . . E I XMTYPE="I" Q
81 . . E S XMSTAT=""
82 . . I $Y+3>IOSL D Q:XMABORT
83 . . . I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
84 . . . W @IOF D SHDR(XMTODAY,.XMPAGE)
85 . . S XMBOXCNT=XMBOXCNT+1
86 . . W !,$E($$NAME^XMXUTIL(XMDUZ),1,30)
87 . . S XMK=.9,(XMINCNT,XMZCNT)=0
88 . . F XMKCNT=1:1 S XMK=$O(^XMB(3.7,XMDUZ,2,XMK)) Q:XMK'>0 D
89 . . . D:'$D(^XMB(3.7,XMDUZ,2,XMK,1,0)) MAKENODE
90 . . . I XMK=1 S XMINCNT=+$P($G(^XMB(3.7,XMDUZ,2,XMK,1,0)),U,4),XMZCNT=XMINCNT Q
91 . . . S XMZCNT=XMZCNT+$P($G(^XMB(3.7,XMDUZ,2,XMK,1,0)),U,4)
92 . . S XMLSIGN=$P($G(^VA(200,XMDUZ,1.1)),U)
93 . . S XMLSIGN=$S(XMSTAT'="":XMSTAT,'XMLSIGN:$$EZBLD^DIALOG(38002),1:$J($$MMDT^XMXUTIL1($P(XMLSIGN,".")),8)) ; Never
94 . . S XMLMAIL=$P($G(^XMB(3.7,XMDUZ,"L")),U)
95 . . S XMLMAIL=$S(XMLMAIL["@":$P(XMLMAIL,"@"),1:$P(XMLMAIL," ",1,3))
96 . . W ?30,$J(XMKCNT,4),$J(XMZCNT,7),$J(XMINCNT,8),?53,XMLSIGN,?67,$S($L(XMLMAIL):XMLMAIL,1:$$EZBLD^DIALOG(38002)) ; Never
97 Q:XMABORT
98 W !!,XMTYPE("DESC"),": ",XMBOXCNT
99 I $E(IOST,1,2)="C-" D WAIT^XMXUTIL
100 Q
101MAKENODE ; Create the zero node for the message multiple
102 N XMCNT,XMZ
103 Q:'$O(^XMB(3.7,XMDUZ,2,XMK,1,0))
104 S (XMZ,XMCNT)=0
105 F S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,XMZ)) Q:XMZ'>0 S XMCNT=XMCNT+1
106 S ^XMB(3.7,XMDUZ,2,XMK,1,0)="^3.702P^"_+$O(^XMB(3.7,XMDUZ,2,XMK,1,"C"),-1)_U_XMCNT
107 Q
108SHDR(XMTODAY,XMPAGE) ; Header for Mailbox Statistics Report
109 S XMPAGE=XMPAGE+1
110 W XMTYPE("DESC"),", ",XMTODAY,?65,$J($$EZBLD^DIALOG(34542,XMPAGE),15) ; Page |1|
111 D BLD^DIALOG(36443,"","","XMTEXT","F")
112 D MSG^DIALOG("WM","",IOM,"","XMTEXT")
113 W !
114 ;User Bskts Msgs IN Bskt Last Sign on Last Mail Use"
115 Q
116DONTPURG ; Find all messages which might not be in someone's mailbox,
117 ; but which shouldn't be purged anyway.
118 N XMDUZ,XMZ,XMZR,XMQ,XMT,XMD,XMINST,XMG
119 K ^TMP("XM",$J)
120 ;
121 ; DON'T PURGE LOCAL MESSAGES AND REPLIES WHICH ARE ABOUT TO BE DELIVERED
122 ;
123 S (XMT,XMG,XMZ)="" ; new messages, forwarded messages, and replies
124 F S XMT=$O(^XMBPOST("BOX",XMT)) Q:XMT="" D
125 . F S XMG=$O(^XMBPOST("BOX",XMT,XMG)) Q:XMG="" D
126 . . F S XMZ=$O(^XMBPOST("BOX",XMT,XMG,XMZ)) Q:XMZ="" S ^TMP("XM",$J,"NOP",+XMZ)="" I XMG="R" S ^TMP("XM",$J,"NOP",$P(XMZ,U,2))=""
127 ;
128 ; new messages, forwarded messages
129 S (XMQ,XMT,XMZ)="" ; Queue number, Timestamp, Message IEN
130 F S XMQ=$O(^XMBPOST("M",XMQ)) Q:XMQ="" D
131 . F S XMT=$O(^XMBPOST("M",XMQ,XMT)) Q:XMT="" D
132 . . F S XMZ=$O(^XMBPOST("M",XMQ,XMT,XMZ)) Q:XMZ="" S ^TMP("XM",$J,"NOP",+XMZ)=""
133 ;
134 ; replies
135 S (XMQ,XMZ,XMZR)="" ; Queue number, Message IEN, Reply IEN
136 F S XMQ=$O(^XMBPOST("R",XMQ)) Q:XMQ="" D
137 . S XMT="" ; Timestamp
138 . F S XMT=$O(^XMBPOST("R",XMQ,XMT)) Q:XMT'>0 D
139 . . F S XMZ=$O(^XMBPOST("R",XMQ,XMT,XMZ)) Q:XMZ="" D
140 . . . S ^TMP("XM",$J,"NOP",XMZ)="" ; Original msg to new replies
141 . . . F S XMZR=$O(^XMBPOST("R",XMQ,XMT,XMZ,XMZR)) Q:XMZR="" S ^TMP("XM",$J,"NOP",XMZR)="" ; Reply
142 ;
143 ; DON'T PURGE MESSAGES QUEUED TO BE DELIVERED REMOTELY
144 S XMINST=999 ; Institution
145 F S XMINST=$O(^XMB(3.7,.5,2,XMINST)) Q:XMINST'>0 D
146 . S XMZ=0
147 . F S XMZ=$O(^XMB(3.7,.5,2,XMINST,1,XMZ)) Q:XMZ'>0 S ^TMP("XM",$J,"NOP",XMZ)=""
148 ;
149 ; DON'T PURGE LATER'D MESSAGES
150 S XMD=0 ; Date to be later'd
151 F S XMD=$O(^XMB(3.73,XMD)) Q:XMD'>0 D
152 . S XMZ=$P(^XMB(3.73,XMD,0),U,3)
153 . S:XMZ ^TMP("XM",$J,"NOP",XMZ)="" ; Msg to be later'd
154 ;
155 ; DON'T PURGE MESSAGES WHICH ARE BEING EDITED
156 S (XMDUZ,XMZ)=""
157 F S XMDUZ=$O(^XMB(3.7,"AD",XMDUZ)) Q:XMDUZ="" D
158 . F S XMZ=$O(^XMB(3.7,"AD",XMDUZ,XMZ)) Q:XMZ="" S ^TMP("XM",$J,"NOP",XMZ)=""
159 ;
160 ; DON'T PURGE MESSAGES WHICH ARE TO BE DELIVERED LATER TO CERTAIN RECIPIENTS
161 S (XMD,XMZ)=""
162 F S XMD=$O(^XMB(3.9,"AL",XMD)) Q:XMD="" D
163 . F S XMZ=$O(^XMB(3.9,"AL",XMD,XMZ)) Q:XMZ="" S ^TMP("XM",$J,"NOP",XMZ)=""
164 Q
Note: See TracBrowser for help on using the repository browser.