source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSTZ.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1XUSTZ ;SF/RWF - Security Twilight Zone ;05/17/2005 09:41
2 ;;8.0;KERNEL;**36,180,265**;Jul 10, 1995
3 ;Called from XUS3 for R/S
4 N XUSTZ,DUOUT,SETLK,TMOUT
5 ;Only send the bulletin once.
6 I '$D(XUSTZ) S XUSTZ=1 D SB
7 ;Set the lockout time
8 S TMOUT=$$LKTME
9 ;Check and Lock
10 W !!,?10,$$RA
11 ;If because device is locked only lock till "Lock till time"
12 I $$LKCHECK^XUSTZIP() S TMOUT=$$LKWAIT^XUSTZIP(TMOUT)
13 ;
14 ;Make user wait for timeout.
15 F D ASK Q:$D(DUOUT)
16 D CLEAN^XUSTZIP
17 I XUF D FILE
18 W !!,$$EZBLD^DIALOG(30810.41)
19 K ^DISV("XU",IOS)
20 Q ;Back to XUS3
21 ;
22RA(IP) ;EF. Entry point for Remote Access (Broker/Vistalink) and R/S
23 ;This is used to Lock the User or IP. Returns Text.
24 N TXT,TMOUT S TXT="",TMOUT=$$LKTME,IP=$$IP^XUSTZIP
25 D FILE ;File in FAA, Do now before user can disconnect
26 D CLEAN^XUSTZIP
27 ;Check if Lock the user
28 I $G(XUF(.3))>0,$$LKUSER(XUF(.3)) S TXT=$$EZBLD^DIALOG(30810.43,TMOUT)
29 ;Check and LOCK the IP.
30 I '$T,$$IPCHECK^XUSTZIP(IP) D
31 . S SETLK=$$LKSET^XUSTZIP(IP)
32 . I SETLK>0 S TXT=$$EZBLD^DIALOG(30810.44)
33 . Q
34 Q TXT
35 ;
36ASK N XUM,XUFAC
37 W !!!,$$EZBLD^DIALOG(30810.42)
38 X XUEOFF S %="",XUM=4,XUEXIT=0,XUC="",TMOUT=$S(TMOUT>10:TMOUT,1:10)
39A1 ;Let user keep trying
40 W !,XUSTMP(51) S X=$$ACCEPT^XUS(TMOUT) ;Access
41 Q:$D(DUOUT) G A1:X="" ;,OK:'$D(^DISV("XU",IOS)),A1:X=""
42 I X[U W " '^' not allowed in Access Code, Use EDIT USER option." Q
43 S:X[";" %=$P(X,";",2),X=$P(X,";") I XUF S %1="Access: "_X D FAC
44 HANG 2
45 ;
46 S %1="" I %="" W !,XUSTMP(52) S X=$$ACCEPT^XUS(60),%="" ;Verify
47 I XUF S %1="Verify: "_X D FAC
48 HANG 2
49 I XUF,XUF(.2)>50 D FILE S XUF(.2)=0
50 S XUFAC=0,%=$$NO^XUS3
51 Q
52 ;
53FAC G FAC^XUS
54 ;
55FILE ;File data into Access Atempt Log
56 ;Call needs, IOS,XUVOL,XUF(.1),(.2),(.3),XUT,XUCI,IO("ZIO"),XUNOW
57 ;Want to use IO("IP") in place of IO("ZIO") if we have it.
58 Q:'$G(XUF)
59 N XUT,ZIO S ZIO=$G(IO("ZIO")) S:$D(IO("IP")) IO("ZIO")=IO("IP")
60 S X1=IOS,X2=DT F I=1:1:XUF(.2) S X=XUF(I) D EN^XUSHSHP S XUF(I)=X
61 S XUT=XUFAC
62 S XUSLNT=1,XQZ="FAAL^ZUA[MGR]" D DO^%XUCI
63 F I=1:1:XUF(.2) K XUF(I)
64 S XUF(.2)=0 S:$L(ZIO) IO("ZIO")=ZIO
65 Q
66 ;
67SB ;Send the XUSLOCK bulletin
68 S XMB="XUSLOCK",XMB(1)=$S($D(IO("IP")):IO("IP"),$D(IO("ZIO")):IO("ZIO"),1:$I),XMB(2)=+XUFAC,XMB(3)=ION
69 D ^XMB
70 Q
71LKTME() ;Get Lock-out time
72 I $D(XOPT) Q $P(XOPT,U,3)
73 Q $P(^XTV(8989.3,1,"XUS"),U,3)
74 ;
75LKUSER(IEN) ;Lock user, Return: 0 not locked, 1 locked
76 Q:$P($G(^XTV(8989.3,1,405)),U,4)'="y" 0
77 N FDA
78 ;If already locked don't change time
79 S FDA=$$GET1^DIQ(200,IEN_",",202.05,"I")
80 I FDA>XUNOW Q 0 ;Still Locked.
81 ;If locking user clear XUFAC.
82 D CLRFAC^XUS3($G(IO("IP")))
83 K FDA ;Add d,h,m,s
84 S FDA(200,IEN_",",202.05)=$$HTFM^XLFDT($$HADD^XLFDT($H,0,0,0,TMOUT))
85 D UPDATE^DIE("","FDA")
86 Q 1
Note: See TracBrowser for help on using the repository browser.