Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMUTERM1

XMUTERM1.m

Go to the documentation of this file. 
  1. XMUTERM1 ;ISC-SF/GMB-Delete Mailbox (cont.) ;12/04/2002  13:51
  1.  ;;8.0;MailMan;**10**;Jun 28, 2002
  1.  ; Taken from XUSTERM (SEA/AMF/WDE)
  1. ALL1TASK ; Deletions
  1.  N XMI,XMABORT,XMTERM,XMNAME,XMWHY,XMCUTEXT,XMLEN,XMCNT,XMADDED,XMAC,XMVC,XMPM,XMLASTON,XMTDATE,XMDELM,XMTOTAL,XMNEW,XMFWD,XMYES
  1.  S XMYES=$$EZBLD^DIALOG(39054.1) ; Y
  1.  S XMCUTEXT=$$FMTE^XLFDT(XMCUTOFF,"2DF")
  1.  S XMLEN=$L($P(^VA(200,0),U,3))
  1.  S (XMCNT,XMABORT,XMTOTAL)=0
  1.  W:$E(IOST,1,2)="C-" @IOF D HEADER1
  1.  S XMI=.999
  1.  F  S XMI=$O(^XMB(3.7,XMI)) Q:XMI'>0  D  Q:XMABORT
  1.  . S XMTOTAL=XMTOTAL+1 I '$D(ZTQUEUED),'(XMTOTAL#1000) U IO(0) W:$X>50 ! W "." U IO
  1.  . D CHECK1(XMI,XMGRACE,XMCUTOFF,.XMTERM,.XMNAME,.XMWHY) Q:'XMTERM
  1.  . D GETDATA(XMI,.XMADDED,.XMAC,.XMVC,.XMPM,.XMLASTON,.XMTDATE,.XMDELM,.XMNEW,.XMFWD)
  1.  . I $Y+3+(XMAC=XMYES&(XMFWD'=""))>IOSL D  Q:XMABORT
  1.  . . I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
  1.  . . W @IOF D HEADER1
  1.  . W !,$J(XMI,XMLEN)," ",$E(XMNAME,1,32-XMLEN),?34,XMADDED,?44,XMAC,?47,XMVC,?50,XMPM,?53,XMLASTON,?63,XMTDATE,?76,XMDELM
  1.  . I XMAC=XMYES,XMFWD'="" W !,$$EZBLD^DIALOG(36347),$$EZBLD^DIALOG(38004),XMFWD Q  ; *** not deleted - Forwarding Address:
  1.  . S XMCNT=XMCNT+1
  1.  . D:'XMTEST TERMINAT(XMI)  ; Delete if real mode
  1.  W:XMCNT=0 !!,$$EZBLD^DIALOG(36351) ; No user mailboxes deleted.
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1. HEADER1 ;
  1.  N XMPARM
  1.  S XMPARM(1)=$S(XMTEST:$$EZBLD^DIALOG(36352),1:"") ; Test:
  1.  S XMPARM(2)=XMCUTEXT
  1.  D BLD^DIALOG(36353,.XMPARM,"","","F")
  1.  D MSG^DIALOG("WM","",IOM)
  1.  ;|1|Delete user mailbox
  1.  ;(Logon cutoff date: |2|, AC=Access Code, VC=Verify Code, PM=Primary Menu)
  1.  ;                                           Last
  1.  ;                       ^VA(200             Mail/  Terminate  Delete
  1.  ;Delete Mailbox         Created  AC VC PM  Sign on    Date     Mail
  1.  ;-----------------------------------------------------------------------
  1.  ;                      xx/xx/xx  y  y  y  xx/xx/xx  xx/xx/xx     y
  1.  Q
  1. CHECK1(XMI,XMGRACE,XMCUTOFF,XMTERM,XMNAME,XMWHY) ;
  1.  N XMREC,XMADDED
  1.  S XMTERM=0
  1.  Q:XMI<1
  1.  S XMREC=$G(^VA(200,XMI,0))
  1.  I XMREC="" D  Q
  1.  . S XMTERM=1
  1.  . S XMNAME=$$EZBLD^DIALOG(34009) ; * No Name *
  1.  . S XMWHY=$$EZBLD^DIALOG(36346) ; Not in NEW PERSON file
  1.  ; User is in NEW PERSON file
  1.  S XMADDED=$P($G(^VA(200,XMI,1)),U,7)
  1.  Q:XMADDED>XMGRACE
  1.  I $P(XMREC,U,3)="" D  Q  ; if no access code...
  1.  . N XMTDATE
  1.  . S XMTDATE=$P(XMREC,U,11)
  1.  . I XMTDATE="" D  Q
  1.  . . S XMTERM=1
  1.  . . S XMNAME=$$NAME^XMXUTIL(XMI)
  1.  . . S XMWHY=$$EZBLD^DIALOG(36357) ; No AC, no termination date
  1.  . I XMTDATE'<DT Q  ; To be Terminated in the future
  1.  . I $P(XMREC,U,5)="n" Q  ; Terminated w/mail retention
  1.  . S XMTERM=1
  1.  . S XMNAME=$$NAME^XMXUTIL(XMI)
  1.  . S XMWHY=$$EZBLD^DIALOG(36358) ; No AC, terminated w/o mail retention
  1.  ; User has access code
  1.  I $P($G(^VA(200,XMI,201)),U,1)="" D  Q  ; if no primary menu...
  1.  . S XMTERM=1
  1.  . S XMNAME=$$NAME^XMXUTIL(XMI)
  1.  . S XMWHY=$$EZBLD^DIALOG(36359) ; AC, but no PM
  1.  ; User has primary menu
  1.  I $P($G(^VA(200,XMI,.1)),U,2)="" D  Q  ; if no verify code...
  1.  . N XMLASTON  ; latest of 'last sign on' or 'last mailman use'
  1.  . S XMLASTON=$$MAX^XLFMTH(+$P($G(^VA(200,XMI,1.1)),U),+$P($G(^XMB(3.7,XMI,"L")),U,2))
  1.  . I XMLASTON=0 D  Q
  1.  . . I XMADDED<XMCUTOFF D  Q
  1.  . . . S XMTERM=1
  1.  . . . S XMNAME=$$NAME^XMXUTIL(XMI)
  1.  . . . S XMWHY=$$EZBLD^DIALOG(36360,$$FMTE^XLFDT(XMADDED,"2DF")) ; AC & PM, no VC, no logon, added |1|
  1.  . I XMLASTON<XMCUTOFF D  Q
  1.  . . S XMTERM=1
  1.  . . S XMNAME=$$NAME^XMXUTIL(XMI)
  1.  . . S XMWHY=$$EZBLD^DIALOG(36361,$$FMTE^XLFDT(XMLASTON,"2DF")) ; AC & PM, no VC, last logon |1|
  1.  ; User has verify code
  1.  Q
  1. GETDATA(XMI,XMADDED,XMAC,XMVC,XMPM,XMLASTON,XMTDATE,XMDELM,XMNEW,XMFWD,XMDIS) ;
  1.  N XMREC
  1.  S XMREC=$G(^VA(200,XMI,0))
  1.  S XMADDED=$P($G(^VA(200,XMI,1)),U,7) ; date added to NEW PERSON file
  1.  S XMADDED=$S(XMADDED="":"",1:$$FMTE^XLFDT(XMADDED,"2DF"))
  1.  S XMAC=$S($P(XMREC,U,3)="":"",1:XMYES) ; access code
  1.  S XMVC=$S($P($G(^VA(200,XMI,.1)),U,2)="":"",1:XMYES) ; verify code
  1.  S XMPM=$S($P($G(^VA(200,XMI,201)),U,1)="":"",1:XMYES) ; primary menu
  1.  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
  1.  S XMLASTON=$S(XMLASTON=0:"",1:$$FMTE^XLFDT(XMLASTON,"2DF"))
  1.  S XMTDATE=$P(XMREC,U,11) ; termination date
  1.  S XMTDATE=$S(XMTDATE="":"",1:$$FMTE^XLFDT(XMTDATE,"2DF"))
  1.  S XMDELM=$$UP^XLFSTR($P(XMREC,U,5)) ; delete mail on termination
  1.  S XMDIS=$S($P(XMREC,U,7):XMYES,1:"") ; DISUSER'd
  1.  S XMREC=$G(^XMB(3.7,XMI,0))
  1.  S XMFWD=$P(XMREC,U,2) ; Forwarding address
  1.  S XMNEW=$P(XMREC,U,6) ; New messages
  1.  Q
  1. ALL2TASK ; Suggestions
  1.  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
  1.  S XMYES=$$EZBLD^DIALOG(39054.1) ; Y
  1.  K ^TMP("XM",$J)
  1.  S XMCUTEXT=$$FMTE^XLFDT(XMCUTOFF,"2DF")
  1.  S XMLEN=$L($P(^VA(200,0),U,3))
  1.  S (XMCNT,XMABORT,XMTOTAL)=0,XMFIRST=1
  1.  S XMI=.999
  1.  F  S XMI=$O(^XMB(3.7,XMI)) Q:XMI'>0  D  Q:XMABORT
  1.  . S XMTOTAL=XMTOTAL+1 I '$D(ZTQUEUED),'(XMTOTAL#1000) U IO(0) W:$X>50 ! W "." U IO
  1.  . D CHECK2(XMI,XMCUTOFF,.XMTERM,.XMNAME,.XMWHY) Q:'XMTERM
  1.  . S XMCNT=XMCNT+1
  1.  . D GETDATA(XMI,.XMADDED,.XMAC,.XMVC,.XMPM,.XMLASTON,.XMTDATE,.XMDELM,.XMNEW,.XMFWD,.XMDIS)
  1.  . 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
  1.  . 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 *
  1.  S (XMSVC,XMNAME,XMI)=""
  1.  F  S XMSVC=$O(^TMP("XM",$J,XMSVC)) Q:XMSVC=""  D  Q:XMABORT
  1.  . I XMFIRST D
  1.  . . S XMFIRST=0
  1.  . . W:$E(IOST,1,2)="C-" @IOF D HEADER2
  1.  . E  D PAGE2(.XMABORT) Q:XMABORT
  1.  . F  S XMNAME=$O(^TMP("XM",$J,XMSVC,XMNAME)) Q:XMNAME=""  D  Q:XMABORT
  1.  . . F  S XMI=$O(^TMP("XM",$J,XMSVC,XMNAME,XMI)) Q:XMI=""  D  Q:XMABORT
  1.  . . . S XMREC=^TMP("XM",$J,XMSVC,XMNAME,XMI)
  1.  . . . I $Y+3+($P(XMREC,U,1)=XMYES&($P(XMREC,U,9)'=""))>IOSL D PAGE2(.XMABORT) Q:XMABORT
  1.  . . . 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)
  1.  . . . S XMSURR=0,XMSNAM=""
  1.  . . . F  S XMSURR=$O(^XMB(3.7,XMI,9,XMSURR)) Q:'XMSURR  D  Q:XMSNAM'=""
  1.  . . . . 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:"")
  1.  . . . I XMSNAM'="" W " ",$E(XMSNAM,1,12)
  1.  . . . I $P(XMREC,U,1)=XMYES,$P(XMREC,U,9)'="" W !,?XMLEN+1,$$EZBLD^DIALOG(38004),$P(XMREC,U,9) ; Forwarding address:
  1.  W:XMCNT=0 !!,$$EZBLD^DIALOG(36362) ; No user mailboxes to report.
  1.  K ^TMP("XM",$J)
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1. PAGE2(XMABORT) ;
  1.  I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
  1.  W @IOF D HEADER2
  1.  Q
  1. HEADER2 ;
  1.  N XMPARM
  1.  S XMPARM(1)=XMSVC
  1.  S XMPARM(2)=XMCUTEXT
  1.  D BLD^DIALOG(36364,.XMPARM,"","","F")
  1.  D MSG^DIALOG("WM","",IOM)
  1.  ;Check user mailbox for Service/Section: |1|
  1.  ;
  1.  ;(Logon cutoff date: |2|, AC=Access Code, VC=Verify Code, PM=Primary Menu)
  1.  ;
  1.  ;                            Last
  1.  ;                            Mail/    Term   Del  DIS  New
  1.  ;Check Mailbox    AC VC PM  Sign on   Date  Mail USER Msgs Surrogate
  1.  ;----------------------------------------------------------------------
  1.  ;                  y  y  y xx/xx/xx xx/xx/xx  y   y xxxxxx xxxxxxxxxxxx
  1.  Q
  1. CHECK2(XMI,XMCUTOFF,XMTERM,XMNAME,XMWHY) ;
  1.  N XMREC
  1.  S XMTERM=0
  1.  Q:XMI<1
  1.  S XMREC=$G(^VA(200,XMI,0))
  1.  Q:XMREC=""  ; not in NEW PERSON file
  1.  I $P(XMREC,U,7) D  Q
  1.  . ; DISUSER'd
  1.  . S XMTERM=1
  1.  . S XMNAME=$$NAME^XMXUTIL(XMI)
  1.  . S XMWHY=$$EZBLD^DIALOG(36366) ; DISUSER'd
  1.  I $P(XMREC,U,3)="" D  Q
  1.  . ; no access code
  1.  . N XMTDATE
  1.  . S XMTDATE=$P(XMREC,U,11)
  1.  . Q:XMTDATE=""  ; not terminated
  1.  . Q:XMTDATE'<XMCUTOFF  ; terminated after cutoff date
  1.  . Q:$P(XMREC,U,5)'="n"  ; Terminated w/o mail retention
  1.  . S XMTERM=1
  1.  . S XMNAME=$$NAME^XMXUTIL(XMI)
  1.  . S XMWHY=$$EZBLD^DIALOG(36367) ; No AC, terminated w/mail retention
  1.  ; User has access code
  1.  Q:$P($G(^VA(200,XMI,201)),U,1)=""  ; no primary menu
  1.  Q:$P($G(^VA(200,XMI,.1)),U,2)=""   ; no verify code
  1.  ; User has verify code and primary menu
  1.  N XMLASTON  ; latest of last sign on / mailman use
  1.  S XMLASTON=$$MAX^XLFMTH(+$P($G(^VA(200,XMI,1.1)),U),+$P($G(^XMB(3.7,XMI,"L")),U,2))
  1.  I XMLASTON<XMCUTOFF D  Q
  1.  . S XMNAME=$$NAME^XMXUTIL(XMI)
  1.  . I XMLASTON="" D  Q
  1.  . . N XMADDED
  1.  . . S XMADDED=$P($G(^VA(200,XMI,1)),U,7)
  1.  . . Q:XMADDED'<XMCUTOFF
  1.  . . S XMTERM=1
  1.  . . S XMWHY=$$EZBLD^DIALOG(36368,$$FMTE^XLFDT(XMADDED,"2DF")) ; AC, VC, & PM, no logon, added |1|
  1.  . S XMTERM=1
  1.  . S XMWHY=$$EZBLD^DIALOG(36369,$$FMTE^XLFDT(XMLASTON,"2DF")) ; AC, VC, & PM, last logon |1|
  1.  Q
  1.  ; The following entry is called from a Kernel routine.
  1. TERMINAT(XMDUZ) ; Remove user from MailMan
  1.  D GROUP^XMUTERM2(XMDUZ)
  1.  D SURROGAT^XMUTERM2(XMDUZ)
  1.  D MAILBOX^XMUTERM2(XMDUZ)
  1.  D LATERNEW^XMUTERM2(XMDUZ)
  1.  D LATERSND^XMUTERM2(XMDUZ)
  1.  Q