- 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 Feb 18, 2025@23:39:33 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