XUSTERM1 ;SEA/WDE - DEACTIVATE USER ;06/08/09 15:06
;;8.0;KERNEL;**102,180,208,222,274,313,332,360,384,436,514**;Jul 10, 1995;Build 14
ENALL ;Interactive scan all
S U="^",DTIME=$G(DTIME,60)
W !!,"This option can purge all access & verify codes, mail baskets, messages,",!,"authorized senders access, keys, and electronic signature codes of users who have been terminated."
RD1 W !!,"Do you wish to proceed "
S %=2 D YN^DICN G:%=2!(%=-1) END I %=0 S XQH="XUUSER-PURGEATT" D EN^XQH G RD1
RD2 W !,"Do you wish to verify each user "
S %=2,XUVE=0 D YN^DICN S:%=1 XUVE=1 G:%=1 CHECK G:%=-1 END I %=0 S XQH="XUUSER-PURGEATT-VER" D EN^XQH G RD2
QUE W !,"Do you wish to have this queued for a later time "
S %=1 D YN^DICN I %=1 D Q
. S ZTDESC="USER DEACTIVATION",ZTRTN="CHECK^XUSTERM1",ZTIO="",ZTSAVE("DUZ*")=""
. D ^%ZTLOAD
. Q
I %=0 K X,XUVE Q
;Fall thru if user doesn't queue
CHECK ;Entry point for taskman.
N XUDT540,XUDT90,XUDT30,FDA,XUDT,XUAAW
S U="^",DT=$$DT^XLFDT(),XUDT90=$$HTFM^XLFDT($H-90,1),XUDT30=$$HTFM^XLFDT($H-30,1)
S XUAAW=+$P($G(^XTV(8989.3,1,3)),U,4) ;Academic Waiver
S XUDT540=$$HTFM^XLFDT($H-540,1) ;*p332
S XUDA=.6,XUVE=$G(XUVE,0)
F S XUDA=$O(^VA(200,XUDA)) Q:XUDA'>0 S XUJ=$G(^(XUDA,0)) D
. S XUDT=$P(XUJ,U,11)
. I $P(XUJ,U,3)]"",$L(XUDT),(XUDT'>DT) D
. . D GET
. . I 'XUEMP K Y D:XUVE DISP Q:$D(Y) D ACT ;XUEMP=any data to remove
. . Q
. I $P(XUJ,U,3)]"",'$P(XUJ,U,8),$$NOSIGNON D DISUSER(XUDA)
. I $P(XUJ,U,7) D AUSER(XUDA) ;*p332
. Q
;
END K XUEMP,XUDA,XUI,XUJ,XUK,XUACT,XUKEY,XUGRP,XUSUR,XUNAM,XUF,XUDT,XUIN,XUVE,X,DIC,XUDB,XUDC,XUDP
Q
;
DISUSER(XUDA) ;Set DISUSER flag and reason, Remove last menu option
Q:$P(XUJ,U,7) ;DISUSER already set *p332
N %,FDA S %=XUDA_","
S FDA(200,%,7)=1,FDA(200,%,9.4)="User Inactive for too long"
D FILE^DIE("","FDA"),CONTCL(XUDA) ;Set Disuser
Q
;
AUSER(XUDA) ;If DISUSERed and Last Sign > 540[18Mo.*30] days, then remove"AUSER" xref
I $D(^XUSEC("XUORES",XUDA)) Q ;Owner of XUORES key ;p*436
N Q S Q=$P($G(^VA(200,XUDA,1.1)),U) ;Get last sign-on
I $L(Q),Q<XUDT540 K ^VA(200,"AUSER",$P(XUJ,U),XUDA) ;*p360;*p384
Q
;
;If site has an Academic Affiliation Waiver the last sign-on moves to 90 days from 30.
NOSIGNON() ;Check last signon. Return 1 if should disable account
N Q S Q=$P($G(^VA(200,XUDA,1.1)),U) ;Get last sign-on
I $L(Q),Q>$S('XUAAW:XUDT30,1:XUDT90) Q 0 ;Last sign-on within 30/90 days VA Handbook 6500 ;p514
S Q=$P($G(^VA(200,XUDA,1.1)),U,4) ;Get last Edit date
I $L(Q),Q>XUDT30 Q 0 ;User edited in last 30 days
S Q=$P($G(^VA(200,XUDA,1)),U,7) ;Create Date
I $L(Q),Q>XUDT30 Q 0 ;User set up in last 30 days
S Q=$P($G(^VA(200,XUDA,.1)),U) ;Get verify code change date
I $L(Q),(Q+30)>$H Q 0 ;Verify code changed in last 30 days
Q 1
;
CONTCL(XUDA) ;Clear the fields for Menu "Continue"
N FDA
S FDA(200,XUDA_",",202.1)="@",FDA(200,XUDA_",",202.2)="@"
D FILE^DIE("","FDA") ;Clear 202.1 and 202.2
Q
;
ACT ;
D ACT^XUSTERM
S XUJ=^VA(200,XUDA,0) ;Get new copy of zero node
Q
;
GET ;Kill ^DISV entries each time, should get all CPUs at some point
N XUJ
D GET^XUSTERM K ^DISV(XUDA),Y
Q
DISP ;Display info and get responses.
N DA,DIE,DR,XUJ
S DA=XUDA
L +^VA(200,DA,0):6 D DISP2 L -^VA(200,DA,0)
Q
DISP2 ;Do the work.
W !!,$S(XUTX1(1)["User":XUNAM_$P(XUTX1(1),"User",2),1:XUTX1(1)) ;*p360
S DR="9.21//YES",DIE=200 D ^DIE Q:$D(Y) G:'$D(XUSUR) KEYS
W !!,XUNAM," acts as surrogate for the following users:"
S XUJ=0,XUI=3 F XUK=0:1 S XUJ=$O(XUSUR(XUJ)) Q:XUJ'>0 W:'(XUK#XUI) ! W ?(XUK#XUI*26),$P(^VA(200,XUJ,0),U,1) W !,"These surrogate privileges will be deleted on deactivation."
KEYS ;This section checks for authorized senders of mail groups and security keys.
W !,"User will no longer be an authorized sender to any mail groups."
I '$D(XUKEY) W !!,XUNAM," currently holds no keys." G KEYS1
W !!,XUNAM," holds the following keys: "
S XUJ=0,XUI=5 F XUK=0:1 S XUJ=$O(XUKEY(XUJ)) Q:XUJ'>0 W:'(XUK#XUI) ! W ?(XUK#XUI*15),$P($G(^DIC(19.1,XUJ,0)),U,1)
KEYS1 W ! S DR="9.22//YES" D ^DIE Q:$D(Y)
GROUP I '$D(XUGRP) W !!,XUNAM," currently is not a member of any MAIL GROUP." G GROUP1
W !!,XUNAM," is a member of the following Mail Groups:"
S XUI="" F XUI=0:0 S XUI=$O(XUGRP(XUI)) Q:XUI'>0 D
. S XUJ=XUGRP(XUI)
. I $P(XUJ,U,2)="PU"!$D(^XMB(3.8,"AB",XUDA,XUI)) W !?2,$P(XUJ,U,1) W:$P(XUJ,U,3) " (Organizer)" W ?40,$S(($P(XUJ,U,2)="PR"):"(Private)",1:"(Public)")
. Q
GROUP1 W ! S DR="9.23//YES" D ^DIE Q:$D(Y)
Q
;
DQ1 ;Terminate one person.
N XUJ,XUDT,XUVE
S XUJ=$G(^VA(200,XUDA,0)),XUDT=$P(XUJ,U,11) I XUDT,(XUDT'>DT) D
. S XUVE=0 D GET I 'XUEMP D ACT
. Q
Q
;
SEND ; send deactivated message to assigned mail group
K XMB,XMY
S XMB(1)=$P(XUJ,"^",1)
S XMB(2)=$$GET1^DIQ(200,XUDA,8)
S XMB(3)=$$GET1^DIQ(200,XUDA,29)
S XMB(4)=$$FMTE^XLFDT(XUDT)
S XMB="XUSERDEAC" D ^XMB:$D(^XMB(3.6,"B",XMB))
K XMB
Q
XUSTERM1 ;SEA/WDE - DEACTIVATE USER ;06/08/09 15:06
+1 ;;8.0;KERNEL;**102,180,208,222,274,313,332,360,384,436,514**;Jul 10, 1995;Build 14
ENALL ;Interactive scan all
+1 SET U="^"
SET DTIME=$GET(DTIME,60)
+2 WRITE !!,"This option can purge all access & verify codes, mail baskets, messages,",!,"authorized senders access, keys, and electronic signature codes of users who have been terminated."
RD1 WRITE !!,"Do you wish to proceed "
+1 SET %=2
DO YN^DICN
IF %=2!(%=-1)
GOTO END
IF %=0
SET XQH="XUUSER-PURGEATT"
DO EN^XQH
GOTO RD1
RD2 WRITE !,"Do you wish to verify each user "
+1 SET %=2
SET XUVE=0
DO YN^DICN
IF %=1
SET XUVE=1
IF %=1
GOTO CHECK
IF %=-1
GOTO END
IF %=0
SET XQH="XUUSER-PURGEATT-VER"
DO EN^XQH
GOTO RD2
QUE WRITE !,"Do you wish to have this queued for a later time "
+1 SET %=1
DO YN^DICN
IF %=1
Begin DoDot:1
+2 SET ZTDESC="USER DEACTIVATION"
SET ZTRTN="CHECK^XUSTERM1"
SET ZTIO=""
SET ZTSAVE("DUZ*")=""
+3 DO ^%ZTLOAD
+4 QUIT
End DoDot:1
QUIT
+5 IF %=0
KILL X,XUVE
QUIT
+6 ;Fall thru if user doesn't queue
CHECK ;Entry point for taskman.
+1 NEW XUDT540,XUDT90,XUDT30,FDA,XUDT,XUAAW
+2 SET U="^"
SET DT=$$DT^XLFDT()
SET XUDT90=$$HTFM^XLFDT($HOROLOG-90,1)
SET XUDT30=$$HTFM^XLFDT($HOROLOG-30,1)
+3 ;Academic Waiver
SET XUAAW=+$PIECE($GET(^XTV(8989.3,1,3)),U,4)
+4 ;*p332
SET XUDT540=$$HTFM^XLFDT($HOROLOG-540,1)
+5 SET XUDA=.6
SET XUVE=$GET(XUVE,0)
+6 FOR
SET XUDA=$ORDER(^VA(200,XUDA))
IF XUDA'>0
QUIT
SET XUJ=$GET(^(XUDA,0))
Begin DoDot:1
+7 SET XUDT=$PIECE(XUJ,U,11)
+8 IF $PIECE(XUJ,U,3)]""
IF $LENGTH(XUDT)
IF (XUDT'>DT)
Begin DoDot:2
+9 DO GET
+10 ;XUEMP=any data to remove
IF 'XUEMP
KILL Y
IF XUVE
DO DISP
IF $DATA(Y)
QUIT
DO ACT
+11 QUIT
End DoDot:2
+12 IF $PIECE(XUJ,U,3)]""
IF '$PIECE(XUJ,U,8)
IF $$NOSIGNON
DO DISUSER(XUDA)
+13 ;*p332
IF $PIECE(XUJ,U,7)
DO AUSER(XUDA)
+14 QUIT
End DoDot:1
+15 ;
END KILL XUEMP,XUDA,XUI,XUJ,XUK,XUACT,XUKEY,XUGRP,XUSUR,XUNAM,XUF,XUDT,XUIN,XUVE,X,DIC,XUDB,XUDC,XUDP
+1 QUIT
+2 ;
DISUSER(XUDA) ;Set DISUSER flag and reason, Remove last menu option
+1 ;DISUSER already set *p332
IF $PIECE(XUJ,U,7)
QUIT
+2 NEW %,FDA
SET %=XUDA_","
+3 SET FDA(200,%,7)=1
SET FDA(200,%,9.4)="User Inactive for too long"
+4 ;Set Disuser
DO FILE^DIE("","FDA")
DO CONTCL(XUDA)
+5 QUIT
+6 ;
AUSER(XUDA) ;If DISUSERed and Last Sign > 540[18Mo.*30] days, then remove"AUSER" xref
+1 ;Owner of XUORES key ;p*436
IF $DATA(^XUSEC("XUORES",XUDA))
QUIT
+2 ;Get last sign-on
NEW Q
SET Q=$PIECE($GET(^VA(200,XUDA,1.1)),U)
+3 ;*p360;*p384
IF $LENGTH(Q)
IF Q<XUDT540
KILL ^VA(200,"AUSER",$PIECE(XUJ,U),XUDA)
+4 QUIT
+5 ;
+6 ;If site has an Academic Affiliation Waiver the last sign-on moves to 90 days from 30.
NOSIGNON() ;Check last signon. Return 1 if should disable account
+1 ;Get last sign-on
NEW Q
SET Q=$PIECE($GET(^VA(200,XUDA,1.1)),U)
+2 ;Last sign-on within 30/90 days VA Handbook 6500 ;p514
IF $LENGTH(Q)
IF Q>$SELECT('XUAAW:XUDT30,1:XUDT90)
QUIT 0
+3 ;Get last Edit date
SET Q=$PIECE($GET(^VA(200,XUDA,1.1)),U,4)
+4 ;User edited in last 30 days
IF $LENGTH(Q)
IF Q>XUDT30
QUIT 0
+5 ;Create Date
SET Q=$PIECE($GET(^VA(200,XUDA,1)),U,7)
+6 ;User set up in last 30 days
IF $LENGTH(Q)
IF Q>XUDT30
QUIT 0
+7 ;Get verify code change date
SET Q=$PIECE($GET(^VA(200,XUDA,.1)),U)
+8 ;Verify code changed in last 30 days
IF $LENGTH(Q)
IF (Q+30)>$HOROLOG
QUIT 0
+9 QUIT 1
+10 ;
CONTCL(XUDA) ;Clear the fields for Menu "Continue"
+1 NEW FDA
+2 SET FDA(200,XUDA_",",202.1)="@"
SET FDA(200,XUDA_",",202.2)="@"
+3 ;Clear 202.1 and 202.2
DO FILE^DIE("","FDA")
+4 QUIT
+5 ;
ACT ;
+1 DO ACT^XUSTERM
+2 ;Get new copy of zero node
SET XUJ=^VA(200,XUDA,0)
+3 QUIT
+4 ;
GET ;Kill ^DISV entries each time, should get all CPUs at some point
+1 NEW XUJ
+2 DO GET^XUSTERM
KILL ^DISV(XUDA),Y
+3 QUIT
DISP ;Display info and get responses.
+1 NEW DA,DIE,DR,XUJ
+2 SET DA=XUDA
+3 LOCK +^VA(200,DA,0):6
DO DISP2
LOCK -^VA(200,DA,0)
+4 QUIT
DISP2 ;Do the work.
+1 ;*p360
WRITE !!,$SELECT(XUTX1(1)["User":XUNAM_$PIECE(XUTX1(1),"User",2),1:XUTX1(1))
+2 SET DR="9.21//YES"
SET DIE=200
DO ^DIE
IF $DATA(Y)
QUIT
IF '$DATA(XUSUR)
GOTO KEYS
+3 WRITE !!,XUNAM," acts as surrogate for the following users:"
+4 SET XUJ=0
SET XUI=3
FOR XUK=0:1
SET XUJ=$ORDER(XUSUR(XUJ))
IF XUJ'>0
QUIT
IF '(XUK#XUI)
WRITE !
WRITE ?(XUK#XUI*26),$PIECE(^VA(200,XUJ,0),U,1)
WRITE !,"These surrogate privileges will be deleted on deactivation."
KEYS ;This section checks for authorized senders of mail groups and security keys.
+1 WRITE !,"User will no longer be an authorized sender to any mail groups."
+2 IF '$DATA(XUKEY)
WRITE !!,XUNAM," currently holds no keys."
GOTO KEYS1
+3 WRITE !!,XUNAM," holds the following keys: "
+4 SET XUJ=0
SET XUI=5
FOR XUK=0:1
SET XUJ=$ORDER(XUKEY(XUJ))
IF XUJ'>0
QUIT
IF '(XUK#XUI)
WRITE !
WRITE ?(XUK#XUI*15),$PIECE($GET(^DIC(19.1,XUJ,0)),U,1)
KEYS1 WRITE !
SET DR="9.22//YES"
DO ^DIE
IF $DATA(Y)
QUIT
GROUP IF '$DATA(XUGRP)
WRITE !!,XUNAM," currently is not a member of any MAIL GROUP."
GOTO GROUP1
+1 WRITE !!,XUNAM," is a member of the following Mail Groups:"
+2 SET XUI=""
FOR XUI=0:0
SET XUI=$ORDER(XUGRP(XUI))
IF XUI'>0
QUIT
Begin DoDot:1
+3 SET XUJ=XUGRP(XUI)
+4 IF $PIECE(XUJ,U,2)="PU"!$DATA(^XMB(3.8,"AB",XUDA,XUI))
WRITE !?2,$PIECE(XUJ,U,1)
IF $PIECE(XUJ,U,3)
WRITE " (Organizer)"
WRITE ?40,$SELECT(($PIECE(XUJ,U,2)="PR"):"(Private)",1:"(Public)")
+5 QUIT
End DoDot:1
GROUP1 WRITE !
SET DR="9.23//YES"
DO ^DIE
IF $DATA(Y)
QUIT
+1 QUIT
+2 ;
DQ1 ;Terminate one person.
+1 NEW XUJ,XUDT,XUVE
+2 SET XUJ=$GET(^VA(200,XUDA,0))
SET XUDT=$PIECE(XUJ,U,11)
IF XUDT
IF (XUDT'>DT)
Begin DoDot:1
+3 SET XUVE=0
DO GET
IF 'XUEMP
DO ACT
+4 QUIT
End DoDot:1
+5 QUIT
+6 ;
SEND ; send deactivated message to assigned mail group
+1 KILL XMB,XMY
+2 SET XMB(1)=$PIECE(XUJ,"^",1)
+3 SET XMB(2)=$$GET1^DIQ(200,XUDA,8)
+4 SET XMB(3)=$$GET1^DIQ(200,XUDA,29)
+5 SET XMB(4)=$$FMTE^XLFDT(XUDT)
+6 SET XMB="XUSERDEAC"
IF $DATA(^XMB(3.6,"B",XMB))
DO ^XMB
+7 KILL XMB
+8 QUIT
