source: cprs/branches/GUI-config/KIDS Server patch/TMG-GUI-CONFIG-1.0-4.KIDS@ 828

Last change on this file since 828 was 828, checked in by Kevin Toppenberg, 14 years ago

Sortable grids, fixed hint-bug
File size: 31.9 KB
Line 
1KIDS Distribution saved on Jul 07, 2010@13:39:05
2TMG GUI CONFIG 1.0*4
3**KIDS**:TMG-GUI-CONFIG*1.0*4^
4
5**INSTALL NAME**
6TMG-GUI-CONFIG*1.0*4
7"BLD",7637,0)
8TMG-GUI-CONFIG*1.0*4^^0^3100707^n
9"BLD",7637,1,0)
10^^8^8^3100707^^
11"BLD",7637,1,1,0)
12This patch fixes server crashes when accessing
13"BLD",7637,1,2,0)
14help message for fields that have help code
15"BLD",7637,1,3,0)
16expecting information about specific record being
17"BLD",7637,1,4,0)
18viewed.
19"BLD",7637,1,5,0)
20
21"BLD",7637,1,6,0)
22It provides updated versions of two files:
23"BLD",7637,1,7,0)
24TMGRPC3.m
25"BLD",7637,1,8,0)
26TMGRPC3E.m
27"BLD",7637,4,0)
28^9.64PA^^
29"BLD",7637,6.3)
301
31"BLD",7637,"KRN",0)
32^9.67PA^8989.52^19
33"BLD",7637,"KRN",.4,0)
34.4
35"BLD",7637,"KRN",.401,0)
36.401
37"BLD",7637,"KRN",.402,0)
38.402
39"BLD",7637,"KRN",.403,0)
40.403
41"BLD",7637,"KRN",.5,0)
42.5
43"BLD",7637,"KRN",.84,0)
44.84
45"BLD",7637,"KRN",3.6,0)
463.6
47"BLD",7637,"KRN",3.8,0)
483.8
49"BLD",7637,"KRN",9.2,0)
509.2
51"BLD",7637,"KRN",9.8,0)
529.8
53"BLD",7637,"KRN",9.8,"NM",0)
54^9.68A^2^2
55"BLD",7637,"KRN",9.8,"NM",1,0)
56TMGRPC3^^0^B83275090
57"BLD",7637,"KRN",9.8,"NM",2,0)
58TMGRPC3E^^0^B73901626
59"BLD",7637,"KRN",9.8,"NM","B","TMGRPC3",1)
60
61"BLD",7637,"KRN",9.8,"NM","B","TMGRPC3E",2)
62
63"BLD",7637,"KRN",19,0)
6419
65"BLD",7637,"KRN",19.1,0)
6619.1
67"BLD",7637,"KRN",101,0)
68101
69"BLD",7637,"KRN",409.61,0)
70409.61
71"BLD",7637,"KRN",771,0)
72771
73"BLD",7637,"KRN",870,0)
74870
75"BLD",7637,"KRN",8989.51,0)
768989.51
77"BLD",7637,"KRN",8989.52,0)
788989.52
79"BLD",7637,"KRN",8994,0)
808994
81"BLD",7637,"KRN","B",.4,.4)
82
83"BLD",7637,"KRN","B",.401,.401)
84
85"BLD",7637,"KRN","B",.402,.402)
86
87"BLD",7637,"KRN","B",.403,.403)
88
89"BLD",7637,"KRN","B",.5,.5)
90
91"BLD",7637,"KRN","B",.84,.84)
92
93"BLD",7637,"KRN","B",3.6,3.6)
94
95"BLD",7637,"KRN","B",3.8,3.8)
96
97"BLD",7637,"KRN","B",9.2,9.2)
98
99"BLD",7637,"KRN","B",9.8,9.8)
100
101"BLD",7637,"KRN","B",19,19)
102
103"BLD",7637,"KRN","B",19.1,19.1)
104
105"BLD",7637,"KRN","B",101,101)
106
107"BLD",7637,"KRN","B",409.61,409.61)
108
109"BLD",7637,"KRN","B",771,771)
110
111"BLD",7637,"KRN","B",870,870)
112
113"BLD",7637,"KRN","B",8989.51,8989.51)
114
115"BLD",7637,"KRN","B",8989.52,8989.52)
116
117"BLD",7637,"KRN","B",8994,8994)
118
119"BLD",7637,"QDEF")
120^^^^NO^^^^NO^^NO
121"BLD",7637,"QUES",0)
122^9.62^^
123"MBREQ")
1240
125"QUES","XPF1",0)
126Y
127"QUES","XPF1","??")
128^D REP^XPDH
129"QUES","XPF1","A")
130Shall I write over your |FLAG| File
131"QUES","XPF1","B")
132YES
133"QUES","XPF1","M")
134D XPF1^XPDIQ
135"QUES","XPF2",0)
136Y
137"QUES","XPF2","??")
138^D DTA^XPDH
139"QUES","XPF2","A")
140Want my data |FLAG| yours
141"QUES","XPF2","B")
142YES
143"QUES","XPF2","M")
144D XPF2^XPDIQ
145"QUES","XPI1",0)
146YO
147"QUES","XPI1","??")
148^D INHIBIT^XPDH
149"QUES","XPI1","A")
150Want KIDS to INHIBIT LOGONs during the install
151"QUES","XPI1","B")
152NO
153"QUES","XPI1","M")
154D XPI1^XPDIQ
155"QUES","XPM1",0)
156PO^VA(200,:EM
157"QUES","XPM1","??")
158^D MG^XPDH
159"QUES","XPM1","A")
160Enter the Coordinator for Mail Group '|FLAG|'
161"QUES","XPM1","B")
162
163"QUES","XPM1","M")
164D XPM1^XPDIQ
165"QUES","XPO1",0)
166Y
167"QUES","XPO1","??")
168^D MENU^XPDH
169"QUES","XPO1","A")
170Want KIDS to Rebuild Menu Trees Upon Completion of Install
171"QUES","XPO1","B")
172NO
173"QUES","XPO1","M")
174D XPO1^XPDIQ
175"QUES","XPZ1",0)
176Y
177"QUES","XPZ1","??")
178^D OPT^XPDH
179"QUES","XPZ1","A")
180Want to DISABLE Scheduled Options, Menu Options, and Protocols
181"QUES","XPZ1","B")
182NO
183"QUES","XPZ1","M")
184D XPZ1^XPDIQ
185"QUES","XPZ2",0)
186Y
187"QUES","XPZ2","??")
188^D RTN^XPDH
189"QUES","XPZ2","A")
190Want to MOVE routines to other CPUs
191"QUES","XPZ2","B")
192NO
193"QUES","XPZ2","M")
194D XPZ2^XPDIQ
195"RTN")
1962
197"RTN","TMGRPC3")
1980^1^B83275090
199"RTN","TMGRPC3",1,0)
200TMGRPC3 ;TMG/kst/RPC Functions for GUI_Config ;07/20/08, 7/7/10
201"RTN","TMGRPC3",2,0)
202 ;;1.0;TMG-LIB;**1**;08/31/08;Build 1
203"RTN","TMGRPC3",3,0)
204 ;
205"RTN","TMGRPC3",4,0)
206 ;"TMG RPC FUNCTIONS for a GUI config program
207"RTN","TMGRPC3",5,0)
208 ;
209"RTN","TMGRPC3",6,0)
210 ;"Kevin Toppenberg MD
211"RTN","TMGRPC3",7,0)
212 ;"GNU Lessor General Public License (LGPL) applies
213"RTN","TMGRPC3",8,0)
214 ;"7/20/08
215"RTN","TMGRPC3",9,0)
216 ;
217"RTN","TMGRPC3",10,0)
218 ;"=======================================================================
219"RTN","TMGRPC3",11,0)
220 ;" RPC -- Public Functions.
221"RTN","TMGRPC3",12,0)
222 ;"=======================================================================
223"RTN","TMGRPC3",13,0)
224 ;"CHANNEL(TMGRESULT,INPUT) -- general purpose channel RPC from a GUI config program
225"RTN","TMGRPC3",14,0)
226 ;
227"RTN","TMGRPC3",15,0)
228 ;"=======================================================================
229"RTN","TMGRPC3",16,0)
230 ;"Dependencies:
231"RTN","TMGRPC3",17,0)
232 ;" TMGRPC3* only
233"RTN","TMGRPC3",18,0)
234 ;
235"RTN","TMGRPC3",19,0)
236 ;"=======================================================================
237"RTN","TMGRPC3",20,0)
238 ;
239"RTN","TMGRPC3",21,0)
240CHANNEL(TMGRESULT,INPUT) ;
241"RTN","TMGRPC3",22,0)
242 ;"Purpose: This will be a general purpose channel RPC from a GUI config program
243"RTN","TMGRPC3",23,0)
244 ;"Input: TMGRESULT -- this is an OUT parameter, and it is always passed by reference
245"RTN","TMGRPC3",24,0)
246 ;" INPUT -- this will be array of data sent from the GUI client. Defined below:
247"RTN","TMGRPC3",25,0)
248 ;" <Stuff will go here>
249"RTN","TMGRPC3",26,0)
250 ;" INPUT("REQUEST")="cmd^params" Valid values for "cmd" are:
251"RTN","TMGRPC3",27,0)
252 ;" "GET USER LIST"
253"RTN","TMGRPC3",28,0)
254 ;" params: <empty> or NODISUSER
255"RTN","TMGRPC3",29,0)
256 ;" "GET RECORDS LIST" -- get list of all .01 fields for file.
257"RTN","TMGRPC3",30,0)
258 ;" params: FileNumber (e.g. 'GET RECORDS LIST^8989.3')
259"RTN","TMGRPC3",31,0)
260 ;" "GET ONE USER"
261"RTN","TMGRPC3",32,0)
262 ;" params: IEN (e.g. 'GET ONE USER^12345')
263"RTN","TMGRPC3",33,0)
264 ;" "GET ONE RECORD"
265"RTN","TMGRPC3",34,0)
266 ;" params: FileNum^IENS (e.g. 'GET ONE RECORD^200^73,')
267"RTN","TMGRPC3",35,0)
268 ;" "GET ONE WP FIELD"
269"RTN","TMGRPC3",36,0)
270 ;" params: FileNum^Field^IENS^ (e.g. 'GET ONE WP FIELD^200^2^73,')
271"RTN","TMGRPC3",37,0)
272 ;" "FILE ENTRY SUBSET"
273"RTN","TMGRPC3",38,0)
274 ;" params: FileNum^ListStartValue^direction^MaxCount(optional, def=44)
275"RTN","TMGRPC3",39,0)
276 ;" "GET SUB RECS LIST" -- get all .01 sub record entries for a subfile
277"RTN","TMGRPC3",40,0)
278 ;" params: SubFileNum^ParentIENS
279"RTN","TMGRPC3",41,0)
280 ;" "POST DATA"
281"RTN","TMGRPC3",42,0)
282 ;" params: (not used)
283"RTN","TMGRPC3",43,0)
284 ;" INPUT(0)=FileNum^IENS^FieldNum^FieldName^newValue^oldValue
285"RTN","TMGRPC3",44,0)
286 ;" INPUT(1)=FileNum^IENS^FieldNum^FieldName^newValue^oldValue
287"RTN","TMGRPC3",45,0)
288 ;" ... (note: FieldName and oldValue are not used)
289"RTN","TMGRPC3",46,0)
290 ;" "POST WP FIELD"
291"RTN","TMGRPC3",47,0)
292 ;" params: FileNum^FieldNum^IENS (e.g. 'POST WP FIELD^200^2^73,')
293"RTN","TMGRPC3",48,0)
294 ;" WP field itself is stored as follows:
295"RTN","TMGRPC3",49,0)
296 ;" INPUT(0)=0TH line
297"RTN","TMGRPC3",50,0)
298 ;" INPUT(1)=1st line
299"RTN","TMGRPC3",51,0)
300 ;" INPUT(2)=2nd line
301"RTN","TMGRPC3",52,0)
302 ;" ...
303"RTN","TMGRPC3",53,0)
304 ;" Note: don't include INPUT("REQUEST") with text.
305"RTN","TMGRPC3",54,0)
306 ;" "GET EMPTY ENTRY" -- getting stub entries for subfiles typically
307"RTN","TMGRPC3",55,0)
308 ;" params: file entry (file or subfile number)
309"RTN","TMGRPC3",56,0)
310 ;" "GET CURRENT USER NAME" -- return name of DUZ (current) user
311"RTN","TMGRPC3",57,0)
312 ;" (params: not used)
313"RTN","TMGRPC3",58,0)
314 ;" "CLONE USER"
315"RTN","TMGRPC3",59,0)
316 ;" params: SourceIENS^New.01Value
317"RTN","TMGRPC3",60,0)
318 ;" "CLONE RECORD"
319"RTN","TMGRPC3",61,0)
320 ;" params: FileNum^SourceIENS^New.01Value
321"RTN","TMGRPC3",62,0)
322 ;" "GET HELP MSG"
323"RTN","TMGRPC3",63,0)
324 ;" params : FileNum^FieldNum^HelpType^IENS
325"RTN","TMGRPC3",64,0)
326 ;" "IS WP FIELD"
327"RTN","TMGRPC3",65,0)
328 ;" params: FileNum^FieldNum
329"RTN","TMGRPC3",66,0)
330 ;" "GET ONE WP FIELD" -- retrieve on word processing (WP) field entry
331"RTN","TMGRPC3",67,0)
332 ;" param -- FileNum^Field^IENS (e.g. 'GET ONE WP FIELD^200^2^73,')
333"RTN","TMGRPC3",68,0)
334 ;" "REGISTER PATIENT"
335"RTN","TMGRPC3",69,0)
336 ;" param -- FieldNum1^FieldValue1^FieldNum2^FieldValue2^FieldNum3^FieldValue3^...
337"RTN","TMGRPC3",70,0)
338 ;"Output: results of this function should be put into TMGRESULTS array.
339"RTN","TMGRPC3",71,0)
340 ;" For cmd:
341"RTN","TMGRPC3",72,0)
342 ;" "GET USER LIST"
343"RTN","TMGRPC3",73,0)
344 ;" TMGRESULT(0)="1^Success" or "-1^Message"
345"RTN","TMGRPC3",74,0)
346 ;" TMGRESULT(1)=Name^IEN^200^DISUSER DISUSER will be 1 for "Y" or 0 for "N"
347"RTN","TMGRPC3",75,0)
348 ;" TMGRESULT(2)=Name^IEN^200^DISUSER
349"RTN","TMGRPC3",76,0)
350 ;" etc ...
351"RTN","TMGRPC3",77,0)
352 ;" "GET RECORDS LIST"
353"RTN","TMGRPC3",78,0)
354 ;" TMGRESULT(0)="1^Success" or "-1^Message"
355"RTN","TMGRPC3",79,0)
356 ;" TMGRESULT(1)=.01Value^IEN^FileNum
357"RTN","TMGRPC3",80,0)
358 ;" TMGRESULT(2)=.01Value^IEN^FileNum
359"RTN","TMGRPC3",81,0)
360 ;" etc ...
361"RTN","TMGRPC3",82,0)
362 ;" "GET ONE USER"
363"RTN","TMGRPC3",83,0)
364 ;" TMGRESULT(0)="1^Success" or "-1^Message"
365"RTN","TMGRPC3",84,0)
366 ;" TMGRESULT(1)=File^IENS^FieldNum^ExternalValue^DDInfo...
367"RTN","TMGRPC3",85,0)
368 ;" TMGRESULT(2)=File^IENS^FieldNum^ExternalValue^DDInfo...
369"RTN","TMGRPC3",86,0)
370 ;" etc ...
371"RTN","TMGRPC3",87,0)
372 ;" "GET ONE RECORD"
373"RTN","TMGRPC3",88,0)
374 ;" TMGRESULT(0)="1^Success" or "-1^Message"
375"RTN","TMGRPC3",89,0)
376 ;" TMGRESULT(1)=File^IENS^FieldNum^ExternalValue^DDInfo...
377"RTN","TMGRPC3",90,0)
378 ;" TMGRESULT(2)=File^IENS^FieldNum^ExternalValue^DDInfo...
379"RTN","TMGRPC3",91,0)
380 ;" ...
381"RTN","TMGRPC3",92,0)
382 ;" "GET ONE WP FIELD"
383"RTN","TMGRPC3",93,0)
384 ;" TMGRESULT(0): "1^Success" or "-1^Message"
385"RTN","TMGRPC3",94,0)
386 ;" TMGRESULT(1) will contain Fileman error, if any
387"RTN","TMGRPC3",95,0)
388 ;" - or to return WP array -
389"RTN","TMGRPC3",96,0)
390 ;" TMGRESULT(1)=1st line of text
391"RTN","TMGRPC3",97,0)
392 ;" TMGRESULT(2)=2nd line of text
393"RTN","TMGRPC3",98,0)
394 ;" etc..
395"RTN","TMGRPC3",99,0)
396 ;" "FILE ENTRY SUBSET"
397"RTN","TMGRPC3",100,0)
398 ;" TMGRESULT(0)="1^Success" or "-1^Message"
399"RTN","TMGRPC3",101,0)
400 ;" TMGRESULT(1)=Value
401"RTN","TMGRPC3",102,0)
402 ;" TMGRESULT(2)=Value
403"RTN","TMGRPC3",103,0)
404 ;" etc ...
405"RTN","TMGRPC3",104,0)
406 ;" "GET SUB RECS LIST"
407"RTN","TMGRPC3",105,0)
408 ;" TMGRESULT(0)="1^Success" or "-1^Message"
409"RTN","TMGRPC3",106,0)
410 ;" TMGRESULT(1)=IEN^Value
411"RTN","TMGRPC3",107,0)
412 ;" TMGRESULT(2)=IEN^Value
413"RTN","TMGRPC3",108,0)
414 ;" ...
415"RTN","TMGRPC3",109,0)
416 ;" "POST DATA"
417"RTN","TMGRPC3",110,0)
418 ;" TMGRESULT(0)="1^Success" or "-1^Message"
419"RTN","TMGRPC3",111,0)
420 ;" TMGRESULT(1)=Fileman message (long) (if generated)
421"RTN","TMGRPC3",112,0)
422 ;" -or (if +1 etc values used)-
423"RTN","TMGRPC3",113,0)
424 ;" TMGRESULT(1)=+5^1234 <-- results of IEN array returned (+5 converted to record 1234)
425"RTN","TMGRPC3",114,0)
426 ;" TMGRESULT(2)=+3^2341 <-- results of IEN array returned (+3 converted to record 2341)
427"RTN","TMGRPC3",115,0)
428 ;" ...
429"RTN","TMGRPC3",116,0)
430 ;" "GET EMPTY ENTRY"
431"RTN","TMGRPC3",117,0)
432 ;" TMGRESULT(0)="1^Success" or "-1^Message"
433"RTN","TMGRPC3",118,0)
434 ;" TMGRESULT(1)=File^^FieldNum^^DDInfo...
435"RTN","TMGRPC3",119,0)
436 ;" TMGRESULT(2)=File^^FieldNum^^DDInfo...
437"RTN","TMGRPC3",120,0)
438 ;" etc ...
439"RTN","TMGRPC3",121,0)
440 ;" "GET CURRENT USER NAME" -- return name of DUZ (current) user
441"RTN","TMGRPC3",122,0)
442 ;" TMGRESULT(0)="1^Success^UserName" or "-1^Message"
443"RTN","TMGRPC3",123,0)
444 ;" "CLONE USER"
445"RTN","TMGRPC3",124,0)
446 ;" TMGRESULT(0)="1^Success^NewIENS" or "-1^Message"
447"RTN","TMGRPC3",125,0)
448 ;" TMGRESULT(1)=Long Fileman message (if -1 error)
449"RTN","TMGRPC3",126,0)
450 ;" "CLONE RECORD"
451"RTN","TMGRPC3",127,0)
452 ;" TMGRESULT(0)="1^Success^NewIENS" or "-1^Message"
453"RTN","TMGRPC3",128,0)
454 ;" TMGRESULT(1)=Fileman message (long) (if generated)
455"RTN","TMGRPC3",129,0)
456 ;" "GET HELP MSG"
457"RTN","TMGRPC3",130,0)
458 ;" TMGRESULT(0)="1^Success^NewIENS" or "-1^Message"
459"RTN","TMGRPC3",131,0)
460 ;" TMGRESULT(1)=Fileman message (long) (if generated)
461"RTN","TMGRPC3",132,0)
462 ;" "IS WP FIELD"
463"RTN","TMGRPC3",133,0)
464 ;" TMGRESULT(0)="1^Success^YES/NO" or "-1^Message"
465"RTN","TMGRPC3",134,0)
466 ;" "YES" if is a WP subfile, otherwise "NO"
467"RTN","TMGRPC3",135,0)
468 ;" TMGRESULT(1)=Fileman message (long) (if generated)
469"RTN","TMGRPC3",136,0)
470 ;" "REGISTER PATIENT"
471"RTN","TMGRPC3",137,0)
472 ;" TMGRESULT(0)="1^Success^NewIEN" or
473"RTN","TMGRPC3",138,0)
474 ;" "-1^Message" Frank failure... or
475"RTN","TMGRPC3",139,0)
476 ;" "0^BoolAndMessage^NewIEN". Format:
477"RTN","TMGRPC3",140,0)
478 ;" [Bool1;Bool2;Bool3;Bool4;Bool5*MessageText] (e.g. '1;0;1;0;0*ErrorMsg')
479"RTN","TMGRPC3",141,0)
480 ;" (for Bool fields, 0=no or 1=yes)
481"RTN","TMGRPC3",142,0)
482 ;" Bool1 -- patient had previously been registered
483"RTN","TMGRPC3",143,0)
484 ;" Bool2 -- patient registered during this Fn
485"RTN","TMGRPC3",144,0)
486 ;" Bool3 -- problem filing data into non-identifier fields
487"RTN","TMGRPC3",145,0)
488 ;" Bool4 -- problem filing data into sub-file fields
489"RTN","TMGRPC3",146,0)
490 ;" Bool5 -- problem with filing HRN
491"RTN","TMGRPC3",147,0)
492 ;" TMGRESULT(1)=Long Fileman message (if -1 error, or perhaps 0 code)
493"RTN","TMGRPC3",148,0)
494
495"RTN","TMGRPC3",149,0)
496 ;
497"RTN","TMGRPC3",150,0)
498 ;"Result: none
499"RTN","TMGRPC3",151,0)
500 ;
501"RTN","TMGRPC3",152,0)
502 NEW TMGCOMMAND,TMGCOMMAND
503"RTN","TMGRPC3",153,0)
504 SET TMGCOMMAND=$$TRIM^XLFSTR($$UP^XLFSTR($PIECE($GET(INPUT("REQUEST")),"^",1)))
505"RTN","TMGRPC3",154,0)
506 SET TMGPARAMS=$$UP^XLFSTR($PIECE($GET(INPUT("REQUEST")),"^",2,199))
507"RTN","TMGRPC3",155,0)
508 SET TMGRESULT(0)="-1^No command requested." ;"default to error state.
509"RTN","TMGRPC3",156,0)
510 IF TMGCOMMAND="GET USER LIST" DO
511"RTN","TMGRPC3",157,0)
512 . DO GETUSRLT^TMGRPC3B(.TMGRESULT,TMGPARAMS)
513"RTN","TMGRPC3",158,0)
514 IF TMGCOMMAND="GET RECORDS LIST" DO
515"RTN","TMGRPC3",159,0)
516 . DO GETRECLT^TMGRPC3B(.TMGRESULT,TMGPARAMS)
517"RTN","TMGRPC3",160,0)
518 ELSE IF TMGCOMMAND="GET ONE USER" DO
519"RTN","TMGRPC3",161,0)
520 . DO GET1USER^TMGRPC3B(.TMGRESULT,TMGPARAMS)
521"RTN","TMGRPC3",162,0)
522 ELSE IF TMGCOMMAND="GET ONE RECORD" DO
523"RTN","TMGRPC3",163,0)
524 . DO GET1REC^TMGRPC3B(.TMGRESULT,TMGPARAMS)
525"RTN","TMGRPC3",164,0)
526 ELSE IF TMGCOMMAND="FILE ENTRY SUBSET" DO
527"RTN","TMGRPC3",165,0)
528 . DO GFLSUBST^TMGRPC3B(.TMGRESULT,TMGPARAMS)
529"RTN","TMGRPC3",166,0)
530 ELSE IF TMGCOMMAND="GET SUB RECS LIST" DO
531"RTN","TMGRPC3",167,0)
532 . DO GETSRLST^TMGRPC3D(.TMGRESULT,TMGPARAMS)
533"RTN","TMGRPC3",168,0)
534 ELSE IF TMGCOMMAND="POST DATA" DO
535"RTN","TMGRPC3",169,0)
536 . KILL INPUT("REQUEST")
537"RTN","TMGRPC3",170,0)
538 . DO POSTDATA^TMGRPC3C(.TMGRESULT,.INPUT)
539"RTN","TMGRPC3",171,0)
540 ELSE IF TMGCOMMAND="GET EMPTY ENTRY" DO
541"RTN","TMGRPC3",172,0)
542 . DO GETEMPTY^TMGRPC3E(.TMGRESULT,TMGPARAMS)
543"RTN","TMGRPC3",173,0)
544 ELSE IF TMGCOMMAND="GET CURRENT USER NAME" DO
545"RTN","TMGRPC3",174,0)
546 . SET TMGRESULT(0)="1^Success^"_$PIECE($GET(^VA(200,DUZ,0)),"^",1)
547"RTN","TMGRPC3",175,0)
548 ELSE IF TMGCOMMAND="CLONE RECORD" DO
549"RTN","TMGRPC3",176,0)
550 . DO CLONEREC^TMGRPC3D(.TMGRESULT,TMGPARAMS)
551"RTN","TMGRPC3",177,0)
552 ELSE IF TMGCOMMAND="CLONE USER" DO
553"RTN","TMGRPC3",178,0)
554 . DO CLONEUSR^TMGRPC3D(.TMGRESULT,TMGPARAMS)
555"RTN","TMGRPC3",179,0)
556 ELSE IF TMGCOMMAND="GET HELP MSG" DO
557"RTN","TMGRPC3",180,0)
558 . DO GETHELPM^TMGRPC3E(.TMGRESULT,TMGPARAMS)
559"RTN","TMGRPC3",181,0)
560 ELSE IF TMGCOMMAND="IS WP FIELD" DO
561"RTN","TMGRPC3",182,0)
562 . DO GETIFWP^TMGRPC3E(.TMGRESULT,TMGPARAMS)
563"RTN","TMGRPC3",183,0)
564 ELSE IF TMGCOMMAND="GET ONE WP FIELD" DO
565"RTN","TMGRPC3",184,0)
566 . DO GETWPFLD^TMGRPC3E(.TMGRESULT,TMGPARAMS)
567"RTN","TMGRPC3",185,0)
568 ELSE IF TMGCOMMAND="POST WP FIELD" DO
569"RTN","TMGRPC3",186,0)
570 . KILL INPUT("REQUEST")
571"RTN","TMGRPC3",187,0)
572 . DO PSTWPFLD^TMGRPC3E(.TMGRESULT,TMGPARAMS,.INPUT)
573"RTN","TMGRPC3",188,0)
574 ELSE IF TMGCOMMAND="REGISTER PATIENT" DO
575"RTN","TMGRPC3",189,0)
576 . DO REGPAT^TMGRPC3F(.TMGRESULT,TMGPARAMS)
577"RTN","TMGRPC3",190,0)
578 ;
579"RTN","TMGRPC3",191,0)
580 ;
581"RTN","TMGRPC3",192,0)
582 QUIT
583"RTN","TMGRPC3",193,0)
584 ;
585"RTN","TMGRPC3E")
5860^2^B73901626
587"RTN","TMGRPC3E",1,0)
588TMGRPC3E ;TMG/kst/Support Functions for GUI_Config ;08/31/08, 7/7/10
589"RTN","TMGRPC3E",2,0)
590 ;;1.0;TMG-LIB;**1**;08/31/08;Build 1
591"RTN","TMGRPC3E",3,0)
592 ;
593"RTN","TMGRPC3E",4,0)
594 ;"TMG RPC FUNCTIONS for a GUI config program
595"RTN","TMGRPC3E",5,0)
596 ;
597"RTN","TMGRPC3E",6,0)
598 ;"Kevin Toppenberg MD
599"RTN","TMGRPC3E",7,0)
600 ;"GNU Lessor General Public License (LGPL) applies
601"RTN","TMGRPC3E",8,0)
602 ;"7/20/08
603"RTN","TMGRPC3E",9,0)
604 ;
605"RTN","TMGRPC3E",10,0)
606 ;"=======================================================================
607"RTN","TMGRPC3E",11,0)
608 ;" RPC -- Public Functions.
609"RTN","TMGRPC3E",12,0)
610 ;"=======================================================================
611"RTN","TMGRPC3E",13,0)
612 ;" <none>
613"RTN","TMGRPC3E",14,0)
614 ;"=======================================================================
615"RTN","TMGRPC3E",15,0)
616 ;"PRIVATE API FUNCTIONS
617"RTN","TMGRPC3E",16,0)
618 ;"=======================================================================
619"RTN","TMGRPC3E",17,0)
620 ;"GETEMPTY(TMGOUT,TMGPARAMS) -- get stub entries for a file (typically a subfile)
621"RTN","TMGRPC3E",18,0)
622 ;"GETHELPM(TMGOUT,TMGPARAMS) -- retrieve the help message for a given field.
623"RTN","TMGRPC3E",19,0)
624 ;"STUBNEWR(TMGFILE,NewValue,TMGOUT) -- create a stub entry in the file (200), to be filled in elsewhere
625"RTN","TMGRPC3E",20,0)
626 ;"GETIFWP(TMGOUT,TMGPARAMS) -- return if filenumber is a WP subfile
627"RTN","TMGRPC3E",21,0)
628 ;"GETWPFLD(TMGOUT,TMGPARAMS) -- retrieve on word processing (WP) field entry
629"RTN","TMGRPC3E",22,0)
630 ;"PSTWPFLD(TMGOUT,TMGPARAMS,INPUT) -- store a word processing (WP) field entry
631"RTN","TMGRPC3E",23,0)
632 ;
633"RTN","TMGRPC3E",24,0)
634 ;"=======================================================================
635"RTN","TMGRPC3E",25,0)
636 ;"=======================================================================
637"RTN","TMGRPC3E",26,0)
638 ;"Dependencies:
639"RTN","TMGRPC3E",27,0)
640 ;" TMGRPC3* only
641"RTN","TMGRPC3E",28,0)
642 ;
643"RTN","TMGRPC3E",29,0)
644 ;"=======================================================================
645"RTN","TMGRPC3E",30,0)
646 ;"=======================================================================
647"RTN","TMGRPC3E",31,0)
648 ;
649"RTN","TMGRPC3E",32,0)
650GETEMPTY(TMGOUT,TMGPARAMS) ;"GET EMPTY ENTRY
651"RTN","TMGRPC3E",33,0)
652 ;"Purpose: to get stub entries for a file (typically a subfile)
653"RTN","TMGRPC3E",34,0)
654 ;" "GET EMPTY ENTRY" -- getting stub entries for subfiles typically
655"RTN","TMGRPC3E",35,0)
656 ;" TMGPARAMS: file entry (file or subfile number)
657"RTN","TMGRPC3E",36,0)
658 ;"Input: TMGOUT --an OUT ARRAY, filled as follows:
659"RTN","TMGRPC3E",37,0)
660 ;" TMGOUT(0)="1^Success" or "-1^Message"
661"RTN","TMGRPC3E",38,0)
662 ;" TMGOUT(1)=File^^FieldNum^^DDInfo...
663"RTN","TMGRPC3E",39,0)
664 ;" TMGOUT(2)=File^^FieldNum^^DDInfo...
665"RTN","TMGRPC3E",40,0)
666 ;" Etc ...
667"RTN","TMGRPC3E",41,0)
668 ;" Params: filenumber (typically a subfilenumber)
669"RTN","TMGRPC3E",42,0)
670 ;"Result: None
671"RTN","TMGRPC3E",43,0)
672 ;
673"RTN","TMGRPC3E",44,0)
674 SET TMGOUT(0)="1^Success"
675"RTN","TMGRPC3E",45,0)
676 NEW TMGCOUNT SET TMGCOUNT=1
677"RTN","TMGRPC3E",46,0)
678 NEW TMGFNUM SET TMGFNUM=+$GET(TMGPARAMS)
679"RTN","TMGRPC3E",47,0)
680 NEW TMGFLDNUM SET TMGFLDNUM=0
681"RTN","TMGRPC3E",48,0)
682 FOR SET TMGFLDNUM=$ORDER(^DD(TMGFNUM,TMGFLDNUM)) QUIT:(+TMGFLDNUM'>0) DO
683"RTN","TMGRPC3E",49,0)
684 . NEW TMGDDINFO SET TMGDDINFO=$PIECE($GET(^DD(TMGFNUM,TMGFLDNUM,0)),"^",1,4)
685"RTN","TMGRPC3E",50,0)
686 . SET TMGOUT(TMGCOUNT)=TMGFNUM_"^^"_TMGFLDNUM_"^^"_TMGDDINFO
687"RTN","TMGRPC3E",51,0)
688 . SET TMGCOUNT=TMGCOUNT+1
689"RTN","TMGRPC3E",52,0)
690 ;
691"RTN","TMGRPC3E",53,0)
692 QUIT
693"RTN","TMGRPC3E",54,0)
694 ;
695"RTN","TMGRPC3E",55,0)
696 ;
697"RTN","TMGRPC3E",56,0)
698GETHELPM(TMGOUT,TMGPARAMS) ;
699"RTN","TMGRPC3E",57,0)
700 ;"Purpose: to retrieve the help message for a given field.
701"RTN","TMGRPC3E",58,0)
702 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
703"RTN","TMGRPC3E",59,0)
704 ;" TMGPARAMS -- file^field^HelpType^IENS
705"RTN","TMGRPC3E",60,0)
706 ;"Output: TMGOUT is filled as follows:
707"RTN","TMGRPC3E",61,0)
708 ;" TMGOUT(0)="1^Success" or "-1^Message"
709"RTN","TMGRPC3E",62,0)
710 ;" TMGOUT(1...?)=Help Message
711"RTN","TMGRPC3E",63,0)
712 ;
713"RTN","TMGRPC3E",64,0)
714 NEW TMGMSG
715"RTN","TMGRPC3E",65,0)
716 NEW TMGINDEX SET TMGINDEX=1
717"RTN","TMGRPC3E",66,0)
718 NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
719"RTN","TMGRPC3E",67,0)
720 NEW TMGFIELD SET TMGFIELD=+$PIECE(TMGPARAMS,"^",2)
721"RTN","TMGRPC3E",68,0)
722 NEW TMGHELPTYPE SET TMGHELPTYPE=$PIECE(TMGPARAMS,"^",3)
723"RTN","TMGRPC3E",69,0)
724 NEW TMGIENS SET TMGIENS=$PIECE(TMGPARAMS,"^",4)
725"RTN","TMGRPC3E",70,0)
726 IF TMGFILE'>0 DO GOTO GHMDONE
727"RTN","TMGRPC3E",71,0)
728 . SET TMGOUT(0)="-1^No file number supplied"
729"RTN","TMGRPC3E",72,0)
730 IF TMGFIELD'>0 DO GOTO GHMDONE
731"RTN","TMGRPC3E",73,0)
732 . SET TMGOUT(0)="-1^No Field Number supplied"
733"RTN","TMGRPC3E",74,0)
734 DO HELP^DIE(TMGFILE,TMGIENS,TMGFIELD,TMGHELPTYPE,"TMGMSG")
735"RTN","TMGRPC3E",75,0)
736 NEW TMGI SET TMGI=""
737"RTN","TMGRPC3E",76,0)
738 FOR SET TMGI=$ORDER(TMGMSG("DIHELP",TMGI)) QUIT:(TMGI="") DO
739"RTN","TMGRPC3E",77,0)
740 . SET TMGOUT(TMGINDEX)=TMGMSG("DIHELP",TMGI)
741"RTN","TMGRPC3E",78,0)
742 . SET TMGINDEX=TMGINDEX+1
743"RTN","TMGRPC3E",79,0)
744 ;
745"RTN","TMGRPC3E",80,0)
746 SET TMGOUT(0)="1^Success"
747"RTN","TMGRPC3E",81,0)
748 ;
749"RTN","TMGRPC3E",82,0)
750GHMDONE ;
751"RTN","TMGRPC3E",83,0)
752 QUIT
753"RTN","TMGRPC3E",84,0)
754 ;
755"RTN","TMGRPC3E",85,0)
756 ;
757"RTN","TMGRPC3E",86,0)
758STUBNEWR(TMGFILE,TMGNEWVALUE,TMGOUT) ;"STUB NEW RECORD
759"RTN","TMGRPC3E",87,0)
760 ;"Purpose: to create a stub entry in the file (200), to be filled in elsewhere
761"RTN","TMGRPC3E",88,0)
762 ;"Input: TMGNEWVALUE -- a value for the .01 field
763"RTN","TMGRPC3E",89,0)
764 ;" TMGOUT -- PASS BY REFERENCE, an OUT PARAMETER.
765"RTN","TMGRPC3E",90,0)
766 ;"Output: A new record will be added to file, if no errors
767"RTN","TMGRPC3E",91,0)
768 ;" TMGOUT(0): 1^Success^NewIEN or -1^See Fileman message
769"RTN","TMGRPC3E",92,0)
770 ;" TMGOUT(1) will contain Fileman error, if any
771"RTN","TMGRPC3E",93,0)
772 ;"Results: none
773"RTN","TMGRPC3E",94,0)
774 ;"NOTICE: This function makes no promise that the creation of the
775"RTN","TMGRPC3E",95,0)
776 ;" new record will succeed. For example, if there are required
777"RTN","TMGRPC3E",96,0)
778 ;" fields, the creation will fail. So users should check for success
779"RTN","TMGRPC3E",97,0)
780 ;" result and error feedback.
781"RTN","TMGRPC3E",98,0)
782 ;"Results: none
783"RTN","TMGRPC3E",99,0)
784 ;
785"RTN","TMGRPC3E",100,0)
786 NEW TMGFDA,TMGIEN,TMGMSG,DIC
787"RTN","TMGRPC3E",101,0)
788 SET DIC(0)="" ;"I get a crash without this, for some reason...
789"RTN","TMGRPC3E",102,0)
790 SET TMGFDA(TMGFILE,"+1,",.01)=TMGNEWVALUE
791"RTN","TMGRPC3E",103,0)
792 DO UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG")
793"RTN","TMGRPC3E",104,0)
794 ;
795"RTN","TMGRPC3E",105,0)
796 IF $DATA(TMGMSG("DIERR")) DO GOTO SNPDONE
797"RTN","TMGRPC3E",106,0)
798 . SET TMGOUT(0)="-1^See Fileman message"
799"RTN","TMGRPC3E",107,0)
800 . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
801"RTN","TMGRPC3E",108,0)
802 ;
803"RTN","TMGRPC3E",109,0)
804 SET TMGOUT(0)="1^Success^"_$GET(TMGIEN(1))
805"RTN","TMGRPC3E",110,0)
806 ;
807"RTN","TMGRPC3E",111,0)
808SNPDONE ;
809"RTN","TMGRPC3E",112,0)
810 QUIT
811"RTN","TMGRPC3E",113,0)
812 ;
813"RTN","TMGRPC3E",114,0)
814 ;
815"RTN","TMGRPC3E",115,0)
816GETIFWP(TMGOUT,TMGPARAMS) ;"GET IF WP FIELD
817"RTN","TMGRPC3E",116,0)
818 ;"Purpose: to return if filenumber is a WP subfile
819"RTN","TMGRPC3E",117,0)
820 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
821"RTN","TMGRPC3E",118,0)
822 ;" TMGPARAMS -- file^field
823"RTN","TMGRPC3E",119,0)
824 ;"Output:
825"RTN","TMGRPC3E",120,0)
826 ;" TMGOUT(0): "1^Success^YES/NO" or "-1^Message"
827"RTN","TMGRPC3E",121,0)
828 ;" "YES" if is a WP subfile, otherwise "NO"
829"RTN","TMGRPC3E",122,0)
830 ;" TMGOUT(1) will contain Fileman error, if any
831"RTN","TMGRPC3E",123,0)
832 ;"Results: none
833"RTN","TMGRPC3E",124,0)
834 ;
835"RTN","TMGRPC3E",125,0)
836 NEW TMGRESULT
837"RTN","TMGRPC3E",126,0)
838 NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
839"RTN","TMGRPC3E",127,0)
840 NEW TMGFIELD SET TMGFIELD=+$PIECE(TMGPARAMS,"^",2)
841"RTN","TMGRPC3E",128,0)
842 IF TMGFILE'>0 DO GOTO GWPSDONE
843"RTN","TMGRPC3E",129,0)
844 . SET TMGOUT(0)="-1^No file number supplied"
845"RTN","TMGRPC3E",130,0)
846 IF TMGFIELD'>0 DO GOTO GWPSDONE
847"RTN","TMGRPC3E",131,0)
848 . SET TMGOUT(0)="-1^No Field Number supplied"
849"RTN","TMGRPC3E",132,0)
850 ;
851"RTN","TMGRPC3E",133,0)
852 DO FIELD^DID(TMGFILE,TMGFIELD,"","TYPE","TMGARRAY","TMGMSG")
853"RTN","TMGRPC3E",134,0)
854 ;
855"RTN","TMGRPC3E",135,0)
856 IF $DATA(TMGMSG("DIERR")) DO GOTO GWPSDONE
857"RTN","TMGRPC3E",136,0)
858 . SET TMGOUT(0)="-1^See Fileman message"
859"RTN","TMGRPC3E",137,0)
860 . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
861"RTN","TMGRPC3E",138,0)
862 ;
863"RTN","TMGRPC3E",139,0)
864 IF $GET(TMGARRAY("TYPE"))="WORD-PROCESSING" DO
865"RTN","TMGRPC3E",140,0)
866 . SET TMGRESULT="YES"
867"RTN","TMGRPC3E",141,0)
868 ELSE DO
869"RTN","TMGRPC3E",142,0)
870 . SET TMGRESULT="NO"
871"RTN","TMGRPC3E",143,0)
872 ;
873"RTN","TMGRPC3E",144,0)
874 SET TMGOUT(0)="1^Success^"_TMGRESULT
875"RTN","TMGRPC3E",145,0)
876 ;
877"RTN","TMGRPC3E",146,0)
878GWPSDONE ;
879"RTN","TMGRPC3E",147,0)
880 QUIT
881"RTN","TMGRPC3E",148,0)
882 ;
883"RTN","TMGRPC3E",149,0)
884 ;
885"RTN","TMGRPC3E",150,0)
886GETWPFLD(TMGOUT,TMGPARAMS) ;"GET WP FIELD
887"RTN","TMGRPC3E",151,0)
888 ;"Purpose: To retrieve on word processing (WP) field entry
889"RTN","TMGRPC3E",152,0)
890 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
891"RTN","TMGRPC3E",153,0)
892 ;" TMGPARAMS -- FileNum^Field^IENS (e.g. 'GET ONE WP FIELD^200^73,')
893"RTN","TMGRPC3E",154,0)
894 ;"Output:
895"RTN","TMGRPC3E",155,0)
896 ;" TMGOUT(0): "1^Success" or "-1^Message"
897"RTN","TMGRPC3E",156,0)
898 ;" TMGOUT(1) will contain Fileman error, if any
899"RTN","TMGRPC3E",157,0)
900 ;" - or to return WP array -
901"RTN","TMGRPC3E",158,0)
902 ;" TMGOUT(1)=1st line of text
903"RTN","TMGRPC3E",159,0)
904 ;" TMGOUT(2)=2nd line of text
905"RTN","TMGRPC3E",160,0)
906 ;" etc..
907"RTN","TMGRPC3E",161,0)
908 ;"Results: None
909"RTN","TMGRPC3E",162,0)
910 ;
911"RTN","TMGRPC3E",163,0)
912 NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
913"RTN","TMGRPC3E",164,0)
914 NEW TMGFIELD SET TMGFIELD=+$PIECE(TMGPARAMS,"^",2)
915"RTN","TMGRPC3E",165,0)
916 NEW TMGIENS SET TMGIENS=+$PIECE(TMGPARAMS,"^",3)
917"RTN","TMGRPC3E",166,0)
918 IF TMGFILE'>0 DO GOTO GWPDONE
919"RTN","TMGRPC3E",167,0)
920 . SET TMGOUT(0)="-1^No file number supplied"
921"RTN","TMGRPC3E",168,0)
922 IF TMGFIELD'>0 DO GOTO GWPDONE
923"RTN","TMGRPC3E",169,0)
924 . SET TMGOUT(0)="-1^No Field Number supplied"
925"RTN","TMGRPC3E",170,0)
926 IF TMGIENS="" DO GOTO GWPDONE
927"RTN","TMGRPC3E",171,0)
928 . SET TMGOUT(0)="-1^No IENS supplied"
929"RTN","TMGRPC3E",172,0)
930 ;
931"RTN","TMGRPC3E",173,0)
932 NEW TMGTEMP
933"RTN","TMGRPC3E",174,0)
934 SET TMGTEMP=$$GET1^DIQ(TMGFILE,TMGIENS,TMGFIELD,"","TMGARRAY","TMGMSG")
935"RTN","TMGRPC3E",175,0)
936 IF $DATA(TMGMSG("DIERR")) DO GOTO GWPDONE
937"RTN","TMGRPC3E",176,0)
938 . SET TMGOUT(0)="-1^See Fileman message"
939"RTN","TMGRPC3E",177,0)
940 . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
941"RTN","TMGRPC3E",178,0)
942 ;
943"RTN","TMGRPC3E",179,0)
944 SET TMGOUT(0)="1^Success"
945"RTN","TMGRPC3E",180,0)
946 NEW TMGINDEX SET TMGINDEX=1
947"RTN","TMGRPC3E",181,0)
948 NEW TMGI SET TMGI=0
949"RTN","TMGRPC3E",182,0)
950 FOR SET TMGI=$ORDER(TMGARRAY(TMGI)) QUIT:(TMGI="") DO
951"RTN","TMGRPC3E",183,0)
952 . SET TMGOUT(TMGINDEX)=TMGARRAY(TMGI)
953"RTN","TMGRPC3E",184,0)
954 . SET TMGINDEX=TMGINDEX+1
955"RTN","TMGRPC3E",185,0)
956 ;
957"RTN","TMGRPC3E",186,0)
958GWPDONE ;
959"RTN","TMGRPC3E",187,0)
960 QUIT
961"RTN","TMGRPC3E",188,0)
962 ;
963"RTN","TMGRPC3E",189,0)
964 ;
965"RTN","TMGRPC3E",190,0)
966PSTWPFLD(TMGOUT,TMGPARAMS,INPUT) ;"POST WP FIELD
967"RTN","TMGRPC3E",191,0)
968 ;"Purpose: To store a word processing (WP) field entry
969"RTN","TMGRPC3E",192,0)
970 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
971"RTN","TMGRPC3E",193,0)
972 ;" TMGPARAMS -- FileNum^FieldNum^IENS (e.g. 'GET ONE WP FIELD^200^73,')
973"RTN","TMGRPC3E",194,0)
974 ;" INPUT -- holds the WP itself to be stored:
975"RTN","TMGRPC3E",195,0)
976 ;" INPUT(0)=0TH line
977"RTN","TMGRPC3E",196,0)
978 ;" INPUT(1)=1st line
979"RTN","TMGRPC3E",197,0)
980 ;" INPUT(2)=2nd line
981"RTN","TMGRPC3E",198,0)
982 ;" ...
983"RTN","TMGRPC3E",199,0)
984 ;"Output:
985"RTN","TMGRPC3E",200,0)
986 ;" TMGOUT(0): "1^Success" or "-1^Message"
987"RTN","TMGRPC3E",201,0)
988 ;" TMGOUT(1) will contain Fileman error, if any
989"RTN","TMGRPC3E",202,0)
990 ;"Results: None
991"RTN","TMGRPC3E",203,0)
992 ;
993"RTN","TMGRPC3E",204,0)
994 NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
995"RTN","TMGRPC3E",205,0)
996 NEW TMGFIELD SET TMGFIELD=+$PIECE(TMGPARAMS,"^",2)
997"RTN","TMGRPC3E",206,0)
998 NEW TMGIENS SET TMGIENS=+$PIECE(TMGPARAMS,"^",3)
999"RTN","TMGRPC3E",207,0)
1000 IF TMGFILE'>0 DO GOTO PWPDONE
1001"RTN","TMGRPC3E",208,0)
1002 . SET TMGOUT(0)="-1^No file number supplied"
1003"RTN","TMGRPC3E",209,0)
1004 IF TMGFIELD'>0 DO GOTO PWPDONE
1005"RTN","TMGRPC3E",210,0)
1006 . SET TMGOUT(0)="-1^No Field Number supplied"
1007"RTN","TMGRPC3E",211,0)
1008 IF TMGIENS="" DO GOTO PWPDONE
1009"RTN","TMGRPC3E",212,0)
1010 . SET TMGOUT(0)="-1^No IENS supplied"
1011"RTN","TMGRPC3E",213,0)
1012 IF $LENGTH(TMGIENS,",")=1 SET TMGIENS=TMGIENS_","
1013"RTN","TMGRPC3E",214,0)
1014 ;
1015"RTN","TMGRPC3E",215,0)
1016 DO WP^DIE(TMGFILE,TMGIENS,TMGFIELD,"K","INPUT","TMGMSG")
1017"RTN","TMGRPC3E",216,0)
1018 ;
1019"RTN","TMGRPC3E",217,0)
1020 IF $DATA(TMGMSG("DIERR")) DO GOTO GWPDONE
1021"RTN","TMGRPC3E",218,0)
1022 . SET TMGOUT(0)="-1^See Fileman message"
1023"RTN","TMGRPC3E",219,0)
1024 . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
1025"RTN","TMGRPC3E",220,0)
1026 ;
1027"RTN","TMGRPC3E",221,0)
1028 SET TMGOUT(0)="1^Success"
1029"RTN","TMGRPC3E",222,0)
1030 ;
1031"RTN","TMGRPC3E",223,0)
1032PWPDONE ;
1033"RTN","TMGRPC3E",224,0)
1034 QUIT
1035"RTN","TMGRPC3E",225,0)
1036 ;
1037"RTN","TMGRPC3E",226,0)
1038 ;
1039"VER")
10408.0^22.0
1041**END**
1042**END**
Note: See TracBrowser for help on using the repository browser.