Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUSAP

XUSAP.m

Go to the documentation of this file.
  1. XUSAP ;ISF/RWF - PROXY User Tools ;08/16/2006
  1. ;;8.0;KERNEL;**361,425**;Jul 10, 1995;Build 18
  1. Q
  1. ;
  1. APFIND(NAME) ;Lookup Appliction user by name, return ien^vpid if OK
  1. ; -1,-2,-3 if not
  1. N X,IEN
  1. S X=0,IEN=+$$FIND1^DIC(200,,"X",NAME,"B") S:'IEN X="-1^not in user file"
  1. I IEN>0,'$$USERTYPE(IEN,"APPLICATION PROXY") S IEN=0,X="-2^not an app user"
  1. I IEN>0,$$USERTYPE(IEN,"CONNECTOR PROXY") S IEN=0,X="-3^is both an app user and a connector user"
  1. I IEN S X=IEN_"^"_$$VPID^XUPS(IEN)
  1. Q X
  1. ;
  1. APCHK(IEN) ;Check if OK for AP user to run.
  1. ;Return 1 if OK, 0 if not
  1. Q $$ACTIVE(IEN)
  1. ;
  1. CPCHK(IEN) ;Check if OK for Connector Proxy to run
  1. ;Return 1 if OK, "0^text" if NOT ok.
  1. I $D(^VA(200,IEN,0))[0 Q "0^IEN not valid"
  1. I IEN>0,'$$USERTYPE(IEN,"CONNECTOR PROXY") Q "0^Not a CONNECTOR PROXY User"
  1. I IEN>0,$$USERTYPE(IEN,"APPLICATION PROXY") Q "0^APPLICATION PROXY USER" ;Can't be both
  1. Q 1
  1. ;
  1. ACTIVE(XUDA) ;Get if a user is active.
  1. N %,X1,X2
  1. S X1=$G(^VA(200,+$G(XUDA),0)),X2=1
  1. S:$P(X1,U,7)=1 X2="0^DISUSER"
  1. S %=$P(X1,U,11) I %>0,%'>DT S X2="0^TERMINATED^"_%
  1. Q X2
  1. ;
  1. USERTYPE(IE,CLASS) ;See if IEN points to a APP user
  1. ;Return 1 if match class, else 0
  1. N IX,R
  1. I $E(CLASS,1)="`" S IX=+$E(CLASS,2,9)
  1. E S IX=$$FIND1^DIC(201,,"X",CLASS)
  1. Q:'IX 0 ;Did not find User class.
  1. S R=+$O(^VA(200,IE,"USC3","B",IX,0))
  1. Q (R>0)
  1. ;
  1. RPC(RPC) ;Check if OK for AP to run RPC
  1. ;Return 1 if OK to run, 0 otherwise.
  1. I +RPC'=RPC S RPC=$O(^XWB(8994,"B",RPC,0))
  1. I RPC'>0 Q 0
  1. Q +$P($G(^XWB(8994,RPC,0)),"^",11)
  1. ;
  1. CREATE(NAME,FMAC,OPT,NIL) ;Create an APPLICATION PROXY user
  1. ;Return ien if OK, -1 if failed or 0 if exists.
  1. ;NAME for user, FMAC FM access code, OPT Option menu for secondary menu.
  1. ;OPT can be a name or array of names
  1. N IEN,IENS,FDA,DIC,IX K ^TMP("DIERR",$J)
  1. S IEN=$$FIND1^DIC(200,,"M",NAME)
  1. I IEN Q "0^Name in Use"
  1. S DIC="^VA(200,",DIC(0)="LMQ",DLAYGO=200,X=NAME
  1. S DIC("DR")="3///"_FMAC
  1. S XUNOTRIG=1 ;Needed to stop call to name components.
  1. D ^DIC S IEN=+Y
  1. Q:IEN<0 -1 ;Failed to create
  1. ;Build FDA to add Options
  1. S IEN(1)=","_IEN_",",IX=2
  1. I $D(OPT)#2 S FDA(200.03,"+"_IX_IEN(1),.01)=OPT,IX=IX+1
  1. I $D(OPT)>9 D
  1. . N O S O=""
  1. . F S O=$O(OPT(O)) Q:O="" S FDA(200.03,"+"_IX_IEN(1),.01)=O,IX=IX+1
  1. . Q
  1. S FDA(200.07,"+"_IX_IEN(1),.01)="APPLICATION PROXY",FDA(200.07,"+"_IX_IEN(1),2)=1
  1. S DIC(0)="" ;Needed in call to XUA4A7
  1. D UPDATE^DIE("E","FDA","IENS")
  1. I $D(^TMP("DIERR",$J)) Q -1
  1. Q IEN
  1. ;
  1. CONT ;Connector Proxy User
  1. N DA,DIC,DIE,DR,DLAYGO,DIRUT,XUITNAME,X,Y
  1. I '$D(^XUSEC("XUMGR",$G(DUZ,0))) W !,"You MUST hold the XUMGR key" Q
  1. S DIC="^VA(200,",DIC(0)="AELMQ",DLAYGO=200,DIC("A")="Enter NPF CONNECTOR PROXY name : ",XUITNAME=1
  1. S DIC("DR")="3///@"
  1. D ^DIC S DA=+Y
  1. Q:DA'>0
  1. I '$P(Y,U,3),'$$USERTYPE(DA,"CONNECTOR PROXY") D Q ;Quit
  1. . W !,"Existing User is not a CONNECTOR PROXY"
  1. . Q
  1. I DA,$$USERTYPE(DA,"APPLICATION PROXY") W !,"Can't use an APPLICATION PROXY user." Q
  1. ;Build DIE call
  1. L +^VA(200,DA,0):DTIME
  1. S DIE="^VA(200,"
  1. S DR="7.2///Y;9.5///CONNECTOR PROXY;2.1;11.1;200.04///ALLOWED;201///@",DR(2,200.07)="2///Y"
  1. D ^DIE
  1. L -^VA(200,DA,0)
  1. Q