- 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 Jan 18, 2025@03:13:16 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