- 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 Jan 18, 2025@03:14:05 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)