XUSRA ;ISCSF/RWF - Remote access control ;08/27/2003 10:11
;;8.0;KERNEL;**70,115,208,265**;Jul 10, 1995
Q ;No entry from top
;
;OUTSIDE app user cheking, The supported entry-points are:
;VALIDAV, INTRO, USERSET
;First parameter is always call-by-reference
VALIDAV(RESULT,AVCODE) ;Check a users access
;Return DUZ^problem message^verify needs changing
;This entry point is subscription only.
N X,XUSER,XUF,XRA1,XRA2,XUMSG
K ^UTILITY($J),^TMP($J),^XUTL("XQ",$J)
D SET1^XUS(0) S XRA1=$$INHIBIT^XUSRB,XRA2=0,XUF=0,DUZ=0,XUMSG=0
I 'XRA1 S DUZ=$$CHECKAV^XUS(AVCODE) S:DUZ XRA2=$$VCVALID S:XRA2 DUZ=0,XRA1=12
S XUMSG=$S(XRA1:XRA1,'DUZ:4,1:0),XUMSG=$S(XUMSG:$$TXT^XUS3(XUMSG),1:"")
S RESULT=DUZ_U_XUMSG_U_XRA2
Q
;
INTRO(RESULT) ;Return INTRO TEXT.
D INTRO^XUS1A("RESULT")
Q
VCVALID() ;Check if the Verify code needs changing.
Q:'$G(DUZ) 1
Q $G(^VA(200,DUZ,.1))+$P(^XTV(8989.3,1,"XUS"),"^",15)'>(+$H)
;
CVC(RESULT,XU1) ;change VC
S RESULT=0 Q:$G(DUZ)'>0 N XU2 S U="^",XU2=$P(XU1,U,2),XU1=$P(XU1,U)
Q $$BRCVC^XUS2(XU1,XU2)
;
USERSET(AV) ;sr. If a valid A/V setup DUZ for user.
;input: AV = accesscode_;_verifycode
;output: 0 = not OK ^ msg
; 1 = OK
N NZ,X,XUSER,XUF,XUNOW,XUDEV,XUM,XUMSG,%1,VCOK K DUZ
S DUZ=0,DUZ(0)="",VCOK=0,U="^",XUF=0,XUM=0,XUMSG=0 D NOW^XUSRB
D SET1^XUS(0)
S XUM=$$INHIBIT^XUSRB() I XUM G USX ;Logon inhibited
S DUZ=$$CHECKAV^XUS(AV),XUM=$$UVALID^XUS() G:XUM USX
S VCOK=$$VCVALID^XUSRB()
USX I XUM S DUZ=0,XUMSG=$$TXT^XUS3(XUM)
I 'XUM S XQXFLG("ZEBRA")=-1 D LOG^XUS1 ;Record the sign-on.
Q $S(XUM:"0^"_XUMSG,1:1)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSRA 1616 printed Oct 16, 2024@18:13:41 Page 2
XUSRA ;ISCSF/RWF - Remote access control ;08/27/2003 10:11
+1 ;;8.0;KERNEL;**70,115,208,265**;Jul 10, 1995
+2 ;No entry from top
QUIT
+3 ;
+4 ;OUTSIDE app user cheking, The supported entry-points are:
+5 ;VALIDAV, INTRO, USERSET
+6 ;First parameter is always call-by-reference
VALIDAV(RESULT,AVCODE) ;Check a users access
+1 ;Return DUZ^problem message^verify needs changing
+2 ;This entry point is subscription only.
+3 NEW X,XUSER,XUF,XRA1,XRA2,XUMSG
+4 KILL ^UTILITY($JOB),^TMP($JOB),^XUTL("XQ",$JOB)
+5 DO SET1^XUS(0)
SET XRA1=$$INHIBIT^XUSRB
SET XRA2=0
SET XUF=0
SET DUZ=0
SET XUMSG=0
+6 IF 'XRA1
SET DUZ=$$CHECKAV^XUS(AVCODE)
if DUZ
SET XRA2=$$VCVALID
if XRA2
SET DUZ=0
SET XRA1=12
+7 SET XUMSG=$SELECT(XRA1:XRA1,'DUZ:4,1:0)
SET XUMSG=$SELECT(XUMSG:$$TXT^XUS3(XUMSG),1:"")
+8 SET RESULT=DUZ_U_XUMSG_U_XRA2
+9 QUIT
+10 ;
INTRO(RESULT) ;Return INTRO TEXT.
+1 DO INTRO^XUS1A("RESULT")
+2 QUIT
VCVALID() ;Check if the Verify code needs changing.
+1 if '$GET(DUZ)
QUIT 1
+2 QUIT $GET(^VA(200,DUZ,.1))+$PIECE(^XTV(8989.3,1,"XUS"),"^",15)'>(+$HOROLOG)
+3 ;
CVC(RESULT,XU1) ;change VC
+1 SET RESULT=0
if $GET(DUZ)'>0
QUIT
NEW XU2
SET U="^"
SET XU2=$PIECE(XU1,U,2)
SET XU1=$PIECE(XU1,U)
+2 QUIT $$BRCVC^XUS2(XU1,XU2)
+3 ;
USERSET(AV) ;sr. If a valid A/V setup DUZ for user.
+1 ;input: AV = accesscode_;_verifycode
+2 ;output: 0 = not OK ^ msg
+3 ; 1 = OK
+4 NEW NZ,X,XUSER,XUF,XUNOW,XUDEV,XUM,XUMSG,%1,VCOK
KILL DUZ
+5 SET DUZ=0
SET DUZ(0)=""
SET VCOK=0
SET U="^"
SET XUF=0
SET XUM=0
SET XUMSG=0
DO NOW^XUSRB
+6 DO SET1^XUS(0)
+7 ;Logon inhibited
SET XUM=$$INHIBIT^XUSRB()
IF XUM
GOTO USX
+8 SET DUZ=$$CHECKAV^XUS(AV)
SET XUM=$$UVALID^XUS()
if XUM
GOTO USX
+9 SET VCOK=$$VCVALID^XUSRB()
USX IF XUM
SET DUZ=0
SET XUMSG=$$TXT^XUS3(XUM)
+1 ;Record the sign-on.
IF 'XUM
SET XQXFLG("ZEBRA")=-1
DO LOG^XUS1
+2 QUIT $SELECT(XUM:"0^"_XUMSG,1:1)
+3 ;
