source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMUTERM1.m@ 1361

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

initial load of WorldVistAEHR
File size: 8.6 KB
RevLine 
[613]1XMUTERM1 ;ISC-SF/GMB-Delete Mailbox (cont.) ;12/04/2002 13:51
2 ;;8.0;MailMan;**10**;Jun 28, 2002
3 ; Taken from XUSTERM (SEA/AMF/WDE)
4ALL1TASK ; Deletions
5 N XMI,XMABORT,XMTERM,XMNAME,XMWHY,XMCUTEXT,XMLEN,XMCNT,XMADDED,XMAC,XMVC,XMPM,XMLASTON,XMTDATE,XMDELM,XMTOTAL,XMNEW,XMFWD,XMYES
6 S XMYES=$$EZBLD^DIALOG(39054.1) ; Y
7 S XMCUTEXT=$$FMTE^XLFDT(XMCUTOFF,"2DF")
8 S XMLEN=$L($P(^VA(200,0),U,3))
9 S (XMCNT,XMABORT,XMTOTAL)=0
10 W:$E(IOST,1,2)="C-" @IOF D HEADER1
11 S XMI=.999
12 F S XMI=$O(^XMB(3.7,XMI)) Q:XMI'>0 D Q:XMABORT
13 . S XMTOTAL=XMTOTAL+1 I '$D(ZTQUEUED),'(XMTOTAL#1000) U IO(0) W:$X>50 ! W "." U IO
14 . D CHECK1(XMI,XMGRACE,XMCUTOFF,.XMTERM,.XMNAME,.XMWHY) Q:'XMTERM
15 . D GETDATA(XMI,.XMADDED,.XMAC,.XMVC,.XMPM,.XMLASTON,.XMTDATE,.XMDELM,.XMNEW,.XMFWD)
16 . I $Y+3+(XMAC=XMYES&(XMFWD'=""))>IOSL D Q:XMABORT
17 . . I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
18 . . W @IOF D HEADER1
19 . W !,$J(XMI,XMLEN)," ",$E(XMNAME,1,32-XMLEN),?34,XMADDED,?44,XMAC,?47,XMVC,?50,XMPM,?53,XMLASTON,?63,XMTDATE,?76,XMDELM
20 . I XMAC=XMYES,XMFWD'="" W !,$$EZBLD^DIALOG(36347),$$EZBLD^DIALOG(38004),XMFWD Q ; *** not deleted - Forwarding Address:
21 . S XMCNT=XMCNT+1
22 . D:'XMTEST TERMINAT(XMI) ; Delete if real mode
23 W:XMCNT=0 !!,$$EZBLD^DIALOG(36351) ; No user mailboxes deleted.
24 S:$D(ZTQUEUED) ZTREQ="@"
25 Q
26HEADER1 ;
27 N XMPARM
28 S XMPARM(1)=$S(XMTEST:$$EZBLD^DIALOG(36352),1:"") ; Test:
29 S XMPARM(2)=XMCUTEXT
30 D BLD^DIALOG(36353,.XMPARM,"","","F")
31 D MSG^DIALOG("WM","",IOM)
32 ;|1|Delete user mailbox
33 ;(Logon cutoff date: |2|, AC=Access Code, VC=Verify Code, PM=Primary Menu)
34 ; Last
35 ; ^VA(200 Mail/ Terminate Delete
36 ;Delete Mailbox Created AC VC PM Sign on Date Mail
37 ;-----------------------------------------------------------------------
38 ; xx/xx/xx y y y xx/xx/xx xx/xx/xx y
39 Q
40CHECK1(XMI,XMGRACE,XMCUTOFF,XMTERM,XMNAME,XMWHY) ;
41 N XMREC,XMADDED
42 S XMTERM=0
43 Q:XMI<1
44 S XMREC=$G(^VA(200,XMI,0))
45 I XMREC="" D Q
46 . S XMTERM=1
47 . S XMNAME=$$EZBLD^DIALOG(34009) ; * No Name *
48 . S XMWHY=$$EZBLD^DIALOG(36346) ; Not in NEW PERSON file
49 ; User is in NEW PERSON file
50 S XMADDED=$P($G(^VA(200,XMI,1)),U,7)
51 Q:XMADDED>XMGRACE
52 I $P(XMREC,U,3)="" D Q ; if no access code...
53 . N XMTDATE
54 . S XMTDATE=$P(XMREC,U,11)
55 . I XMTDATE="" D Q
56 . . S XMTERM=1
57 . . S XMNAME=$$NAME^XMXUTIL(XMI)
58 . . S XMWHY=$$EZBLD^DIALOG(36357) ; No AC, no termination date
59 . I XMTDATE'<DT Q ; To be Terminated in the future
60 . I $P(XMREC,U,5)="n" Q ; Terminated w/mail retention
61 . S XMTERM=1
62 . S XMNAME=$$NAME^XMXUTIL(XMI)
63 . S XMWHY=$$EZBLD^DIALOG(36358) ; No AC, terminated w/o mail retention
64 ; User has access code
65 I $P($G(^VA(200,XMI,201)),U,1)="" D Q ; if no primary menu...
66 . S XMTERM=1
67 . S XMNAME=$$NAME^XMXUTIL(XMI)
68 . S XMWHY=$$EZBLD^DIALOG(36359) ; AC, but no PM
69 ; User has primary menu
70 I $P($G(^VA(200,XMI,.1)),U,2)="" D Q ; if no verify code...
71 . N XMLASTON ; latest of 'last sign on' or 'last mailman use'
72 . S XMLASTON=$$MAX^XLFMTH(+$P($G(^VA(200,XMI,1.1)),U),+$P($G(^XMB(3.7,XMI,"L")),U,2))
73 . I XMLASTON=0 D Q
74 . . I XMADDED<XMCUTOFF D Q
75 . . . S XMTERM=1
76 . . . S XMNAME=$$NAME^XMXUTIL(XMI)
77 . . . S XMWHY=$$EZBLD^DIALOG(36360,$$FMTE^XLFDT(XMADDED,"2DF")) ; AC & PM, no VC, no logon, added |1|
78 . I XMLASTON<XMCUTOFF D Q
79 . . S XMTERM=1
80 . . S XMNAME=$$NAME^XMXUTIL(XMI)
81 . . S XMWHY=$$EZBLD^DIALOG(36361,$$FMTE^XLFDT(XMLASTON,"2DF")) ; AC & PM, no VC, last logon |1|
82 ; User has verify code
83 Q
84GETDATA(XMI,XMADDED,XMAC,XMVC,XMPM,XMLASTON,XMTDATE,XMDELM,XMNEW,XMFWD,XMDIS) ;
85 N XMREC
86 S XMREC=$G(^VA(200,XMI,0))
87 S XMADDED=$P($G(^VA(200,XMI,1)),U,7) ; date added to NEW PERSON file
88 S XMADDED=$S(XMADDED="":"",1:$$FMTE^XLFDT(XMADDED,"2DF"))
89 S XMAC=$S($P(XMREC,U,3)="":"",1:XMYES) ; access code
90 S XMVC=$S($P($G(^VA(200,XMI,.1)),U,2)="":"",1:XMYES) ; verify code
91 S XMPM=$S($P($G(^VA(200,XMI,201)),U,1)="":"",1:XMYES) ; primary menu
92 S XMLASTON=$$MAX^XLFMTH(+$P($G(^VA(200,XMI,1.1)),U),+$P($G(^XMB(3.7,XMI,"L")),U,2)) ; last sign on / mailman use
93 S XMLASTON=$S(XMLASTON=0:"",1:$$FMTE^XLFDT(XMLASTON,"2DF"))
94 S XMTDATE=$P(XMREC,U,11) ; termination date
95 S XMTDATE=$S(XMTDATE="":"",1:$$FMTE^XLFDT(XMTDATE,"2DF"))
96 S XMDELM=$$UP^XLFSTR($P(XMREC,U,5)) ; delete mail on termination
97 S XMDIS=$S($P(XMREC,U,7):XMYES,1:"") ; DISUSER'd
98 S XMREC=$G(^XMB(3.7,XMI,0))
99 S XMFWD=$P(XMREC,U,2) ; Forwarding address
100 S XMNEW=$P(XMREC,U,6) ; New messages
101 Q
102ALL2TASK ; Suggestions
103 N XMI,XMABORT,XMTERM,XMNAME,XMWHY,XMCUTEXT,XMSVC,XMLEN,XMCNT,XMADDED,XMAC,XMVC,XMPM,XMLASTON,XMTDATE,XMDELM,XMREC,XMTOTAL,XMNEW,XMFWD,XMFIRST,XMYES,XMDIS,XMSURR,XMSNAM
104 S XMYES=$$EZBLD^DIALOG(39054.1) ; Y
105 K ^TMP("XM",$J)
106 S XMCUTEXT=$$FMTE^XLFDT(XMCUTOFF,"2DF")
107 S XMLEN=$L($P(^VA(200,0),U,3))
108 S (XMCNT,XMABORT,XMTOTAL)=0,XMFIRST=1
109 S XMI=.999
110 F S XMI=$O(^XMB(3.7,XMI)) Q:XMI'>0 D Q:XMABORT
111 . S XMTOTAL=XMTOTAL+1 I '$D(ZTQUEUED),'(XMTOTAL#1000) U IO(0) W:$X>50 ! W "." U IO
112 . D CHECK2(XMI,XMCUTOFF,.XMTERM,.XMNAME,.XMWHY) Q:'XMTERM
113 . S XMCNT=XMCNT+1
114 . D GETDATA(XMI,.XMADDED,.XMAC,.XMVC,.XMPM,.XMLASTON,.XMTDATE,.XMDELM,.XMNEW,.XMFWD,.XMDIS)
115 . S XMSVC=$S($P($G(^VA(200,XMI,5)),U,1)="":$$EZBLD^DIALOG(36334),1:$P($G(^DIC(49,$P(^(5),U,1),0),$$EZBLD^DIALOG(36334)),U,1)) ; NONE
116 . S ^TMP("XM",$J,XMSVC,$S(XMNAME="":$$EZBLD^DIALOG(34009),1:$E(XMNAME,1,25-XMLEN)),XMI)=XMAC_U_XMVC_U_XMPM_U_XMLASTON_U_XMTDATE_U_XMDELM_U_XMDIS_U_XMNEW_U_XMFWD ; * No Name *
117 S (XMSVC,XMNAME,XMI)=""
118 F S XMSVC=$O(^TMP("XM",$J,XMSVC)) Q:XMSVC="" D Q:XMABORT
119 . I XMFIRST D
120 . . S XMFIRST=0
121 . . W:$E(IOST,1,2)="C-" @IOF D HEADER2
122 . E D PAGE2(.XMABORT) Q:XMABORT
123 . F S XMNAME=$O(^TMP("XM",$J,XMSVC,XMNAME)) Q:XMNAME="" D Q:XMABORT
124 . . F S XMI=$O(^TMP("XM",$J,XMSVC,XMNAME,XMI)) Q:XMI="" D Q:XMABORT
125 . . . S XMREC=^TMP("XM",$J,XMSVC,XMNAME,XMI)
126 . . . I $Y+3+($P(XMREC,U,1)=XMYES&($P(XMREC,U,9)'=""))>IOSL D PAGE2(.XMABORT) Q:XMABORT
127 . . . W !,$J(XMI,XMLEN)," ",XMNAME,?27,$P(XMREC,U,1),?30,$P(XMREC,U,2),?33,$P(XMREC,U,3),?35,$P(XMREC,U,4),?44,$P(XMREC,U,5),?54,$P(XMREC,U,6),?58,$P(XMREC,U,7),?60,$J($P(XMREC,U,8),6)
128 . . . S XMSURR=0,XMSNAM=""
129 . . . F S XMSURR=$O(^XMB(3.7,XMI,9,XMSURR)) Q:'XMSURR D Q:XMSNAM'=""
130 . . . . S XMSNAM=$S($D(^VA(200,+$G(^XMB(3.7,XMI,9,XMSURR,0)),0)):$$NAME^XMXUTIL(+^XMB(3.7,XMI,9,XMSURR,0)),1:"")
131 . . . I XMSNAM'="" W " ",$E(XMSNAM,1,12)
132 . . . I $P(XMREC,U,1)=XMYES,$P(XMREC,U,9)'="" W !,?XMLEN+1,$$EZBLD^DIALOG(38004),$P(XMREC,U,9) ; Forwarding address:
133 W:XMCNT=0 !!,$$EZBLD^DIALOG(36362) ; No user mailboxes to report.
134 K ^TMP("XM",$J)
135 S:$D(ZTQUEUED) ZTREQ="@"
136 Q
137PAGE2(XMABORT) ;
138 I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
139 W @IOF D HEADER2
140 Q
141HEADER2 ;
142 N XMPARM
143 S XMPARM(1)=XMSVC
144 S XMPARM(2)=XMCUTEXT
145 D BLD^DIALOG(36364,.XMPARM,"","","F")
146 D MSG^DIALOG("WM","",IOM)
147 ;Check user mailbox for Service/Section: |1|
148 ;
149 ;(Logon cutoff date: |2|, AC=Access Code, VC=Verify Code, PM=Primary Menu)
150 ;
151 ; Last
152 ; Mail/ Term Del DIS New
153 ;Check Mailbox AC VC PM Sign on Date Mail USER Msgs Surrogate
154 ;----------------------------------------------------------------------
155 ; y y y xx/xx/xx xx/xx/xx y y xxxxxx xxxxxxxxxxxx
156 Q
157CHECK2(XMI,XMCUTOFF,XMTERM,XMNAME,XMWHY) ;
158 N XMREC
159 S XMTERM=0
160 Q:XMI<1
161 S XMREC=$G(^VA(200,XMI,0))
162 Q:XMREC="" ; not in NEW PERSON file
163 I $P(XMREC,U,7) D Q
164 . ; DISUSER'd
165 . S XMTERM=1
166 . S XMNAME=$$NAME^XMXUTIL(XMI)
167 . S XMWHY=$$EZBLD^DIALOG(36366) ; DISUSER'd
168 I $P(XMREC,U,3)="" D Q
169 . ; no access code
170 . N XMTDATE
171 . S XMTDATE=$P(XMREC,U,11)
172 . Q:XMTDATE="" ; not terminated
173 . Q:XMTDATE'<XMCUTOFF ; terminated after cutoff date
174 . Q:$P(XMREC,U,5)'="n" ; Terminated w/o mail retention
175 . S XMTERM=1
176 . S XMNAME=$$NAME^XMXUTIL(XMI)
177 . S XMWHY=$$EZBLD^DIALOG(36367) ; No AC, terminated w/mail retention
178 ; User has access code
179 Q:$P($G(^VA(200,XMI,201)),U,1)="" ; no primary menu
180 Q:$P($G(^VA(200,XMI,.1)),U,2)="" ; no verify code
181 ; User has verify code and primary menu
182 N XMLASTON ; latest of last sign on / mailman use
183 S XMLASTON=$$MAX^XLFMTH(+$P($G(^VA(200,XMI,1.1)),U),+$P($G(^XMB(3.7,XMI,"L")),U,2))
184 I XMLASTON<XMCUTOFF D Q
185 . S XMNAME=$$NAME^XMXUTIL(XMI)
186 . I XMLASTON="" D Q
187 . . N XMADDED
188 . . S XMADDED=$P($G(^VA(200,XMI,1)),U,7)
189 . . Q:XMADDED'<XMCUTOFF
190 . . S XMTERM=1
191 . . S XMWHY=$$EZBLD^DIALOG(36368,$$FMTE^XLFDT(XMADDED,"2DF")) ; AC, VC, & PM, no logon, added |1|
192 . S XMTERM=1
193 . S XMWHY=$$EZBLD^DIALOG(36369,$$FMTE^XLFDT(XMLASTON,"2DF")) ; AC, VC, & PM, last logon |1|
194 Q
195 ; The following entry is called from a Kernel routine.
196TERMINAT(XMDUZ) ; Remove user from MailMan
197 D GROUP^XMUTERM2(XMDUZ)
198 D SURROGAT^XMUTERM2(XMDUZ)
199 D MAILBOX^XMUTERM2(XMDUZ)
200 D LATERNEW^XMUTERM2(XMDUZ)
201 D LATERSND^XMUTERM2(XMDUZ)
202 Q
Note: See TracBrowser for help on using the repository browser.