XUSRB2 ;SFISC/RWF - RPC Broker Kernel Utilities. ;1/30/08 11:37
;;8.0;KERNEL;**115,150,277,337,469**;Jul 10, 1995;Build 7
;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
DIVGET(RET,IEN) ;Get Division data
;IEN is userid (DUZ or username) for future use.
N %,XUDIV
S XUDIV=0,%=$$CHKDIV^XUS1(.XUDIV) ;Get users div.
I (%>0)&($P(%,U,2)'>0) D UPDIV(+%) ;Set users default div.
S RET(0)=XUDIV ;RET(0) is number of divisions.
I XUDIV S %=0 D S RET(0)=XUDIV
. ;RET(%) is divison array eg. ien;station name;station#
. F S %=$O(XUDIV(%)) Q:(%'>0) S RET(%)=XUDIV(%)
Q
DIVSET(RET,DIV) ;Set users Division
S RET=0,DIV=$$FIND1^DIC(200.02,","_DUZ_",","MX",$G(DIV))
Q:DIV'>0
N X
I '$D(^VA(200,DUZ,2,DIV,0)) Q
S RET=1 ;1=set, 0=not set
D UPDIV(+DIV) ;Update Sign-on log
Q
;
UPDIV(V) ;Update the Sign-on Log & DUZ(2)
N IX
S DUZ(2)=V
S IX=$G(^XUTL("XQ",$J,0)) I IX S $P(^XUSEC(0,IX,0),U,17)=DUZ(2)
Q
;
USERINFO(RET) ;generic user information for seeding VistaUser object.
;Entry point for 'XUS GET USER INFO' RPC
N %,XU1,XU5
S RET(0)=DUZ
F %=1:1:6 S RET(%)="unk"
I DUZ'>0 S XWBSEC="User not fully sign-on" Q
S XU1=^VA(200,DUZ,0),XU5=$G(^(5))
S RET(1)=$P(XU1,"^") ;.01 User name.
S RET(2)=$$NAME^XUSER(DUZ) ;Return standard name.
S RET(3)=DUZ(2)_"^"_$$NS^XUAF4(DUZ(2))
S %=+$P(XU1,U,9),RET(4)=$P($G(^DIC(3.1,%,0)),U) ;Title
S %=+XU5,RET(5)=$P($G(^DIC(49,%,0)),U) ;Service/Section
S RET(6)=$G(DUZ("LANG")) ;User language
S RET(7)=DTIME ;Users DTIME
S RET(8)=$$VPID^XUPS(DUZ) ;Return VPID
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSRB2 1583 printed Nov 22, 2024@17:23:04 Page 2
XUSRB2 ;SFISC/RWF - RPC Broker Kernel Utilities. ;1/30/08 11:37
+1 ;;8.0;KERNEL;**115,150,277,337,469**;Jul 10, 1995;Build 7
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
DIVGET(RET,IEN) ;Get Division data
+1 ;IEN is userid (DUZ or username) for future use.
+2 NEW %,XUDIV
+3 ;Get users div.
SET XUDIV=0
SET %=$$CHKDIV^XUS1(.XUDIV)
+4 ;Set users default div.
IF (%>0)&($PIECE(%,U,2)'>0)
DO UPDIV(+%)
+5 ;RET(0) is number of divisions.
SET RET(0)=XUDIV
+6 IF XUDIV
SET %=0
Begin DoDot:1
+7 ;RET(%) is divison array eg. ien;station name;station#
+8 FOR
SET %=$ORDER(XUDIV(%))
if (%'>0)
QUIT
SET RET(%)=XUDIV(%)
End DoDot:1
SET RET(0)=XUDIV
+9 QUIT
DIVSET(RET,DIV) ;Set users Division
+1 SET RET=0
SET DIV=$$FIND1^DIC(200.02,","_DUZ_",","MX",$GET(DIV))
+2 if DIV'>0
QUIT
+3 NEW X
+4 IF '$DATA(^VA(200,DUZ,2,DIV,0))
QUIT
+5 ;1=set, 0=not set
SET RET=1
+6 ;Update Sign-on log
DO UPDIV(+DIV)
+7 QUIT
+8 ;
UPDIV(V) ;Update the Sign-on Log & DUZ(2)
+1 NEW IX
+2 SET DUZ(2)=V
+3 SET IX=$GET(^XUTL("XQ",$JOB,0))
IF IX
SET $PIECE(^XUSEC(0,IX,0),U,17)=DUZ(2)
+4 QUIT
+5 ;
USERINFO(RET) ;generic user information for seeding VistaUser object.
+1 ;Entry point for 'XUS GET USER INFO' RPC
+2 NEW %,XU1,XU5
+3 SET RET(0)=DUZ
+4 FOR %=1:1:6
SET RET(%)="unk"
+5 IF DUZ'>0
SET XWBSEC="User not fully sign-on"
QUIT
+6 SET XU1=^VA(200,DUZ,0)
SET XU5=$GET(^(5))
+7 ;.01 User name.
SET RET(1)=$PIECE(XU1,"^")
+8 ;Return standard name.
SET RET(2)=$$NAME^XUSER(DUZ)
+9 SET RET(3)=DUZ(2)_"^"_$$NS^XUAF4(DUZ(2))
+10 ;Title
SET %=+$PIECE(XU1,U,9)
SET RET(4)=$PIECE($GET(^DIC(3.1,%,0)),U)
+11 ;Service/Section
SET %=+XU5
SET RET(5)=$PIECE($GET(^DIC(49,%,0)),U)
+12 ;User language
SET RET(6)=$GET(DUZ("LANG"))
+13 ;Users DTIME
SET RET(7)=DTIME
+14 ;Return VPID
SET RET(8)=$$VPID^XUPS(DUZ)
+15 QUIT
