RORRP038 ;HCIOFO/SG - RPC: USER AND PACKAGE PARAMETERS ; 11/21/05 9:28am
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
; This routine uses the following IA's:
;
; #2263 GETWP^XPAR and PUT^XPAR (supported)
;
Q
;
;***** RETRIEVES THE VALUE OF THE GUI PARAMETER
; RPC: [ROR GUI PARAMETER GET]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; INSTANCE Instance name of the GUI parameter.
; Optional second "^"-piece of this parameter can
; contain name of the parameter. By default, the
; "ROR GUI PARAMETER" is used.
;
; [ENTITY] Entity where the parameter value is searched for.
; By default ($G(ENTITY)=""), the "ALL" value is used
; (see the DBIA #2263 for more details).
;
; Return Values:
;
; A negative value of the first "^"-piece of the RESULTS(0) indicates
; an error (see the RPCSTK^RORERR procedure for more details).
;
; Otherwise, the RESULTS(0) will contain 0 and the subsequent nodes
; of the RESULTS array will contain the lines of parameter value.
;
GETPARM(RESULTS,INSTANCE,ENTITY) ;
N CNT,I,RC,RORBUF,RORERRDL,RORMSG K RESULTS
D CLEAR^RORERR("GETPARM^RORRP038",1)
;--- Check the parameters
I $G(INSTANCE)="" D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$ERROR^RORERR(-88,,,,"INSTANCE",$G(INSTANCE))
S:$G(ENTITY)="" ENTITY="ALL"
S NAME=$P(INSTANCE,U,2)
S:$G(NAME)="" NAME="ROR GUI PARAMETER"
;--- Get the value
D GETWP^XPAR(.RORBUF,ENTITY,NAME,$P(INSTANCE,U),.RORMSG)
I $G(RORMSG) D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$ERROR^RORERR(-56,,$P(RORMSG,U,2),,+RORMSG,"GETWP^XPAR")
S RESULTS(0)=0
;--- Ignore and delete old parameters without description.
; These parameters were created by the CCR v1.0.
;--- Unfortunately, the ENVAL^XPAR procedure ignores them.
I $G(RORBUF)="" D DEL^XPAR(ENTITY,NAME,$P(INSTANCE,U)) Q
;--- Copy the value to the output array
S I="",CNT=0
F S I=$O(RORBUF(I)) Q:I="" D
. S CNT=CNT+1,RESULTS(CNT)=RORBUF(I,0) K RORBUF(I)
Q
;
;***** RETRIEVES THE LIST OF ALL INSTANCES OF THE PARAMETER
; RPC: [ROR LIST PARAMETER INSTANCES]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; [NAME] Name of the parameter (by default, the
; "ROR GUI PARAMETER" is used)
;
; [ENTITY] Entity where the parameters are searched for.
; By default ($G(ENTITY)=""), the "ALL" value is used
; (see the DBIA #2263 for more details).
;
; [PREFIX] Instance name prefix (by default, all instances
; are selected). Bear in mind that the prefix is
; removed from the instance names.
;
GETPLIST(RESULTS,NAME,ENTITY,PREFIX) ;
N CNT,I,LP,RC,RORBUF,RORERRDL,RORMSG K RESULTS
D CLEAR^RORERR("GETRPLST^RORRP038",1)
S:$G(NAME)="" NAME="ROR GUI PARAMETER"
S:$G(ENTITY)="" ENTITY="ALL"
S:$G(PREFIX)="" PREFIX=""
D GETLST^XPAR(.RESULTS,ENTITY,NAME,"Q")
I $G(RORMSG) D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$ERROR^RORERR(-56,,$P(RORMSG,U,2),,+RORMSG,"GETLST^XPAR")
;--- Screen unwanted instances and strip the prefixes
S LP=$L(PREFIX)
I LP>0 S (CNT,I)=0 D
. F S I=$O(RESULTS(I)) Q:I="" D
. . I $E(RESULTS(I),1,LP)'=PREFIX K RESULTS(I) Q
. . S RESULTS(I)=$E(RESULTS(I),LP+1,999),CNT=CNT+1
E S CNT=+$G(RESULTS)
;--- Store the total number of instances
S RESULTS(0)=CNT,RESULTS=""
Q
;
;***** RENAMES THE INSTANCE OF THE GUI PARAMETER
; RPC: [ROR GUI PARAMETER RENAME]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; ENTITY Entity that the parameter is associated with.
;
; NAME Name of the parameter
;
; OLDINST Current instance name of the GUI parameter
;
; NEWINST New instance name for the GUI parameter
;
; Return Values:
;
; A negative value of the first "^"-piece of the RESULTS(0) indicates
; an error (see the RPCSTK^RORERR procedure for more details).
;
; Otherwise, the RESULTS(0) will contain 0.
;
RENPARM(RESULTS,ENTITY,NAME,OLDINST,NEWINST) ;
N RC,RORERRDL,RORMSG,TMP K RESULTS
D CLEAR^RORERR("RENPARM^RORRP038",1)
;--- Check the parameters
I $G(ENTITY)="" D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$ERROR^RORERR(-88,,,,"ENTITY",$G(ENTITY))
I $G(NAME)="" D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$ERROR^RORERR(-88,,,,"NAME",$G(NAME))
I $G(OLDINST)="" D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$ERROR^RORERR(-88,,,,"OLDINST",$G(OLDINST))
I $G(NEWINST)="" D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$ERROR^RORERR(-88,,,,"NEWINST",$G(NEWINST))
;--- Delete the instance with the new name if it exists
;--- (otherwise, the REP^XPAR will return an error)
D:$$UP^XLFSTR(OLDINST)'=$$UP^XLFSTR(NEWINST)
. D DEL^XPAR(ENTITY,NAME,NEWINST,.RORMSG) K RORMSG
;--- Rename the instance
D REP^XPAR(ENTITY,NAME,OLDINST,NEWINST,.RORMSG)
I $G(RORMSG) D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$ERROR^RORERR(-56,,$P(RORMSG,U,2),,+RORMSG,"REP^XPAR")
S RESULTS(0)=0
Q
;
;***** STORES THE VALUE OF THE GUI PARAMETER
; RPC: [ROR GUI PARAMETER SET]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; INSTANCE Instance name of the GUI parameter.
; Optional second "^"-piece of this parameter can
; contain name of the parameter. By default, the
; "ROR GUI PARAMETER" is used.
;
; [ENTITY] Entity that the parameter is associated with.
; By default ($G(ENTITY)=""), the "USR" value is used
; (see the DBIA #2263 for more details).
;
; [.]VALUE Value of the parameter. It should be either a string
; or a reference to a local array that contains a text
; (prepared for a word-processing field).
;
; The local array should not contain the 0 subscript
; (it will not be stored).
;
; You can use the "@" value to delete the parameter.
;
; Return Values:
;
; A negative value of the first "^"-piece of the RESULTS(0) indicates
; an error (see the RPCSTK^RORERR procedure for more details).
;
; Otherwise, the RESULTS(0) will contain 0.
;
SETPARM(RESULTS,INSTANCE,ENTITY,VALUE) ;
N RC,RORBUF,RORERRDL,RORMSG,TMP K RESULTS
D CLEAR^RORERR("SETPARM^RORRP038",1)
;--- Check the parameters
I $G(INSTANCE)="" D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$ERROR^RORERR(-88,,,,"INSTANCE",$G(INSTANCE))
I '$D(VALUE) D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$ERROR^RORERR(-88,,,,"VALUE","<UNDEFINED>")
S:$G(ENTITY)="" ENTITY="USR"
S NAME=$P(INSTANCE,U,2)
S:$G(NAME)="" NAME="ROR GUI PARAMETER"
;--- Prepare the value (make sure the description is not empty)
I $D(VALUE),$G(VALUE)'="@" D
. I $D(VALUE)=1 S RORBUF(1,0)=VALUE
. E M RORBUF=VALUE
. S:$G(RORBUF)="" RORBUF="CCR GUI Parameter"
E S RORBUF="@"
;--- Store the value
D PUT^XPAR(ENTITY,NAME,$P(INSTANCE,U),.RORBUF,.RORMSG)
I $G(RORMSG),+RORMSG'=1 D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$ERROR^RORERR(-56,,$P(RORMSG,U,2),,+RORMSG,"PUT^XPAR")
S RESULTS=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORRP038 7375 printed Apr 09, 2024@20:48:45 Page 2
RORRP038 ;HCIOFO/SG - RPC: USER AND PACKAGE PARAMETERS ; 11/21/05 9:28am
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 ; This routine uses the following IA's:
+4 ;
+5 ; #2263 GETWP^XPAR and PUT^XPAR (supported)
+6 ;
+7 QUIT
+8 ;
+9 ;***** RETRIEVES THE VALUE OF THE GUI PARAMETER
+10 ; RPC: [ROR GUI PARAMETER GET]
+11 ;
+12 ; .RESULTS Reference to a local variable where the results
+13 ; are returned to.
+14 ;
+15 ; INSTANCE Instance name of the GUI parameter.
+16 ; Optional second "^"-piece of this parameter can
+17 ; contain name of the parameter. By default, the
+18 ; "ROR GUI PARAMETER" is used.
+19 ;
+20 ; [ENTITY] Entity where the parameter value is searched for.
+21 ; By default ($G(ENTITY)=""), the "ALL" value is used
+22 ; (see the DBIA #2263 for more details).
+23 ;
+24 ; Return Values:
+25 ;
+26 ; A negative value of the first "^"-piece of the RESULTS(0) indicates
+27 ; an error (see the RPCSTK^RORERR procedure for more details).
+28 ;
+29 ; Otherwise, the RESULTS(0) will contain 0 and the subsequent nodes
+30 ; of the RESULTS array will contain the lines of parameter value.
+31 ;
GETPARM(RESULTS,INSTANCE,ENTITY) ;
+1 NEW CNT,I,RC,RORBUF,RORERRDL,RORMSG
KILL RESULTS
+2 DO CLEAR^RORERR("GETPARM^RORRP038",1)
+3 ;--- Check the parameters
+4 IF $GET(INSTANCE)=""
Begin DoDot:1
+5 SET RC=$$ERROR^RORERR(-88,,,,"INSTANCE",$GET(INSTANCE))
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+6 if $GET(ENTITY)=""
SET ENTITY="ALL"
+7 SET NAME=$PIECE(INSTANCE,U,2)
+8 if $GET(NAME)=""
SET NAME="ROR GUI PARAMETER"
+9 ;--- Get the value
+10 DO GETWP^XPAR(.RORBUF,ENTITY,NAME,$PIECE(INSTANCE,U),.RORMSG)
+11 IF $GET(RORMSG)
Begin DoDot:1
+12 SET RC=$$ERROR^RORERR(-56,,$PIECE(RORMSG,U,2),,+RORMSG,"GETWP^XPAR")
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+13 SET RESULTS(0)=0
+14 ;--- Ignore and delete old parameters without description.
+15 ; These parameters were created by the CCR v1.0.
+16 ;--- Unfortunately, the ENVAL^XPAR procedure ignores them.
+17 IF $GET(RORBUF)=""
DO DEL^XPAR(ENTITY,NAME,$PIECE(INSTANCE,U))
QUIT
+18 ;--- Copy the value to the output array
+19 SET I=""
SET CNT=0
+20 FOR
SET I=$ORDER(RORBUF(I))
if I=""
QUIT
Begin DoDot:1
+21 SET CNT=CNT+1
SET RESULTS(CNT)=RORBUF(I,0)
KILL RORBUF(I)
End DoDot:1
+22 QUIT
+23 ;
+24 ;***** RETRIEVES THE LIST OF ALL INSTANCES OF THE PARAMETER
+25 ; RPC: [ROR LIST PARAMETER INSTANCES]
+26 ;
+27 ; .RESULTS Reference to a local variable where the results
+28 ; are returned to.
+29 ;
+30 ; [NAME] Name of the parameter (by default, the
+31 ; "ROR GUI PARAMETER" is used)
+32 ;
+33 ; [ENTITY] Entity where the parameters are searched for.
+34 ; By default ($G(ENTITY)=""), the "ALL" value is used
+35 ; (see the DBIA #2263 for more details).
+36 ;
+37 ; [PREFIX] Instance name prefix (by default, all instances
+38 ; are selected). Bear in mind that the prefix is
+39 ; removed from the instance names.
+40 ;
GETPLIST(RESULTS,NAME,ENTITY,PREFIX) ;
+1 NEW CNT,I,LP,RC,RORBUF,RORERRDL,RORMSG
KILL RESULTS
+2 DO CLEAR^RORERR("GETRPLST^RORRP038",1)
+3 if $GET(NAME)=""
SET NAME="ROR GUI PARAMETER"
+4 if $GET(ENTITY)=""
SET ENTITY="ALL"
+5 if $GET(PREFIX)=""
SET PREFIX=""
+6 DO GETLST^XPAR(.RESULTS,ENTITY,NAME,"Q")
+7 IF $GET(RORMSG)
Begin DoDot:1
+8 SET RC=$$ERROR^RORERR(-56,,$PIECE(RORMSG,U,2),,+RORMSG,"GETLST^XPAR")
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+9 ;--- Screen unwanted instances and strip the prefixes
+10 SET LP=$LENGTH(PREFIX)
+11 IF LP>0
SET (CNT,I)=0
Begin DoDot:1
+12 FOR
SET I=$ORDER(RESULTS(I))
if I=""
QUIT
Begin DoDot:2
+13 IF $EXTRACT(RESULTS(I),1,LP)'=PREFIX
KILL RESULTS(I)
QUIT
+14 SET RESULTS(I)=$EXTRACT(RESULTS(I),LP+1,999)
SET CNT=CNT+1
End DoDot:2
End DoDot:1
+15 IF '$TEST
SET CNT=+$GET(RESULTS)
+16 ;--- Store the total number of instances
+17 SET RESULTS(0)=CNT
SET RESULTS=""
+18 QUIT
+19 ;
+20 ;***** RENAMES THE INSTANCE OF THE GUI PARAMETER
+21 ; RPC: [ROR GUI PARAMETER RENAME]
+22 ;
+23 ; .RESULTS Reference to a local variable where the results
+24 ; are returned to.
+25 ;
+26 ; ENTITY Entity that the parameter is associated with.
+27 ;
+28 ; NAME Name of the parameter
+29 ;
+30 ; OLDINST Current instance name of the GUI parameter
+31 ;
+32 ; NEWINST New instance name for the GUI parameter
+33 ;
+34 ; Return Values:
+35 ;
+36 ; A negative value of the first "^"-piece of the RESULTS(0) indicates
+37 ; an error (see the RPCSTK^RORERR procedure for more details).
+38 ;
+39 ; Otherwise, the RESULTS(0) will contain 0.
+40 ;
RENPARM(RESULTS,ENTITY,NAME,OLDINST,NEWINST) ;
+1 NEW RC,RORERRDL,RORMSG,TMP
KILL RESULTS
+2 DO CLEAR^RORERR("RENPARM^RORRP038",1)
+3 ;--- Check the parameters
+4 IF $GET(ENTITY)=""
Begin DoDot:1
+5 SET RC=$$ERROR^RORERR(-88,,,,"ENTITY",$GET(ENTITY))
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+6 IF $GET(NAME)=""
Begin DoDot:1
+7 SET RC=$$ERROR^RORERR(-88,,,,"NAME",$GET(NAME))
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+8 IF $GET(OLDINST)=""
Begin DoDot:1
+9 SET RC=$$ERROR^RORERR(-88,,,,"OLDINST",$GET(OLDINST))
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+10 IF $GET(NEWINST)=""
Begin DoDot:1
+11 SET RC=$$ERROR^RORERR(-88,,,,"NEWINST",$GET(NEWINST))
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+12 ;--- Delete the instance with the new name if it exists
+13 ;--- (otherwise, the REP^XPAR will return an error)
+14 if $$UP^XLFSTR(OLDINST)'=$$UP^XLFSTR(NEWINST)
Begin DoDot:1
+15 DO DEL^XPAR(ENTITY,NAME,NEWINST,.RORMSG)
KILL RORMSG
End DoDot:1
+16 ;--- Rename the instance
+17 DO REP^XPAR(ENTITY,NAME,OLDINST,NEWINST,.RORMSG)
+18 IF $GET(RORMSG)
Begin DoDot:1
+19 SET RC=$$ERROR^RORERR(-56,,$PIECE(RORMSG,U,2),,+RORMSG,"REP^XPAR")
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+20 SET RESULTS(0)=0
+21 QUIT
+22 ;
+23 ;***** STORES THE VALUE OF THE GUI PARAMETER
+24 ; RPC: [ROR GUI PARAMETER SET]
+25 ;
+26 ; .RESULTS Reference to a local variable where the results
+27 ; are returned to.
+28 ;
+29 ; INSTANCE Instance name of the GUI parameter.
+30 ; Optional second "^"-piece of this parameter can
+31 ; contain name of the parameter. By default, the
+32 ; "ROR GUI PARAMETER" is used.
+33 ;
+34 ; [ENTITY] Entity that the parameter is associated with.
+35 ; By default ($G(ENTITY)=""), the "USR" value is used
+36 ; (see the DBIA #2263 for more details).
+37 ;
+38 ; [.]VALUE Value of the parameter. It should be either a string
+39 ; or a reference to a local array that contains a text
+40 ; (prepared for a word-processing field).
+41 ;
+42 ; The local array should not contain the 0 subscript
+43 ; (it will not be stored).
+44 ;
+45 ; You can use the "@" value to delete the parameter.
+46 ;
+47 ; Return Values:
+48 ;
+49 ; A negative value of the first "^"-piece of the RESULTS(0) indicates
+50 ; an error (see the RPCSTK^RORERR procedure for more details).
+51 ;
+52 ; Otherwise, the RESULTS(0) will contain 0.
+53 ;
SETPARM(RESULTS,INSTANCE,ENTITY,VALUE) ;
+1 NEW RC,RORBUF,RORERRDL,RORMSG,TMP
KILL RESULTS
+2 DO CLEAR^RORERR("SETPARM^RORRP038",1)
+3 ;--- Check the parameters
+4 IF $GET(INSTANCE)=""
Begin DoDot:1
+5 SET RC=$$ERROR^RORERR(-88,,,,"INSTANCE",$GET(INSTANCE))
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+6 IF '$DATA(VALUE)
Begin DoDot:1
+7 SET RC=$$ERROR^RORERR(-88,,,,"VALUE","<UNDEFINED>")
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+8 if $GET(ENTITY)=""
SET ENTITY="USR"
+9 SET NAME=$PIECE(INSTANCE,U,2)
+10 if $GET(NAME)=""
SET NAME="ROR GUI PARAMETER"
+11 ;--- Prepare the value (make sure the description is not empty)
+12 IF $DATA(VALUE)
IF $GET(VALUE)'="@"
Begin DoDot:1
+13 IF $DATA(VALUE)=1
SET RORBUF(1,0)=VALUE
+14 IF '$TEST
MERGE RORBUF=VALUE
+15 if $GET(RORBUF)=""
SET RORBUF="CCR GUI Parameter"
End DoDot:1
+16 IF '$TEST
SET RORBUF="@"
+17 ;--- Store the value
+18 DO PUT^XPAR(ENTITY,NAME,$PIECE(INSTANCE,U),.RORBUF,.RORMSG)
+19 IF $GET(RORMSG)
IF +RORMSG'=1
Begin DoDot:1
+20 SET RC=$$ERROR^RORERR(-56,,$PIECE(RORMSG,U,2),,+RORMSG,"PUT^XPAR")
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+21 SET RESULTS=0
+22 QUIT
