- XMUTERM2 ;ISC-SF/GMB-Delete Mailbox (cont.) ;04/17/2002 12:09
- ;;8.0;MailMan;;Jun 28, 2002
- ;
- ; The following are called from CHOOSE^XMUTERM
- ;
- MMCHOOSE(XMGRACE,XMCUTOFF) ;
- N XMI,XMABORT,XMTERM
- S (XMI,XMABORT)=0
- F S XMI=$O(^XMB(3.7,XMI)) Q:XMI'>0 D Q:XMABORT
- . D CHECK1^XMUTERM1(XMI,XMGRACE,XMCUTOFF,.XMTERM) I XMTERM D DELETE(XMI,.XMABORT) Q
- . D CHECK2^XMUTERM1(XMI,XMCUTOFF,.XMTERM) I XMTERM D DELETE(XMI,.XMABORT)
- Q
- ICHOOSE(XMGRACE,XMCUTOFF) ;
- F D Q:XMABORT
- . N DIC,Y
- . S DIC="^XMB(3.7,"
- . S DIC(0)="AEQM"
- . S DIC("S")="N XMTERM,XMFORGET D CHECK1^XMUTERM1(Y,XMGRACE,XMCUTOFF,.XMTERM),CHECK2^XMUTERM1(Y,XMCUTOFF,.XMFORGET) I XMTERM!XMFORGET"
- . W ! D ^DIC I Y=-1 S XMABORT=1 Q
- . D DELETE(+Y)
- Q
- DELETE(XMI,XMABORT) ;
- N XMREC1,XMREC2,XMDELETE
- S XMREC1=$G(^VA(200,XMI,0))
- I XMREC1'="" D Q:'XMDELETE
- . N DIR,Y
- . W !!,$$NAME^XMXUTIL(XMI)
- . W !,$$EZBLD^DIALOG(36336),$$EZBLD^DIALOG($S($P(XMREC1,U,3)="":36334,1:36335)) ; Access Code: NONE / <Hidden>
- . W ?25,$$EZBLD^DIALOG(36337),$$EZBLD^DIALOG($S($P($G(^VA(200,XMI,.1)),U,2)="":36334,1:36335)) ; Verify Code: NONE / <hidden>
- . W ?50,$$EZBLD^DIALOG(36338),$S($P($G(^VA(200,XMI,201)),U,1)="":$$EZBLD^DIALOG(36334),1:$P($G(^DIC(19,$P(^(201),U),0)),U)) ; Primary Menu: NONE / ...
- . W !,$$EZBLD^DIALOG(36339),$S($P($G(^VA(200,XMI,1)),U,7)="":$$EZBLD^DIALOG(36334),1:$$FMTE^XLFDT($P(^(1),U,7),"2D")) ; Date Entered: NONE / date
- . W ?25,$$EZBLD^DIALOG(36340),$S($P($G(^VA(200,XMI,1.1)),U,1)="":$$EZBLD^DIALOG(36334),1:$$FMTE^XLFDT($P(^(1.1),U,1),"2D")) ; Last Logon: NONE / date
- . W ?50,"DISUSER: ",$$EZBLD^DIALOG($S($P(XMREC1,U,7):39054,1:39053)) ; YES / NO
- . W !,$$EZBLD^DIALOG(36341),$S($P(XMREC1,U,11)="":$$EZBLD^DIALOG(36334),1:$$FMTE^XLFDT($P(XMREC1,U,11),"2D")) ; Term Date: NONE / date
- . W:$P(XMREC1,U,11) ?25,$$EZBLD^DIALOG(36342),$$EZBLD^DIALOG($S($P(XMREC1,U,5)="y":39054,1:39053)) ; Delete Mail: YES / NO
- . S XMREC2=^XMB(3.7,XMI,0)
- . W ?50,$$EZBLD^DIALOG(36343),$P(XMREC2,U,6) ; New Messages:
- . W !,$$EZBLD^DIALOG(38012),$S($P($G(^XMB(3.7,XMI,"L")),U)="":$$EZBLD^DIALOG(38002),1:$P(^("L"),U)) ; last used mailman: Never / date
- . W !,$$EZBLD^DIALOG(38004) ; Forwarding Address:
- . I $P(XMREC2,U,2)="" D
- . . W $$EZBLD^DIALOG(36334) ; NONE
- . E D
- . . W $P(XMREC2,U,2),$$EZBLD^DIALOG($S($P(XMREC2,U,8):38005,1:38006)) ; fwding addr, local deliver on/off
- . W !
- . S DIR(0)="Y"
- . S DIR("B")=$$EZBLD^DIALOG(39053) ; NO
- . S DIR("A")=$$EZBLD^DIALOG(36344) ; Delete this user's mailbox
- . D ^DIR I $D(DIRUT) S XMDELETE=0,XMABORT=1 Q
- . I 'Y S XMDELETE=0 Q
- . S XMDELETE=1
- N XMPARM
- S XMPARM(1)=XMI,XMPARM(2)=$S(XMREC1="":$$EZBLD^DIALOG(36346),1:$P(XMREC1,U)) ; * not in NEW PERSON file *
- W !,$$EZBLD^DIALOG(36345,.XMPARM) ; Deleting mailbox for user |1| |2|
- D TERMINAT^XMUTERM1(XMI)
- Q
- ;
- ; The following are called from TERMINAT^XMUTERM1
- ;
- GROUP(XMDUZ) ; Remove user from mail groups
- N XMI,XMJ,DIK,DA
- ; Remove user as member from all mail groups
- S XMI=0
- F S XMI=$O(^XMB(3.8,"AB",XMDUZ,XMI)) Q:XMI'>0 D
- . S DA(1)=XMI,DIK="^XMB(3.8,XMI,1,",XMJ=0
- . F S XMJ=$O(^XMB(3.8,"AB",XMDUZ,XMI,XMJ)) Q:XMJ'>0 S DA=XMJ D ^DIK
- K ^XMB(3.8,"AB",XMDUZ)
- ; Remove user as coordinator from all mail groups
- S XMI=0
- F S XMI=$O(^XMB(3.8,"AC",XMDUZ,XMI)) Q:XMI'>0 D
- . S XMFDA(3.8,XMI_",",5.1)=.5 ; (change coord to postmaster)
- . D FILE^DIE("","XMFDA")
- K ^XMB(3.8,"AC",XMDUZ)
- ; Remove user's personal mail groups, and
- ; remove user as organizer or authorized sender from all mail groups.
- S XMI=0
- F S XMI=$O(^XMB(3.8,XMI)) Q:XMI'>0 D
- . I +$G(^XMB(3.8,XMI,3))=XMDUZ D ; user is organizer
- . . I $P(^XMB(3.8,XMI,0),U,6)=1 S DA=XMI,DIK="^XMB(3.8," D ^DIK Q ; delete personal group
- . . S XMFDA(3.8,XMI_",",5)=.5 ; (change organizer to postmaster)
- . . D FILE^DIE("","XMFDA")
- . ; Remove user as authorized sender from all mail groups
- . Q:'$D(^XMB(3.8,XMI,4,"B",XMDUZ))
- . S DA=$O(^XMB(3.8,XMI,4,"B",XMDUZ,0))
- . I '$D(^XMB(3.8,XMI,4,DA,0)) K ^XMB(3.8,XMI,4,"B",XMDUZ) Q
- . S DA(1)=XMI,DIK="^XMB(3.8,XMI,4," D ^DIK
- Q
- SURROGAT(XMDUZ) ; Remove as mail surrogate
- N XMI,DA,DIK
- S XMI=0,DIK="^XMB(3.7,XMI,9,"
- F S XMI=$O(^XMB(3.7,"AB",XMDUZ,XMI)) Q:XMI'>0 D
- . S DA=$O(^XMB(3.7,"AB",XMDUZ,XMI,0))
- . I '$D(^XMB(3.7,XMI,9,DA,0)) K ^XMB(3.7,"AB",XMDUZ,XMI) Q
- . S DA(1)=XMI D ^DIK
- K ^XMB(3.7,"AB",XMDUZ)
- Q
- MAILBOX(XMDUZ) ; Remove user's mailbox
- Q:'$D(^XMB(3.7,XMDUZ))
- N DIK,DA
- S DIK="^XMB(3.7,",DA=XMDUZ D ^DIK
- K:$D(^XMB(3.7,XMDUZ)) ^XMB(3.7,XMDUZ) ; just in case!
- K:$D(^XMB(3.7,"B",XMDUZ)) ^XMB(3.7,"B",XMDUZ)
- Q
- LATERNEW(XMDUZ) ; Remove the scheduling of any messages slated to become new for this user
- N DIK,DA
- S DIK="^XMB(3.73,"
- S DA=""
- F S DA=$O(^XMB(3.73,"C",XMDUZ,DA)) Q:'DA D ^DIK
- Q
- LATERSND(XMDUZ) ; Remove the scheduling of any messages slated to be sent by this user.
- N XMZ,DIK,DA
- S XMZ=0
- F S XMZ=$O(^XMB(3.9,"AW",XMDUZ,XMZ)) Q:'XMZ D
- . S DA(1)=XMZ
- . S DIK="^XMB(3.9,"_DA(1)_",7,"
- . S DA=0
- . F S DA=$O(^XMB(3.9,"AW",XMDUZ,XMZ,DA)) Q:'DA D ^DIK
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMUTERM2 5087 printed Feb 18, 2025@23:39:58 Page 2
- XMUTERM2 ;ISC-SF/GMB-Delete Mailbox (cont.) ;04/17/2002 12:09
- +1 ;;8.0;MailMan;;Jun 28, 2002
- +2 ;
- +3 ; The following are called from CHOOSE^XMUTERM
- +4 ;
- MMCHOOSE(XMGRACE,XMCUTOFF) ;
- +1 NEW XMI,XMABORT,XMTERM
- +2 SET (XMI,XMABORT)=0
- +3 FOR
- SET XMI=$ORDER(^XMB(3.7,XMI))
- if XMI'>0
- QUIT
- Begin DoDot:1
- +4 DO CHECK1^XMUTERM1(XMI,XMGRACE,XMCUTOFF,.XMTERM)
- IF XMTERM
- DO DELETE(XMI,.XMABORT)
- QUIT
- +5 DO CHECK2^XMUTERM1(XMI,XMCUTOFF,.XMTERM)
- IF XMTERM
- DO DELETE(XMI,.XMABORT)
- End DoDot:1
- if XMABORT
- QUIT
- +6 QUIT
- ICHOOSE(XMGRACE,XMCUTOFF) ;
- +1 FOR
- Begin DoDot:1
- +2 NEW DIC,Y
- +3 SET DIC="^XMB(3.7,"
- +4 SET DIC(0)="AEQM"
- +5 SET DIC("S")="N XMTERM,XMFORGET D CHECK1^XMUTERM1(Y,XMGRACE,XMCUTOFF,.XMTERM),CHECK2^XMUTERM1(Y,XMCUTOFF,.XMFORGET) I XMTERM!XMFORGET"
- +6 WRITE !
- DO ^DIC
- IF Y=-1
- SET XMABORT=1
- QUIT
- +7 DO DELETE(+Y)
- End DoDot:1
- if XMABORT
- QUIT
- +8 QUIT
- DELETE(XMI,XMABORT) ;
- +1 NEW XMREC1,XMREC2,XMDELETE
- +2 SET XMREC1=$GET(^VA(200,XMI,0))
- +3 IF XMREC1'=""
- Begin DoDot:1
- +4 NEW DIR,Y
- +5 WRITE !!,$$NAME^XMXUTIL(XMI)
- +6 ; Access Code: NONE / <Hidden>
- WRITE !,$$EZBLD^DIALOG(36336),$$EZBLD^DIALOG($SELECT($PIECE(XMREC1,U,3)="":36334,1:36335))
- +7 ; Verify Code: NONE / <hidden>
- WRITE ?25,$$EZBLD^DIALOG(36337),$$EZBLD^DIALOG($SELECT($PIECE($GET(^VA(200,XMI,.1)),U,2)="":36334,1:36335))
- +8 ; Primary Menu: NONE / ...
- WRITE ?50,$$EZBLD^DIALOG(36338),$SELECT($PIECE($GET(^VA(200,XMI,201)),U,1)="":$$EZBLD^DIALOG(36334),1:$PIECE($GET(^DIC(19,$PIECE(^(201),U),0)),U))
- +9 ; Date Entered: NONE / date
- WRITE !,$$EZBLD^DIALOG(36339),$SELECT($PIECE($GET(^VA(200,XMI,1)),U,7)="":$$EZBLD^DIALOG(36334),1:$$FMTE^XLFDT($PIECE(^(1),U,7),"2D"))
- +10 ; Last Logon: NONE / date
- WRITE ?25,$$EZBLD^DIALOG(36340),$SELECT($PIECE($GET(^VA(200,XMI,1.1)),U,1)="":$$EZBLD^DIALOG(36334),1:$$FMTE^XLFDT($PIECE(^(1.1),U,1),"2D"))
- +11 ; YES / NO
- WRITE ?50,"DISUSER: ",$$EZBLD^DIALOG($SELECT($PIECE(XMREC1,U,7):39054,1:39053))
- +12 ; Term Date: NONE / date
- WRITE !,$$EZBLD^DIALOG(36341),$SELECT($PIECE(XMREC1,U,11)="":$$EZBLD^DIALOG(36334),1:$$FMTE^XLFDT($PIECE(XMREC1,U,11),"2D"))
- +13 ; Delete Mail: YES / NO
- if $PIECE(XMREC1,U,11)
- WRITE ?25,$$EZBLD^DIALOG(36342),$$EZBLD^DIALOG($SELECT($PIECE(XMREC1,U,5)="y":39054,1:39053))
- +14 SET XMREC2=^XMB(3.7,XMI,0)
- +15 ; New Messages:
- WRITE ?50,$$EZBLD^DIALOG(36343),$PIECE(XMREC2,U,6)
- +16 ; last used mailman: Never / date
- WRITE !,$$EZBLD^DIALOG(38012),$SELECT($PIECE($GET(^XMB(3.7,XMI,"L")),U)="":$$EZBLD^DIALOG(38002),1:$PIECE(^("L"),U))
- +17 ; Forwarding Address:
- WRITE !,$$EZBLD^DIALOG(38004)
- +18 IF $PIECE(XMREC2,U,2)=""
- Begin DoDot:2
- +19 ; NONE
- WRITE $$EZBLD^DIALOG(36334)
- End DoDot:2
- +20 IF '$TEST
- Begin DoDot:2
- +21 ; fwding addr, local deliver on/off
- WRITE $PIECE(XMREC2,U,2),$$EZBLD^DIALOG($SELECT($PIECE(XMREC2,U,8):38005,1:38006))
- End DoDot:2
- +22 WRITE !
- +23 SET DIR(0)="Y"
- +24 ; NO
- SET DIR("B")=$$EZBLD^DIALOG(39053)
- +25 ; Delete this user's mailbox
- SET DIR("A")=$$EZBLD^DIALOG(36344)
- +26 DO ^DIR
- IF $DATA(DIRUT)
- SET XMDELETE=0
- SET XMABORT=1
- QUIT
- +27 IF 'Y
- SET XMDELETE=0
- QUIT
- +28 SET XMDELETE=1
- End DoDot:1
- if 'XMDELETE
- QUIT
- +29 NEW XMPARM
- +30 ; * not in NEW PERSON file *
- SET XMPARM(1)=XMI
- SET XMPARM(2)=$SELECT(XMREC1="":$$EZBLD^DIALOG(36346),1:$PIECE(XMREC1,U))
- +31 ; Deleting mailbox for user |1| |2|
- WRITE !,$$EZBLD^DIALOG(36345,.XMPARM)
- +32 DO TERMINAT^XMUTERM1(XMI)
- +33 QUIT
- +34 ;
- +35 ; The following are called from TERMINAT^XMUTERM1
- +36 ;
- GROUP(XMDUZ) ; Remove user from mail groups
- +1 NEW XMI,XMJ,DIK,DA
- +2 ; Remove user as member from all mail groups
- +3 SET XMI=0
- +4 FOR
- SET XMI=$ORDER(^XMB(3.8,"AB",XMDUZ,XMI))
- if XMI'>0
- QUIT
- Begin DoDot:1
- +5 SET DA(1)=XMI
- SET DIK="^XMB(3.8,XMI,1,"
- SET XMJ=0
- +6 FOR
- SET XMJ=$ORDER(^XMB(3.8,"AB",XMDUZ,XMI,XMJ))
- if XMJ'>0
- QUIT
- SET DA=XMJ
- DO ^DIK
- End DoDot:1
- +7 KILL ^XMB(3.8,"AB",XMDUZ)
- +8 ; Remove user as coordinator from all mail groups
- +9 SET XMI=0
- +10 FOR
- SET XMI=$ORDER(^XMB(3.8,"AC",XMDUZ,XMI))
- if XMI'>0
- QUIT
- Begin DoDot:1
- +11 ; (change coord to postmaster)
- SET XMFDA(3.8,XMI_",",5.1)=.5
- +12 DO FILE^DIE("","XMFDA")
- End DoDot:1
- +13 KILL ^XMB(3.8,"AC",XMDUZ)
- +14 ; Remove user's personal mail groups, and
- +15 ; remove user as organizer or authorized sender from all mail groups.
- +16 SET XMI=0
- +17 FOR
- SET XMI=$ORDER(^XMB(3.8,XMI))
- if XMI'>0
- QUIT
- Begin DoDot:1
- +18 ; user is organizer
- IF +$GET(^XMB(3.8,XMI,3))=XMDUZ
- Begin DoDot:2
- +19 ; delete personal group
- IF $PIECE(^XMB(3.8,XMI,0),U,6)=1
- SET DA=XMI
- SET DIK="^XMB(3.8,"
- DO ^DIK
- QUIT
- +20 ; (change organizer to postmaster)
- SET XMFDA(3.8,XMI_",",5)=.5
- +21 DO FILE^DIE("","XMFDA")
- End DoDot:2
- +22 ; Remove user as authorized sender from all mail groups
- +23 if '$DATA(^XMB(3.8,XMI,4,"B",XMDUZ))
- QUIT
- +24 SET DA=$ORDER(^XMB(3.8,XMI,4,"B",XMDUZ,0))
- +25 IF '$DATA(^XMB(3.8,XMI,4,DA,0))
- KILL ^XMB(3.8,XMI,4,"B",XMDUZ)
- QUIT
- +26 SET DA(1)=XMI
- SET DIK="^XMB(3.8,XMI,4,"
- DO ^DIK
- End DoDot:1
- +27 QUIT
- SURROGAT(XMDUZ) ; Remove as mail surrogate
- +1 NEW XMI,DA,DIK
- +2 SET XMI=0
- SET DIK="^XMB(3.7,XMI,9,"
- +3 FOR
- SET XMI=$ORDER(^XMB(3.7,"AB",XMDUZ,XMI))
- if XMI'>0
- QUIT
- Begin DoDot:1
- +4 SET DA=$ORDER(^XMB(3.7,"AB",XMDUZ,XMI,0))
- +5 IF '$DATA(^XMB(3.7,XMI,9,DA,0))
- KILL ^XMB(3.7,"AB",XMDUZ,XMI)
- QUIT
- +6 SET DA(1)=XMI
- DO ^DIK
- End DoDot:1
- +7 KILL ^XMB(3.7,"AB",XMDUZ)
- +8 QUIT
- MAILBOX(XMDUZ) ; Remove user's mailbox
- +1 if '$DATA(^XMB(3.7,XMDUZ))
- QUIT
- +2 NEW DIK,DA
- +3 SET DIK="^XMB(3.7,"
- SET DA=XMDUZ
- DO ^DIK
- +4 ; just in case!
- if $DATA(^XMB(3.7,XMDUZ))
- KILL ^XMB(3.7,XMDUZ)
- +5 if $DATA(^XMB(3.7,"B",XMDUZ))
- KILL ^XMB(3.7,"B",XMDUZ)
- +6 QUIT
- LATERNEW(XMDUZ) ; Remove the scheduling of any messages slated to become new for this user
- +1 NEW DIK,DA
- +2 SET DIK="^XMB(3.73,"
- +3 SET DA=""
- +4 FOR
- SET DA=$ORDER(^XMB(3.73,"C",XMDUZ,DA))
- if 'DA
- QUIT
- DO ^DIK
- +5 QUIT
- LATERSND(XMDUZ) ; Remove the scheduling of any messages slated to be sent by this user.
- +1 NEW XMZ,DIK,DA
- +2 SET XMZ=0
- +3 FOR
- SET XMZ=$ORDER(^XMB(3.9,"AW",XMDUZ,XMZ))
- if 'XMZ
- QUIT
- Begin DoDot:1
- +4 SET DA(1)=XMZ
- +5 SET DIK="^XMB(3.9,"_DA(1)_",7,"
- +6 SET DA=0
- +7 FOR
- SET DA=$ORDER(^XMB(3.9,"AW",XMDUZ,XMZ,DA))
- if 'DA
- QUIT
- DO ^DIK
- End DoDot:1
- +8 QUIT