source: cprs/branches/tmg-cprs/Server_KIDS/TMG1-1.0-8.KIDS@ 1328

Last change on this file since 1328 was 808, checked in by Kevin Toppenberg, 15 years ago

Fixed bug in server-side .ini file storage
File size: 13.8 KB
Line 
1KIDS Distribution saved on Jun 19, 2010@17:41:48
2TMG 1*1.0*8
3**KIDS**:TMG1*1.0*8^
4
5**INSTALL NAME**
6TMG1*1.0*8
7"BLD",7636,0)
8TMG1*1.0*8^^0^3100619^n
9"BLD",7636,1,0)
10^^4^4^3100619^^
11"BLD",7636,1,1,0)
12This patch fixes a bug in RPC used to save .ini
13"BLD",7636,1,2,0)
14setting on server.
15"BLD",7636,1,3,0)
16This 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)
222
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)
383.6
39"BLD",7636,"KRN",3.8,0)
403.8
41"BLD",7636,"KRN",9.2,0)
429.2
43"BLD",7636,"KRN",9.8,0)
449.8
45"BLD",7636,"KRN",9.8,"NM",0)
46^9.68A^1^1
47"BLD",7636,"KRN",9.8,"NM",1,0)
48TMGRPC1A^^0^B30114621
49"BLD",7636,"KRN",9.8,"NM","B","TMGRPC1A",1)
50
51"BLD",7636,"KRN",19,0)
5219
53"BLD",7636,"KRN",19.1,0)
5419.1
55"BLD",7636,"KRN",101,0)
56101
57"BLD",7636,"KRN",409.61,0)
58409.61
59"BLD",7636,"KRN",771,0)
60771
61"BLD",7636,"KRN",870,0)
62870
63"BLD",7636,"KRN",8989.51,0)
648989.51
65"BLD",7636,"KRN",8989.52,0)
668989.52
67"BLD",7636,"KRN",8994,0)
688994
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")
1140
115"QUES","XPF1",0)
116Y
117"QUES","XPF1","??")
118^D REP^XPDH
119"QUES","XPF1","A")
120Shall I write over your |FLAG| File
121"QUES","XPF1","B")
122YES
123"QUES","XPF1","M")
124D XPF1^XPDIQ
125"QUES","XPF2",0)
126Y
127"QUES","XPF2","??")
128^D DTA^XPDH
129"QUES","XPF2","A")
130Want my data |FLAG| yours
131"QUES","XPF2","B")
132YES
133"QUES","XPF2","M")
134D XPF2^XPDIQ
135"QUES","XPI1",0)
136YO
137"QUES","XPI1","??")
138^D INHIBIT^XPDH
139"QUES","XPI1","A")
140Want KIDS to INHIBIT LOGONs during the install
141"QUES","XPI1","B")
142NO
143"QUES","XPI1","M")
144D XPI1^XPDIQ
145"QUES","XPM1",0)
146PO^VA(200,:EM
147"QUES","XPM1","??")
148^D MG^XPDH
149"QUES","XPM1","A")
150Enter the Coordinator for Mail Group '|FLAG|'
151"QUES","XPM1","B")
152
153"QUES","XPM1","M")
154D XPM1^XPDIQ
155"QUES","XPO1",0)
156Y
157"QUES","XPO1","??")
158^D MENU^XPDH
159"QUES","XPO1","A")
160Want KIDS to Rebuild Menu Trees Upon Completion of Install
161"QUES","XPO1","B")
162NO
163"QUES","XPO1","M")
164D XPO1^XPDIQ
165"QUES","XPZ1",0)
166Y
167"QUES","XPZ1","??")
168^D OPT^XPDH
169"QUES","XPZ1","A")
170Want to DISABLE Scheduled Options, Menu Options, and Protocols
171"QUES","XPZ1","B")
172NO
173"QUES","XPZ1","M")
174D XPZ1^XPDIQ
175"QUES","XPZ2",0)
176Y
177"QUES","XPZ2","??")
178^D RTN^XPDH
179"QUES","XPZ2","A")
180Want to MOVE routines to other CPUs
181"QUES","XPZ2","B")
182NO
183"QUES","XPZ2","M")
184D XPZ2^XPDIQ
185"RTN")
1861
187"RTN","TMGRPC1A")
1880^1^B30114621
189"RTN","TMGRPC1A",1,0)
190TMGRPC1A ;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)
240SETINIVL(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)
340SIDN QUIT
341"RTN","TMGRPC1A",77,0)
342 ;
343"RTN","TMGRPC1A",78,0)
344 ;
345"RTN","TMGRPC1A",79,0)
346GETINIVL(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)
410CONVERT
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)
444INSTALL ;
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")
5028.0^22.0
503**END**
504**END**
Note: See TracBrowser for help on using the repository browser.