source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMUTERM.m@ 1716

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

initial load of WorldVistAEHR

File size: 7.0 KB
RevLine 
[613]1XMUTERM ;ISC-SF/GMB-Delete Mailbox/Delete Message ;04/17/2002 12:08
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Taken from XUSTERM (SEA/AMF/WDE)
4 ; Entry points used by MailMan options (not covered by DBIA):
5 ; ALL1 XMMGR-TERMINATE-MANY
6 ; ALL2 XMMGR-TERMINATE-SUGGEST
7 ; CHOOSE XMMGR-TERMINATE-ONE
8 ; MESSAGE XMMGR-PURGE-MESSAGE
9MESSAGE ; Manager chooses messages to purge
10 N DIR,XMABORT,XMZ,XMKILL,XMPARM
11 Q:$$NOTAUTH()
12 W @IOF
13 D BLD^DIALOG(36301,"","","","F")
14 D MSG^DIALOG("WM","",IOM)
15 ;This option enables you to purge any message.
16 ;Purge means:
17 ;-delete the message from all user mailboxes
18 ;-delete the message from the MESSAGE file ^XMB(3.9
19 ;-delete all responses from the MESSAGE file ^XMB(3.9
20 ;-delete the message from the MESSAGES TO BE NEW AT A LATER DATE file ^XMB(3.73
21 ;Purge is not reversible. The message is gone forever.
22 F S XMZ=$O(^XMB(3.9,":"),-1) Q:XMZ?1N.N K ^XMB(3.9,XMZ) ; kill bogus nodes
23 S (XMABORT,XMKILL)=0
24 F D Q:XMABORT
25 . W !
26 . S DIR(0)="NO^1:"_$O(^XMB(3.9,":"),-1)_":0^D CHKMSG^XMUTERM(Y)",DIR("A")=$$EZBLD^DIALOG(36302) ; Purge MESSAGE
27 . S DIR("?")=$$EZBLD^DIALOG(36303) ; This response must be a message number
28 . D ^DIR K DIR I $D(DIRUT) S XMABORT=1 Q
29 . S XMZ=+Y
30 . S DIR(0)="Y",DIR("A")=$$EZBLD^DIALOG(36304),DIR("B")=$$EZBLD^DIALOG(39053) ; Are you sure / NO
31 . D ^DIR K DIR I 'Y!$D(DIRUT) W !,$$EZBLD^DIALOG(36305) Q ;Message not purged.
32 . S (XMKILL("MSG"),XMKILL("RESP"))=0
33 . D KILL^XMA32A(XMZ,.XMKILL,XMABORT)
34 . S XMPARM(1)=XMKILL("MSG"),XMPARM(2)=XMKILL("RESP")
35 . W !!,$$EZBLD^DIALOG(36306,.XMPARM) ; XMKILL("MSG") message and XMKILL("RESP") response(s) purged.
36 . S XMKILL=XMKILL+XMKILL("MSG")+XMKILL("RESP")
37 Q
38CHKMSG(XMZ) ;
39 I '$D(^XMB(3.9,XMZ)) K X Q
40 W " ",$P($G(^XMB(3.9,XMZ,0)),U,1)
41 Q
42ALL1 ; MailMan chooses users to remove from MailMan
43 ; (Users who shouldn't have mailboxes.)
44 N XMTEST,DIR,XMABORT,XMCUTOFF,XMGRACE
45 Q:$$NOTAUTH()
46 S XMABORT=0
47 W @IOF
48 D BLD^DIALOG(36309,"","","","F")
49 ;This option goes through the MailBox global and deletes the user's mailbox if
50 D HELP1
51 D BLD^DIALOG(36309.5,"","","","F")
52 ;However, if the user meets one of the last two conditions above, but has a
53 ;forwarding address, the user's mailbox will not be deleted. The fact will be
54 ;noted, and the user should be investigated further.
55 ;
56 D MSG^DIALOG("WM","",IOM)
57 D CUTOFF(1,.XMGRACE,.XMCUTOFF,.XMABORT) Q:XMABORT
58 S DIR(0)="SO^"_$$EZBLD^DIALOG(36321)_";"_$$EZBLD^DIALOG(36322) ; T:Test Mode only;R:Real Mode
59 S DIR("B")=$P($$EZBLD^DIALOG(36321),":",2) ; Test Mode only
60 S DIR("A")=$$EZBLD^DIALOG(36323) ; Select Run Option
61 D BLD^DIALOG(36324,"","","DIR(""?"")","F")
62 ;'Real Mode' will remove qualifying users from MailMan.
63 ;'Test Mode' will not.
64 ;Select 'Test Mode' to see who would be removed.
65 ;Select 'Real Mode' to remove them.
66 D ^DIR Q:$D(DIRUT)
67 S XMTEST=$S(X="R":0,1:1)
68 S (ZTSAVE("XMTEST"),ZTSAVE("XMCUTOFF"),ZTSAVE("XMGRACE"))=""
69 W !
70 D BLD^DIALOG(36325,"","","","F")
71 D MSG^DIALOG("WM","",IOM)
72 ;This report may take a while. You might consider spooling it.
73 D EN^XUTMDEVQ("ALL1TASK^XMUTERM1",$$EZBLD^DIALOG(36326),.ZTSAVE) ; MailMan: Remove user Mailboxes
74 Q
75ALL2 ; MailMan reports on users who maybe should be removed from MailMan
76 ; (Users who haven't logged on in a while.)
77 N XMTEST,DIR,XMABORT,XMCUTOFF,XMGRACE
78 Q:$$NOTAUTH()
79 S XMABORT=0
80 W @IOF
81 D BLD^DIALOG(36312,"","","","F")
82 ;This option goes through the MailBox global and reports if
83 D HELP2
84 D BLD^DIALOG(36314,"","","","F")
85 ;This option does not delete any mailboxes. Use the XM-TERMINATE-ONE-USER
86 ;option to delete any user mailboxes identified in this report.
87 D MSG^DIALOG("WM","",IOM)
88 D CUTOFF(2,.XMGRACE,.XMCUTOFF,.XMABORT) Q:XMABORT
89 S ZTSAVE("XMCUTOFF")=""
90 W !
91 D BLD^DIALOG(36325,"","","","F")
92 D MSG^DIALOG("WM","",IOM)
93 ;This report may take a while. You might consider spooling it.
94 D EN^XUTMDEVQ("ALL2TASK^XMUTERM1",$$EZBLD^DIALOG(36327),.ZTSAVE) ; MailMan: Suggest Remove user Mailboxes
95 Q
96NOTAUTH() ;
97 Q:$D(^XUSEC("XMMGR",DUZ)) 0
98 W !,$C(7)
99 D BLD^DIALOG(36300,"","","","F")
100 D MSG^DIALOG("WE","",IOM)
101 ;You must hold the XMMGR key to run this option.
102 Q 1
103HELP1 ;
104 D BLD^DIALOG(36311,"","","","SF")
105 ;- the user is not in the NEW PERSON file.
106 ;- the user has no access code and was not terminated.
107 ;- the user has no access code and was terminated w/o mailbox retention.
108 ;- the user has an access code, but no primary menu.
109 ;- the user has an access code and primary menu, but no verify code AND
110 ; - has never signed on or used mail, since being added before a cutoff date.
111 ; OR
112 ; - last signed on or used mail before a cutoff date.
113 ;'Delete mailbox' includes:
114 ;- Delete user's private mail groups
115 ;- Remove user from membership in any group
116 ;- Remove user as authorized sender from any group
117 ;- Remove user from anyone's list of surrogates
118 ;- Delete user's mailbox
119 ;As a result, the user will not receive any mail.
120 Q
121HELP2 ;
122 D BLD^DIALOG(36313,"","","","SF")
123 ;- the user was DISUSER'd.
124 ;- the user was terminated before a cutoff date and allowed to keep a mailbox.
125 ;- the user has an access code, verify code, and primary menu, AND
126 ; - has never signed on or used mail, since being added before a cutoff date.
127 ; OR
128 ; - last signed on or used mail before a cutoff date.
129 Q
130CUTOFF(XMWHICH,XMGRACE,XMCUTOFF,XMABORT) ;
131 N DIR
132 W !
133 S XMGRACE=$$FMADD^XLFDT(DT,-30)
134 S DIR(0)="D^:"_XMGRACE_":EP"
135 S DIR("A")=$$EZBLD^DIALOG(36315) ; Logon cutoff date
136 S DIR("B")=$$FMTE^XLFDT(DT-10000)
137 S DIR("??")="^D HCUTOFF^XMUTERM(XMWHICH)"
138 D ^DIR I $D(DIRUT) S XMABORT=1 Q
139 S XMCUTOFF=Y
140 Q
141HCUTOFF(XMWHICH) ;
142 D BLD^DIALOG(36316,"","","","F")
143 ;The cutoff date must be more than 30 days ago.
144 ;It is used during the check to see if
145 I XMWHICH="*"!(XMWHICH=1) D
146 . D BLD^DIALOG(36317,"","","","SF")
147 . ;- the user has an access code and primary menu, but no verify code, AND
148 . ; - has never signed on or used mail, since being added before a cutoff date.
149 . ; OR
150 . ; - last signed on or used mail before a cutoff date.
151 I XMWHICH="*"!(XMWHICH=2) D
152 . D BLD^DIALOG(36318,"","","","SF")
153 . ;- the user has an access code, verify code, and primary menu, AND
154 . ; - has never signed on or used mail, since being added before a cutoff date.
155 . ; OR
156 . ; - last signed on or used mail before a cutoff date.
157 D BLD^DIALOG(36319,"","","","F")
158 ;(If you do not wish to check mailboxes based on a cutoff date, enter '1900'.)
159 ;Please enter that cutoff date.
160 D MSG^DIALOG("WH","",IOM)
161 Q
162CHOOSE ; Manager chooses user to remove from MailMan
163 N XMCUTOFF,XMABORT,XMI,XMGRACE
164 S XMABORT=0
165 Q:$$NOTAUTH()
166 W @IOF
167 D BLD^DIALOG(36310,"","","","F")
168 ;This option lets you delete the mailbox of a user if
169 D HELP2
170 D HELP1
171 D MSG^DIALOG("WM","",IOM)
172 D CUTOFF("*",.XMGRACE,.XMCUTOFF,.XMABORT) Q:XMABORT
173 N DIR
174 S DIR(0)="SO^"_$$EZBLD^DIALOG(36330) ; M:MailMan presents;I:I select
175 D BLD^DIALOG(36332,"","","DIR(""?"")","F")
176 ;Select 'M' if you want MailMan to $order through the MailBox file and
177 ;present to you candidates for mailbox deletion.
178 ;Select 'I' if you want to do the selection directly.
179 D ^DIR Q:$D(DIRUT)
180 I Y="M" D MMCHOOSE^XMUTERM2(XMGRACE,XMCUTOFF) Q
181 D ICHOOSE^XMUTERM2(XMGRACE,XMCUTOFF)
182 Q
Note: See TracBrowser for help on using the repository browser.