- 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 Feb 18, 2025@23:39:57 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