source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSRB2.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1XUSRB2 ;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 ;
5DIVGET(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
15DIVSET(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 ;
22USERINFO(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
Note: See TracBrowser for help on using the repository browser.