| 1 | XUS3 ;SF-ISC/STAFF - SIGNON ;5/31/2006
|
|---|
| 2 | ;;8.0;KERNEL;**32,149,265,419**;Jul 10, 1995;Build 5
|
|---|
| 3 | TT ;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 | ;
|
|---|
| 11 | WAIT ;** 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
|
|---|
| 14 | LOCK S XUT=X,XMB="XUSLOCK",XMB(1)=$I,XMB(2)=+XUT,XMB(3)=$P(XUVOL,U,1)_","_XUCI D ^XMB
|
|---|
| 15 | Q Q
|
|---|
| 16 | ;
|
|---|
| 17 | SEC ;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)
|
|---|
| 31 | NOPE 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 | ;
|
|---|
| 35 | H3(%) ;Convert $H to seconds.
|
|---|
| 36 | Q 86400*%+$P(%,",",2)
|
|---|
| 37 | ;
|
|---|
| 38 | GETFAC(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 | ;
|
|---|
| 57 | TS() ;Is IP a Terminal Server (check TSCHK in XUSTZIP).
|
|---|
| 58 | Q $L($O(^XTV(8989.3,1,405.2,"B",IP,0)))
|
|---|
| 59 | ;
|
|---|
| 60 | FINDFAC(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
|
|---|
| 68 | SETFAC(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 | ;
|
|---|
| 77 | CLRFAC(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 | ;
|
|---|
| 83 | FAIL(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 | ;
|
|---|
| 90 | NO() ;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 | ;
|
|---|
| 101 | TXT(%) ;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
|
|---|
| 111 | ZZ ;;Halt;Error Messages
|
|---|
| 112 | 1 ;;1;No Signons.
|
|---|
| 113 | 2 ;;1;Maximum users.
|
|---|
| 114 | 3 ;;1;Bad device.
|
|---|
| 115 | 4 ;;0;Invalid A/V code.
|
|---|
| 116 | 5 ;;0;No Access for User.
|
|---|
| 117 | 6 ;;0;Invalid device password.
|
|---|
| 118 | 7 ;;0;Device locked.
|
|---|
| 119 | 8 ;;1;This device is out of service.
|
|---|
| 120 | 9 ;;0;*** MULTIPLE SIGN-ONS NOT ALLOWED ***
|
|---|
| 121 | 10 ;;1;You don't have access to this device!
|
|---|
| 122 | 11 ;;0;Access code terminated.
|
|---|
| 123 | 12 ;;0;Change VERIFY code.
|
|---|
| 124 | 13 ;;1;Time limited device.
|
|---|
| 125 | 14 ;;0;Bad UCI!
|
|---|
| 126 | 15 ;;0;Bad Routine.
|
|---|
| 127 | 16 ;;0;No PRIMARY MENU.
|
|---|
| 128 | 17 ;;0;User Time limited.
|
|---|
| 129 | 18 ;;0;User lockout
|
|---|
| 130 | 19 ;;0;Signon not allowed as you have required forms to sign in terminal mode.
|
|---|
| 131 | 20 ;;0;Client IP address not setup.
|
|---|
| 132 | 21 ;;0;Null Verify code
|
|---|
