- 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 Feb 18, 2025@23:09:42 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