1 | KIDS Distribution saved on Jun 19, 2010@17:41:48
|
---|
2 | TMG 1*1.0*8
|
---|
3 | **KIDS**:TMG1*1.0*8^
|
---|
4 |
|
---|
5 | **INSTALL NAME**
|
---|
6 | TMG1*1.0*8
|
---|
7 | "BLD",7636,0)
|
---|
8 | TMG1*1.0*8^^0^3100619^n
|
---|
9 | "BLD",7636,1,0)
|
---|
10 | ^^4^4^3100619^^
|
---|
11 | "BLD",7636,1,1,0)
|
---|
12 | This patch fixes a bug in RPC used to save .ini
|
---|
13 | "BLD",7636,1,2,0)
|
---|
14 | setting on server.
|
---|
15 | "BLD",7636,1,3,0)
|
---|
16 | This patch should be added after TMG1*1.0*8
|
---|
17 | "BLD",7636,1,4,0)
|
---|
18 |
|
---|
19 | "BLD",7636,4,0)
|
---|
20 | ^9.64PA^^0
|
---|
21 | "BLD",7636,6.3)
|
---|
22 | 2
|
---|
23 | "BLD",7636,"KRN",0)
|
---|
24 | ^9.67PA^8989.52^19
|
---|
25 | "BLD",7636,"KRN",.4,0)
|
---|
26 | .4
|
---|
27 | "BLD",7636,"KRN",.401,0)
|
---|
28 | .401
|
---|
29 | "BLD",7636,"KRN",.402,0)
|
---|
30 | .402
|
---|
31 | "BLD",7636,"KRN",.403,0)
|
---|
32 | .403
|
---|
33 | "BLD",7636,"KRN",.5,0)
|
---|
34 | .5
|
---|
35 | "BLD",7636,"KRN",.84,0)
|
---|
36 | .84
|
---|
37 | "BLD",7636,"KRN",3.6,0)
|
---|
38 | 3.6
|
---|
39 | "BLD",7636,"KRN",3.8,0)
|
---|
40 | 3.8
|
---|
41 | "BLD",7636,"KRN",9.2,0)
|
---|
42 | 9.2
|
---|
43 | "BLD",7636,"KRN",9.8,0)
|
---|
44 | 9.8
|
---|
45 | "BLD",7636,"KRN",9.8,"NM",0)
|
---|
46 | ^9.68A^1^1
|
---|
47 | "BLD",7636,"KRN",9.8,"NM",1,0)
|
---|
48 | TMGRPC1A^^0^B30114621
|
---|
49 | "BLD",7636,"KRN",9.8,"NM","B","TMGRPC1A",1)
|
---|
50 |
|
---|
51 | "BLD",7636,"KRN",19,0)
|
---|
52 | 19
|
---|
53 | "BLD",7636,"KRN",19.1,0)
|
---|
54 | 19.1
|
---|
55 | "BLD",7636,"KRN",101,0)
|
---|
56 | 101
|
---|
57 | "BLD",7636,"KRN",409.61,0)
|
---|
58 | 409.61
|
---|
59 | "BLD",7636,"KRN",771,0)
|
---|
60 | 771
|
---|
61 | "BLD",7636,"KRN",870,0)
|
---|
62 | 870
|
---|
63 | "BLD",7636,"KRN",8989.51,0)
|
---|
64 | 8989.51
|
---|
65 | "BLD",7636,"KRN",8989.52,0)
|
---|
66 | 8989.52
|
---|
67 | "BLD",7636,"KRN",8994,0)
|
---|
68 | 8994
|
---|
69 | "BLD",7636,"KRN",8994,"NM",0)
|
---|
70 | ^9.68A^^0
|
---|
71 | "BLD",7636,"KRN","B",.4,.4)
|
---|
72 |
|
---|
73 | "BLD",7636,"KRN","B",.401,.401)
|
---|
74 |
|
---|
75 | "BLD",7636,"KRN","B",.402,.402)
|
---|
76 |
|
---|
77 | "BLD",7636,"KRN","B",.403,.403)
|
---|
78 |
|
---|
79 | "BLD",7636,"KRN","B",.5,.5)
|
---|
80 |
|
---|
81 | "BLD",7636,"KRN","B",.84,.84)
|
---|
82 |
|
---|
83 | "BLD",7636,"KRN","B",3.6,3.6)
|
---|
84 |
|
---|
85 | "BLD",7636,"KRN","B",3.8,3.8)
|
---|
86 |
|
---|
87 | "BLD",7636,"KRN","B",9.2,9.2)
|
---|
88 |
|
---|
89 | "BLD",7636,"KRN","B",9.8,9.8)
|
---|
90 |
|
---|
91 | "BLD",7636,"KRN","B",19,19)
|
---|
92 |
|
---|
93 | "BLD",7636,"KRN","B",19.1,19.1)
|
---|
94 |
|
---|
95 | "BLD",7636,"KRN","B",101,101)
|
---|
96 |
|
---|
97 | "BLD",7636,"KRN","B",409.61,409.61)
|
---|
98 |
|
---|
99 | "BLD",7636,"KRN","B",771,771)
|
---|
100 |
|
---|
101 | "BLD",7636,"KRN","B",870,870)
|
---|
102 |
|
---|
103 | "BLD",7636,"KRN","B",8989.51,8989.51)
|
---|
104 |
|
---|
105 | "BLD",7636,"KRN","B",8989.52,8989.52)
|
---|
106 |
|
---|
107 | "BLD",7636,"KRN","B",8994,8994)
|
---|
108 |
|
---|
109 | "BLD",7636,"QDEF")
|
---|
110 | ^^^^NO^^^^NO^^NO
|
---|
111 | "BLD",7636,"QUES",0)
|
---|
112 | ^9.62^^
|
---|
113 | "MBREQ")
|
---|
114 | 0
|
---|
115 | "QUES","XPF1",0)
|
---|
116 | Y
|
---|
117 | "QUES","XPF1","??")
|
---|
118 | ^D REP^XPDH
|
---|
119 | "QUES","XPF1","A")
|
---|
120 | Shall I write over your |FLAG| File
|
---|
121 | "QUES","XPF1","B")
|
---|
122 | YES
|
---|
123 | "QUES","XPF1","M")
|
---|
124 | D XPF1^XPDIQ
|
---|
125 | "QUES","XPF2",0)
|
---|
126 | Y
|
---|
127 | "QUES","XPF2","??")
|
---|
128 | ^D DTA^XPDH
|
---|
129 | "QUES","XPF2","A")
|
---|
130 | Want my data |FLAG| yours
|
---|
131 | "QUES","XPF2","B")
|
---|
132 | YES
|
---|
133 | "QUES","XPF2","M")
|
---|
134 | D XPF2^XPDIQ
|
---|
135 | "QUES","XPI1",0)
|
---|
136 | YO
|
---|
137 | "QUES","XPI1","??")
|
---|
138 | ^D INHIBIT^XPDH
|
---|
139 | "QUES","XPI1","A")
|
---|
140 | Want KIDS to INHIBIT LOGONs during the install
|
---|
141 | "QUES","XPI1","B")
|
---|
142 | NO
|
---|
143 | "QUES","XPI1","M")
|
---|
144 | D XPI1^XPDIQ
|
---|
145 | "QUES","XPM1",0)
|
---|
146 | PO^VA(200,:EM
|
---|
147 | "QUES","XPM1","??")
|
---|
148 | ^D MG^XPDH
|
---|
149 | "QUES","XPM1","A")
|
---|
150 | Enter the Coordinator for Mail Group '|FLAG|'
|
---|
151 | "QUES","XPM1","B")
|
---|
152 |
|
---|
153 | "QUES","XPM1","M")
|
---|
154 | D XPM1^XPDIQ
|
---|
155 | "QUES","XPO1",0)
|
---|
156 | Y
|
---|
157 | "QUES","XPO1","??")
|
---|
158 | ^D MENU^XPDH
|
---|
159 | "QUES","XPO1","A")
|
---|
160 | Want KIDS to Rebuild Menu Trees Upon Completion of Install
|
---|
161 | "QUES","XPO1","B")
|
---|
162 | NO
|
---|
163 | "QUES","XPO1","M")
|
---|
164 | D XPO1^XPDIQ
|
---|
165 | "QUES","XPZ1",0)
|
---|
166 | Y
|
---|
167 | "QUES","XPZ1","??")
|
---|
168 | ^D OPT^XPDH
|
---|
169 | "QUES","XPZ1","A")
|
---|
170 | Want to DISABLE Scheduled Options, Menu Options, and Protocols
|
---|
171 | "QUES","XPZ1","B")
|
---|
172 | NO
|
---|
173 | "QUES","XPZ1","M")
|
---|
174 | D XPZ1^XPDIQ
|
---|
175 | "QUES","XPZ2",0)
|
---|
176 | Y
|
---|
177 | "QUES","XPZ2","??")
|
---|
178 | ^D RTN^XPDH
|
---|
179 | "QUES","XPZ2","A")
|
---|
180 | Want to MOVE routines to other CPUs
|
---|
181 | "QUES","XPZ2","B")
|
---|
182 | NO
|
---|
183 | "QUES","XPZ2","M")
|
---|
184 | D XPZ2^XPDIQ
|
---|
185 | "RTN")
|
---|
186 | 1
|
---|
187 | "RTN","TMGRPC1A")
|
---|
188 | 0^1^B30114621
|
---|
189 | "RTN","TMGRPC1A",1,0)
|
---|
190 | TMGRPC1A ;TMG/kst-RPC Functions ;2/11/10, 6/19/10
|
---|
191 | "RTN","TMGRPC1A",2,0)
|
---|
192 | ;;1.0;TMG-LIB;**1**;2/11/10;Build 2
|
---|
193 | "RTN","TMGRPC1A",3,0)
|
---|
194 | ;
|
---|
195 | "RTN","TMGRPC1A",4,0)
|
---|
196 | ;"TMG RPC FUNCTIONS
|
---|
197 | "RTN","TMGRPC1A",5,0)
|
---|
198 | ;
|
---|
199 | "RTN","TMGRPC1A",6,0)
|
---|
200 | ;"Copyright Kevin Toppenberg MD
|
---|
201 | "RTN","TMGRPC1A",7,0)
|
---|
202 | ;"Released under GNU General Public License (GPL)
|
---|
203 | "RTN","TMGRPC1A",8,0)
|
---|
204 | ;"
|
---|
205 | "RTN","TMGRPC1A",9,0)
|
---|
206 | ;"=======================================================================
|
---|
207 | "RTN","TMGRPC1A",10,0)
|
---|
208 | ;" RPC -- Public Functions.
|
---|
209 | "RTN","TMGRPC1A",11,0)
|
---|
210 | ;"=======================================================================
|
---|
211 | "RTN","TMGRPC1A",12,0)
|
---|
212 | ;"SETINIVL(RESULT,SECTION,KEY,VALUE) ;Entry point for TMG INIFILE SET
|
---|
213 | "RTN","TMGRPC1A",13,0)
|
---|
214 | ;"GETINIVL(RESULT,SECTION,KEY,DEFAULT) ;Entry point for TMG INIFILE GET
|
---|
215 | "RTN","TMGRPC1A",14,0)
|
---|
216 | ;
|
---|
217 | "RTN","TMGRPC1A",15,0)
|
---|
218 | ;"=======================================================================
|
---|
219 | "RTN","TMGRPC1A",16,0)
|
---|
220 | ;"PRIVATE API FUNCTIONS
|
---|
221 | "RTN","TMGRPC1A",17,0)
|
---|
222 | ;"=======================================================================
|
---|
223 | "RTN","TMGRPC1A",18,0)
|
---|
224 | ;
|
---|
225 | "RTN","TMGRPC1A",19,0)
|
---|
226 | ;"=======================================================================
|
---|
227 | "RTN","TMGRPC1A",20,0)
|
---|
228 | ;"=======================================================================
|
---|
229 | "RTN","TMGRPC1A",21,0)
|
---|
230 | ;"Dependencies:
|
---|
231 | "RTN","TMGRPC1A",22,0)
|
---|
232 | ;" DIC, TMGDEBUG
|
---|
233 | "RTN","TMGRPC1A",23,0)
|
---|
234 | ;"=======================================================================
|
---|
235 | "RTN","TMGRPC1A",24,0)
|
---|
236 | ;"=======================================================================
|
---|
237 | "RTN","TMGRPC1A",25,0)
|
---|
238 | ;
|
---|
239 | "RTN","TMGRPC1A",26,0)
|
---|
240 | SETINIVL(RESULT,SECTION,KEY,VALUE) ;
|
---|
241 | "RTN","TMGRPC1A",27,0)
|
---|
242 | ;"SCOPE: Public
|
---|
243 | "RTN","TMGRPC1A",28,0)
|
---|
244 | ;"RPC that calls this: TMG INIFILE SET
|
---|
245 | "RTN","TMGRPC1A",29,0)
|
---|
246 | ;"Purpose: To provide an entry point for a RPC call from a client. The client
|
---|
247 | "RTN","TMGRPC1A",30,0)
|
---|
248 | ;" will use this instead of TIniFile object in Delphi.
|
---|
249 | "RTN","TMGRPC1A",31,0)
|
---|
250 | ;" Note: Since all data are of type string in Mumps, this will work only with strings.
|
---|
251 | "RTN","TMGRPC1A",32,0)
|
---|
252 | ;" and type casting will have to take place in client.
|
---|
253 | "RTN","TMGRPC1A",33,0)
|
---|
254 | ;"Input: RESULT -- an OUT PARAMETER. See output below.
|
---|
255 | "RTN","TMGRPC1A",34,0)
|
---|
256 | ;" SECTION -- String of 'Section' to store setting in (corresponds to section in TIniFile)
|
---|
257 | "RTN","TMGRPC1A",35,0)
|
---|
258 | ;" KEY -- String of Key value. (corresponds to Ident/Key in TIniFile)
|
---|
259 | "RTN","TMGRPC1A",36,0)
|
---|
260 | ;" VALUE -- String of Value to set
|
---|
261 | "RTN","TMGRPC1A",37,0)
|
---|
262 | ;"Note: Because this is a shared resource, it is expected that the client will use
|
---|
263 | "RTN","TMGRPC1A",38,0)
|
---|
264 | ;" User.Name as the Section value.
|
---|
265 | "RTN","TMGRPC1A",39,0)
|
---|
266 | ;" Also, any prior value will be overwritten.
|
---|
267 | "RTN","TMGRPC1A",40,0)
|
---|
268 | ;"Output: Will return RESULT="1^Success", or -1^Error Message"
|
---|
269 | "RTN","TMGRPC1A",41,0)
|
---|
270 | SET RESULT="1^Success"
|
---|
271 | "RTN","TMGRPC1A",42,0)
|
---|
272 | IF $GET(SECTION)="" SET RESULT="-1^No value passed for SECTION" QUIT
|
---|
273 | "RTN","TMGRPC1A",43,0)
|
---|
274 | IF $GET(KEY)="" SET RESULT="-1^No value passed for KEY" QUIT
|
---|
275 | "RTN","TMGRPC1A",44,0)
|
---|
276 | SET VALUE=$GET(VALUE)
|
---|
277 | "RTN","TMGRPC1A",45,0)
|
---|
278 | NEW X,Y,DIC,IEN,IEN2
|
---|
279 | "RTN","TMGRPC1A",46,0)
|
---|
280 | SET DIC=22710,DIC(0)="LM" ;"Find SECTION if previously added.
|
---|
281 | "RTN","TMGRPC1A",47,0)
|
---|
282 | SET X=SECTION
|
---|
283 | "RTN","TMGRPC1A",48,0)
|
---|
284 | DO ^DIC SET IEN=+Y
|
---|
285 | "RTN","TMGRPC1A",49,0)
|
---|
286 | IF IEN'>0 DO ;"For some reason LAYGO doesn't work when called by RPC
|
---|
287 | "RTN","TMGRPC1A",50,0)
|
---|
288 | . NEW TMGFDA,TMGIEN,TMGMSG
|
---|
289 | "RTN","TMGRPC1A",51,0)
|
---|
290 | . SET TMGFDA(22710,"+1,",.01)=SECTION
|
---|
291 | "RTN","TMGRPC1A",52,0)
|
---|
292 | . DO UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG")
|
---|
293 | "RTN","TMGRPC1A",53,0)
|
---|
294 | . IF $DATA(TMGMSG("DIERR")) DO QUIT
|
---|
295 | "RTN","TMGRPC1A",54,0)
|
---|
296 | . . SET RESULT="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
|
---|
297 | "RTN","TMGRPC1A",55,0)
|
---|
298 | . SET IEN=+$GET(TMGIEN(1))
|
---|
299 | "RTN","TMGRPC1A",56,0)
|
---|
300 | IF +RESULT=-1 GOTO SIDN
|
---|
301 | "RTN","TMGRPC1A",57,0)
|
---|
302 | IF IEN'>0 SET RESULT="-1^Error establishing SECTION: ["_SECTION_"]" QUIT
|
---|
303 | "RTN","TMGRPC1A",58,0)
|
---|
304 | SET DA(1)=IEN,DIC(0)="LM",DIC="^TMG(22710,"_IEN_",1,"
|
---|
305 | "RTN","TMGRPC1A",59,0)
|
---|
306 | SET X=KEY
|
---|
307 | "RTN","TMGRPC1A",60,0)
|
---|
308 | DO ^DIC SET IEN2=+Y
|
---|
309 | "RTN","TMGRPC1A",61,0)
|
---|
310 | IF IEN2'>0 DO ;"For some reason LAYGO sometimes doesn't work when called by RPC
|
---|
311 | "RTN","TMGRPC1A",62,0)
|
---|
312 | . NEW TMGFDA,TMGIEN,TMGMSG
|
---|
313 | "RTN","TMGRPC1A",63,0)
|
---|
314 | . SET TMGFDA(22710.01,"+1,"_IEN_",",.01)=KEY
|
---|
315 | "RTN","TMGRPC1A",64,0)
|
---|
316 | . DO UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG")
|
---|
317 | "RTN","TMGRPC1A",65,0)
|
---|
318 | . IF $DATA(TMGMSG("DIERR")) DO QUIT
|
---|
319 | "RTN","TMGRPC1A",66,0)
|
---|
320 | . . SET RESULT="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
|
---|
321 | "RTN","TMGRPC1A",67,0)
|
---|
322 | . SET IEN2=+$GET(TMGIEN(1))
|
---|
323 | "RTN","TMGRPC1A",68,0)
|
---|
324 | IF +RESULT=-1 GOTO SIDN
|
---|
325 | "RTN","TMGRPC1A",69,0)
|
---|
326 | IF IEN2'>0 SET RESULT="-1^Error establishing KEY: ["_KEY_"]" QUIT
|
---|
327 | "RTN","TMGRPC1A",70,0)
|
---|
328 | NEW TMGFDA,TMGMSG
|
---|
329 | "RTN","TMGRPC1A",71,0)
|
---|
330 | IF VALUE="" SET VALUE="@"
|
---|
331 | "RTN","TMGRPC1A",72,0)
|
---|
332 | SET TMGFDA(22710.01,IEN2_","_IEN_",",1)=VALUE
|
---|
333 | "RTN","TMGRPC1A",73,0)
|
---|
334 | DO FILE^DIE("E","TMGFDA","TMGMSG")
|
---|
335 | "RTN","TMGRPC1A",74,0)
|
---|
336 | IF $DATA(TMGMSG("DIERR")) DO GOTO SIDN
|
---|
337 | "RTN","TMGRPC1A",75,0)
|
---|
338 | . SET RESULT="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
|
---|
339 | "RTN","TMGRPC1A",76,0)
|
---|
340 | SIDN QUIT
|
---|
341 | "RTN","TMGRPC1A",77,0)
|
---|
342 | ;
|
---|
343 | "RTN","TMGRPC1A",78,0)
|
---|
344 | ;
|
---|
345 | "RTN","TMGRPC1A",79,0)
|
---|
346 | GETINIVL(RESULT,SECTION,KEY,DEFAULT) ;
|
---|
347 | "RTN","TMGRPC1A",80,0)
|
---|
348 | ;"SCOPE: Public
|
---|
349 | "RTN","TMGRPC1A",81,0)
|
---|
350 | ;"RPC that calls this: TMG INIFILE GET
|
---|
351 | "RTN","TMGRPC1A",82,0)
|
---|
352 | ;"Purpose: To provide an entry point for a RPC call from a client. The client
|
---|
353 | "RTN","TMGRPC1A",83,0)
|
---|
354 | ;" will use this instead of TIniFile object in Delphi.
|
---|
355 | "RTN","TMGRPC1A",84,0)
|
---|
356 | ;" Note: Since all data are of type string in Mumps, this will work only with strings.
|
---|
357 | "RTN","TMGRPC1A",85,0)
|
---|
358 | ;" and type casting will have to take place in client.
|
---|
359 | "RTN","TMGRPC1A",86,0)
|
---|
360 | ;"Input: RESULT -- an OUT PARAMETER. See output below.
|
---|
361 | "RTN","TMGRPC1A",87,0)
|
---|
362 | ;" SECTION -- String of 'Section' to store setting in (corresponds to section in TIniFile)
|
---|
363 | "RTN","TMGRPC1A",88,0)
|
---|
364 | ;" KEY -- String of Key value. (corresponds to Ident/Key in TIniFile)
|
---|
365 | "RTN","TMGRPC1A",89,0)
|
---|
366 | ;" DEFAULT -- The value to be returned, if no value found.
|
---|
367 | "RTN","TMGRPC1A",90,0)
|
---|
368 | ;"Note: Because this is a shared resource, it is expected that the client will use
|
---|
369 | "RTN","TMGRPC1A",91,0)
|
---|
370 | ;" User.Name as the Section value.
|
---|
371 | "RTN","TMGRPC1A",92,0)
|
---|
372 | ;" Also, any prior value will be overwritten.
|
---|
373 | "RTN","TMGRPC1A",93,0)
|
---|
374 | ;"Output: Will return RESULT="1^<Value>", or -1^Error Message"
|
---|
375 | "RTN","TMGRPC1A",94,0)
|
---|
376 | IF $GET(SECTION)="" SET RESULT="-1^No value passed for SECTION" QUIT
|
---|
377 | "RTN","TMGRPC1A",95,0)
|
---|
378 | IF $GET(KEY)="" SET RESULT="-1^No value passed for KEY" QUIT
|
---|
379 | "RTN","TMGRPC1A",96,0)
|
---|
380 | SET DEFAULT=$GET(DEFAULT)
|
---|
381 | "RTN","TMGRPC1A",97,0)
|
---|
382 | NEW X,Y,DIC,IEN,IEN2
|
---|
383 | "RTN","TMGRPC1A",98,0)
|
---|
384 | SET DIC=22710,X=SECTION
|
---|
385 | "RTN","TMGRPC1A",99,0)
|
---|
386 | DO ^DIC SET IEN=+Y
|
---|
387 | "RTN","TMGRPC1A",100,0)
|
---|
388 | IF IEN'>0 SET RESULT="1^"_DEFAULT QUIT
|
---|
389 | "RTN","TMGRPC1A",101,0)
|
---|
390 | SET DA(1)=IEN,DIC="^TMG(22710,"_IEN_",1,"
|
---|
391 | "RTN","TMGRPC1A",102,0)
|
---|
392 | SET X=KEY
|
---|
393 | "RTN","TMGRPC1A",103,0)
|
---|
394 | DO ^DIC SET IEN2=+Y
|
---|
395 | "RTN","TMGRPC1A",104,0)
|
---|
396 | IF IEN2'>0 SET RESULT="1^"_DEFAULT QUIT
|
---|
397 | "RTN","TMGRPC1A",105,0)
|
---|
398 | NEW VALUE SET VALUE=$GET(^TMG(22710,IEN,1,IEN2,1),DEFAULT)
|
---|
399 | "RTN","TMGRPC1A",106,0)
|
---|
400 | IF VALUE'=DEFAULT SET VALUE=$PIECE(VALUE,"^",1)
|
---|
401 | "RTN","TMGRPC1A",107,0)
|
---|
402 | SET RESULT="1^"_VALUE
|
---|
403 | "RTN","TMGRPC1A",108,0)
|
---|
404 | QUIT
|
---|
405 | "RTN","TMGRPC1A",109,0)
|
---|
406 | ;
|
---|
407 | "RTN","TMGRPC1A",110,0)
|
---|
408 | ;
|
---|
409 | "RTN","TMGRPC1A",111,0)
|
---|
410 | CONVERT
|
---|
411 | "RTN","TMGRPC1A",112,0)
|
---|
412 | ;"Purpose: A temp function to convert between the old storage method and the new.
|
---|
413 | "RTN","TMGRPC1A",113,0)
|
---|
414 | ;"Data was stored in: ^TMG("INIDATA",Section,Key,Vaue)
|
---|
415 | "RTN","TMGRPC1A",114,0)
|
---|
416 | NEW SECTION,KEY,VALUE
|
---|
417 | "RTN","TMGRPC1A",115,0)
|
---|
418 | SET SECTION=""
|
---|
419 | "RTN","TMGRPC1A",116,0)
|
---|
420 | FOR SET SECTION=$ORDER(^TMG("INIDATA",SECTION)) QUIT:(SECTION="") DO
|
---|
421 | "RTN","TMGRPC1A",117,0)
|
---|
422 | . SET KEY=""
|
---|
423 | "RTN","TMGRPC1A",118,0)
|
---|
424 | . FOR SET KEY=$ORDER(^TMG("INIDATA",SECTION,KEY)) QUIT:(KEY="") DO
|
---|
425 | "RTN","TMGRPC1A",119,0)
|
---|
426 | . . SET VALUE=$GET(^TMG("INIDATA",SECTION,KEY))
|
---|
427 | "RTN","TMGRPC1A",120,0)
|
---|
428 | . . NEW RESULT
|
---|
429 | "RTN","TMGRPC1A",121,0)
|
---|
430 | . . DO SETINIVL(.RESULT,SECTION,KEY,VALUE) ;
|
---|
431 | "RTN","TMGRPC1A",122,0)
|
---|
432 | . . IF +RESULT>0 KILL ^TMG("INIDATA",SECTION,KEY) QUIT
|
---|
433 | "RTN","TMGRPC1A",123,0)
|
---|
434 | . . WRITE "Error trying to store SECTION=",SECTION,"; KEY=",KEY,"; VALUE=",VALUE,!
|
---|
435 | "RTN","TMGRPC1A",124,0)
|
---|
436 | . . WRITE " -- ",$PIECE(RESULT,"^",2),!
|
---|
437 | "RTN","TMGRPC1A",125,0)
|
---|
438 | QUIT
|
---|
439 | "RTN","TMGRPC1A",126,0)
|
---|
440 | ;
|
---|
441 | "RTN","TMGRPC1A",127,0)
|
---|
442 | ;
|
---|
443 | "RTN","TMGRPC1A",128,0)
|
---|
444 | INSTALL ;
|
---|
445 | "RTN","TMGRPC1A",129,0)
|
---|
446 | ;"Purpose: to add the RPC's to the OPTION record OR CPRS GUI CHART
|
---|
447 | "RTN","TMGRPC1A",130,0)
|
---|
448 | NEW DIC,X,Y,DA
|
---|
449 | "RTN","TMGRPC1A",131,0)
|
---|
450 | SET DIC="^DIC(19,",DIC(0)="M"
|
---|
451 | "RTN","TMGRPC1A",132,0)
|
---|
452 | SET X="OR CPRS GUI CHART"
|
---|
453 | "RTN","TMGRPC1A",133,0)
|
---|
454 | DO ^DIC
|
---|
455 | "RTN","TMGRPC1A",134,0)
|
---|
456 | IF +Y'>0 DO QUIT
|
---|
457 | "RTN","TMGRPC1A",135,0)
|
---|
458 | . WRITE "ERROR. Unable to find [OR CPRS GUI CHART] in file OPTION (#19)",!
|
---|
459 | "RTN","TMGRPC1A",136,0)
|
---|
460 | . NEW TEMP READ "Press [ENTER] to continue...",TEMP:($GET(DTIME,3600))
|
---|
461 | "RTN","TMGRPC1A",137,0)
|
---|
462 | . WRITE !
|
---|
463 | "RTN","TMGRPC1A",138,0)
|
---|
464 | SET DA(1)=+Y
|
---|
465 | "RTN","TMGRPC1A",139,0)
|
---|
466 | SET DIC=DIC_DA(1)_",""RPC"","
|
---|
467 | "RTN","TMGRPC1A",140,0)
|
---|
468 | SET DIC(0)="ML" ;"LAYGO --> add entry if not found
|
---|
469 | "RTN","TMGRPC1A",141,0)
|
---|
470 | SET X="TMG INIFILE GET"
|
---|
471 | "RTN","TMGRPC1A",142,0)
|
---|
472 | DO ^DIC
|
---|
473 | "RTN","TMGRPC1A",143,0)
|
---|
474 | IF +Y'>0 DO
|
---|
475 | "RTN","TMGRPC1A",144,0)
|
---|
476 | . WRITE "ERROR. Unable to add or find TMG INIFILE GET for subfile RPC in record",!
|
---|
477 | "RTN","TMGRPC1A",145,0)
|
---|
478 | . WRITE "OR CPRS GUI CHART in file OPTION (#19)",!
|
---|
479 | "RTN","TMGRPC1A",146,0)
|
---|
480 | . NEW TEMP READ "Press [ENTER] to continue...",TEMP:($GET(DTIME,3600))
|
---|
481 | "RTN","TMGRPC1A",147,0)
|
---|
482 | . WRITE !
|
---|
483 | "RTN","TMGRPC1A",148,0)
|
---|
484 | SET X="TMG INIFILE SET"
|
---|
485 | "RTN","TMGRPC1A",149,0)
|
---|
486 | DO ^DIC
|
---|
487 | "RTN","TMGRPC1A",150,0)
|
---|
488 | IF +Y'>0 DO
|
---|
489 | "RTN","TMGRPC1A",151,0)
|
---|
490 | . WRITE "ERROR. Unable to add or find TMG INIFILE SET for subfile RPC in record",!
|
---|
491 | "RTN","TMGRPC1A",152,0)
|
---|
492 | . WRITE "OR CPRS GUI CHART in file OPTION (#19)",!
|
---|
493 | "RTN","TMGRPC1A",153,0)
|
---|
494 | . NEW TEMP READ "Press [ENTER] to continue...",TEMP:($GET(DTIME,3600))
|
---|
495 | "RTN","TMGRPC1A",154,0)
|
---|
496 | . WRITE !
|
---|
497 | "RTN","TMGRPC1A",155,0)
|
---|
498 | QUIT
|
---|
499 | "RTN","TMGRPC1A",156,0)
|
---|
500 | ;
|
---|
501 | "VER")
|
---|
502 | 8.0^22.0
|
---|
503 | **END**
|
---|
504 | **END**
|
---|