XMUTERM1 ;ISC-SF/GMB-Delete Mailbox (cont.) ;12/04/2002 13:51
;;8.0;MailMan;**10**;Jun 28, 2002
; Taken from XUSTERM (SEA/AMF/WDE)
ALL1TASK ; Deletions
N XMI,XMABORT,XMTERM,XMNAME,XMWHY,XMCUTEXT,XMLEN,XMCNT,XMADDED,XMAC,XMVC,XMPM,XMLASTON,XMTDATE,XMDELM,XMTOTAL,XMNEW,XMFWD,XMYES
S XMYES=$$EZBLD^DIALOG(39054.1) ; Y
S XMCUTEXT=$$FMTE^XLFDT(XMCUTOFF,"2DF")
S XMLEN=$L($P(^VA(200,0),U,3))
S (XMCNT,XMABORT,XMTOTAL)=0
W:$E(IOST,1,2)="C-" @IOF D HEADER1
S XMI=.999
F S XMI=$O(^XMB(3.7,XMI)) Q:XMI'>0 D Q:XMABORT
. S XMTOTAL=XMTOTAL+1 I '$D(ZTQUEUED),'(XMTOTAL#1000) U IO(0) W:$X>50 ! W "." U IO
. D CHECK1(XMI,XMGRACE,XMCUTOFF,.XMTERM,.XMNAME,.XMWHY) Q:'XMTERM
. D GETDATA(XMI,.XMADDED,.XMAC,.XMVC,.XMPM,.XMLASTON,.XMTDATE,.XMDELM,.XMNEW,.XMFWD)
. I $Y+3+(XMAC=XMYES&(XMFWD'=""))>IOSL D Q:XMABORT
. . I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
. . W @IOF D HEADER1
. W !,$J(XMI,XMLEN)," ",$E(XMNAME,1,32-XMLEN),?34,XMADDED,?44,XMAC,?47,XMVC,?50,XMPM,?53,XMLASTON,?63,XMTDATE,?76,XMDELM
. I XMAC=XMYES,XMFWD'="" W !,$$EZBLD^DIALOG(36347),$$EZBLD^DIALOG(38004),XMFWD Q ; *** not deleted - Forwarding Address:
. S XMCNT=XMCNT+1
. D:'XMTEST TERMINAT(XMI) ; Delete if real mode
W:XMCNT=0 !!,$$EZBLD^DIALOG(36351) ; No user mailboxes deleted.
S:$D(ZTQUEUED) ZTREQ="@"
Q
N XMPARM
S XMPARM(1)=$S(XMTEST:$$EZBLD^DIALOG(36352),1:"") ; Test:
S XMPARM(2)=XMCUTEXT
D BLD^DIALOG(36353,.XMPARM,"","","F")
D MSG^DIALOG("WM","",IOM)
;|1|Delete user mailbox
;(Logon cutoff date: |2|, AC=Access Code, VC=Verify Code, PM=Primary Menu)
; Last
; ^VA(200 Mail/ Terminate Delete
;Delete Mailbox Created AC VC PM Sign on Date Mail
;-----------------------------------------------------------------------
; xx/xx/xx y y y xx/xx/xx xx/xx/xx y
Q
CHECK1(XMI,XMGRACE,XMCUTOFF,XMTERM,XMNAME,XMWHY) ;
N XMREC,XMADDED
S XMTERM=0
Q:XMI<1
S XMREC=$G(^VA(200,XMI,0))
I XMREC="" D Q
. S XMTERM=1
. S XMNAME=$$EZBLD^DIALOG(34009) ; * No Name *
. S XMWHY=$$EZBLD^DIALOG(36346) ; Not in NEW PERSON file
; User is in NEW PERSON file
S XMADDED=$P($G(^VA(200,XMI,1)),U,7)
Q:XMADDED>XMGRACE
I $P(XMREC,U,3)="" D Q ; if no access code...
. N XMTDATE
. S XMTDATE=$P(XMREC,U,11)
. I XMTDATE="" D Q
. . S XMTERM=1
. . S XMNAME=$$NAME^XMXUTIL(XMI)
. . S XMWHY=$$EZBLD^DIALOG(36357) ; No AC, no termination date
. I XMTDATE'<DT Q ; To be Terminated in the future
. I $P(XMREC,U,5)="n" Q ; Terminated w/mail retention
. S XMTERM=1
. S XMNAME=$$NAME^XMXUTIL(XMI)
. S XMWHY=$$EZBLD^DIALOG(36358) ; No AC, terminated w/o mail retention
; User has access code
I $P($G(^VA(200,XMI,201)),U,1)="" D Q ; if no primary menu...
. S XMTERM=1
. S XMNAME=$$NAME^XMXUTIL(XMI)
. S XMWHY=$$EZBLD^DIALOG(36359) ; AC, but no PM
; User has primary menu
I $P($G(^VA(200,XMI,.1)),U,2)="" D Q ; if no verify code...
. N XMLASTON ; latest of 'last sign on' or 'last mailman use'
. S XMLASTON=$$MAX^XLFMTH(+$P($G(^VA(200,XMI,1.1)),U),+$P($G(^XMB(3.7,XMI,"L")),U,2))
. I XMLASTON=0 D Q
. . I XMADDED<XMCUTOFF D Q
. . . S XMTERM=1
. . . S XMNAME=$$NAME^XMXUTIL(XMI)
. . . S XMWHY=$$EZBLD^DIALOG(36360,$$FMTE^XLFDT(XMADDED,"2DF")) ; AC & PM, no VC, no logon, added |1|
. I XMLASTON<XMCUTOFF D Q
. . S XMTERM=1
. . S XMNAME=$$NAME^XMXUTIL(XMI)
. . S XMWHY=$$EZBLD^DIALOG(36361,$$FMTE^XLFDT(XMLASTON,"2DF")) ; AC & PM, no VC, last logon |1|
; User has verify code
Q
GETDATA(XMI,XMADDED,XMAC,XMVC,XMPM,XMLASTON,XMTDATE,XMDELM,XMNEW,XMFWD,XMDIS) ;
N XMREC
S XMREC=$G(^VA(200,XMI,0))
S XMADDED=$P($G(^VA(200,XMI,1)),U,7) ; date added to NEW PERSON file
S XMADDED=$S(XMADDED="":"",1:$$FMTE^XLFDT(XMADDED,"2DF"))
S XMAC=$S($P(XMREC,U,3)="":"",1:XMYES) ; access code
S XMVC=$S($P($G(^VA(200,XMI,.1)),U,2)="":"",1:XMYES) ; verify code
S XMPM=$S($P($G(^VA(200,XMI,201)),U,1)="":"",1:XMYES) ; primary menu
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
S XMLASTON=$S(XMLASTON=0:"",1:$$FMTE^XLFDT(XMLASTON,"2DF"))
S XMTDATE=$P(XMREC,U,11) ; termination date
S XMTDATE=$S(XMTDATE="":"",1:$$FMTE^XLFDT(XMTDATE,"2DF"))
S XMDELM=$$UP^XLFSTR($P(XMREC,U,5)) ; delete mail on termination
S XMDIS=$S($P(XMREC,U,7):XMYES,1:"") ; DISUSER'd
S XMREC=$G(^XMB(3.7,XMI,0))
S XMFWD=$P(XMREC,U,2) ; Forwarding address
S XMNEW=$P(XMREC,U,6) ; New messages
Q
ALL2TASK ; Suggestions
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
S XMYES=$$EZBLD^DIALOG(39054.1) ; Y
K ^TMP("XM",$J)
S XMCUTEXT=$$FMTE^XLFDT(XMCUTOFF,"2DF")
S XMLEN=$L($P(^VA(200,0),U,3))
S (XMCNT,XMABORT,XMTOTAL)=0,XMFIRST=1
S XMI=.999
F S XMI=$O(^XMB(3.7,XMI)) Q:XMI'>0 D Q:XMABORT
. S XMTOTAL=XMTOTAL+1 I '$D(ZTQUEUED),'(XMTOTAL#1000) U IO(0) W:$X>50 ! W "." U IO
. D CHECK2(XMI,XMCUTOFF,.XMTERM,.XMNAME,.XMWHY) Q:'XMTERM
. S XMCNT=XMCNT+1
. D GETDATA(XMI,.XMADDED,.XMAC,.XMVC,.XMPM,.XMLASTON,.XMTDATE,.XMDELM,.XMNEW,.XMFWD,.XMDIS)
. 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
. 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 *
S (XMSVC,XMNAME,XMI)=""
F S XMSVC=$O(^TMP("XM",$J,XMSVC)) Q:XMSVC="" D Q:XMABORT
. I XMFIRST D
. . S XMFIRST=0
. . W:$E(IOST,1,2)="C-" @IOF D HEADER2
. E D PAGE2(.XMABORT) Q:XMABORT
. F S XMNAME=$O(^TMP("XM",$J,XMSVC,XMNAME)) Q:XMNAME="" D Q:XMABORT
. . F S XMI=$O(^TMP("XM",$J,XMSVC,XMNAME,XMI)) Q:XMI="" D Q:XMABORT
. . . S XMREC=^TMP("XM",$J,XMSVC,XMNAME,XMI)
. . . I $Y+3+($P(XMREC,U,1)=XMYES&($P(XMREC,U,9)'=""))>IOSL D PAGE2(.XMABORT) Q:XMABORT
. . . 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)
. . . S XMSURR=0,XMSNAM=""
. . . F S XMSURR=$O(^XMB(3.7,XMI,9,XMSURR)) Q:'XMSURR D Q:XMSNAM'=""
. . . . 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:"")
. . . I XMSNAM'="" W " ",$E(XMSNAM,1,12)
. . . I $P(XMREC,U,1)=XMYES,$P(XMREC,U,9)'="" W !,?XMLEN+1,$$EZBLD^DIALOG(38004),$P(XMREC,U,9) ; Forwarding address:
W:XMCNT=0 !!,$$EZBLD^DIALOG(36362) ; No user mailboxes to report.
K ^TMP("XM",$J)
S:$D(ZTQUEUED) ZTREQ="@"
Q
PAGE2(XMABORT) ;
I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
W @IOF D HEADER2
Q
N XMPARM
S XMPARM(1)=XMSVC
S XMPARM(2)=XMCUTEXT
D BLD^DIALOG(36364,.XMPARM,"","","F")
D MSG^DIALOG("WM","",IOM)
;Check user mailbox for Service/Section: |1|
;
;(Logon cutoff date: |2|, AC=Access Code, VC=Verify Code, PM=Primary Menu)
;
; Last
; Mail/ Term Del DIS New
;Check Mailbox AC VC PM Sign on Date Mail USER Msgs Surrogate
;----------------------------------------------------------------------
; y y y xx/xx/xx xx/xx/xx y y xxxxxx xxxxxxxxxxxx
Q
CHECK2(XMI,XMCUTOFF,XMTERM,XMNAME,XMWHY) ;
N XMREC
S XMTERM=0
Q:XMI<1
S XMREC=$G(^VA(200,XMI,0))
Q:XMREC="" ; not in NEW PERSON file
I $P(XMREC,U,7) D Q
. ; DISUSER'd
. S XMTERM=1
. S XMNAME=$$NAME^XMXUTIL(XMI)
. S XMWHY=$$EZBLD^DIALOG(36366) ; DISUSER'd
I $P(XMREC,U,3)="" D Q
. ; no access code
. N XMTDATE
. S XMTDATE=$P(XMREC,U,11)
. Q:XMTDATE="" ; not terminated
. Q:XMTDATE'<XMCUTOFF ; terminated after cutoff date
. Q:$P(XMREC,U,5)'="n" ; Terminated w/o mail retention
. S XMTERM=1
. S XMNAME=$$NAME^XMXUTIL(XMI)
. S XMWHY=$$EZBLD^DIALOG(36367) ; No AC, terminated w/mail retention
; User has access code
Q:$P($G(^VA(200,XMI,201)),U,1)="" ; no primary menu
Q:$P($G(^VA(200,XMI,.1)),U,2)="" ; no verify code
; User has verify code and primary menu
N XMLASTON ; latest of last sign on / mailman use
S XMLASTON=$$MAX^XLFMTH(+$P($G(^VA(200,XMI,1.1)),U),+$P($G(^XMB(3.7,XMI,"L")),U,2))
I XMLASTON<XMCUTOFF D Q
. S XMNAME=$$NAME^XMXUTIL(XMI)
. I XMLASTON="" D Q
. . N XMADDED
. . S XMADDED=$P($G(^VA(200,XMI,1)),U,7)
. . Q:XMADDED'<XMCUTOFF
. . S XMTERM=1
. . S XMWHY=$$EZBLD^DIALOG(36368,$$FMTE^XLFDT(XMADDED,"2DF")) ; AC, VC, & PM, no logon, added |1|
. S XMTERM=1
. S XMWHY=$$EZBLD^DIALOG(36369,$$FMTE^XLFDT(XMLASTON,"2DF")) ; AC, VC, & PM, last logon |1|
Q
; The following entry is called from a Kernel routine.
TERMINAT(XMDUZ) ; Remove user from MailMan
D GROUP^XMUTERM2(XMDUZ)
D SURROGAT^XMUTERM2(XMDUZ)
D MAILBOX^XMUTERM2(XMDUZ)
D LATERNEW^XMUTERM2(XMDUZ)
D LATERSND^XMUTERM2(XMDUZ)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMUTERM1 9021 printed Sep 23, 2025@19:49:47 Page 2
XMUTERM1 ;ISC-SF/GMB-Delete Mailbox (cont.) ;12/04/2002 13:51
+1 ;;8.0;MailMan;**10**;Jun 28, 2002
+2 ; Taken from XUSTERM (SEA/AMF/WDE)
ALL1TASK ; Deletions
+1 NEW XMI,XMABORT,XMTERM,XMNAME,XMWHY,XMCUTEXT,XMLEN,XMCNT,XMADDED,XMAC,XMVC,XMPM,XMLASTON,XMTDATE,XMDELM,XMTOTAL,XMNEW,XMFWD,XMYES
+2 ; Y
SET XMYES=$$EZBLD^DIALOG(39054.1)
+3 SET XMCUTEXT=$$FMTE^XLFDT(XMCUTOFF,"2DF")
+4 SET XMLEN=$LENGTH($PIECE(^VA(200,0),U,3))
+5 SET (XMCNT,XMABORT,XMTOTAL)=0
+6 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
DO HEADER1
+7 SET XMI=.999
+8 FOR
SET XMI=$ORDER(^XMB(3.7,XMI))
if XMI'>0
QUIT
Begin DoDot:1
+9 SET XMTOTAL=XMTOTAL+1
IF '$DATA(ZTQUEUED)
IF '(XMTOTAL#1000)
USE IO(0)
if $X>50
WRITE !
WRITE "."
USE IO
+10 DO CHECK1(XMI,XMGRACE,XMCUTOFF,.XMTERM,.XMNAME,.XMWHY)
if 'XMTERM
QUIT
+11 DO GETDATA(XMI,.XMADDED,.XMAC,.XMVC,.XMPM,.XMLASTON,.XMTDATE,.XMDELM,.XMNEW,.XMFWD)
+12 IF $Y+3+(XMAC=XMYES&(XMFWD'=""))>IOSL
Begin DoDot:2
+13 IF $EXTRACT(IOST,1,2)="C-"
DO PAGE^XMXUTIL(.XMABORT)
if XMABORT
QUIT
+14 WRITE @IOF
DO HEADER1
End DoDot:2
if XMABORT
QUIT
+15 WRITE !,$JUSTIFY(XMI,XMLEN)," ",$EXTRACT(XMNAME,1,32-XMLEN),?34,XMADDED,?44,XMAC,?47,XMVC,?50,XMPM,?53,XMLASTON,?63,XMTDATE,?76,XMDELM
+16 ; *** not deleted - Forwarding Address:
IF XMAC=XMYES
IF XMFWD'=""
WRITE !,$$EZBLD^DIALOG(36347),$$EZBLD^DIALOG(38004),XMFWD
QUIT
+17 SET XMCNT=XMCNT+1
+18 ; Delete if real mode
if 'XMTEST
DO TERMINAT(XMI)
End DoDot:1
if XMABORT
QUIT
+19 ; No user mailboxes deleted.
if XMCNT=0
WRITE !!,$$EZBLD^DIALOG(36351)
+20 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+21 QUIT
+1 NEW XMPARM
+2 ; Test:
SET XMPARM(1)=$SELECT(XMTEST:$$EZBLD^DIALOG(36352),1:"")
+3 SET XMPARM(2)=XMCUTEXT
+4 DO BLD^DIALOG(36353,.XMPARM,"","","F")
+5 DO MSG^DIALOG("WM","",IOM)
+6 ;|1|Delete user mailbox
+7 ;(Logon cutoff date: |2|, AC=Access Code, VC=Verify Code, PM=Primary Menu)
+8 ; Last
+9 ; ^VA(200 Mail/ Terminate Delete
+10 ;Delete Mailbox Created AC VC PM Sign on Date Mail
+11 ;-----------------------------------------------------------------------
+12 ; xx/xx/xx y y y xx/xx/xx xx/xx/xx y
+13 QUIT
CHECK1(XMI,XMGRACE,XMCUTOFF,XMTERM,XMNAME,XMWHY) ;
+1 NEW XMREC,XMADDED
+2 SET XMTERM=0
+3 if XMI<1
QUIT
+4 SET XMREC=$GET(^VA(200,XMI,0))
+5 IF XMREC=""
Begin DoDot:1
+6 SET XMTERM=1
+7 ; * No Name *
SET XMNAME=$$EZBLD^DIALOG(34009)
+8 ; Not in NEW PERSON file
SET XMWHY=$$EZBLD^DIALOG(36346)
End DoDot:1
QUIT
+9 ; User is in NEW PERSON file
+10 SET XMADDED=$PIECE($GET(^VA(200,XMI,1)),U,7)
+11 if XMADDED>XMGRACE
QUIT
+12 ; if no access code...
IF $PIECE(XMREC,U,3)=""
Begin DoDot:1
+13 NEW XMTDATE
+14 SET XMTDATE=$PIECE(XMREC,U,11)
+15 IF XMTDATE=""
Begin DoDot:2
+16 SET XMTERM=1
+17 SET XMNAME=$$NAME^XMXUTIL(XMI)
+18 ; No AC, no termination date
SET XMWHY=$$EZBLD^DIALOG(36357)
End DoDot:2
QUIT
+19 ; To be Terminated in the future
IF XMTDATE'<DT
QUIT
+20 ; Terminated w/mail retention
IF $PIECE(XMREC,U,5)="n"
QUIT
+21 SET XMTERM=1
+22 SET XMNAME=$$NAME^XMXUTIL(XMI)
+23 ; No AC, terminated w/o mail retention
SET XMWHY=$$EZBLD^DIALOG(36358)
End DoDot:1
QUIT
+24 ; User has access code
+25 ; if no primary menu...
IF $PIECE($GET(^VA(200,XMI,201)),U,1)=""
Begin DoDot:1
+26 SET XMTERM=1
+27 SET XMNAME=$$NAME^XMXUTIL(XMI)
+28 ; AC, but no PM
SET XMWHY=$$EZBLD^DIALOG(36359)
End DoDot:1
QUIT
+29 ; User has primary menu
+30 ; if no verify code...
IF $PIECE($GET(^VA(200,XMI,.1)),U,2)=""
Begin DoDot:1
+31 ; latest of 'last sign on' or 'last mailman use'
NEW XMLASTON
+32 SET XMLASTON=$$MAX^XLFMTH(+$PIECE($GET(^VA(200,XMI,1.1)),U),+$PIECE($GET(^XMB(3.7,XMI,"L")),U,2))
+33 IF XMLASTON=0
Begin DoDot:2
+34 IF XMADDED<XMCUTOFF
Begin DoDot:3
+35 SET XMTERM=1
+36 SET XMNAME=$$NAME^XMXUTIL(XMI)
+37 ; AC & PM, no VC, no logon, added |1|
SET XMWHY=$$EZBLD^DIALOG(36360,$$FMTE^XLFDT(XMADDED,"2DF"))
End DoDot:3
QUIT
End DoDot:2
QUIT
+38 IF XMLASTON<XMCUTOFF
Begin DoDot:2
+39 SET XMTERM=1
+40 SET XMNAME=$$NAME^XMXUTIL(XMI)
+41 ; AC & PM, no VC, last logon |1|
SET XMWHY=$$EZBLD^DIALOG(36361,$$FMTE^XLFDT(XMLASTON,"2DF"))
End DoDot:2
QUIT
End DoDot:1
QUIT
+42 ; User has verify code
+43 QUIT
GETDATA(XMI,XMADDED,XMAC,XMVC,XMPM,XMLASTON,XMTDATE,XMDELM,XMNEW,XMFWD,XMDIS) ;
+1 NEW XMREC
+2 SET XMREC=$GET(^VA(200,XMI,0))
+3 ; date added to NEW PERSON file
SET XMADDED=$PIECE($GET(^VA(200,XMI,1)),U,7)
+4 SET XMADDED=$SELECT(XMADDED="":"",1:$$FMTE^XLFDT(XMADDED,"2DF"))
+5 ; access code
SET XMAC=$SELECT($PIECE(XMREC,U,3)="":"",1:XMYES)
+6 ; verify code
SET XMVC=$SELECT($PIECE($GET(^VA(200,XMI,.1)),U,2)="":"",1:XMYES)
+7 ; primary menu
SET XMPM=$SELECT($PIECE($GET(^VA(200,XMI,201)),U,1)="":"",1:XMYES)
+8 ; last sign on / mailman use
SET XMLASTON=$$MAX^XLFMTH(+$PIECE($GET(^VA(200,XMI,1.1)),U),+$PIECE($GET(^XMB(3.7,XMI,"L")),U,2))
+9 SET XMLASTON=$SELECT(XMLASTON=0:"",1:$$FMTE^XLFDT(XMLASTON,"2DF"))
+10 ; termination date
SET XMTDATE=$PIECE(XMREC,U,11)
+11 SET XMTDATE=$SELECT(XMTDATE="":"",1:$$FMTE^XLFDT(XMTDATE,"2DF"))
+12 ; delete mail on termination
SET XMDELM=$$UP^XLFSTR($PIECE(XMREC,U,5))
+13 ; DISUSER'd
SET XMDIS=$SELECT($PIECE(XMREC,U,7):XMYES,1:"")
+14 SET XMREC=$GET(^XMB(3.7,XMI,0))
+15 ; Forwarding address
SET XMFWD=$PIECE(XMREC,U,2)
+16 ; New messages
SET XMNEW=$PIECE(XMREC,U,6)
+17 QUIT
ALL2TASK ; Suggestions
+1 NEW 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
+2 ; Y
SET XMYES=$$EZBLD^DIALOG(39054.1)
+3 KILL ^TMP("XM",$JOB)
+4 SET XMCUTEXT=$$FMTE^XLFDT(XMCUTOFF,"2DF")
+5 SET XMLEN=$LENGTH($PIECE(^VA(200,0),U,3))
+6 SET (XMCNT,XMABORT,XMTOTAL)=0
SET XMFIRST=1
+7 SET XMI=.999
+8 FOR
SET XMI=$ORDER(^XMB(3.7,XMI))
if XMI'>0
QUIT
Begin DoDot:1
+9 SET XMTOTAL=XMTOTAL+1
IF '$DATA(ZTQUEUED)
IF '(XMTOTAL#1000)
USE IO(0)
if $X>50
WRITE !
WRITE "."
USE IO
+10 DO CHECK2(XMI,XMCUTOFF,.XMTERM,.XMNAME,.XMWHY)
if 'XMTERM
QUIT
+11 SET XMCNT=XMCNT+1
+12 DO GETDATA(XMI,.XMADDED,.XMAC,.XMVC,.XMPM,.XMLASTON,.XMTDATE,.XMDELM,.XMNEW,.XMFWD,.XMDIS)
+13 ; NONE
SET XMSVC=$SELECT($PIECE($GET(^VA(200,XMI,5)),U,1)="":$$EZBLD^DIALOG(36334),1:$PIECE($GET(^DIC(49,$PIECE(^(5),U,1),0),$$EZBLD^DIALOG(36334)),U,1))
+14 ; * No Name *
SET ^TMP("XM",$JOB,XMSVC,$SELECT(XMNAME="":$$EZBLD^DIALOG(34009),1:$EXTRACT(XMNAME,1,25-XMLEN)),XMI)=XMAC_U_XMVC_U_XMPM_U_XMLASTON_U_XMTDATE_U_XMDELM_U_XMDIS_U_XMNEW_U_XMFWD
End DoDot:1
if XMABORT
QUIT
+15 SET (XMSVC,XMNAME,XMI)=""
+16 FOR
SET XMSVC=$ORDER(^TMP("XM",$JOB,XMSVC))
if XMSVC=""
QUIT
Begin DoDot:1
+17 IF XMFIRST
Begin DoDot:2
+18 SET XMFIRST=0
+19 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
DO HEADER2
End DoDot:2
+20 IF '$TEST
DO PAGE2(.XMABORT)
if XMABORT
QUIT
+21 FOR
SET XMNAME=$ORDER(^TMP("XM",$JOB,XMSVC,XMNAME))
if XMNAME=""
QUIT
Begin DoDot:2
+22 FOR
SET XMI=$ORDER(^TMP("XM",$JOB,XMSVC,XMNAME,XMI))
if XMI=""
QUIT
Begin DoDot:3
+23 SET XMREC=^TMP("XM",$JOB,XMSVC,XMNAME,XMI)
+24 IF $Y+3+($PIECE(XMREC,U,1)=XMYES&($PIECE(XMREC,U,9)'=""))>IOSL
DO PAGE2(.XMABORT)
if XMABORT
QUIT
+25 WRITE !,$JUSTIFY(XMI,XMLEN)," ",XMNAME,?27,$PIECE(XMREC,U,1),?30,$PIECE(XMREC,U,2),?33,$PIECE(XMREC,U,3),?35,$PIECE(XMREC,U,4),?44,$PIECE(XMREC,U,5),?54,$PIECE(XMREC,U,6),?58,$PIECE(XMREC,U,7),?60,$JUSTIFY($PIECE(XMREC,U
,8),6)
+26 SET XMSURR=0
SET XMSNAM=""
+27 FOR
SET XMSURR=$ORDER(^XMB(3.7,XMI,9,XMSURR))
if 'XMSURR
QUIT
Begin DoDot:4
+28 SET XMSNAM=$SELECT($DATA(^VA(200,+$GET(^XMB(3.7,XMI,9,XMSURR,0)),0)):$$NAME^XMXUTIL(+^XMB(3.7,XMI,9,XMSURR,0)),1:"")
End DoDot:4
if XMSNAM'=""
QUIT
+29 IF XMSNAM'=""
WRITE " ",$EXTRACT(XMSNAM,1,12)
+30 ; Forwarding address:
IF $PIECE(XMREC,U,1)=XMYES
IF $PIECE(XMREC,U,9)'=""
WRITE !,?XMLEN+1,$$EZBLD^DIALOG(38004),$PIECE(XMREC,U,9)
End DoDot:3
if XMABORT
QUIT
End DoDot:2
if XMABORT
QUIT
End DoDot:1
if XMABORT
QUIT
+31 ; No user mailboxes to report.
if XMCNT=0
WRITE !!,$$EZBLD^DIALOG(36362)
+32 KILL ^TMP("XM",$JOB)
+33 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+34 QUIT
PAGE2(XMABORT) ;
+1 IF $EXTRACT(IOST,1,2)="C-"
DO PAGE^XMXUTIL(.XMABORT)
if XMABORT
QUIT
+2 WRITE @IOF
DO HEADER2
+3 QUIT
+1 NEW XMPARM
+2 SET XMPARM(1)=XMSVC
+3 SET XMPARM(2)=XMCUTEXT
+4 DO BLD^DIALOG(36364,.XMPARM,"","","F")
+5 DO MSG^DIALOG("WM","",IOM)
+6 ;Check user mailbox for Service/Section: |1|
+7 ;
+8 ;(Logon cutoff date: |2|, AC=Access Code, VC=Verify Code, PM=Primary Menu)
+9 ;
+10 ; Last
+11 ; Mail/ Term Del DIS New
+12 ;Check Mailbox AC VC PM Sign on Date Mail USER Msgs Surrogate
+13 ;----------------------------------------------------------------------
+14 ; y y y xx/xx/xx xx/xx/xx y y xxxxxx xxxxxxxxxxxx
+15 QUIT
CHECK2(XMI,XMCUTOFF,XMTERM,XMNAME,XMWHY) ;
+1 NEW XMREC
+2 SET XMTERM=0
+3 if XMI<1
QUIT
+4 SET XMREC=$GET(^VA(200,XMI,0))
+5 ; not in NEW PERSON file
if XMREC=""
QUIT
+6 IF $PIECE(XMREC,U,7)
Begin DoDot:1
+7 ; DISUSER'd
+8 SET XMTERM=1
+9 SET XMNAME=$$NAME^XMXUTIL(XMI)
+10 ; DISUSER'd
SET XMWHY=$$EZBLD^DIALOG(36366)
End DoDot:1
QUIT
+11 IF $PIECE(XMREC,U,3)=""
Begin DoDot:1
+12 ; no access code
+13 NEW XMTDATE
+14 SET XMTDATE=$PIECE(XMREC,U,11)
+15 ; not terminated
if XMTDATE=""
QUIT
+16 ; terminated after cutoff date
if XMTDATE'<XMCUTOFF
QUIT
+17 ; Terminated w/o mail retention
if $PIECE(XMREC,U,5)'="n"
QUIT
+18 SET XMTERM=1
+19 SET XMNAME=$$NAME^XMXUTIL(XMI)
+20 ; No AC, terminated w/mail retention
SET XMWHY=$$EZBLD^DIALOG(36367)
End DoDot:1
QUIT
+21 ; User has access code
+22 ; no primary menu
if $PIECE($GET(^VA(200,XMI,201)),U,1)=""
QUIT
+23 ; no verify code
if $PIECE($GET(^VA(200,XMI,.1)),U,2)=""
QUIT
+24 ; User has verify code and primary menu
+25 ; latest of last sign on / mailman use
NEW XMLASTON
+26 SET XMLASTON=$$MAX^XLFMTH(+$PIECE($GET(^VA(200,XMI,1.1)),U),+$PIECE($GET(^XMB(3.7,XMI,"L")),U,2))
+27 IF XMLASTON<XMCUTOFF
Begin DoDot:1
+28 SET XMNAME=$$NAME^XMXUTIL(XMI)
+29 IF XMLASTON=""
Begin DoDot:2
+30 NEW XMADDED
+31 SET XMADDED=$PIECE($GET(^VA(200,XMI,1)),U,7)
+32 if XMADDED'<XMCUTOFF
QUIT
+33 SET XMTERM=1
+34 ; AC, VC, & PM, no logon, added |1|
SET XMWHY=$$EZBLD^DIALOG(36368,$$FMTE^XLFDT(XMADDED,"2DF"))
End DoDot:2
QUIT
+35 SET XMTERM=1
+36 ; AC, VC, & PM, last logon |1|
SET XMWHY=$$EZBLD^DIALOG(36369,$$FMTE^XLFDT(XMLASTON,"2DF"))
End DoDot:1
QUIT
+37 QUIT
+38 ; The following entry is called from a Kernel routine.
TERMINAT(XMDUZ) ; Remove user from MailMan
+1 DO GROUP^XMUTERM2(XMDUZ)
+2 DO SURROGAT^XMUTERM2(XMDUZ)
+3 DO MAILBOX^XMUTERM2(XMDUZ)
+4 DO LATERNEW^XMUTERM2(XMDUZ)
+5 DO LATERSND^XMUTERM2(XMDUZ)
+6 QUIT
