XUSRA.m

XUSRA ;ISCSF/RWF - Remote access control ;08/27/2003  10:11

 ;;8.0;KERNEL;**70,115,208,265**;Jul 10, 1995;Build 5

 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)

 ;

XUSRA     ;ISCSF/RWF - Remote access control ;08/27/2003  10:11

 +1       ;;8.0;KERNEL;**70,115,208,265**;Jul 10, 1995;Build 5

 +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       ;