1 | XUSRA ;ISCSF/RWF - Remote access control ;08/27/2003 10:11
|
---|
2 | ;;8.0;KERNEL;**70,115,208,265**;Jul 10, 1995
|
---|
3 | Q ;No entry from top
|
---|
4 | ;
|
---|
5 | ;OUTSIDE app user cheking, The supported entry-points are:
|
---|
6 | ;VALIDAV, INTRO, USERSET
|
---|
7 | ;First parameter is always call-by-reference
|
---|
8 | VALIDAV(RESULT,AVCODE) ;Check a users access
|
---|
9 | ;Return DUZ^problem message^verify needs changing
|
---|
10 | ;This entry point is subscription only.
|
---|
11 | N X,XUSER,XUF,XRA1,XRA2,XUMSG
|
---|
12 | K ^UTILITY($J),^TMP($J),^XUTL("XQ",$J)
|
---|
13 | D SET1^XUS(0) S XRA1=$$INHIBIT^XUSRB,XRA2=0,XUF=0,DUZ=0,XUMSG=0
|
---|
14 | I 'XRA1 S DUZ=$$CHECKAV^XUS(AVCODE) S:DUZ XRA2=$$VCVALID S:XRA2 DUZ=0,XRA1=12
|
---|
15 | S XUMSG=$S(XRA1:XRA1,'DUZ:4,1:0),XUMSG=$S(XUMSG:$$TXT^XUS3(XUMSG),1:"")
|
---|
16 | S RESULT=DUZ_U_XUMSG_U_XRA2
|
---|
17 | Q
|
---|
18 | ;
|
---|
19 | INTRO(RESULT) ;Return INTRO TEXT.
|
---|
20 | D INTRO^XUS1A("RESULT")
|
---|
21 | Q
|
---|
22 | VCVALID() ;Check if the Verify code needs changing.
|
---|
23 | Q:'$G(DUZ) 1
|
---|
24 | Q $G(^VA(200,DUZ,.1))+$P(^XTV(8989.3,1,"XUS"),"^",15)'>(+$H)
|
---|
25 | ;
|
---|
26 | CVC(RESULT,XU1) ;change VC
|
---|
27 | S RESULT=0 Q:$G(DUZ)'>0 N XU2 S U="^",XU2=$P(XU1,U,2),XU1=$P(XU1,U)
|
---|
28 | Q $$BRCVC^XUS2(XU1,XU2)
|
---|
29 | ;
|
---|
30 | USERSET(AV) ;sr. If a valid A/V setup DUZ for user.
|
---|
31 | ;input: AV = accesscode_;_verifycode
|
---|
32 | ;output: 0 = not OK ^ msg
|
---|
33 | ; 1 = OK
|
---|
34 | N NZ,X,XUSER,XUF,XUNOW,XUDEV,XUM,XUMSG,%1,VCOK K DUZ
|
---|
35 | S DUZ=0,DUZ(0)="",VCOK=0,U="^",XUF=0,XUM=0,XUMSG=0 D NOW^XUSRB
|
---|
36 | D SET1^XUS(0)
|
---|
37 | S XUM=$$INHIBIT^XUSRB() I XUM G USX ;Logon inhibited
|
---|
38 | S DUZ=$$CHECKAV^XUS(AV),XUM=$$UVALID^XUS() G:XUM USX
|
---|
39 | S VCOK=$$VCVALID^XUSRB()
|
---|
40 | USX I XUM S DUZ=0,XUMSG=$$TXT^XUS3(XUM)
|
---|
41 | I 'XUM S XQXFLG("ZEBRA")=-1 D LOG^XUS1 ;Record the sign-on.
|
---|
42 | Q $S(XUM:"0^"_XUMSG,1:1)
|
---|
43 | ;
|
---|