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 Dec 13, 2024@02:13:48 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
