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