| [613] | 1 | XUSTERM ;SEA/AMF/WDE - DEACTIVATE USER ; [6/22/05 12:30pm]
|
|---|
| 2 | ;;8.0;KERNEL;**36,73,135,148,169,222,313,384**;Jul 10, 1995;Build 8
|
|---|
| 3 | LKUP N DIRUT,DIC,DIR,XUDA,DA
|
|---|
| 4 | S DIC=200,DIC("S")="I $L($P(^(0),U,3))",DIC(0)="AEQMZ",DIC("A")="Select USER to be deactivated: "
|
|---|
| 5 | D ^DIC K DIC G END:Y<0 S XUDA=+Y
|
|---|
| 6 | D INQ Q:$D(DIRUT)
|
|---|
| 7 | S DA=XUDA,DIE=200,DR="["_$$GET^XUPARAM("XUSERDEACT","N")_"]" D GET,XUDIE^XUS5
|
|---|
| 8 | S XUDT=$P(^VA(200,DA,0),U,11),XUACT=XUDT&(XUDT>DT) G END:'XUDT
|
|---|
| 9 | G:XUACT WHEN G NOW
|
|---|
| 10 | ;
|
|---|
| 11 | WHEN W !!,XUNAM," will be deactivated on date specified."
|
|---|
| 12 | S ZTDTH=XUDT,ZTRTN="DQ1^XUSTERM1",ZTDESC="DEACTIVATE USER",ZTSAVE("XUDA")="",ZTIO="" D ^%ZTLOAD
|
|---|
| 13 | G END
|
|---|
| 14 | ;
|
|---|
| 15 | NOW S DIR("A")=XUNAM_" will be deactivated now. Do you wish to proceed",DIR("B")="YES",DIR("??")="XUUSER-DEACT",DIR(0)="Y"
|
|---|
| 16 | D ^DIR I "Yy"'[$E(X_U) S XUDT=$$NOW^XLFDT G WHEN
|
|---|
| 17 | W ! S XUVE=1 D ACT
|
|---|
| 18 | G END
|
|---|
| 19 | ;
|
|---|
| 20 | INQ ;Ask to show User Inquiry
|
|---|
| 21 | N DIR,DIC,FLDS,BY,FR,TO,Y,L
|
|---|
| 22 | S DIR(0)="Y",DIR("A")="View/Print User Inquiry Data",DIR("B")="Yes" D ^DIR Q:$D(DIRUT)!('Y)
|
|---|
| 23 | S L=0,DIC=200,FLDS="[XUSERINQ]",BY="NUMBER",(TO,FR)=XUDA D EN1^DIP K DIC
|
|---|
| 24 | K DIR S DIR(0)="E" D ^DIR
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | GET ;XUGRP=mail group, XUKEY=keys, XUSUR=mail surrogates, XUJ=# baskets, XUK=# mail msg, XUIN=# in-basket msg
|
|---|
| 28 | ;XUTX1, XUTX2 used in edit templates
|
|---|
| 29 | K XUGRP,XUKEY,XUSUR,XUTX1,XUTX2 N %,XU10,XU11,XU20,XU21,XU30,XU31
|
|---|
| 30 | S (XU10,XU20)=0,(XU11,XU21,XU31)=""
|
|---|
| 31 | S DA=XUDA,XUNAM=$P(^VA(200,XUDA,0),U,1)
|
|---|
| 32 | F XUI=0:0 S XUI=$O(^XMB(3.8,"AB",XUDA,XUI)) Q:XUI'>0 D ;Mail groups
|
|---|
| 33 | . S XUK=^XMB(3.8,XUI,0) S:'$L($P(XUK,U,2)) $P(XUK,U,2)="PU"
|
|---|
| 34 | . S XUGRP(XUI)=$P(XUK,U,1,2)_U_$S('$D(^XMB(3.8,XUI,3)):0,1:^(3)=XUDA)
|
|---|
| 35 | . S XU10=XU10+1 S:$L(XU11)<70 XU11=XU11_","_$P(XUK,U)
|
|---|
| 36 | F XUI=0:0 S XUI=$O(^VA(200,XUDA,51,XUI)) Q:XUI'>0 D ;Get keys
|
|---|
| 37 | . S %=$G(^DIC(19.1,XUI,0)),XU20=XU20+1
|
|---|
| 38 | . S:$L(XU21)<70 XU21=XU21_","_$P(%,U)
|
|---|
| 39 | . Q:$P(%,U,4)="y" ;Don't count keep at terminate keys
|
|---|
| 40 | . S XUKEY(XUI)=""
|
|---|
| 41 | F XUI=0:0 S XUI=$O(^XMB(3.7,"AB",XUDA,XUI)) Q:XUI'>0 D
|
|---|
| 42 | . S XUSUR(XUI)="" S:$L(XU31)<70 XU31=XU31_","_$P(^VA(200,XUI,0),U)
|
|---|
| 43 | S (XUJ,XUK,XUIN,XUNUM)=0
|
|---|
| 44 | F I=.9:0 S I=$O(^XMB(3.7,XUDA,2,I)) Q:I'>0 D
|
|---|
| 45 | . S XUJ=XUJ+1,XUNUM=$P($G(^XMB(3.7,XUDA,2,I,1,0)),U,4)
|
|---|
| 46 | . S:XUNUM>0 XUK=XUK+XUNUM S:I=1 XUIN=XUNUM
|
|---|
| 47 | . Q
|
|---|
| 48 | S XUTX1(1)="User has "_XUK_" messages in "_XUJ_" baskets, Member of "_XU10_" Mail Groups."
|
|---|
| 49 | S:XU10 XUTX1(2)="Mail Groups: "_$E(XU11,2,80) S:$L(XU31) XUTX1(3)="Surrogate for: "_$E(XU31,2,80)
|
|---|
| 50 | S XUTX2(1)="User has "_XU20_" keys" S:XU20 XUTX2(2)=$E(XU21,2,80)
|
|---|
| 51 | S XUEMP='($D(XUSUR)!$D(XUKEY)!$D(XUGRP)!XUJ!XUK!XUIN!$L($P(^VA(200,XUDA,0),U,3)))
|
|---|
| 52 | Q
|
|---|
| 53 | ACT ;First let others clean-up, Then do our part.
|
|---|
| 54 | ;D ^XUSTERM2 ;Cleanup by other packages.
|
|---|
| 55 | N DIC,DA,DIE,DR
|
|---|
| 56 | L +^VA(200,XUDA,0):6
|
|---|
| 57 | ;Delete some fields first.
|
|---|
| 58 | ;Access;Verify;PAC;Last signon;SMD delegate;electronic signature,Primary menu,Hinq Employee #
|
|---|
| 59 | S DIE=200,DA=XUDA,DR="2///@;11///@;14///@;1.1///@;19///@;19.2///@;20.4///@;201///@;14.9///@" D ^DIE
|
|---|
| 60 | L -^VA(200,XUDA,0)
|
|---|
| 61 | D DEQUE^XUSERP(XUDA,3) ;Cleanup by other packages.
|
|---|
| 62 | ;
|
|---|
| 63 | K DIC S DA=XUDA,XUJ=^VA(200,XUDA,0),XUNAM=$P(XUJ,U,1),XUACT(19)=$S($D(^VA(200,XUDA,19)):^(19),1:"") F XUI=5,6,10 S XUACT(XUI)=$P(XUJ,U,XUI)
|
|---|
| 64 | ACT1 K ^DISV(XUDA) ; WARNING: This only gets ^DISV entries on current CPU
|
|---|
| 65 | ;keys
|
|---|
| 66 | I XUACT(6)="y" F XUI=0:0 S XUI=$O(^VA(200,XUDA,51,XUI)) Q:XUI'>0 I $P($G(^DIC(19.1,XUI,0)),U,4)'="y" S DA=XUI,DA(1)=XUDA,DIK="^VA(200,XUDA,51," D ^DIK W:XUVE "..."
|
|---|
| 67 | ;delegated keys
|
|---|
| 68 | I XUACT(6)="y" F XUI=0:0 S XUI=$O(^VA(200,XUDA,52,XUI)) Q:XUI'>0 S DA=XUI,DA(1)=XUDA,DIK="^VA(200,XUDA,52," D ^DIK W:XUVE "..."
|
|---|
| 69 | ;Delegated options
|
|---|
| 70 | S DIK="^VA(200,XUDA,19.5,",DA(1)=XUDA F XUI=0:0 S XUI=$O(^VA(200,XUDA,19.5,XUI)) Q:XUI'>0 S DA=XUI D ^DIK
|
|---|
| 71 | ;Menu templates
|
|---|
| 72 | S DIK="^VA(200,XUDA,19.8,",DA(1)=XUDA F XUI=0:0 S XUI=$O(^VA(200,XUDA,19.8,XUI)) Q:XUI'>0 S DA=XUI D ^DIK
|
|---|
| 73 | ;Secondary Menus
|
|---|
| 74 | S DIK="^VA(200,XUDA,203,",DA(1)=XUDA F XUI=0:0 S XUI=$O(^VA(200,XUDA,203,XUI)) Q:XUI'>0 S DA=XUI D ^DIK
|
|---|
| 75 | S DA=0,DA(1)=XUDA D D2^XUFILE1 ;Remove all access to files.
|
|---|
| 76 | ;Terminate Person Class
|
|---|
| 77 | D TERM^XUA4A72(XUDA,XUDT)
|
|---|
| 78 | ;Remove all parameters for the user.
|
|---|
| 79 | D DELUSR^XPAR3(XUDA)
|
|---|
| 80 | ;
|
|---|
| 81 | ACT2 ;XUACT(5) All Mail access, Mail groups
|
|---|
| 82 | D MAIL
|
|---|
| 83 | D SEND^XUSTERM1
|
|---|
| 84 | W:XUVE "... DONE"
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | END K C,D,D0,DI,DR,DIC,DIE,DA,DIR,XUEMP,XUDA,XUI,XUJ,XUK,XUACT,XUKEY,XUGRP,XUSUR,XUNAM,XUF,XUDT,XUIN,DIC,XUDB,XUDC,XUDP,XUGP,XUNUM,XUVE,Y
|
|---|
| 88 | K XUTX1,XUTX2,DIRUT,DIR
|
|---|
| 89 | Q
|
|---|
| 90 | MAIL ;Remove mail access
|
|---|
| 91 | I XUACT(5)="y" D TERMINAT^XMUTERM1(XUDA)
|
|---|
| 92 | Q
|
|---|
