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/XUSAP.m@ 703

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

initial load of WorldVistAEHR
File size: 3.0 KB
Line 
1XUSAP ;ISF/RWF - PROXY User Tools ;08/16/2006
2 ;;8.0;KERNEL;**361,425**;Jul 10, 1995;Build 18
3 Q
4 ;
5APFIND(NAME) ;Lookup Appliction user by name, return ien^vpid if OK
6 ; -1,-2,-3 if not
7 N X,IEN
8 S X=0,IEN=+$$FIND1^DIC(200,,"X",NAME,"B") S:'IEN X="-1^not in user file"
9 I IEN>0,'$$USERTYPE(IEN,"APPLICATION PROXY") S IEN=0,X="-2^not an app user"
10 I IEN>0,$$USERTYPE(IEN,"CONNECTOR PROXY") S IEN=0,X="-3^is both an app user and a connector user"
11 I IEN S X=IEN_"^"_$$VPID^XUPS(IEN)
12 Q X
13 ;
14APCHK(IEN) ;Check if OK for AP user to run.
15 ;Return 1 if OK, 0 if not
16 Q $$ACTIVE(IEN)
17 ;
18CPCHK(IEN) ;Check if OK for Connector Proxy to run
19 ;Return 1 if OK, "0^text" if NOT ok.
20 I $D(^VA(200,IEN,0))[0 Q "0^IEN not valid"
21 I IEN>0,'$$USERTYPE(IEN,"CONNECTOR PROXY") Q "0^Not a CONNECTOR PROXY User"
22 I IEN>0,$$USERTYPE(IEN,"APPLICATION PROXY") Q "0^APPLICATION PROXY USER" ;Can't be both
23 Q 1
24 ;
25ACTIVE(XUDA) ;Get if a user is active.
26 N %,X1,X2
27 S X1=$G(^VA(200,+$G(XUDA),0)),X2=1
28 S:$P(X1,U,7)=1 X2="0^DISUSER"
29 S %=$P(X1,U,11) I %>0,%'>DT S X2="0^TERMINATED^"_%
30 Q X2
31 ;
32USERTYPE(IE,CLASS) ;See if IEN points to a APP user
33 ;Return 1 if match class, else 0
34 N IX,R
35 I $E(CLASS,1)="`" S IX=+$E(CLASS,2,9)
36 E S IX=$$FIND1^DIC(201,,"X",CLASS)
37 Q:'IX 0 ;Did not find User class.
38 S R=+$O(^VA(200,IE,"USC3","B",IX,0))
39 Q (R>0)
40 ;
41RPC(RPC) ;Check if OK for AP to run RPC
42 ;Return 1 if OK to run, 0 otherwise.
43 I +RPC'=RPC S RPC=$O(^XWB(8994,"B",RPC,0))
44 I RPC'>0 Q 0
45 Q +$P($G(^XWB(8994,RPC,0)),"^",11)
46 ;
47CREATE(NAME,FMAC,OPT,NIL) ;Create an APPLICATION PROXY user
48 ;Return ien if OK, -1 if failed or 0 if exists.
49 ;NAME for user, FMAC FM access code, OPT Option menu for secondary menu.
50 ;OPT can be a name or array of names
51 N IEN,IENS,FDA,DIC,IX K ^TMP("DIERR",$J)
52 S IEN=$$FIND1^DIC(200,,"M",NAME)
53 I IEN Q "0^Name in Use"
54 S DIC="^VA(200,",DIC(0)="LMQ",DLAYGO=200,X=NAME
55 S DIC("DR")="3///"_FMAC
56 S XUNOTRIG=1 ;Needed to stop call to name components.
57 D ^DIC S IEN=+Y
58 Q:IEN<0 -1 ;Failed to create
59 ;Build FDA to add Options
60 S IEN(1)=","_IEN_",",IX=2
61 I $D(OPT)#2 S FDA(200.03,"+"_IX_IEN(1),.01)=OPT,IX=IX+1
62 I $D(OPT)>9 D
63 . N O S O=""
64 . F S O=$O(OPT(O)) Q:O="" S FDA(200.03,"+"_IX_IEN(1),.01)=O,IX=IX+1
65 . Q
66 S FDA(200.07,"+"_IX_IEN(1),.01)="APPLICATION PROXY",FDA(200.07,"+"_IX_IEN(1),2)=1
67 S DIC(0)="" ;Needed in call to XUA4A7
68 D UPDATE^DIE("E","FDA","IENS")
69 I $D(^TMP("DIERR",$J)) Q -1
70 Q IEN
71 ;
72CONT ;Connector Proxy User
73 N DA,DIC,DIE,DR,DLAYGO,DIRUT,XUITNAME,X,Y
74 I '$D(^XUSEC("XUMGR",$G(DUZ,0))) W !,"You MUST hold the XUMGR key" Q
75 S DIC="^VA(200,",DIC(0)="AELMQ",DLAYGO=200,DIC("A")="Enter NPF CONNECTOR PROXY name : ",XUITNAME=1
76 S DIC("DR")="3///@"
77 D ^DIC S DA=+Y
78 Q:DA'>0
79 I '$P(Y,U,3),'$$USERTYPE(DA,"CONNECTOR PROXY") D Q ;Quit
80 . W !,"Existing User is not a CONNECTOR PROXY"
81 . Q
82 I DA,$$USERTYPE(DA,"APPLICATION PROXY") W !,"Can't use an APPLICATION PROXY user." Q
83 ;Build DIE call
84 L +^VA(200,DA,0):DTIME
85 S DIE="^VA(200,"
86 S DR="7.2///Y;9.5///CONNECTOR PROXY;2.1;11.1;200.04///ALLOWED;201///@",DR(2,200.07)="2///Y"
87 D ^DIE
88 L -^VA(200,DA,0)
89 Q
Note: See TracBrowser for help on using the repository browser.