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

XUSTZ.m

Go to the documentation of this file.
  1. XUSTZ ;SF/RWF - Security Twilight Zone ;11/25/08 15:21
  1. ;;8.0;KERNEL;**36,180,265,514**;Jul 10, 1995;Build 8
  1. ;Per VHA Directive 2004-038, this routine should not be modified
  1. ;Called from XUS3 for R/S
  1. N XUSTZ,DUOUT,SETLK,TMOUT
  1. ;Only send the bulletin once.
  1. I '$D(XUSTZ) S XUSTZ=1 D SB
  1. ;Set the lockout time
  1. S TMOUT=$$LKTME
  1. ;Check and Lock
  1. W !!,?10,$$RA
  1. ;If because device is locked only lock till "Lock till time"
  1. I $$LKCHECK^XUSTZIP() S TMOUT=$$LKWAIT^XUSTZIP(TMOUT)
  1. ;
  1. ;Make user wait for timeout.
  1. F D ASK Q:$D(DUOUT)
  1. D CLEAN^XUSTZIP
  1. I XUF D FILE
  1. W !!,$$EZBLD^DIALOG(30810.41)
  1. K ^DISV("XU",IOS)
  1. Q ;Back to XUS3
  1. ;
  1. 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.
  1. N TXT,TMOUT
  1. S TXT="",TMOUT=$$LKTME,IP=$$IP^XUSTZIP,XUFAC=+$G(XUFAC)
  1. D FILE ;File in FAA, Do now before user can disconnect
  1. D CLEAN^XUSTZIP
  1. ;Check if Lock the user
  1. I $G(XUF(.3))>0,$$LKUSER(XUF(.3)) S TXT=$$EZBLD^DIALOG(30810.43,TMOUT)
  1. ;Check and LOCK the IP.
  1. I '$T,$$IPCHECK^XUSTZIP(IP) D
  1. . S SETLK=$$LKSET^XUSTZIP(IP)
  1. . I SETLK>0 S TXT=$$EZBLD^DIALOG(30810.44)
  1. . Q
  1. Q TXT
  1. ;
  1. ASK N XUM
  1. W !!!,$$EZBLD^DIALOG(30810.42)
  1. X XUEOFF S %="",XUM=4,XUEXIT=0,XUC="",TMOUT=$S(TMOUT>10:TMOUT,1:10)
  1. A1 ;Let user keep trying
  1. W !,XUSTMP(51) S X=$$ACCEPT^XUS(TMOUT) ;Access
  1. Q:$D(DUOUT) G A1:X="" ;,OK:'$D(^DISV("XU",IOS)),A1:X=""
  1. I X[U W " '^' not allowed in Access Code, Use EDIT USER option." Q
  1. S:X[";" %=$P(X,";",2),X=$P(X,";") I XUF S %1="Access: "_X D FAC
  1. HANG 2
  1. ;
  1. S %1="" I %="" W !,XUSTMP(52) S X=$$ACCEPT^XUS(60),%="" ;Verify
  1. I XUF S %1="Verify: "_X D FAC
  1. HANG 2
  1. I XUF,XUF(.2)>50 D FILE S XUF(.2)=0,XUFAC=0
  1. ;I XUF,XUF(.2)>2 D FILE S XUF(.2)=0,XUFAC=0 ;used for testing
  1. S XUFAC=XUFAC+1,%=$$NO^XUS3
  1. Q
  1. ;
  1. FAC G FAC^XUS
  1. ;
  1. FILE ;File data into Access Atempt Log
  1. ;Call needs, IOS,XUVOL,XUF(.1),(.2),(.3),XUT,XUCI,IO("ZIO"),XUNOW
  1. ;Want to use IO("IP") in place of IO("ZIO") if we have it.
  1. Q:'$G(XUF)
  1. N XUT,ZIO S ZIO=$G(IO("ZIO")) S:$D(IO("IP")) IO("ZIO")=IO("IP")
  1. S X1=IOS,X2=DT F I=1:1:XUF(.2) S X=XUF(I) D EN^XUSHSHP S XUF(I)=X
  1. S XUT=XUFAC
  1. ;S XUSLNT=1,XQZ="FAAL^ZUA[MGR]" D DO^%XUCI
  1. D FAAL^ZUA
  1. F I=1:1:XUF(.2) K XUF(I)
  1. S XUF(.2)=0,XUFAC=0 S:$L(ZIO) IO("ZIO")=ZIO
  1. Q
  1. ;
  1. SB ;Send the XUSLOCK bulletin
  1. S XMB="XUSLOCK",XMB(1)=$S($D(IO("IP")):IO("IP"),$D(IO("ZIO")):IO("ZIO"),1:$I),XMB(2)=+XUFAC,XMB(3)=ION
  1. D ^XMB
  1. Q
  1. LKTME() ;Get Lock-out time
  1. I $D(XOPT) Q $P(XOPT,U,3)
  1. Q $P(^XTV(8989.3,1,"XUS"),U,3)
  1. ;
  1. LKUSER(IEN) ;Lock user, Return: 0 not locked, 1 locked
  1. Q:$P($G(^XTV(8989.3,1,405)),U,4)'="y" 0
  1. N FDA
  1. ;If already locked don't change time
  1. S FDA=$$GET1^DIQ(200,IEN_",",202.05,"I")
  1. I FDA>XUNOW Q 0 ;Still Locked.
  1. ;If locking user clear XUFAC.
  1. D CLRFAC^XUS3($G(IO("IP")))
  1. K FDA ;Add d,h,m,s
  1. S FDA(200,IEN_",",202.05)=$$HTFM^XLFDT($$HADD^XLFDT($H,0,0,0,TMOUT))
  1. D UPDATE^DIE("","FDA")
  1. Q 1