XUSTZ ;SF/RWF - Security Twilight Zone ;11/25/08 15:21
;;8.0;KERNEL;**36,180,265,514**;Jul 10, 1995;Build 8
;Per VHA Directive 2004-038, this routine should not be modified
;Called from XUS3 for R/S
N XUSTZ,DUOUT,SETLK,TMOUT
;Only send the bulletin once.
I '$D(XUSTZ) S XUSTZ=1 D SB
;Set the lockout time
S TMOUT=$$LKTME
;Check and Lock
W !!,?10,$$RA
;If because device is locked only lock till "Lock till time"
I $$LKCHECK^XUSTZIP() S TMOUT=$$LKWAIT^XUSTZIP(TMOUT)
;
;Make user wait for timeout.
F D ASK Q:$D(DUOUT)
D CLEAN^XUSTZIP
I XUF D FILE
W !!,$$EZBLD^DIALOG(30810.41)
K ^DISV("XU",IOS)
Q ;Back to XUS3
;
RA(IP) ;EF. Entry point for Remote Access (Broker/Vistalink) and R/S
;This is used to Lock the User or IP. Returns Text.
N TXT,TMOUT
S TXT="",TMOUT=$$LKTME,IP=$$IP^XUSTZIP,XUFAC=+$G(XUFAC)
D FILE ;File in FAA, Do now before user can disconnect
D CLEAN^XUSTZIP
;Check if Lock the user
I $G(XUF(.3))>0,$$LKUSER(XUF(.3)) S TXT=$$EZBLD^DIALOG(30810.43,TMOUT)
;Check and LOCK the IP.
I '$T,$$IPCHECK^XUSTZIP(IP) D
. S SETLK=$$LKSET^XUSTZIP(IP)
. I SETLK>0 S TXT=$$EZBLD^DIALOG(30810.44)
. Q
Q TXT
;
ASK N XUM
W !!!,$$EZBLD^DIALOG(30810.42)
X XUEOFF S %="",XUM=4,XUEXIT=0,XUC="",TMOUT=$S(TMOUT>10:TMOUT,1:10)
A1 ;Let user keep trying
W !,XUSTMP(51) S X=$$ACCEPT^XUS(TMOUT) ;Access
Q:$D(DUOUT) G A1:X="" ;,OK:'$D(^DISV("XU",IOS)),A1:X=""
I X[U W " '^' not allowed in Access Code, Use EDIT USER option." Q
S:X[";" %=$P(X,";",2),X=$P(X,";") I XUF S %1="Access: "_X D FAC
HANG 2
;
S %1="" I %="" W !,XUSTMP(52) S X=$$ACCEPT^XUS(60),%="" ;Verify
I XUF S %1="Verify: "_X D FAC
HANG 2
I XUF,XUF(.2)>50 D FILE S XUF(.2)=0,XUFAC=0
;I XUF,XUF(.2)>2 D FILE S XUF(.2)=0,XUFAC=0 ;used for testing
S XUFAC=XUFAC+1,%=$$NO^XUS3
Q
;
FAC G FAC^XUS
;
FILE ;File data into Access Atempt Log
;Call needs, IOS,XUVOL,XUF(.1),(.2),(.3),XUT,XUCI,IO("ZIO"),XUNOW
;Want to use IO("IP") in place of IO("ZIO") if we have it.
Q:'$G(XUF)
N XUT,ZIO S ZIO=$G(IO("ZIO")) S:$D(IO("IP")) IO("ZIO")=IO("IP")
S X1=IOS,X2=DT F I=1:1:XUF(.2) S X=XUF(I) D EN^XUSHSHP S XUF(I)=X
S XUT=XUFAC
;S XUSLNT=1,XQZ="FAAL^ZUA[MGR]" D DO^%XUCI
D FAAL^ZUA
F I=1:1:XUF(.2) K XUF(I)
S XUF(.2)=0,XUFAC=0 S:$L(ZIO) IO("ZIO")=ZIO
Q
;
SB ;Send the XUSLOCK bulletin
S XMB="XUSLOCK",XMB(1)=$S($D(IO("IP")):IO("IP"),$D(IO("ZIO")):IO("ZIO"),1:$I),XMB(2)=+XUFAC,XMB(3)=ION
D ^XMB
Q
LKTME() ;Get Lock-out time
I $D(XOPT) Q $P(XOPT,U,3)
Q $P(^XTV(8989.3,1,"XUS"),U,3)
;
LKUSER(IEN) ;Lock user, Return: 0 not locked, 1 locked
Q:$P($G(^XTV(8989.3,1,405)),U,4)'="y" 0
N FDA
;If already locked don't change time
S FDA=$$GET1^DIQ(200,IEN_",",202.05,"I")
I FDA>XUNOW Q 0 ;Still Locked.
;If locking user clear XUFAC.
D CLRFAC^XUS3($G(IO("IP")))
K FDA ;Add d,h,m,s
S FDA(200,IEN_",",202.05)=$$HTFM^XLFDT($$HADD^XLFDT($H,0,0,0,TMOUT))
D UPDATE^DIE("","FDA")
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSTZ 2970 printed Oct 16, 2024@18:13:54 Page 2
XUSTZ ;SF/RWF - Security Twilight Zone ;11/25/08 15:21
+1 ;;8.0;KERNEL;**36,180,265,514**;Jul 10, 1995;Build 8
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 ;Called from XUS3 for R/S
+4 NEW XUSTZ,DUOUT,SETLK,TMOUT
+5 ;Only send the bulletin once.
+6 IF '$DATA(XUSTZ)
SET XUSTZ=1
DO SB
+7 ;Set the lockout time
+8 SET TMOUT=$$LKTME
+9 ;Check and Lock
+10 WRITE !!,?10,$$RA
+11 ;If because device is locked only lock till "Lock till time"
+12 IF $$LKCHECK^XUSTZIP()
SET TMOUT=$$LKWAIT^XUSTZIP(TMOUT)
+13 ;
+14 ;Make user wait for timeout.
+15 FOR
DO ASK
if $DATA(DUOUT)
QUIT
+16 DO CLEAN^XUSTZIP
+17 IF XUF
DO FILE
+18 WRITE !!,$$EZBLD^DIALOG(30810.41)
+19 KILL ^DISV("XU",IOS)
+20 ;Back to XUS3
QUIT
+21 ;
RA(IP) ;EF. Entry point for Remote Access (Broker/Vistalink) and R/S
+1 ;This is used to Lock the User or IP. Returns Text.
+2 NEW TXT,TMOUT
+3 SET TXT=""
SET TMOUT=$$LKTME
SET IP=$$IP^XUSTZIP
SET XUFAC=+$GET(XUFAC)
+4 ;File in FAA, Do now before user can disconnect
DO FILE
+5 DO CLEAN^XUSTZIP
+6 ;Check if Lock the user
+7 IF $GET(XUF(.3))>0
IF $$LKUSER(XUF(.3))
SET TXT=$$EZBLD^DIALOG(30810.43,TMOUT)
+8 ;Check and LOCK the IP.
+9 IF '$TEST
IF $$IPCHECK^XUSTZIP(IP)
Begin DoDot:1
+10 SET SETLK=$$LKSET^XUSTZIP(IP)
+11 IF SETLK>0
SET TXT=$$EZBLD^DIALOG(30810.44)
+12 QUIT
End DoDot:1
+13 QUIT TXT
+14 ;
ASK NEW XUM
+1 WRITE !!!,$$EZBLD^DIALOG(30810.42)
+2 XECUTE XUEOFF
SET %=""
SET XUM=4
SET XUEXIT=0
SET XUC=""
SET TMOUT=$SELECT(TMOUT>10:TMOUT,1:10)
A1 ;Let user keep trying
+1 ;Access
WRITE !,XUSTMP(51)
SET X=$$ACCEPT^XUS(TMOUT)
+2 ;,OK:'$D(^DISV("XU",IOS)),A1:X=""
if $DATA(DUOUT)
QUIT
if X=""
GOTO A1
+3 IF X[U
WRITE " '^' not allowed in Access Code, Use EDIT USER option."
QUIT
+4 if X[";"
SET %=$PIECE(X,";",2)
SET X=$PIECE(X,";")
IF XUF
SET %1="Access: "_X
DO FAC
+5 HANG 2
+6 ;
+7 ;Verify
SET %1=""
IF %=""
WRITE !,XUSTMP(52)
SET X=$$ACCEPT^XUS(60)
SET %=""
+8 IF XUF
SET %1="Verify: "_X
DO FAC
+9 HANG 2
+10 IF XUF
IF XUF(.2)>50
DO FILE
SET XUF(.2)=0
SET XUFAC=0
+11 ;I XUF,XUF(.2)>2 D FILE S XUF(.2)=0,XUFAC=0 ;used for testing
+12 SET XUFAC=XUFAC+1
SET %=$$NO^XUS3
+13 QUIT
+14 ;
FAC GOTO FAC^XUS
+1 ;
FILE ;File data into Access Atempt Log
+1 ;Call needs, IOS,XUVOL,XUF(.1),(.2),(.3),XUT,XUCI,IO("ZIO"),XUNOW
+2 ;Want to use IO("IP") in place of IO("ZIO") if we have it.
+3 if '$GET(XUF)
QUIT
+4 NEW XUT,ZIO
SET ZIO=$GET(IO("ZIO"))
if $DATA(IO("IP"))
SET IO("ZIO")=IO("IP")
+5 SET X1=IOS
SET X2=DT
FOR I=1:1:XUF(.2)
SET X=XUF(I)
DO EN^XUSHSHP
SET XUF(I)=X
+6 SET XUT=XUFAC
+7 ;S XUSLNT=1,XQZ="FAAL^ZUA[MGR]" D DO^%XUCI
+8 DO FAAL^ZUA
+9 FOR I=1:1:XUF(.2)
KILL XUF(I)
+10 SET XUF(.2)=0
SET XUFAC=0
if $LENGTH(ZIO)
SET IO("ZIO")=ZIO
+11 QUIT
+12 ;
SB ;Send the XUSLOCK bulletin
+1 SET XMB="XUSLOCK"
SET XMB(1)=$SELECT($DATA(IO("IP")):IO("IP"),$DATA(IO("ZIO")):IO("ZIO"),1:$IO)
SET XMB(2)=+XUFAC
SET XMB(3)=ION
+2 DO ^XMB
+3 QUIT
LKTME() ;Get Lock-out time
+1 IF $DATA(XOPT)
QUIT $PIECE(XOPT,U,3)
+2 QUIT $PIECE(^XTV(8989.3,1,"XUS"),U,3)
+3 ;
LKUSER(IEN) ;Lock user, Return: 0 not locked, 1 locked
+1 if $PIECE($GET(^XTV(8989.3,1,405)),U,4)'="y"
QUIT 0
+2 NEW FDA
+3 ;If already locked don't change time
+4 SET FDA=$$GET1^DIQ(200,IEN_",",202.05,"I")
+5 ;Still Locked.
IF FDA>XUNOW
QUIT 0
+6 ;If locking user clear XUFAC.
+7 DO CLRFAC^XUS3($GET(IO("IP")))
+8 ;Add d,h,m,s
KILL FDA
+9 SET FDA(200,IEN_",",202.05)=$$HTFM^XLFDT($$HADD^XLFDT($HOROLOG,0,0,0,TMOUT))
+10 DO UPDATE^DIE("","FDA")
+11 QUIT 1
