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/XUSRA.m@ 701

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

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1XUSRA ;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
8VALIDAV(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 ;
19INTRO(RESULT) ;Return INTRO TEXT.
20 D INTRO^XUS1A("RESULT")
21 Q
22VCVALID() ;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 ;
26CVC(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 ;
30USERSET(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()
40USX 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 ;
Note: See TracBrowser for help on using the repository browser.