| 1 | XUSRB2 ;SFISC/RWF - RPC Broker Kernel Utilities. ;05/04/2004 16:12
|
|---|
| 2 | ;;8.0;KERNEL;**115,150,277,337**;Jul 10, 1995
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | DIVGET(RET,IEN) ;Get Division data
|
|---|
| 6 | ;IEN is userid (DUZ or username) for future use.
|
|---|
| 7 | N %,XUDIV
|
|---|
| 8 | S XUDIV=0,%=$$CHKDIV^XUS1(.XUDIV) ;Get users div.
|
|---|
| 9 | S:(%>0)&($P(%,U,2)'>0) DUZ(2)=+% ;Set users default div.
|
|---|
| 10 | S RET(0)=XUDIV ;RET(0) is number of divisions.
|
|---|
| 11 | I XUDIV S %=0 D S RET(0)=XUDIV
|
|---|
| 12 | . ;RET(%) is divison array eg. ien;station name;station#
|
|---|
| 13 | . F S %=$O(XUDIV(%)) Q:(%'>0) S RET(%)=XUDIV(%)
|
|---|
| 14 | Q
|
|---|
| 15 | DIVSET(RET,DIV) ;Set users Division
|
|---|
| 16 | S RET=0,DIV=$$FIND1^DIC(200.02,","_DUZ_",","MX",$G(DIV))
|
|---|
| 17 | Q:DIV'>0
|
|---|
| 18 | I '$D(^VA(200,DUZ,2,DIV,0)) Q
|
|---|
| 19 | S DUZ(2)=DIV,RET=1 ;1=set, 0=not set
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | USERINFO(RET) ;generic user information for seeding VistaUser object.
|
|---|
| 23 | ;Entry point for 'XUS GET USER INFO' RPC
|
|---|
| 24 | N %,XU1,XU5
|
|---|
| 25 | S RET(0)=DUZ
|
|---|
| 26 | F %=1:1:6 S RET(%)="unk"
|
|---|
| 27 | I DUZ'>0 S XWBSEC="User not fully sign-on" Q
|
|---|
| 28 | S XU1=^VA(200,DUZ,0),XU5=$G(^(5))
|
|---|
| 29 | S RET(1)=$P(XU1,"^") ;.01 User name.
|
|---|
| 30 | S RET(2)=$$NAME^XUSER(DUZ) ;Return standard name.
|
|---|
| 31 | S RET(3)=DUZ(2)_"^"_$$NS^XUAF4(DUZ(2))
|
|---|
| 32 | S %=+$P(XU1,U,9),RET(4)=$P($G(^DIC(3.1,%,0)),U) ;Title
|
|---|
| 33 | S %=+XU5,RET(5)=$P($G(^DIC(49,%,0)),U) ;Service/Section
|
|---|
| 34 | S RET(6)=$G(DUZ("LANG")) ;User language
|
|---|
| 35 | S RET(7)=DTIME ;Users DTIME
|
|---|
| 36 | S RET(8)=$$VPID^XUPS(DUZ) ;Return VPID
|
|---|
| 37 | Q
|
|---|
