| [613] | 1 | XUSAP ;ISF/RWF - PROXY User Tools ;08/16/2006
|
|---|
| 2 | ;;8.0;KERNEL;**361,425**;Jul 10, 1995;Build 18
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | APFIND(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 | ;
|
|---|
| 14 | APCHK(IEN) ;Check if OK for AP user to run.
|
|---|
| 15 | ;Return 1 if OK, 0 if not
|
|---|
| 16 | Q $$ACTIVE(IEN)
|
|---|
| 17 | ;
|
|---|
| 18 | CPCHK(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 | ;
|
|---|
| 25 | ACTIVE(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 | ;
|
|---|
| 32 | USERTYPE(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 | ;
|
|---|
| 41 | RPC(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 | ;
|
|---|
| 47 | CREATE(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 | ;
|
|---|
| 72 | CONT ;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
|
|---|
