Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUSTERM1

XUSTERM1.m

Go to the documentation of this file.
  1. XUSTERM1 ;SEA/WDE - DEACTIVATE USER ;09/18/18
  1. ;;8.0;KERNEL;**102,180,208,222,274,313,332,360,384,436,514,693**;Jul 10, 1995;Build 13
  1. ;;Per VHA Directive 6402, this routine should not be modified.
  1. ENALL ;Interactive scan all
  1. S U="^",DTIME=$G(DTIME,60)
  1. 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."
  1. RD1 W !!,"Do you wish to proceed "
  1. S %=2 D YN^DICN G:%=2!(%=-1) END I %=0 S XQH="XUUSER-PURGEATT" D EN^XQH G RD1
  1. RD2 W !,"Do you wish to verify each user "
  1. 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
  1. QUE W !,"Do you wish to have this queued for a later time "
  1. S %=1 D YN^DICN I %=1 D Q
  1. . S ZTDESC="USER DEACTIVATION",ZTRTN="CHECK^XUSTERM1",ZTIO="",ZTSAVE("DUZ*")=""
  1. . D ^%ZTLOAD
  1. . Q
  1. I %=0 K X,XUVE Q
  1. ;Fall thru if user doesn't queue
  1. CHECK ;Entry point for taskman.
  1. N XUDT540,XUDT90,XUDT30,FDA,XUDT,XUAAW
  1. S U="^",DT=$$DT^XLFDT(),XUDT90=$$HTFM^XLFDT($H-90,1),XUDT30=$$HTFM^XLFDT($H-30,1)
  1. S XUAAW=+$P($G(^XTV(8989.3,1,3)),U,4) ;Academic Waiver
  1. S XUDT540=$$HTFM^XLFDT($H-540,1) ;*p332
  1. S XUDA=.6,XUVE=$G(XUVE,0)
  1. F S XUDA=$O(^VA(200,XUDA)) Q:XUDA'>0 S XUJ=$G(^(XUDA,0)) D
  1. . S XUDT=$P(XUJ,U,11)
  1. . I $P(XUJ,U,3)]"",$L(XUDT),(XUDT'>DT) D
  1. . . D GET
  1. . . I 'XUEMP K Y D:XUVE DISP Q:$D(Y) D ACT ;XUEMP=any data to remove
  1. . . Q
  1. . I $P(XUJ,U,3)]"",'$P(XUJ,U,8),$$NOSIGNON D DISUSER(XUDA)
  1. . I $P(XUJ,U,7) D AUSER(XUDA) ;*p332
  1. . Q
  1. ;
  1. END K XUEMP,XUDA,XUI,XUJ,XUK,XUACT,XUKEY,XUGRP,XUSUR,XUNAM,XUF,XUDT,XUIN,XUVE,X,DIC,XUDB,XUDC,XUDP
  1. Q
  1. ;
  1. DISUSER(XUDA) ;Set DISUSER flag and reason, Remove last menu option
  1. Q:$P(XUJ,U,7) ;DISUSER already set *p332
  1. N %,FDA S %=XUDA_","
  1. S FDA(200,%,7)=1,FDA(200,%,9.4)="User Inactive for too long"
  1. D FILE^DIE("","FDA"),CONTCL(XUDA) ;Set Disuser
  1. Q
  1. ;
  1. AUSER(XUDA) ;If DISUSERed and Last Sign > 540[18Mo.*30] days, then remove"AUSER" xref
  1. I $D(^XUSEC("XUORES",XUDA)) Q ;Owner of XUORES key ;p*436
  1. N Q S Q=$P($G(^VA(200,XUDA,1.1)),U) ;Get last sign-on
  1. I $L(Q),Q<XUDT540 K ^VA(200,"AUSER",$P(XUJ,U),XUDA) ;*p360;*p384
  1. Q
  1. ;
  1. ;If site has an Academic Affiliation Waiver the last sign-on moves to 90 days from 30.
  1. NOSIGNON() ;Check last signon. Return 1 if should disable account
  1. N Q S Q=$P($G(^VA(200,XUDA,1.1)),U) ;Get last sign-on
  1. I $L(Q),Q>$S('XUAAW:XUDT30,1:XUDT90) Q 0 ;Last sign-on within 30/90 days VA Handbook 6500 ;p514
  1. S Q=$P($G(^VA(200,XUDA,1.1)),U,4) ;Get last Edit date
  1. I $L(Q),Q>XUDT30 Q 0 ;User edited in last 30 days
  1. S Q=$P($G(^VA(200,XUDA,1)),U,7) ;Create Date
  1. I $L(Q),Q>XUDT30 Q 0 ;User set up in last 30 days
  1. S Q=$P($G(^VA(200,XUDA,.1)),U) ;Get verify code change date
  1. I $L(Q),(Q+30)>$H Q 0 ;Verify code changed in last 30 days
  1. Q 1
  1. ;
  1. CONTCL(XUDA) ;Clear the fields for Menu "Continue"
  1. N FDA
  1. S FDA(200,XUDA_",",202.1)="@",FDA(200,XUDA_",",202.2)="@"
  1. D FILE^DIE("","FDA") ;Clear 202.1 and 202.2
  1. Q
  1. ;
  1. ACT ;
  1. D ACT^XUSTERM
  1. S XUJ=^VA(200,XUDA,0) ;Get new copy of zero node
  1. Q
  1. ;
  1. GET ;Kill ^DISV entries each time, should get all CPUs at some point
  1. N XUJ
  1. D GET^XUSTERM K ^DISV(XUDA),Y
  1. Q
  1. DISP ;Display info and get responses.
  1. N DA,DIE,DR,XUJ
  1. S DA=XUDA
  1. L +^VA(200,DA,0):6 D DISP2 L -^VA(200,DA,0)
  1. Q
  1. DISP2 ;Do the work.
  1. W !!,$S(XUTX1(1)["User":XUNAM_$P(XUTX1(1),"User",2),1:XUTX1(1)) ;*p360
  1. S DR="9.21//YES",DIE=200 D ^DIE Q:$D(Y) G:'$D(XUSUR) KEYS
  1. W !!,XUNAM," acts as surrogate for the following users:"
  1. 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."
  1. KEYS ;This section checks for authorized senders of mail groups and security keys.
  1. W !,"User will no longer be an authorized sender to any mail groups."
  1. I '$D(XUKEY) W !!,XUNAM," currently holds no keys." G KEYS1
  1. W !!,XUNAM," holds the following keys: "
  1. 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)
  1. KEYS1 W ! S DR="9.22//YES" D ^DIE Q:$D(Y)
  1. GROUP I '$D(XUGRP) W !!,XUNAM," currently is not a member of any MAIL GROUP." G GROUP1
  1. W !!,XUNAM," is a member of the following Mail Groups:"
  1. S XUI="" F XUI=0:0 S XUI=$O(XUGRP(XUI)) Q:XUI'>0 D
  1. . S XUJ=XUGRP(XUI)
  1. . 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)")
  1. . Q
  1. GROUP1 W ! S DR="9.23//YES" D ^DIE Q:$D(Y)
  1. Q
  1. ;
  1. DQ1 ;Terminate one person.
  1. N XUJ,XUDT,XUVE
  1. S XUJ=$G(^VA(200,XUDA,0)),XUDT=$P(XUJ,U,11) I XUDT,(XUDT'>DT) D
  1. . S XUVE=0 D GET I 'XUEMP D ACT
  1. . Q
  1. Q
  1. ;
  1. SEND ; send deactivated message to assigned mail group
  1. K XMB,XMY
  1. N XUSTN S XUSTN=""
  1. S XMB(1)=$$GET1^DIQ(200,XUDA,.01)
  1. S XMB(2)=$$GET1^DIQ(200,XUDA,8)
  1. S XMB(3)=$$GET1^DIQ(200,XUDA,29)
  1. S XMB(4)=XUDA
  1. S XMB(5)=""
  1. S XUSTN=$$SITE^VASITE
  1. S XMB(5)=$P(XUSTN,"^",3)_" STATION NAME: "_$P(XUSTN,"^",2)
  1. S XMB(6)=$$FMTE^XLFDT(XUDT)
  1. S XMB="XUSERDEAC" D ^XMB:$D(^XMB(3.6,"B",XMB))
  1. K XMB,XMY
  1. Q
  1. ;
  1. SEND1(XUDA,X) ; send disusered message to assigned mail group p693
  1. K XMB,XMY
  1. I +$G(X)'>0 Q
  1. N XUSTN S XUSTN=""
  1. S XMB(1)=$$GET1^DIQ(200,XUDA,.01)
  1. S XMB(2)=$$GET1^DIQ(200,XUDA,8)
  1. S XMB(3)=$$GET1^DIQ(200,XUDA,29)
  1. S XMB(4)=XUDA
  1. S XMB(5)=""
  1. S XUSTN=$$SITE^VASITE
  1. S XMB(5)=$P(XUSTN,"^",3)_" "_$P(XUSTN,"^",2)
  1. S XMB(6)=$$FMTE^XLFDT($$DT^XLFDT())
  1. S XMB="XUSERDIS" D ^XMB:$D(^XMB(3.6,"B",XMB))
  1. K XMB,XMY
  1. Q
  1. ;