source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSTERM1.m@ 668

XUSTERM1 ;SEA/WDE - DEACTIVATE USER ;6:40 AM  11 Oct 2006
 ;;8.0;KERNEL;**102,180,208,222,274,313,332,360,384,436**;Jul 10, 1995;Build 2
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
 S U="^",DT=$$DT^XLFDT(),XUDT90=$$HTFM^XLFDT($H-90,1),XUDT30=$$HTFM^XLFDT($H-30,1)
 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
 ;
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>XUDT90 Q 0 ;Last sign-on within 90 days
 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