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/XUS3.m@ 623

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

initial load of WorldVistAEHR

File size: 4.1 KB
Line 
1XUS3 ;SF-ISC/STAFF - SIGNON ;5/31/2006
2 ;;8.0;KERNEL;**32,149,265,419**;Jul 10, 1995;Build 5
3TT ;Terminal Type select
4 Q:$D(XUIOP(1))
5 S DIC("B")=$S($P(XUIOP,";",2)]"":$P(XUIOP,";",2),$D(^%ZIS(1,XUDEV,"SUBTYPE")):+^("SUBTYPE"),1:"C-VT100")
6 S DIC="^%ZIS(2,",DIC(0)="AEMQO",DIC("S")="I $P(^(0),U,2)" D ^DIC K DIC Q:Y<1
7 ;M/11 & M/VX sites may want to remove the ; from the next line.
8 ;S J=$P(Y,U,2) I $D(^%IS(0,"SUB",J)) S $P(^%IS($I,1),U,3)=J
9 S ^VA(200,DUZ,1.2)=+Y,$P(XUIOP,";",2)=$P(Y,U,2) Q
10 ;
11WAIT ;** doesn't work with virtual device
12 Q:'$L(IO("ZIO"))
13 S X=XUT,XUT=0,H=$P(^DISV("XU",XUDEV),U,2),T=$P(H,",",2)+$P(XOPT,U,3),H=T\86400+H,T=T#86400 Q:H<$H I +$H=H Q:$P($H,",",2)'<T
14LOCK S XUT=X,XMB="XUSLOCK",XMB(1)=$I,XMB(2)=+XUT,XMB(3)=$P(XUVOL,U,1)_","_XUCI D ^XMB
15Q Q
16 ;
17SEC ;Check device's security and time lock.
18 Q:$P(XOPT,"^",11) ;Bypass device lockout
19 N %A,%B,%H,Y
20 S %A=$P(XUSER(0),U,4),%B=0
21 I $G(^%ZIS(1,XUDEV,95))]"",%A'="@" D
22 . S %H=$P(^(95),U),%B=1 F Y=1:1:$L(%H) I %A[$E(%H,Y) S %B=0
23 I %B D Q
24 . S XMB="XUSECURITY",XMB(1)=$P(XUSER(0),U,1),XMB(2)=$I,XMB(3)=^(95),XMB(4)=%A D ^XMB
25 . S XUM=10
26 . Q
27 S %A=$P($G(^%ZIS(1,XUDEV,"TIME")),U) Q:%A=""
28 S Y=$P($H,",",2),%H=Y\60#60+(Y\3600*100),Y=$P(%A,"-",2)
29 I Y'<%A G NOPE:%H'>Y&(%H'<%A) Q
30 Q:%H'>%A&(%H'<Y)
31NOPE S XMB="XUSTIME",XMB(1)=$I,XMB(2)=$P(XUSER(0),U,1),XMB(4)=%A D ^XMB
32 S XUM=13,XUM(0)=%A
33 Q
34 ;
35H3(%) ;Convert $H to seconds.
36 Q 86400*%+$P(%,",",2)
37 ;
38GETFAC(IP) ;Set XUFAC from saved value, Failed Access Count
39 I $D(XUFAC) Q
40 S XUFAC=0 ;Use default.
41 Q:'$L(IP)
42 N X,R
43 S X=$$FINDFAC(IP)
44 ;Clear count if lockout time has passed
45 I X>0 D
46 . L +^XUSEC(4,X,0):5
47 . S R=$G(^XUSEC(4,X,0))
48 . L -^XUSEC(4,X,0)
49 . ;Use 30 seconds as a balance. Not lock user out, stop scripts.
50 . I ($$H3($P(R,"^",3))+30)<$$H3($H) D CLRFAC(IP) Q ;Exit without changing XUFAC
51 . S XUFAC=$P(R,U,2)
52 . Q
53 ;If IP is a TS, if should lock return 4 else 0.
54 I $$TS S XUFAC=$S($$IPCHECK^XUSTZIP(IP):4,1:0)
55 Q
56 ;
57TS() ;Is IP a Terminal Server (check TSCHK in XUSTZIP).
58 Q $L($O(^XTV(8989.3,1,405.2,"B",IP,0)))
59 ;
60FINDFAC(IP) ;Find the entry
61 N I
62 I $G(XUFAC(1))>0,$D(^XUSEC(4,XUFAC(1),0)) Q XUFAC(1)
63 K XUFAC(1)
64 Q:'$L(IP) 0
65 S I=$O(^XUSEC(4,"B",IP,0))
66 I I>0 S XUFAC(1)=I
67 Q I
68SETFAC(IP) ;Set the value of Failed Access atempts
69 N FDA,IEN,I
70 I $G(XUFAC(1)),'$D(^XUSEC(4,XUFAC(1),0)) K XUFAC(1)
71 S I=$S($G(XUFAC(1)):XUFAC(1),1:"?+1")_","
72 S FDA(3.084,I,.01)=IP,FDA(3.084,I,2)=XUFAC,FDA(3.084,I,3)=$H
73 D UPDATE^DIE("S","FDA","IEN")
74 I $G(IEN(1))>0 S XUFAC(1)=IEN(1)
75 Q
76 ;
77CLRFAC(IP) ;Clear FAC from the global
78 N DA,DIK,I
79 S I=$$FINDFAC(IP) Q:I'>0
80 S DA=I,DIK="^XUSEC(4," D ^DIK
81 Q
82 ;
83FAIL(IP) ;If user fails logon, Call to inc XUFAC
84 ; and check if time to lock. IP is optional.
85 S IP=$$IP^XUSTZIP
86 D GETFAC(IP) I '$L($G(XOPT)) D XOPT^XUS
87 S XUFAC=XUFAC+1 D SETFAC(IP) ;Fail count
88 Q XUFAC'<$P(XOPT,U,2)
89 ;
90NO() ;Fail, R/S entry. Reference to XGWIN has been removed.
91 N XUEXIT,% ;Gets set in $$TXT, If 1 halt process.
92 W !,"Device: ",$I,!!,$$TXT(XUM),!
93 S %=$$FAIL($G(IO("IP"))),XUEXIT=XUEXIT!$D(XUHALT)
94 I ('XUEXIT)&'% Q 0 ;Continue to try
95 I 'XUEXIT&(XUM-7) W !,$$TXT(7) ;Tell user we are locking device
96 ;XUF handled in XUSTZ
97 I 'XUEXIT D ^XUSTZ
98 H 4
99 Q XUEXIT
100 ;
101TXT(%) ;Call by R/S and Broker
102 N XU1
103 ;This string tells if a error code should HALT process.
104 S:'$D(XUEXIT) XUEXIT=$E("111000010100100000000",%)
105 S XU1=30810+(%/100)
106 S %=$$EZBLD^DIALOG(XU1) I %["|" S %=$P(%,"|",1)_$G(XUM(0))_$P(%,"|",2)
107 K XUM(0)
108 Q %
109 ;All error messages are now in the DIALOG file.
110 ;Message numbers are 30810.01 to 30810.99
111ZZ ;;Halt;Error Messages
1121 ;;1;No Signons.
1132 ;;1;Maximum users.
1143 ;;1;Bad device.
1154 ;;0;Invalid A/V code.
1165 ;;0;No Access for User.
1176 ;;0;Invalid device password.
1187 ;;0;Device locked.
1198 ;;1;This device is out of service.
1209 ;;0;*** MULTIPLE SIGN-ONS NOT ALLOWED ***
12110 ;;1;You don't have access to this device!
12211 ;;0;Access code terminated.
12312 ;;0;Change VERIFY code.
12413 ;;1;Time limited device.
12514 ;;0;Bad UCI!
12615 ;;0;Bad Routine.
12716 ;;0;No PRIMARY MENU.
12817 ;;0;User Time limited.
12918 ;;0;User lockout
13019 ;;0;Signon not allowed as you have required forms to sign in terminal mode.
13120 ;;0;Client IP address not setup.
13221 ;;0;Null Verify code
Note: See TracBrowser for help on using the repository browser.