XUSRB ;ISCSF/RWF - Request Broker ;12/01/15 07:54
;;8.0;KERNEL;**11,16,28,32,59,70,82,109,115,165,150,180,213,234,238,265,337,395,404,437,523,659**;Jul 10, 1995;Build 22
;Per VA Directive 6402, this routine should not be modified.
Q ;No entry from top
;
;RPC BROKER calls, First parameter is always call-by-reference
VALIDAV(RET,AVCODE) ;RPC. XUS CVC - IA #6296
;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
;
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
;3 Strikes
I $$LKCHECK^XUSTZIP($G(IO("IP"))) S XUMSG=7 G VAX ;IP locked
;Check type of sign-on code
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
VAX S:XUMSG>0 DUZ=0 ;Can't sign-on, Clear DUZ.
I DUZ>0 D
. S DUZ("LOA")=2
. D POST2
S RET(0)=DUZ,RET(1)=XUM,RET(2)=VCCH,RET(3)=$S(XUMSG:$$TXT^XUS3(XUMSG),1:""),RET(4)=0
K DUZ("CCOW")
Q
;
NOW S U="^",XUNOW=$$NOW^XLFDT(),DT=$P(XUNOW,".")
Q
;
INTRO(RET) ;Return INTRO TEXT.
D INTRO^XUS1A("RET")
Q
;
VCVALID() ;Return 1 if the Verify code needs changing.
Q:'$G(DUZ) 1
Q:$P($G(^VA(200,DUZ,.1)),U,2)="" 1 ;VC is empty
Q:$P(^VA(200,DUZ,0),U,8)=1 0 ;VC never expires
N XUSER D USER^XUS(DUZ)
Q $$VCHG^XUS1
;
CVC(RET,XU1) ;change VC, Return 0 = success
N XU2,XU3,XU4 S DUZ=$G(DUZ),RET(0)=99,XU4=$$STATE^XWBSEC("XUS DUZ") S:(DUZ=0)&(XU4>0) DUZ=XU4 Q:DUZ'>0
S U="^",XU2=$P(XU1,U,2),XU3=$P(XU1,U,3),XU1=$P(XU1,U)
S XU1=$$DECRYP^XUSRB1(XU1),XU2=$$DECRYP^XUSRB1(XU2),XU3=$$DECRYP^XUSRB1(XU3)
S XU3=$$BRCVC^XUS2(XU1,XU2),RET(0)=+XU3,RET(1)=$P(XU3,U,2,9)
I XU3>0 S DUZ=0 ;Clean-up if not changed.
I 'XU3,XU4 D KILL^XWBSEC("XUS DUZ"),POST2
Q
;
SHOWPOST() ;EF. Check if should send the POST SIGN-ON msg.
Q +$P($G(^XTV(8989.3,1,"XWB")),"^",2)
;
POST(CVC) ;Finish setup partition, I CVC don't log yet
N X,XUM,XUDIV S:$D(IO)[0 IO=$I S IO(0)=IO
K ^UTILITY($J),^TMP($J)
I '$D(XUSER(0)),DUZ D USER^XUS(DUZ)
S XUM=$$USER^XUS1A Q:XUM>0 XUM ;User can't sign on for some reason.
S RET(5)=0 ;The next line sends the post sign-on msg
F %=1:1 Q:'$D(XUTEXT(%)) S RET(5+%)=$E(XUTEXT(%),2,256),RET(5)=%
I '$$SHOWPOST S RET(5)=0 ;This line stops the sending/display of the msg.
D:'$G(CVC) POST2
Q 0
;
POST2 ;Finish User Setup for silent log-on
D:'$D(XUNOW) NOW
D DUZ^XUS1A,SAVE^XUS1,LOG^XUS1,ABT^XQ12
D KILL^XWBSEC("XUS XOPT"),CLRFAC^XUS3($G(IO("IP"))) ;p265
D SETTIME^XWBTCPM() ;Set normal Broker time-out
S DTIME=$$DTIME^XUP(DUZ) ;See DTIME set for user
K:$G(XWBVER)<1.106 XQY,XQY0 ;Delete the sign-on context.
K XUTEXT,XOPT,XUEON,XUEOFF,XUTT,XUDEV,XUSER
Q
;
INHIBIT() ;Is Logon to this system Inhibited?
I $$INHIB1() Q 1
I $$INHIB2() Q 2
Q 0
;
INHIB1() ;The LOGON check
I $G(^%ZIS(14.5,"LOGON",XQVOL)) Q 1
Q 0
;
INHIB2() ;The Max User Check
I $D(^%ZOSF("ACTJ")) X ^("ACTJ") I $P(XUVOL,U,3),($P(XUVOL,U,3)'>Y) Q 2
Q 0
;
LOGOUT ;Finish logout of user.
N XU1
D CLEARALL^XWBDRPC(.XU1)
;Remove CCOW sign-on data
S HDL=$G(^XUTL("XQ",$J,"HDL")) I $L(HDL) D
. K ^XTMP(HDL,"JOB",$J)
. I $O(^XTMP(HDL,"JOB",0))="" K ^XTMP(HDL)
;
D BYE^XUSCLEAN,XUTL^XUSCLEAN ;Mark the sign-on log, File cleanup.
Q
;D1,D2 are place holders for now
SETUP(RET,XWBUSRNM,ASOSKIP,D2) ;RPC. XUS SIGNON SETUP - IA #1632 (API IA #4054)
;sets up environment for GUI signon
N X1 K DUZ
S XWBUSRNM=$G(XWBUSRNM),ASOSKIP=$G(ASOSKIP)
I $L($G(XWBTIP)) S IO("IP")=XWBTIP
S IO("CLNM")=$$LOW^XLFSTR($G(XWBCLMAN)) D ZIO^%ZIS4
;Setup needed variables
D SET1^XUS(0),SET^XWBSEC("XUS XOPT",XOPT) ;p265
;I '$D(IO("HOME")) S %ZIS="0H",IOP="NULL" D ^%ZIS ;Setup NULL as the home device
D SAVE^XUS1 ;save the home device
;0=server name, 1=volume, 2=uci, 3=device, 4=# attempts, 5=skip signon-screen,6=Domain Name, 7=Production (0=no, 1=Yes)
S RET(0)=$P(XUENV,U,3),RET(1)=$P(XUVOL,U),RET(2)=XUCI
S RET(3)=$I,RET(4)=$P(XOPT,U,2),RET(5)=0
S RET(6)=$G(^XMB("NETNAME")) ;DBIA #1131
S RET(7)=$$PROD^XUPROD ;Tell if production.
S X1=$$INHIBIT() I X1 S XWBERR=$S(X1=1:"Logons Inhibited",1:"Max Users") Q ;p523
; Check for Broker Security Enhancement (BSE) token
I (+XWBUSRNM<-30),$$CHKUSER^XUSBSE1(XWBUSRNM) S RET(5)=1 D POST2 Q ;p523 BSE CHANGE
; End of Check for BSE token
;Auto sign-on check only for Broker v1.1
I $G(ASOSKIP) S XQXFLG("ASO")=1 ;Skip the ASO check, Not for VISITORS p523
I $G(XWBVER)<1.1 S XQXFLG("ZEBRA")=-1 ;Disable for v1.0
I $L(IO("CLNM")),'$G(DUZ) S DUZ=$$AUTOXWB^XUS1B() ;Only check when 1.1 CL.
I $G(DUZ)>0 D ;p523
. I '$D(XUSER(0)),DUZ D USER^XUS(DUZ)
. N %T S %T=$$USER^XUS1A I %T S DUZ=0 Q
. D NOW,POST2 S RET(5)=1
Q
;
OWNSKEY(RET,LIST,IEN) ;RPC. XUS KEY CHECK - IA #6286 (API IA #3277)
;Does user have Security Key?
N I,K S I=""
I $G(IEN)'>0 S IEN=$G(DUZ)
I $G(IEN)'>0 S RET(0)=0 Q
I $O(LIST(""))="" S RET(0)=$$KCHK(LIST,IEN) Q
F S I=$O(LIST(I)) Q:I="" S RET(I)=$$KCHK(LIST(I),IEN)
Q
;
KCHK(%,IEN) ;Key Check
S:$G(IEN)'>0 IEN=$G(DUZ) Q $S($G(IEN)>0:$D(^XUSEC(%,IEN)),1:0)
;
ALLKEYS(RET,IEN,FLG) ;RPC. XUS ALLKEYS - IA #6287 (API IA #3277)
;Return ALL or most KEYS that a user has.
N I,J,K,L K ^TMP("XU",$J)
S RET=$NA(^TMP("XU",$J))
S:'$D(IEN) IEN=DUZ I IEN'>0 S @RET@(0)=-1 Q
S I=0,L=0
F S I=$O(^VA(200,IEN,51,I)) Q:I'>0 S K=$G(^DIC(19.1,I,0)) D
. Q:'$P(K,U,5) ;Check 'Send to J2EE' field.
. S L=L+1,@RET@(L,0)=$P(K,U,1)
. Q
Q
;
AVHELP(RET) ; send access/verify code instructions.
S RET(0)=$$AVHLPTXT^XUS2()
Q
;
OPTACCES(RET,USER,OPTIONS,MODE) ;Checks or sets user's access for passed in options
S MODE="CHECK" ;only CHECK mode supported for now
N I S I=""
I $G(USER)'>0 S RET(0)=0 Q
F S I=$O(OPTIONS(I)) Q:I="" S RET(I)=$$CHK^XQCS(USER,OPTIONS(I))=1
Q
;
CHECKAV(AVC) ;SR. EF. to check an A/V code, Separate w/ ";", return IEN or 0
N XUF,XUSER S XUF=0,U="^"
Q $$CHECKAV^XUS(AVC)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSRB 6815 printed Oct 16, 2024@18:13:42 Page 2
XUSRB ;ISCSF/RWF - Request Broker ;12/01/15 07:54
+1 ;;8.0;KERNEL;**11,16,28,32,59,70,82,109,115,165,150,180,213,234,238,265,337,395,404,437,523,659**;Jul 10, 1995;Build 22
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;No entry from top
QUIT
+4 ;
+5 ;RPC BROKER calls, First parameter is always call-by-reference
VALIDAV(RET,AVCODE) ;RPC. XUS CVC - IA #6296
+1 ;Check a users access
+2 ;Return R(0)=DUZ, R(1)=(0=OK, 1,2...=Can't sign-on for some reason)
+3 ; R(2)=verify needs changing, R(3)=Message, R(4)=0, R(5)=msg cnt, R(5+n)
+4 ; R(R(5)+6)=# div user must select from, R(R(5)+6+n)=div
+5 ;
+6 NEW X,XUSER,XUNOW,XUDEV,XUM,XUMSG,%1,VCCH
KILL DUZ
+7 SET U="^"
SET RET(0)=0
SET RET(5)=0
SET XUF=$GET(XUF,0)
SET XUM=0
SET XUMSG=0
SET XUDEV=0
+8 SET DUZ=0
SET DUZ(0)=""
SET VCCH=0
DO NOW
+9 SET XOPT=$$STATE^XWBSEC("XUS XOPT")
+10 ;Logon inhibited
SET XUMSG=$$INHIBIT()
IF XUMSG
SET XUM=1
GOTO VAX
+11 ;3 Strikes
+12 ;IP locked
IF $$LKCHECK^XUSTZIP($GET(IO("IP")))
SET XUMSG=7
GOTO VAX
+13 ;Check type of sign-on code
+14 IF $LENGTH(AVCODE)
Begin DoDot:1
+15 IF $EXTRACT(AVCODE,1,2)="~1"
SET DUZ=$$CHKASH^XUSRB4(AVCODE)
SET DUZ("AUTHENTICATION")="ASHTOKEN"
QUIT
+16 IF $EXTRACT(AVCODE,1,2)="~2"
SET DUZ=$$CHKCCOW^XUSRB4(AVCODE)
SET DUZ("AUTHENTICATION")="CCOWTOKEN"
QUIT
+17 SET DUZ=$$CHECKAV^XUS($$DECRYP^XUSRB1(AVCODE))
SET DUZ("AUTHENTICATION")="AVCODES"
+18 QUIT
End DoDot:1
+19 IF DUZ'>0
IF $$FAIL^XUS3
Begin DoDot:1
+20 ;3 Strikes
SET XUM=1
SET XUMSG=7
SET X=$$RA^XUSTZ
HANG 5
End DoDot:1
GOTO VAX
+21 ;Check User
SET XUMSG=$$UVALID^XUS()
if XUMSG
GOTO VAX
+22 ;Check VC
SET VCCH=$$VCVALID()
+23 IF $GET(DUZ("LOA"))=""
SET DUZ("LOA")=2
+24 IF DUZ>0
SET XUMSG=$$POST(1)
+25 ;If can't sign-on, don't tell need to change VC
IF XUMSG>0
SET DUZ=0
SET VCCH=0
+26 ;Need to change VC
IF 'XUMSG
IF VCCH
SET XUMSG=12
DO SET^XWBSEC("XUS DUZ",DUZ)
VAX ;Can't sign-on, Clear DUZ.
if XUMSG>0
SET DUZ=0
+1 IF DUZ>0
Begin DoDot:1
+2 SET DUZ("LOA")=2
+3 DO POST2
End DoDot:1
+4 SET RET(0)=DUZ
SET RET(1)=XUM
SET RET(2)=VCCH
SET RET(3)=$SELECT(XUMSG:$$TXT^XUS3(XUMSG),1:"")
SET RET(4)=0
+5 KILL DUZ("CCOW")
+6 QUIT
+7 ;
NOW SET U="^"
SET XUNOW=$$NOW^XLFDT()
SET DT=$PIECE(XUNOW,".")
+1 QUIT
+2 ;
INTRO(RET) ;Return INTRO TEXT.
+1 DO INTRO^XUS1A("RET")
+2 QUIT
+3 ;
VCVALID() ;Return 1 if the Verify code needs changing.
+1 if '$GET(DUZ)
QUIT 1
+2 ;VC is empty
if $PIECE($GET(^VA(200,DUZ,.1)),U,2)=""
QUIT 1
+3 ;VC never expires
if $PIECE(^VA(200,DUZ,0),U,8)=1
QUIT 0
+4 NEW XUSER
DO USER^XUS(DUZ)
+5 QUIT $$VCHG^XUS1
+6 ;
CVC(RET,XU1) ;change VC, Return 0 = success
+1 NEW XU2,XU3,XU4
SET DUZ=$GET(DUZ)
SET RET(0)=99
SET XU4=$$STATE^XWBSEC("XUS DUZ")
if (DUZ=0)&(XU4>0)
SET DUZ=XU4
if DUZ'>0
QUIT
+2 SET U="^"
SET XU2=$PIECE(XU1,U,2)
SET XU3=$PIECE(XU1,U,3)
SET XU1=$PIECE(XU1,U)
+3 SET XU1=$$DECRYP^XUSRB1(XU1)
SET XU2=$$DECRYP^XUSRB1(XU2)
SET XU3=$$DECRYP^XUSRB1(XU3)
+4 SET XU3=$$BRCVC^XUS2(XU1,XU2)
SET RET(0)=+XU3
SET RET(1)=$PIECE(XU3,U,2,9)
+5 ;Clean-up if not changed.
IF XU3>0
SET DUZ=0
+6 IF 'XU3
IF XU4
DO KILL^XWBSEC("XUS DUZ")
DO POST2
+7 QUIT
+8 ;
SHOWPOST() ;EF. Check if should send the POST SIGN-ON msg.
+1 QUIT +$PIECE($GET(^XTV(8989.3,1,"XWB")),"^",2)
+2 ;
POST(CVC) ;Finish setup partition, I CVC don't log yet
+1 NEW X,XUM,XUDIV
if $DATA(IO)[0
SET IO=$IO
SET IO(0)=IO
+2 KILL ^UTILITY($JOB),^TMP($JOB)
+3 IF '$DATA(XUSER(0))
IF DUZ
DO USER^XUS(DUZ)
+4 ;User can't sign on for some reason.
SET XUM=$$USER^XUS1A
if XUM>0
QUIT XUM
+5 ;The next line sends the post sign-on msg
SET RET(5)=0
+6 FOR %=1:1
if '$DATA(XUTEXT(%))
QUIT
SET RET(5+%)=$EXTRACT(XUTEXT(%),2,256)
SET RET(5)=%
+7 ;This line stops the sending/display of the msg.
IF '$$SHOWPOST
SET RET(5)=0
+8 if '$GET(CVC)
DO POST2
+9 QUIT 0
+10 ;
POST2 ;Finish User Setup for silent log-on
+1 if '$DATA(XUNOW)
DO NOW
+2 DO DUZ^XUS1A
DO SAVE^XUS1
DO LOG^XUS1
DO ABT^XQ12
+3 ;p265
DO KILL^XWBSEC("XUS XOPT")
DO CLRFAC^XUS3($GET(IO("IP")))
+4 ;Set normal Broker time-out
DO SETTIME^XWBTCPM()
+5 ;See DTIME set for user
SET DTIME=$$DTIME^XUP(DUZ)
+6 ;Delete the sign-on context.
if $GET(XWBVER)<1.106
KILL XQY,XQY0
+7 KILL XUTEXT,XOPT,XUEON,XUEOFF,XUTT,XUDEV,XUSER
+8 QUIT
+9 ;
INHIBIT() ;Is Logon to this system Inhibited?
+1 IF $$INHIB1()
QUIT 1
+2 IF $$INHIB2()
QUIT 2
+3 QUIT 0
+4 ;
INHIB1() ;The LOGON check
+1 IF $GET(^%ZIS(14.5,"LOGON",XQVOL))
QUIT 1
+2 QUIT 0
+3 ;
INHIB2() ;The Max User Check
+1 IF $DATA(^%ZOSF("ACTJ"))
XECUTE ^("ACTJ")
IF $PIECE(XUVOL,U,3)
IF ($PIECE(XUVOL,U,3)'>Y)
QUIT 2
+2 QUIT 0
+3 ;
LOGOUT ;Finish logout of user.
+1 NEW XU1
+2 DO CLEARALL^XWBDRPC(.XU1)
+3 ;Remove CCOW sign-on data
+4 SET HDL=$GET(^XUTL("XQ",$JOB,"HDL"))
IF $LENGTH(HDL)
Begin DoDot:1
+5 KILL ^XTMP(HDL,"JOB",$JOB)
+6 IF $ORDER(^XTMP(HDL,"JOB",0))=""
KILL ^XTMP(HDL)
End DoDot:1
+7 ;
+8 ;Mark the sign-on log, File cleanup.
DO BYE^XUSCLEAN
DO XUTL^XUSCLEAN
+9 QUIT
+10 ;D1,D2 are place holders for now
SETUP(RET,XWBUSRNM,ASOSKIP,D2) ;RPC. XUS SIGNON SETUP - IA #1632 (API IA #4054)
+1 ;sets up environment for GUI signon
+2 NEW X1
KILL DUZ
+3 SET XWBUSRNM=$GET(XWBUSRNM)
SET ASOSKIP=$GET(ASOSKIP)
+4 IF $LENGTH($GET(XWBTIP))
SET IO("IP")=XWBTIP
+5 SET IO("CLNM")=$$LOW^XLFSTR($GET(XWBCLMAN))
DO ZIO^%ZIS4
+6 ;Setup needed variables
+7 ;p265
DO SET1^XUS(0)
DO SET^XWBSEC("XUS XOPT",XOPT)
+8 ;I '$D(IO("HOME")) S %ZIS="0H",IOP="NULL" D ^%ZIS ;Setup NULL as the home device
+9 ;save the home device
DO SAVE^XUS1
+10 ;0=server name, 1=volume, 2=uci, 3=device, 4=# attempts, 5=skip signon-screen,6=Domain Name, 7=Production (0=no, 1=Yes)
+11 SET RET(0)=$PIECE(XUENV,U,3)
SET RET(1)=$PIECE(XUVOL,U)
SET RET(2)=XUCI
+12 SET RET(3)=$IO
SET RET(4)=$PIECE(XOPT,U,2)
SET RET(5)=0
+13 ;DBIA #1131
SET RET(6)=$GET(^XMB("NETNAME"))
+14 ;Tell if production.
SET RET(7)=$$PROD^XUPROD
+15 ;p523
SET X1=$$INHIBIT()
IF X1
SET XWBERR=$SELECT(X1=1:"Logons Inhibited",1:"Max Users")
QUIT
+16 ; Check for Broker Security Enhancement (BSE) token
+17 ;p523 BSE CHANGE
IF (+XWBUSRNM<-30)
IF $$CHKUSER^XUSBSE1(XWBUSRNM)
SET RET(5)=1
DO POST2
QUIT
+18 ; End of Check for BSE token
+19 ;Auto sign-on check only for Broker v1.1
+20 ;Skip the ASO check, Not for VISITORS p523
IF $GET(ASOSKIP)
SET XQXFLG("ASO")=1
+21 ;Disable for v1.0
IF $GET(XWBVER)<1.1
SET XQXFLG("ZEBRA")=-1
+22 ;Only check when 1.1 CL.
IF $LENGTH(IO("CLNM"))
IF '$GET(DUZ)
SET DUZ=$$AUTOXWB^XUS1B()
+23 ;p523
IF $GET(DUZ)>0
Begin DoDot:1
+24 IF '$DATA(XUSER(0))
IF DUZ
DO USER^XUS(DUZ)
+25 NEW %T
SET %T=$$USER^XUS1A
IF %T
SET DUZ=0
QUIT
+26 DO NOW
DO POST2
SET RET(5)=1
End DoDot:1
+27 QUIT
+28 ;
OWNSKEY(RET,LIST,IEN) ;RPC. XUS KEY CHECK - IA #6286 (API IA #3277)
+1 ;Does user have Security Key?
+2 NEW I,K
SET I=""
+3 IF $GET(IEN)'>0
SET IEN=$GET(DUZ)
+4 IF $GET(IEN)'>0
SET RET(0)=0
QUIT
+5 IF $ORDER(LIST(""))=""
SET RET(0)=$$KCHK(LIST,IEN)
QUIT
+6 FOR
SET I=$ORDER(LIST(I))
if I=""
QUIT
SET RET(I)=$$KCHK(LIST(I),IEN)
+7 QUIT
+8 ;
KCHK(%,IEN) ;Key Check
+1 if $GET(IEN)'>0
SET IEN=$GET(DUZ)
QUIT $SELECT($GET(IEN)>0:$DATA(^XUSEC(%,IEN)),1:0)
+2 ;
ALLKEYS(RET,IEN,FLG) ;RPC. XUS ALLKEYS - IA #6287 (API IA #3277)
+1 ;Return ALL or most KEYS that a user has.
+2 NEW I,J,K,L
KILL ^TMP("XU",$JOB)
+3 SET RET=$NAME(^TMP("XU",$JOB))
+4 if '$DATA(IEN)
SET IEN=DUZ
IF IEN'>0
SET @RET@(0)=-1
QUIT
+5 SET I=0
SET L=0
+6 FOR
SET I=$ORDER(^VA(200,IEN,51,I))
if I'>0
QUIT
SET K=$GET(^DIC(19.1,I,0))
Begin DoDot:1
+7 ;Check 'Send to J2EE' field.
if '$PIECE(K,U,5)
QUIT
+8 SET L=L+1
SET @RET@(L,0)=$PIECE(K,U,1)
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
AVHELP(RET) ; send access/verify code instructions.
+1 SET RET(0)=$$AVHLPTXT^XUS2()
+2 QUIT
+3 ;
OPTACCES(RET,USER,OPTIONS,MODE) ;Checks or sets user's access for passed in options
+1 ;only CHECK mode supported for now
SET MODE="CHECK"
+2 NEW I
SET I=""
+3 IF $GET(USER)'>0
SET RET(0)=0
QUIT
+4 FOR
SET I=$ORDER(OPTIONS(I))
if I=""
QUIT
SET RET(I)=$$CHK^XQCS(USER,OPTIONS(I))=1
+5 QUIT
+6 ;
CHECKAV(AVC) ;SR. EF. to check an A/V code, Separate w/ ";", return IEN or 0
+1 NEW XUF,XUSER
SET XUF=0
SET U="^"
+2 QUIT $$CHECKAV^XUS(AVC)
