First Comment |
Check a users access Return R(0)=DUZ, R(1)=(0=OK, 1,2...=Can't sign-on for some reason) R(2)=verify needs changing, R(3)=Message, R(4)=0, R(5)=msg cnt, R(5+n) R(R(5)+6)=# div user must select from, R(R(5)+6+n)=div
|
Code |
N X,XUSER,XUNOW,XUDEV,XUM,XUMSG,%1,VCCH K DUZ S U="^",RET(0)=0,RET(5)=0,XUF=$G(XUF,0),XUM=0,XUMSG=0,XUDEV=0 S DUZ=0,DUZ(0)="",VCCH=0 D NOW S XOPT=$$STATE^XWBSEC("XUS XOPT") S XUMSG=$$INHIBIT() I XUMSG S XUM=1 G VAX ;Logon inhibited I $$LKCHECK^XUSTZIP($G(IO("IP"))) S XUMSG=7 G VAX ;IP locked I $L(AVCODE) D . I $E(AVCODE,1,2)="~1" S DUZ=$$CHKASH^XUSRB4(AVCODE),DUZ("AUTHENTICATION")="ASHTOKEN" Q . I $E(AVCODE,1,2)="~2" S DUZ=$$CHKCCOW^XUSRB4(AVCODE),DUZ("AUTHENTICATION")="CCOWTOKEN" Q . S DUZ=$$CHECKAV^XUS($$DECRYP^XUSRB1(AVCODE)),DUZ("AUTHENTICATION")="AVCODES" . Q I DUZ'>0,$$FAIL^XUS3 D G VAX . S XUM=1,XUMSG=7,X=$$RA^XUSTZ H 5 ;3 Strikes S XUMSG=$$UVALID^XUS() G:XUMSG VAX ;Check User S VCCH=$$VCVALID() ;Check VC I $G(DUZ("LOA"))="" S DUZ("LOA")=2 I DUZ>0 S XUMSG=$$POST(1) I XUMSG>0 S DUZ=0,VCCH=0 ;If can't sign-on, don't tell need to change VC I 'XUMSG,VCCH S XUMSG=12 D SET^XWBSEC("XUS DUZ",DUZ) ;Need to change VC
|