source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORRP038.m@ 635

Last change on this file since 635 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1RORRP038 ;HCIOFO/SG - RPC: USER AND PACKAGE PARAMETERS ; 11/21/05 9:28am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ; This routine uses the following IA's:
5 ;
6 ; #2263 GETWP^XPAR and PUT^XPAR (supported)
7 ;
8 Q
9 ;
10 ;***** RETRIEVES THE VALUE OF THE GUI PARAMETER
11 ; RPC: [ROR GUI PARAMETER GET]
12 ;
13 ; .RESULTS Reference to a local variable where the results
14 ; are returned to.
15 ;
16 ; INSTANCE Instance name of the GUI parameter.
17 ; Optional second "^"-piece of this parameter can
18 ; contain name of the parameter. By default, the
19 ; "ROR GUI PARAMETER" is used.
20 ;
21 ; [ENTITY] Entity where the parameter value is searched for.
22 ; By default ($G(ENTITY)=""), the "ALL" value is used
23 ; (see the DBIA #2263 for more details).
24 ;
25 ; Return Values:
26 ;
27 ; A negative value of the first "^"-piece of the RESULTS(0) indicates
28 ; an error (see the RPCSTK^RORERR procedure for more details).
29 ;
30 ; Otherwise, the RESULTS(0) will contain 0 and the subsequent nodes
31 ; of the RESULTS array will contain the lines of parameter value.
32 ;
33GETPARM(RESULTS,INSTANCE,ENTITY) ;
34 N CNT,I,RC,RORBUF,RORERRDL,RORMSG K RESULTS
35 D CLEAR^RORERR("GETPARM^RORRP038",1)
36 ;--- Check the parameters
37 I $G(INSTANCE)="" D D RPCSTK^RORERR(.RESULTS,RC) Q
38 . S RC=$$ERROR^RORERR(-88,,,,"INSTANCE",$G(INSTANCE))
39 S:$G(ENTITY)="" ENTITY="ALL"
40 S NAME=$P(INSTANCE,U,2)
41 S:$G(NAME)="" NAME="ROR GUI PARAMETER"
42 ;--- Get the value
43 D GETWP^XPAR(.RORBUF,ENTITY,NAME,$P(INSTANCE,U),.RORMSG)
44 I $G(RORMSG) D D RPCSTK^RORERR(.RESULTS,RC) Q
45 . S RC=$$ERROR^RORERR(-56,,$P(RORMSG,U,2),,+RORMSG,"GETWP^XPAR")
46 S RESULTS(0)=0
47 ;--- Ignore and delete old parameters without description.
48 ; These parameters were created by the CCR v1.0.
49 ;--- Unfortunately, the ENVAL^XPAR procedure ignores them.
50 I $G(RORBUF)="" D DEL^XPAR(ENTITY,NAME,$P(INSTANCE,U)) Q
51 ;--- Copy the value to the output array
52 S I="",CNT=0
53 F S I=$O(RORBUF(I)) Q:I="" D
54 . S CNT=CNT+1,RESULTS(CNT)=RORBUF(I,0) K RORBUF(I)
55 Q
56 ;
57 ;***** RETRIEVES THE LIST OF ALL INSTANCES OF THE PARAMETER
58 ; RPC: [ROR LIST PARAMETER INSTANCES]
59 ;
60 ; .RESULTS Reference to a local variable where the results
61 ; are returned to.
62 ;
63 ; [NAME] Name of the parameter (by default, the
64 ; "ROR GUI PARAMETER" is used)
65 ;
66 ; [ENTITY] Entity where the parameters are searched for.
67 ; By default ($G(ENTITY)=""), the "ALL" value is used
68 ; (see the DBIA #2263 for more details).
69 ;
70 ; [PREFIX] Instance name prefix (by default, all instances
71 ; are selected). Bear in mind that the prefix is
72 ; removed from the instance names.
73 ;
74GETPLIST(RESULTS,NAME,ENTITY,PREFIX) ;
75 N CNT,I,LP,RC,RORBUF,RORERRDL,RORMSG K RESULTS
76 D CLEAR^RORERR("GETRPLST^RORRP038",1)
77 S:$G(NAME)="" NAME="ROR GUI PARAMETER"
78 S:$G(ENTITY)="" ENTITY="ALL"
79 S:$G(PREFIX)="" PREFIX=""
80 D GETLST^XPAR(.RESULTS,ENTITY,NAME,"Q")
81 I $G(RORMSG) D D RPCSTK^RORERR(.RESULTS,RC) Q
82 . S RC=$$ERROR^RORERR(-56,,$P(RORMSG,U,2),,+RORMSG,"GETLST^XPAR")
83 ;--- Screen unwanted instances and strip the prefixes
84 S LP=$L(PREFIX)
85 I LP>0 S (CNT,I)=0 D
86 . F S I=$O(RESULTS(I)) Q:I="" D
87 . . I $E(RESULTS(I),1,LP)'=PREFIX K RESULTS(I) Q
88 . . S RESULTS(I)=$E(RESULTS(I),LP+1,999),CNT=CNT+1
89 E S CNT=+$G(RESULTS)
90 ;--- Store the total number of instances
91 S RESULTS(0)=CNT,RESULTS=""
92 Q
93 ;
94 ;***** RENAMES THE INSTANCE OF THE GUI PARAMETER
95 ; RPC: [ROR GUI PARAMETER RENAME]
96 ;
97 ; .RESULTS Reference to a local variable where the results
98 ; are returned to.
99 ;
100 ; ENTITY Entity that the parameter is associated with.
101 ;
102 ; NAME Name of the parameter
103 ;
104 ; OLDINST Current instance name of the GUI parameter
105 ;
106 ; NEWINST New instance name for the GUI parameter
107 ;
108 ; Return Values:
109 ;
110 ; A negative value of the first "^"-piece of the RESULTS(0) indicates
111 ; an error (see the RPCSTK^RORERR procedure for more details).
112 ;
113 ; Otherwise, the RESULTS(0) will contain 0.
114 ;
115RENPARM(RESULTS,ENTITY,NAME,OLDINST,NEWINST) ;
116 N RC,RORERRDL,RORMSG,TMP K RESULTS
117 D CLEAR^RORERR("RENPARM^RORRP038",1)
118 ;--- Check the parameters
119 I $G(ENTITY)="" D D RPCSTK^RORERR(.RESULTS,RC) Q
120 . S RC=$$ERROR^RORERR(-88,,,,"ENTITY",$G(ENTITY))
121 I $G(NAME)="" D D RPCSTK^RORERR(.RESULTS,RC) Q
122 . S RC=$$ERROR^RORERR(-88,,,,"NAME",$G(NAME))
123 I $G(OLDINST)="" D D RPCSTK^RORERR(.RESULTS,RC) Q
124 . S RC=$$ERROR^RORERR(-88,,,,"OLDINST",$G(OLDINST))
125 I $G(NEWINST)="" D D RPCSTK^RORERR(.RESULTS,RC) Q
126 . S RC=$$ERROR^RORERR(-88,,,,"NEWINST",$G(NEWINST))
127 ;--- Delete the instance with the new name if it exists
128 ;--- (otherwise, the REP^XPAR will return an error)
129 D:$$UP^XLFSTR(OLDINST)'=$$UP^XLFSTR(NEWINST)
130 . D DEL^XPAR(ENTITY,NAME,NEWINST,.RORMSG) K RORMSG
131 ;--- Rename the instance
132 D REP^XPAR(ENTITY,NAME,OLDINST,NEWINST,.RORMSG)
133 I $G(RORMSG) D D RPCSTK^RORERR(.RESULTS,RC) Q
134 . S RC=$$ERROR^RORERR(-56,,$P(RORMSG,U,2),,+RORMSG,"REP^XPAR")
135 S RESULTS(0)=0
136 Q
137 ;
138 ;***** STORES THE VALUE OF THE GUI PARAMETER
139 ; RPC: [ROR GUI PARAMETER SET]
140 ;
141 ; .RESULTS Reference to a local variable where the results
142 ; are returned to.
143 ;
144 ; INSTANCE Instance name of the GUI parameter.
145 ; Optional second "^"-piece of this parameter can
146 ; contain name of the parameter. By default, the
147 ; "ROR GUI PARAMETER" is used.
148 ;
149 ; [ENTITY] Entity that the parameter is associated with.
150 ; By default ($G(ENTITY)=""), the "USR" value is used
151 ; (see the DBIA #2263 for more details).
152 ;
153 ; [.]VALUE Value of the parameter. It should be either a string
154 ; or a reference to a local array that contains a text
155 ; (prepared for a word-processing field).
156 ;
157 ; The local array should not contain the 0 subscript
158 ; (it will not be stored).
159 ;
160 ; You can use the "@" value to delete the parameter.
161 ;
162 ; Return Values:
163 ;
164 ; A negative value of the first "^"-piece of the RESULTS(0) indicates
165 ; an error (see the RPCSTK^RORERR procedure for more details).
166 ;
167 ; Otherwise, the RESULTS(0) will contain 0.
168 ;
169SETPARM(RESULTS,INSTANCE,ENTITY,VALUE) ;
170 N RC,RORBUF,RORERRDL,RORMSG,TMP K RESULTS
171 D CLEAR^RORERR("SETPARM^RORRP038",1)
172 ;--- Check the parameters
173 I $G(INSTANCE)="" D D RPCSTK^RORERR(.RESULTS,RC) Q
174 . S RC=$$ERROR^RORERR(-88,,,,"INSTANCE",$G(INSTANCE))
175 I '$D(VALUE) D D RPCSTK^RORERR(.RESULTS,RC) Q
176 . S RC=$$ERROR^RORERR(-88,,,,"VALUE","<UNDEFINED>")
177 S:$G(ENTITY)="" ENTITY="USR"
178 S NAME=$P(INSTANCE,U,2)
179 S:$G(NAME)="" NAME="ROR GUI PARAMETER"
180 ;--- Prepare the value (make sure the description is not empty)
181 I $D(VALUE),$G(VALUE)'="@" D
182 . I $D(VALUE)=1 S RORBUF(1,0)=VALUE
183 . E M RORBUF=VALUE
184 . S:$G(RORBUF)="" RORBUF="CCR GUI Parameter"
185 E S RORBUF="@"
186 ;--- Store the value
187 D PUT^XPAR(ENTITY,NAME,$P(INSTANCE,U),.RORBUF,.RORMSG)
188 I $G(RORMSG),+RORMSG'=1 D D RPCSTK^RORERR(.RESULTS,RC) Q
189 . S RC=$$ERROR^RORERR(-56,,$P(RORMSG,U,2),,+RORMSG,"PUT^XPAR")
190 S RESULTS=0
191 Q
Note: See TracBrowser for help on using the repository browser.