source: cprs/branches/GUI-config/KIDS Server patch/TMG_GUI_CONFIG-1-2.kid@ 750

Last change on this file since 750 was 480, checked in by Kevin Toppenberg, 16 years ago

Made Server code SACC compliant
File size: 91.4 KB
Line 
1KIDS Distribution saved on Aug 31, 2008@20:28:32
2TMG GUI CONFIG PATCH
3**KIDS**:TMG-GUI-CONFIG*1.0*2^
4
5**INSTALL NAME**
6TMG-GUI-CONFIG*1.0*2
7"BLD",5421,0)
8TMG-GUI-CONFIG*1.0*2^^0^3080831^n
9"BLD",5421,1,0)
10^^12^12^3080820^^
11"BLD",5421,1,1,0)
12This will contain one source file (TMGRPC3.m) and RPC's
13"BLD",5421,1,2,0)
14to support the WorldVistA Config Utility (a Windows
15"BLD",5421,1,3,0)
16GUI client for performing Fileman tasks.
17"BLD",5421,1,4,0)
18
19"BLD",5421,1,5,0)
20Note, user will need to have the menu option:
21"BLD",5421,1,6,0)
22 TMG RPC CONTEXT GUI_CONFIG
23"BLD",5421,1,7,0)
24added to their secondary menu to be authorized for use.
25"BLD",5421,1,8,0)
26
27"BLD",5421,1,9,0)
28Note: This utility will allow an authorized user to perform
29"BLD",5421,1,10,0)
30arbitrary Fileman writes, and could potentially cause
31"BLD",5421,1,11,0)
32significant problems. So careful consideration should be
33"BLD",5421,1,12,0)
34given to determining who can use this GUI utility.
35"BLD",5421,4,0)
36^9.64PA^^0
37"BLD",5421,"KRN",0)
38^9.67PA^8989.52^19
39"BLD",5421,"KRN",.4,0)
40.4
41"BLD",5421,"KRN",.401,0)
42.401
43"BLD",5421,"KRN",.402,0)
44.402
45"BLD",5421,"KRN",.403,0)
46.403
47"BLD",5421,"KRN",.5,0)
48.5
49"BLD",5421,"KRN",.84,0)
50.84
51"BLD",5421,"KRN",3.6,0)
523.6
53"BLD",5421,"KRN",3.8,0)
543.8
55"BLD",5421,"KRN",9.2,0)
569.2
57"BLD",5421,"KRN",9.8,0)
589.8
59"BLD",5421,"KRN",9.8,"NM",0)
60^9.68A^7^7
61"BLD",5421,"KRN",9.8,"NM",1,0)
62TMGRPC3^^0^B73247867
63"BLD",5421,"KRN",9.8,"NM",2,0)
64TMGRPC3B^^0^B82011776
65"BLD",5421,"KRN",9.8,"NM",3,0)
66TMGRPC3C^^0^B54917889
67"BLD",5421,"KRN",9.8,"NM",4,0)
68TMGRPC3D^^0^B81308711
69"BLD",5421,"KRN",9.8,"NM",5,0)
70TMGRPC3E^^0^B73079721
71"BLD",5421,"KRN",9.8,"NM",6,0)
72TMGRPC3F^^0^B82393873
73"BLD",5421,"KRN",9.8,"NM",7,0)
74TMGRPC3G^^0^B8609927
75"BLD",5421,"KRN",9.8,"NM","B","TMGRPC3",1)
76
77"BLD",5421,"KRN",9.8,"NM","B","TMGRPC3B",2)
78
79"BLD",5421,"KRN",9.8,"NM","B","TMGRPC3C",3)
80
81"BLD",5421,"KRN",9.8,"NM","B","TMGRPC3D",4)
82
83"BLD",5421,"KRN",9.8,"NM","B","TMGRPC3E",5)
84
85"BLD",5421,"KRN",9.8,"NM","B","TMGRPC3F",6)
86
87"BLD",5421,"KRN",9.8,"NM","B","TMGRPC3G",7)
88
89"BLD",5421,"KRN",19,0)
9019
91"BLD",5421,"KRN",19,"NM",0)
92^9.68A^1^1
93"BLD",5421,"KRN",19,"NM",1,0)
94TMG RPC CONTEXT GUI_CONFIG^^0
95"BLD",5421,"KRN",19,"NM","B","TMG RPC CONTEXT GUI_CONFIG",1)
96
97"BLD",5421,"KRN",19.1,0)
9819.1
99"BLD",5421,"KRN",101,0)
100101
101"BLD",5421,"KRN",409.61,0)
102409.61
103"BLD",5421,"KRN",771,0)
104771
105"BLD",5421,"KRN",870,0)
106870
107"BLD",5421,"KRN",8989.51,0)
1088989.51
109"BLD",5421,"KRN",8989.52,0)
1108989.52
111"BLD",5421,"KRN",8994,0)
1128994
113"BLD",5421,"KRN",8994,"NM",0)
114^9.68A^1^1
115"BLD",5421,"KRN",8994,"NM",1,0)
116TMG CHANNEL^^0
117"BLD",5421,"KRN",8994,"NM","B","TMG CHANNEL",1)
118
119"BLD",5421,"KRN","B",.4,.4)
120
121"BLD",5421,"KRN","B",.401,.401)
122
123"BLD",5421,"KRN","B",.402,.402)
124
125"BLD",5421,"KRN","B",.403,.403)
126
127"BLD",5421,"KRN","B",.5,.5)
128
129"BLD",5421,"KRN","B",.84,.84)
130
131"BLD",5421,"KRN","B",3.6,3.6)
132
133"BLD",5421,"KRN","B",3.8,3.8)
134
135"BLD",5421,"KRN","B",9.2,9.2)
136
137"BLD",5421,"KRN","B",9.8,9.8)
138
139"BLD",5421,"KRN","B",19,19)
140
141"BLD",5421,"KRN","B",19.1,19.1)
142
143"BLD",5421,"KRN","B",101,101)
144
145"BLD",5421,"KRN","B",409.61,409.61)
146
147"BLD",5421,"KRN","B",771,771)
148
149"BLD",5421,"KRN","B",870,870)
150
151"BLD",5421,"KRN","B",8989.51,8989.51)
152
153"BLD",5421,"KRN","B",8989.52,8989.52)
154
155"BLD",5421,"KRN","B",8994,8994)
156
157"BLD",5421,"QUES",0)
158^9.62^^
159"KRN",19,10090,-1)
1600^1
161"KRN",19,10090,0)
162TMG RPC CONTEXT GUI_CONFIG^GUIConfig 1.0.0.0^^B^^^^^^^^FP OF GREENEVILLE (TMG)
163"KRN",19,10090,1,0)
164^^2^2^3080720^^
165"KRN",19,10090,1,1,0)
166This will be the context file for GUI_Config
167"KRN",19,10090,1,2,0)
168It will hold the list of all allowed RPC calls.
169"KRN",19,10090,"RPC",0)
170^19.05P^1^1
171"KRN",19,10090,"RPC",1,0)
172TMG CHANNEL
173"KRN",19,10090,"U")
174GUICONFIG 1.0.0.0
175"KRN",8994,1785,-1)
1760^1
177"KRN",8994,1785,0)
178TMG CHANNEL^CHANNEL^TMGRPC3^2^^^^1^1
179"KRN",8994,1785,1,0)
180^8994.01^2^2^3080805^^^
181"KRN",8994,1785,1,1,0)
182This RPC will be used to pass multiple requests back
183"KRN",8994,1785,1,2,0)
184and forth from client to server
185"KRN",8994,1785,2,0)
186^8994.02A^1^1
187"KRN",8994,1785,2,1,0)
188INPUT^3^^1^1
189"KRN",8994,1785,2,1,1,0)
190^8994.021^2^2^3080805^^^
191"KRN",8994,1785,2,1,1,1,0)
192This is the data array sent from client.
193"KRN",8994,1785,2,1,1,2,0)
194Format still to be decided.
195"KRN",8994,1785,2,"B","INPUT",1)
196
197"KRN",8994,1785,2,"PARAMSEQ",1,1)
198
199"KRN",8994,1785,3,0)
200^8994.03^3^3^3080805^^^
201"KRN",8994,1785,3,1,0)
202This is the result array passed from server back to client.
203"KRN",8994,1785,3,2,0)
204Format still to be decided.
205"KRN",8994,1785,3,3,0)
206See documentation in CHANNEL^TMGRPC3
207"MBREQ")
2080
209"ORD",16,8994)
2108994;16;1;;;;;;;RPCDEL^XPDIA1
211"ORD",16,8994,0)
212REMOTE PROCEDURE
213"ORD",18,19)
21419;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA
215"ORD",18,19,0)
216OPTION
217"QUES","XPF1",0)
218Y
219"QUES","XPF1","??")
220^D REP^XPDH
221"QUES","XPF1","A")
222Shall I write over your |FLAG| File
223"QUES","XPF1","B")
224YES
225"QUES","XPF1","M")
226D XPF1^XPDIQ
227"QUES","XPF2",0)
228Y
229"QUES","XPF2","??")
230^D DTA^XPDH
231"QUES","XPF2","A")
232Want my data |FLAG| yours
233"QUES","XPF2","B")
234YES
235"QUES","XPF2","M")
236D XPF2^XPDIQ
237"QUES","XPI1",0)
238YO
239"QUES","XPI1","??")
240^D INHIBIT^XPDH
241"QUES","XPI1","A")
242Want KIDS to INHIBIT LOGONs during the install
243"QUES","XPI1","B")
244YES
245"QUES","XPI1","M")
246D XPI1^XPDIQ
247"QUES","XPM1",0)
248PO^VA(200,:EM
249"QUES","XPM1","??")
250^D MG^XPDH
251"QUES","XPM1","A")
252Enter the Coordinator for Mail Group '|FLAG|'
253"QUES","XPM1","B")
254
255"QUES","XPM1","M")
256D XPM1^XPDIQ
257"QUES","XPO1",0)
258Y
259"QUES","XPO1","??")
260^D MENU^XPDH
261"QUES","XPO1","A")
262Want KIDS to Rebuild Menu Trees Upon Completion of Install
263"QUES","XPO1","B")
264YES
265"QUES","XPO1","M")
266D XPO1^XPDIQ
267"QUES","XPZ1",0)
268Y
269"QUES","XPZ1","??")
270^D OPT^XPDH
271"QUES","XPZ1","A")
272Want to DISABLE Scheduled Options, Menu Options, and Protocols
273"QUES","XPZ1","B")
274YES
275"QUES","XPZ1","M")
276D XPZ1^XPDIQ
277"QUES","XPZ2",0)
278Y
279"QUES","XPZ2","??")
280^D RTN^XPDH
281"QUES","XPZ2","A")
282Want to MOVE routines to other CPUs
283"QUES","XPZ2","B")
284NO
285"QUES","XPZ2","M")
286D XPZ2^XPDIQ
287"RTN")
2887
289"RTN","TMGRPC3")
2900^1^B73247867
291"RTN","TMGRPC3",1,0)
292TMGRPC3 ;TMG/kst/RPC Functions for GUI_Config ;07/20/08
293"RTN","TMGRPC3",2,0)
294 ;;1.0;TMG-LIB;**1**;08/31/08
295"RTN","TMGRPC3",3,0)
296 ;
297"RTN","TMGRPC3",4,0)
298 ;"TMG RPC FUNCTIONS for a GUI config program
299"RTN","TMGRPC3",5,0)
300 ;
301"RTN","TMGRPC3",6,0)
302 ;"Kevin Toppenberg MD
303"RTN","TMGRPC3",7,0)
304 ;"GNU Lessor General Public License (LGPL) applies
305"RTN","TMGRPC3",8,0)
306 ;"7/20/08
307"RTN","TMGRPC3",9,0)
308 ;
309"RTN","TMGRPC3",10,0)
310 ;"=======================================================================
311"RTN","TMGRPC3",11,0)
312 ;" RPC -- Public Functions.
313"RTN","TMGRPC3",12,0)
314 ;"=======================================================================
315"RTN","TMGRPC3",13,0)
316 ;"CHANNEL(TMGRESULT,INPUT) -- general purpose channel RPC from a GUI config program
317"RTN","TMGRPC3",14,0)
318 ;
319"RTN","TMGRPC3",15,0)
320 ;"=======================================================================
321"RTN","TMGRPC3",16,0)
322 ;"Dependencies:
323"RTN","TMGRPC3",17,0)
324 ;" TMGRPC3* only
325"RTN","TMGRPC3",18,0)
326 ;
327"RTN","TMGRPC3",19,0)
328 ;"=======================================================================
329"RTN","TMGRPC3",20,0)
330 ;
331"RTN","TMGRPC3",21,0)
332CHANNEL(TMGRESULT,INPUT) ;
333"RTN","TMGRPC3",22,0)
334 ;"Purpose: This will be a general purpose channel RPC from a GUI config program
335"RTN","TMGRPC3",23,0)
336 ;"Input: TMGRESULT -- this is an OUT parameter, and it is always passed by reference
337"RTN","TMGRPC3",24,0)
338 ;" INPUT -- this will be array of data sent from the GUI client. Defined below:
339"RTN","TMGRPC3",25,0)
340 ;" <Stuff will go here>
341"RTN","TMGRPC3",26,0)
342 ;" INPUT("REQUEST")="cmd^params" Valid values for "cmd" are:
343"RTN","TMGRPC3",27,0)
344 ;" "GET USER LIST"
345"RTN","TMGRPC3",28,0)
346 ;" params: <empty> or NODISUSER
347"RTN","TMGRPC3",29,0)
348 ;" "GET RECORDS LIST" -- get list of all .01 fields for file.
349"RTN","TMGRPC3",30,0)
350 ;" params: FileNumber (e.g. 'GET RECORDS LIST^8989.3')
351"RTN","TMGRPC3",31,0)
352 ;" "GET ONE USER"
353"RTN","TMGRPC3",32,0)
354 ;" params: IEN (e.g. 'GET ONE USER^12345')
355"RTN","TMGRPC3",33,0)
356 ;" "GET ONE RECORD"
357"RTN","TMGRPC3",34,0)
358 ;" params: FileNum^IENS (e.g. 'GET ONE RECORD^200^73,')
359"RTN","TMGRPC3",35,0)
360 ;" "GET ONE WP FIELD"
361"RTN","TMGRPC3",36,0)
362 ;" params: FileNum^Field^IENS^ (e.g. 'GET ONE WP FIELD^200^2^73,')
363"RTN","TMGRPC3",37,0)
364 ;" "FILE ENTRY SUBSET"
365"RTN","TMGRPC3",38,0)
366 ;" params: FileNum^ListStartValue^direction^MaxCount(optional, def=44)
367"RTN","TMGRPC3",39,0)
368 ;" "GET SUB RECS LIST" -- get all .01 sub record entries for a subfile
369"RTN","TMGRPC3",40,0)
370 ;" params: SubFileNum^ParentIENS
371"RTN","TMGRPC3",41,0)
372 ;" "POST DATA"
373"RTN","TMGRPC3",42,0)
374 ;" params: (not used)
375"RTN","TMGRPC3",43,0)
376 ;" INPUT(0)=FileNum^IENS^FieldNum^FieldName^newValue^oldValue
377"RTN","TMGRPC3",44,0)
378 ;" INPUT(1)=FileNum^IENS^FieldNum^FieldName^newValue^oldValue
379"RTN","TMGRPC3",45,0)
380 ;" ... (note: FieldName and oldValue are not used)
381"RTN","TMGRPC3",46,0)
382 ;" "POST WP FIELD"
383"RTN","TMGRPC3",47,0)
384 ;" params: FileNum^FieldNum^IENS (e.g. 'POST WP FIELD^200^2^73,')
385"RTN","TMGRPC3",48,0)
386 ;" WP field itself is stored as follows:
387"RTN","TMGRPC3",49,0)
388 ;" INPUT(0)=0TH line
389"RTN","TMGRPC3",50,0)
390 ;" INPUT(1)=1st line
391"RTN","TMGRPC3",51,0)
392 ;" INPUT(2)=2nd line
393"RTN","TMGRPC3",52,0)
394 ;" ...
395"RTN","TMGRPC3",53,0)
396 ;" Note: don't include INPUT("REQUEST") with text.
397"RTN","TMGRPC3",54,0)
398 ;" "GET EMPTY ENTRY" -- getting stub entries for subfiles typically
399"RTN","TMGRPC3",55,0)
400 ;" params: file entry (file or subfile number)
401"RTN","TMGRPC3",56,0)
402 ;" "GET CURRENT USER NAME" -- return name of DUZ (current) user
403"RTN","TMGRPC3",57,0)
404 ;" (params: not used)
405"RTN","TMGRPC3",58,0)
406 ;" "CLONE USER"
407"RTN","TMGRPC3",59,0)
408 ;" params: SourceIENS^New.01Value
409"RTN","TMGRPC3",60,0)
410 ;" "CLONE RECORD"
411"RTN","TMGRPC3",61,0)
412 ;" params: FileNum^SourceIENS^New.01Value
413"RTN","TMGRPC3",62,0)
414 ;" "GET HELP MSG"
415"RTN","TMGRPC3",63,0)
416 ;" params : FileNum^FieldNum^HelpType
417"RTN","TMGRPC3",64,0)
418 ;" "IS WP FIELD"
419"RTN","TMGRPC3",65,0)
420 ;" params: FileNum^FieldNum
421"RTN","TMGRPC3",66,0)
422 ;" "GET ONE WP FIELD" -- retrieve on word processing (WP) field entry
423"RTN","TMGRPC3",67,0)
424 ;" param -- FileNum^Field^IENS (e.g. 'GET ONE WP FIELD^200^2^73,')
425"RTN","TMGRPC3",68,0)
426 ;" "REGISTER PATIENT"
427"RTN","TMGRPC3",69,0)
428 ;" param -- FieldNum1^FieldValue1^FieldNum2^FieldValue2^FieldNum3^FieldValue3^...
429"RTN","TMGRPC3",70,0)
430 ;"Output: results of this function should be put into TMGRESULTS array.
431"RTN","TMGRPC3",71,0)
432 ;" For cmd:
433"RTN","TMGRPC3",72,0)
434 ;" "GET USER LIST"
435"RTN","TMGRPC3",73,0)
436 ;" TMGRESULT(0)="1^Success" or "-1^Message"
437"RTN","TMGRPC3",74,0)
438 ;" TMGRESULT(1)=Name^IEN^200^DISUSER DISUSER will be 1 for "Y" or 0 for "N"
439"RTN","TMGRPC3",75,0)
440 ;" TMGRESULT(2)=Name^IEN^200^DISUSER
441"RTN","TMGRPC3",76,0)
442 ;" etc ...
443"RTN","TMGRPC3",77,0)
444 ;" "GET RECORDS LIST"
445"RTN","TMGRPC3",78,0)
446 ;" TMGRESULT(0)="1^Success" or "-1^Message"
447"RTN","TMGRPC3",79,0)
448 ;" TMGRESULT(1)=.01Value^IEN^FileNum
449"RTN","TMGRPC3",80,0)
450 ;" TMGRESULT(2)=.01Value^IEN^FileNum
451"RTN","TMGRPC3",81,0)
452 ;" etc ...
453"RTN","TMGRPC3",82,0)
454 ;" "GET ONE USER"
455"RTN","TMGRPC3",83,0)
456 ;" TMGRESULT(0)="1^Success" or "-1^Message"
457"RTN","TMGRPC3",84,0)
458 ;" TMGRESULT(1)=File^IENS^FieldNum^ExternalValue^DDInfo...
459"RTN","TMGRPC3",85,0)
460 ;" TMGRESULT(2)=File^IENS^FieldNum^ExternalValue^DDInfo...
461"RTN","TMGRPC3",86,0)
462 ;" etc ...
463"RTN","TMGRPC3",87,0)
464 ;" "GET ONE RECORD"
465"RTN","TMGRPC3",88,0)
466 ;" TMGRESULT(0)="1^Success" or "-1^Message"
467"RTN","TMGRPC3",89,0)
468 ;" TMGRESULT(1)=File^IENS^FieldNum^ExternalValue^DDInfo...
469"RTN","TMGRPC3",90,0)
470 ;" TMGRESULT(2)=File^IENS^FieldNum^ExternalValue^DDInfo...
471"RTN","TMGRPC3",91,0)
472 ;" ...
473"RTN","TMGRPC3",92,0)
474 ;" "GET ONE WP FIELD"
475"RTN","TMGRPC3",93,0)
476 ;" TMGRESULT(0): "1^Success" or "-1^Message"
477"RTN","TMGRPC3",94,0)
478 ;" TMGRESULT(1) will contain Fileman error, if any
479"RTN","TMGRPC3",95,0)
480 ;" - or to return WP array -
481"RTN","TMGRPC3",96,0)
482 ;" TMGRESULT(1)=1st line of text
483"RTN","TMGRPC3",97,0)
484 ;" TMGRESULT(2)=2nd line of text
485"RTN","TMGRPC3",98,0)
486 ;" etc..
487"RTN","TMGRPC3",99,0)
488 ;" "FILE ENTRY SUBSET"
489"RTN","TMGRPC3",100,0)
490 ;" TMGRESULT(0)="1^Success" or "-1^Message"
491"RTN","TMGRPC3",101,0)
492 ;" TMGRESULT(1)=Value
493"RTN","TMGRPC3",102,0)
494 ;" TMGRESULT(2)=Value
495"RTN","TMGRPC3",103,0)
496 ;" etc ...
497"RTN","TMGRPC3",104,0)
498 ;" "GET SUB RECS LIST"
499"RTN","TMGRPC3",105,0)
500 ;" TMGRESULT(0)="1^Success" or "-1^Message"
501"RTN","TMGRPC3",106,0)
502 ;" TMGRESULT(1)=IEN^Value
503"RTN","TMGRPC3",107,0)
504 ;" TMGRESULT(2)=IEN^Value
505"RTN","TMGRPC3",108,0)
506 ;" ...
507"RTN","TMGRPC3",109,0)
508 ;" "POST DATA"
509"RTN","TMGRPC3",110,0)
510 ;" TMGRESULT(0)="1^Success" or "-1^Message"
511"RTN","TMGRPC3",111,0)
512 ;" TMGRESULT(1)=Fileman message (long) (if generated)
513"RTN","TMGRPC3",112,0)
514 ;" -or (if +1 etc values used)-
515"RTN","TMGRPC3",113,0)
516 ;" TMGRESULT(1)=+5^1234 <-- results of IEN array returned (+5 converted to record 1234)
517"RTN","TMGRPC3",114,0)
518 ;" TMGRESULT(2)=+3^2341 <-- results of IEN array returned (+3 converted to record 2341)
519"RTN","TMGRPC3",115,0)
520 ;" ...
521"RTN","TMGRPC3",116,0)
522 ;" "GET EMPTY ENTRY"
523"RTN","TMGRPC3",117,0)
524 ;" TMGRESULT(0)="1^Success" or "-1^Message"
525"RTN","TMGRPC3",118,0)
526 ;" TMGRESULT(1)=File^^FieldNum^^DDInfo...
527"RTN","TMGRPC3",119,0)
528 ;" TMGRESULT(2)=File^^FieldNum^^DDInfo...
529"RTN","TMGRPC3",120,0)
530 ;" etc ...
531"RTN","TMGRPC3",121,0)
532 ;" "GET CURRENT USER NAME" -- return name of DUZ (current) user
533"RTN","TMGRPC3",122,0)
534 ;" TMGRESULT(0)="1^Success^UserName" or "-1^Message"
535"RTN","TMGRPC3",123,0)
536 ;" "CLONE USER"
537"RTN","TMGRPC3",124,0)
538 ;" TMGRESULT(0)="1^Success^NewIENS" or "-1^Message"
539"RTN","TMGRPC3",125,0)
540 ;" TMGRESULT(1)=Long Fileman message (if -1 error)
541"RTN","TMGRPC3",126,0)
542 ;" "CLONE RECORD"
543"RTN","TMGRPC3",127,0)
544 ;" TMGRESULT(0)="1^Success^NewIENS" or "-1^Message"
545"RTN","TMGRPC3",128,0)
546 ;" TMGRESULT(1)=Fileman message (long) (if generated)
547"RTN","TMGRPC3",129,0)
548 ;" "GET HELP MSG"
549"RTN","TMGRPC3",130,0)
550 ;" TMGRESULT(0)="1^Success^NewIENS" or "-1^Message"
551"RTN","TMGRPC3",131,0)
552 ;" TMGRESULT(1)=Fileman message (long) (if generated)
553"RTN","TMGRPC3",132,0)
554 ;" "IS WP FIELD"
555"RTN","TMGRPC3",133,0)
556 ;" TMGRESULT(0)="1^Success^YES/NO" or "-1^Message"
557"RTN","TMGRPC3",134,0)
558 ;" "YES" if is a WP subfile, otherwise "NO"
559"RTN","TMGRPC3",135,0)
560 ;" TMGRESULT(1)=Fileman message (long) (if generated)
561"RTN","TMGRPC3",136,0)
562 ;" "REGISTER PATIENT"
563"RTN","TMGRPC3",137,0)
564 ;" TMGRESULT(0)="1^Success^NewIEN" or "-1^Message"
565"RTN","TMGRPC3",138,0)
566 ;" TMGRESULT(1)=Fileman message (long) (if generated)
567"RTN","TMGRPC3",139,0)
568 ;
569"RTN","TMGRPC3",140,0)
570 ;"Result: none
571"RTN","TMGRPC3",141,0)
572 ;
573"RTN","TMGRPC3",142,0)
574 NEW TMGCOMMAND,TMGCOMMAND
575"RTN","TMGRPC3",143,0)
576 SET TMGCOMMAND=$$TRIM^XLFSTR($$UP^XLFSTR($PIECE($GET(INPUT("REQUEST")),"^",1)))
577"RTN","TMGRPC3",144,0)
578 SET TMGPARAMS=$$UP^XLFSTR($PIECE($GET(INPUT("REQUEST")),"^",2,199))
579"RTN","TMGRPC3",145,0)
580 SET TMGRESULT(0)="-1^No command requested." ;"default to error state.
581"RTN","TMGRPC3",146,0)
582 IF TMGCOMMAND="GET USER LIST" DO
583"RTN","TMGRPC3",147,0)
584 . DO GETUSRLT^TMGRPC3B(.TMGRESULT,TMGPARAMS)
585"RTN","TMGRPC3",148,0)
586 IF TMGCOMMAND="GET RECORDS LIST" DO
587"RTN","TMGRPC3",149,0)
588 . DO GETRECLT^TMGRPC3B(.TMGRESULT,TMGPARAMS)
589"RTN","TMGRPC3",150,0)
590 ELSE IF TMGCOMMAND="GET ONE USER" DO
591"RTN","TMGRPC3",151,0)
592 . DO GET1USER^TMGRPC3B(.TMGRESULT,TMGPARAMS)
593"RTN","TMGRPC3",152,0)
594 ELSE IF TMGCOMMAND="GET ONE RECORD" DO
595"RTN","TMGRPC3",153,0)
596 . DO GET1REC^TMGRPC3B(.TMGRESULT,TMGPARAMS)
597"RTN","TMGRPC3",154,0)
598 ELSE IF TMGCOMMAND="FILE ENTRY SUBSET" DO
599"RTN","TMGRPC3",155,0)
600 . DO GFLSUBST^TMGRPC3B(.TMGRESULT,TMGPARAMS)
601"RTN","TMGRPC3",156,0)
602 ELSE IF TMGCOMMAND="GET SUB RECS LIST" DO
603"RTN","TMGRPC3",157,0)
604 . DO GETSRLST^TMGRPC3D(.TMGRESULT,TMGPARAMS)
605"RTN","TMGRPC3",158,0)
606 ELSE IF TMGCOMMAND="POST DATA" DO
607"RTN","TMGRPC3",159,0)
608 . KILL INPUT("REQUEST")
609"RTN","TMGRPC3",160,0)
610 . DO POSTDATA^TMGRPC3C(.TMGRESULT,.INPUT)
611"RTN","TMGRPC3",161,0)
612 ELSE IF TMGCOMMAND="GET EMPTY ENTRY" DO
613"RTN","TMGRPC3",162,0)
614 . DO GETEMPTY^TMGRPC3E(.TMGRESULT,TMGPARAMS)
615"RTN","TMGRPC3",163,0)
616 ELSE IF TMGCOMMAND="GET CURRENT USER NAME" DO
617"RTN","TMGRPC3",164,0)
618 . SET TMGRESULT(0)="1^Success^"_$PIECE($GET(^VA(200,DUZ,0)),"^",1)
619"RTN","TMGRPC3",165,0)
620 ELSE IF TMGCOMMAND="CLONE RECORD" DO
621"RTN","TMGRPC3",166,0)
622 . DO CLONEREC^TMGRPC3D(.TMGRESULT,TMGPARAMS)
623"RTN","TMGRPC3",167,0)
624 ELSE IF TMGCOMMAND="CLONE USER" DO
625"RTN","TMGRPC3",168,0)
626 . DO CLONEUSR^TMGRPC3D(.TMGRESULT,TMGPARAMS)
627"RTN","TMGRPC3",169,0)
628 ELSE IF TMGCOMMAND="GET HELP MSG" DO
629"RTN","TMGRPC3",170,0)
630 . DO GETHELPM^TMGRPC3E(.TMGRESULT,TMGPARAMS)
631"RTN","TMGRPC3",171,0)
632 ELSE IF TMGCOMMAND="IS WP FIELD" DO
633"RTN","TMGRPC3",172,0)
634 . DO GETIFWP^TMGRPC3E(.TMGRESULT,TMGPARAMS)
635"RTN","TMGRPC3",173,0)
636 ELSE IF TMGCOMMAND="GET ONE WP FIELD" DO
637"RTN","TMGRPC3",174,0)
638 . DO GETWPFLD^TMGRPC3E(.TMGRESULT,TMGPARAMS)
639"RTN","TMGRPC3",175,0)
640 ELSE IF TMGCOMMAND="POST WP FIELD" DO
641"RTN","TMGRPC3",176,0)
642 . KILL INPUT("REQUEST")
643"RTN","TMGRPC3",177,0)
644 . DO PSTWPFLD^TMGRPC3E(.TMGRESULT,TMGPARAMS,.INPUT)
645"RTN","TMGRPC3",178,0)
646 ELSE IF TMGCOMMAND="REGISTER PATIENT" DO
647"RTN","TMGRPC3",179,0)
648 . DO REGPAT^TMGRPC3F(.TMGRESULT,TMGPARAMS)
649"RTN","TMGRPC3",180,0)
650 ;
651"RTN","TMGRPC3",181,0)
652 ;
653"RTN","TMGRPC3",182,0)
654 QUIT
655"RTN","TMGRPC3",183,0)
656 ;
657"RTN","TMGRPC3B")
6580^2^B82011776
659"RTN","TMGRPC3B",1,0)
660TMGRPC3B ;TMG/kst/Support Functions for GUI_Config ;08/31/08
661"RTN","TMGRPC3B",2,0)
662 ;;1.0;TMG-LIB;**1**;08/31/08
663"RTN","TMGRPC3B",3,0)
664 ;
665"RTN","TMGRPC3B",4,0)
666 ;"TMG RPC FUNCTIONS for a GUI config program
667"RTN","TMGRPC3B",5,0)
668 ;
669"RTN","TMGRPC3B",6,0)
670 ;"Kevin Toppenberg MD
671"RTN","TMGRPC3B",7,0)
672 ;"GNU Lessor General Public License (LGPL) applies
673"RTN","TMGRPC3B",8,0)
674 ;"7/20/08
675"RTN","TMGRPC3B",9,0)
676 ;
677"RTN","TMGRPC3B",10,0)
678 ;"=======================================================================
679"RTN","TMGRPC3B",11,0)
680 ;" RPC -- Public Functions.
681"RTN","TMGRPC3B",12,0)
682 ;"=======================================================================
683"RTN","TMGRPC3B",13,0)
684 ;" <none>
685"RTN","TMGRPC3B",14,0)
686 ;"=======================================================================
687"RTN","TMGRPC3B",15,0)
688 ;"PRIVATE API FUNCTIONS
689"RTN","TMGRPC3B",16,0)
690 ;"=======================================================================
691"RTN","TMGRPC3B",17,0)
692 ;"GETUSRLT(TMGOUT,TMGPARAMS) -- fill list with users on the system.
693"RTN","TMGRPC3B",18,0)
694 ;"GETRECLT(TMGOUT,TMGPARAMS) -- fill list with records in file on the system
695"RTN","TMGRPC3B",19,0)
696 ;"GET1USER(TMGOUT,TMGIEN) -- Get one user's record
697"RTN","TMGRPC3B",20,0)
698 ;"GET1REC(TMGOUT,TMGPARAMS) -- get one record in file
699"RTN","TMGRPC3B",21,0)
700 ;"XTRCTFLD(TMGOUT,TMGARRAY,TMGFLAG) -- convert output from GETS^DIQ into another format
701"RTN","TMGRPC3B",22,0)
702 ;"GFLSUBST(TMGOUT,TMGPARAMS) -- return a subset of entries a file's .01 names
703"RTN","TMGRPC3B",23,0)
704 ;
705"RTN","TMGRPC3B",24,0)
706 ;"=======================================================================
707"RTN","TMGRPC3B",25,0)
708 ;"=======================================================================
709"RTN","TMGRPC3B",26,0)
710 ;"Dependencies:
711"RTN","TMGRPC3B",27,0)
712 ;" TMGRPC3* only
713"RTN","TMGRPC3B",28,0)
714 ;
715"RTN","TMGRPC3B",29,0)
716 ;"=======================================================================
717"RTN","TMGRPC3B",30,0)
718 ;"=======================================================================
719"RTN","TMGRPC3B",31,0)
720 ;
721"RTN","TMGRPC3B",32,0)
722 ;"=======================================================================
723"RTN","TMGRPC3B",33,0)
724 ;
725"RTN","TMGRPC3B",34,0)
726GETUSRLT(TMGOUT,TMGPARAMS) ;"GET USER LIST
727"RTN","TMGRPC3B",35,0)
728 ;"Purpose: to fill list with users on the system.
729"RTN","TMGRPC3B",36,0)
730 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
731"RTN","TMGRPC3B",37,0)
732 ;" TMGPARAMS -- either "" or "NODISUSER" if not to return DISUSER=YES users
733"RTN","TMGRPC3B",38,0)
734 ;"Output: TMGOUT is filled as follows:
735"RTN","TMGRPC3B",39,0)
736 ;" TMGOUT(0)="1^Success" or "-1^Message"
737"RTN","TMGRPC3B",40,0)
738 ;" TMGOUT(1)=Name^IEN^200^DISUSER DISUSER will be 1 for "Y" or 0 for "N"
739"RTN","TMGRPC3B",41,0)
740 ;" TMGOUT(2)=Name^IEN^200^DISUSER
741"RTN","TMGRPC3B",42,0)
742 ;"Results: none
743"RTN","TMGRPC3B",43,0)
744 ;
745"RTN","TMGRPC3B",44,0)
746 NEW TMGACTIVEONLY SET TMGACTIVEONLY=($GET(TMGPARAMS)="NODISUSER")
747"RTN","TMGRPC3B",45,0)
748 NEW TMGINDEX SET TMGINDEX=1
749"RTN","TMGRPC3B",46,0)
750 NEW TMGNAME SET TMGNAME=""
751"RTN","TMGRPC3B",47,0)
752 FOR SET TMGNAME=$ORDER(^VA(200,"B",TMGNAME)) QUIT:(TMGNAME="") DO
753"RTN","TMGRPC3B",48,0)
754 . NEW TMGIEN SET TMGIEN=""
755"RTN","TMGRPC3B",49,0)
756 . FOR SET TMGIEN=$ORDER(^VA(200,"B",TMGNAME,TMGIEN)) QUIT:(+TMGIEN'>0) DO
757"RTN","TMGRPC3B",50,0)
758 . . NEW TMGDISUSER SET TMGDISUSER=$PIECE($GET(^VA(200,TMGIEN,0)),"^",7)
759"RTN","TMGRPC3B",51,0)
760 . . IF (TMGACTIVEONLY)&(TMGDISUSER) QUIT
761"RTN","TMGRPC3B",52,0)
762 . . NEW TMGNAME SET TMGNAME=$PIECE($GET(^VA(200,TMGIEN,0)),"^",1)
763"RTN","TMGRPC3B",53,0)
764 . . SET TMGOUT(TMGINDEX)=TMGNAME_"^"_TMGIEN_"^200^"_TMGDISUSER
765"RTN","TMGRPC3B",54,0)
766 . . SET TMGINDEX=TMGINDEX+1
767"RTN","TMGRPC3B",55,0)
768 ;
769"RTN","TMGRPC3B",56,0)
770 SET TMGOUT(0)="1^Success"
771"RTN","TMGRPC3B",57,0)
772 ;
773"RTN","TMGRPC3B",58,0)
774 QUIT
775"RTN","TMGRPC3B",59,0)
776 ;
777"RTN","TMGRPC3B",60,0)
778GETRECLT(TMGOUT,TMGPARAMS) ;"GET RECS LIST
779"RTN","TMGRPC3B",61,0)
780 ;"Purpose: to fill list with records in file on the system.
781"RTN","TMGRPC3B",62,0)
782 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
783"RTN","TMGRPC3B",63,0)
784 ;" TMGPARAMS -- Filenumber
785"RTN","TMGRPC3B",64,0)
786 ;"Output: TMGOUT is filled as follows:
787"RTN","TMGRPC3B",65,0)
788 ;" TMGOUT(0)="1^Success" or "-1^Message"
789"RTN","TMGRPC3B",66,0)
790 ;" TMGOUT(1)=.01Value^IEN^FileNum
791"RTN","TMGRPC3B",67,0)
792 ;" TMGOUT(2)=.01Value^IEN^FileNum
793"RTN","TMGRPC3B",68,0)
794 ;"Results: none
795"RTN","TMGRPC3B",69,0)
796 ;
797"RTN","TMGRPC3B",70,0)
798 NEW TMGINDEX SET TMGINDEX=1
799"RTN","TMGRPC3B",71,0)
800 NEW TMGNAME SET TMGNAME=""
801"RTN","TMGRPC3B",72,0)
802 NEW TMGFNUM SET TMGFNUM=+$GET(TMGPARAMS)
803"RTN","TMGRPC3B",73,0)
804 IF TMGFNUM'>0 DO GOTO GRLDONE
805"RTN","TMGRPC3B",74,0)
806 . SET TMGOUT(0)="-1^Valid file number not found"
807"RTN","TMGRPC3B",75,0)
808 NEW TMGREF SET TMGREF=$GET(^DIC(TMGFNUM,0,"GL"))
809"RTN","TMGRPC3B",76,0)
810 SET TMGREF=$$CREF^DILF(TMGREF)
811"RTN","TMGRPC3B",77,0)
812 IF TMGREF="" DO GOTO GRLDONE
813"RTN","TMGRPC3B",78,0)
814 . SET TMGOUT(0)="-1^Unable to find global reference for file: "_TMGFNUM
815"RTN","TMGRPC3B",79,0)
816 NEW TMGLOC,TMGPIECE
817"RTN","TMGRPC3B",80,0)
818 SET TMGLOC=$PIECE(^DD(TMGFNUM,.01,0),"^",4)
819"RTN","TMGRPC3B",81,0)
820 SET TMGPIECE=$PIECE(TMGLOC,";",2)
821"RTN","TMGRPC3B",82,0)
822 SET TMGLOC=$PIECE(TMGLOC,";",1)
823"RTN","TMGRPC3B",83,0)
824 FOR SET TMGNAME=$ORDER(@TMGREF@("B",TMGNAME)) QUIT:(TMGNAME="") DO
825"RTN","TMGRPC3B",84,0)
826 . NEW TMGIEN SET TMGIEN=""
827"RTN","TMGRPC3B",85,0)
828 . FOR SET TMGIEN=$ORDER(@TMGREF@("B",TMGNAME,TMGIEN)) QUIT:(+TMGIEN'>0) DO
829"RTN","TMGRPC3B",86,0)
830 . . NEW TMGNAME SET TMGNAME=$PIECE($GET(@TMGREF@(TMGIEN,TMGLOC)),"^",TMGPIECE)
831"RTN","TMGRPC3B",87,0)
832 . . SET TMGOUT(TMGINDEX)=TMGNAME_"^"_TMGIEN_"^"_TMGFNUM
833"RTN","TMGRPC3B",88,0)
834 . . SET TMGINDEX=TMGINDEX+1
835"RTN","TMGRPC3B",89,0)
836 ;
837"RTN","TMGRPC3B",90,0)
838 SET TMGOUT(0)="1^Success"
839"RTN","TMGRPC3B",91,0)
840GRLDONE ;
841"RTN","TMGRPC3B",92,0)
842 QUIT
843"RTN","TMGRPC3B",93,0)
844 ;
845"RTN","TMGRPC3B",94,0)
846GET1USER(TMGOUT,TMGIEN) ;"GET ONE USER
847"RTN","TMGRPC3B",95,0)
848 ;"Purpose: to get record of one user
849"RTN","TMGRPC3B",96,0)
850 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
851"RTN","TMGRPC3B",97,0)
852 ;" TMGIEN -- the IEN in file 200 to get
853"RTN","TMGRPC3B",98,0)
854 ;"Output: TMGOUT is filled as follows:
855"RTN","TMGRPC3B",99,0)
856 ;" TMGOUT(0)="1^Success" or "-1^Message"
857"RTN","TMGRPC3B",100,0)
858 ;" TMGOUT(1)=File^IENS^FieldNum^ExternalValue^DDInfo...
859"RTN","TMGRPC3B",101,0)
860 ;" TMGOUT(2)=File^IENS^FieldNum^ExternalValue^DDInfo...
861"RTN","TMGRPC3B",102,0)
862 ;"Note: the fields to return are decided HERE
863"RTN","TMGRPC3B",103,0)
864 ;"Results: none
865"RTN","TMGRPC3B",104,0)
866 ;
867"RTN","TMGRPC3B",105,0)
868 NEW TMGIENS SET TMGIENS=+$GET(TMGIEN)_","
869"RTN","TMGRPC3B",106,0)
870 DO GET1REC(.TMGOUT,"200^"_TMGIENS)
871"RTN","TMGRPC3B",107,0)
872 QUIT
873"RTN","TMGRPC3B",108,0)
874 ;
875"RTN","TMGRPC3B",109,0)
876 ;
877"RTN","TMGRPC3B",110,0)
878GET1REC(TMGOUT,TMGPARAMS) ;
879"RTN","TMGRPC3B",111,0)
880 ;"Purpose: to get one record in file
881"RTN","TMGRPC3B",112,0)
882 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
883"RTN","TMGRPC3B",113,0)
884 ;" TMGPARAMS: File^IENS
885"RTN","TMGRPC3B",114,0)
886 ;" File -- the file or subfile to retrieve from
887"RTN","TMGRPC3B",115,0)
888 ;" IENS -- if File is a subfile, then IENS should be full IENS to get (e.g. '2,103,')
889"RTN","TMGRPC3B",116,0)
890 ;" if File is not a subfile, then IENS can be just IEN or IEN_","
891"RTN","TMGRPC3B",117,0)
892 ;"Output: TMGOUT is filled as follows:
893"RTN","TMGRPC3B",118,0)
894 ;" TMGOUT(0)="1^Success" or "-1^Message"
895"RTN","TMGRPC3B",119,0)
896 ;" TMGOUT(1)=File^IENS^FieldNum^ExternalValue^DDInfo...
897"RTN","TMGRPC3B",120,0)
898 ;" TMGOUT(2)=File^IENS^FieldNum^ExternalValue^DDInfo...
899"RTN","TMGRPC3B",121,0)
900 ;"Note: the fields to return are decided HERE
901"RTN","TMGRPC3B",122,0)
902 ;"Results: none
903"RTN","TMGRPC3B",123,0)
904 ;
905"RTN","TMGRPC3B",124,0)
906 SET TMGOUT(0)="1^Success" ;"default to success
907"RTN","TMGRPC3B",125,0)
908 NEW TMGARRAY,TMGMSG
909"RTN","TMGRPC3B",126,0)
910 NEW TMGREF SET TMGREF="TMGARRAY"
911"RTN","TMGRPC3B",127,0)
912 SET TMGPARAMS=$GET(TMGPARAMS)
913"RTN","TMGRPC3B",128,0)
914 NEW TMGFILE SET TMGFILE=$PIECE(TMGPARAMS,"^",1)
915"RTN","TMGRPC3B",129,0)
916 IF +TMGFILE'>0 DO GOTO GORDONE
917"RTN","TMGRPC3B",130,0)
918 . SET TMGOUT(0)="-1^No file number supplied"
919"RTN","TMGRPC3B",131,0)
920 NEW TMGIENS SET TMGIENS=$PIECE(TMGPARAMS,"^",2)
921"RTN","TMGRPC3B",132,0)
922 IF TMGIENS="" DO GOTO GORDONE
923"RTN","TMGRPC3B",133,0)
924 . SET TMGOUT(0)="-1^No IENS supplied"
925"RTN","TMGRPC3B",134,0)
926 ;
927"RTN","TMGRPC3B",135,0)
928 DO GETS^DIQ(TMGFILE,TMGIENS,"**","IE",TMGREF,"TMGMSG")
929"RTN","TMGRPC3B",136,0)
930 ;
931"RTN","TMGRPC3B",137,0)
932 IF $DATA(TMGMSG("DIERR")) DO GOTO GORDONE
933"RTN","TMGRPC3B",138,0)
934 . SET TMGOUT(0)="-1^See Fileman message"
935"RTN","TMGRPC3B",139,0)
936 . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
937"RTN","TMGRPC3B",140,0)
938 ;
939"RTN","TMGRPC3B",141,0)
940 DO XTRCTFLD(.TMGOUT,.TMGARRAY,"E")
941"RTN","TMGRPC3B",142,0)
942 ;
943"RTN","TMGRPC3B",143,0)
944GORDONE ;
945"RTN","TMGRPC3B",144,0)
946 QUIT
947"RTN","TMGRPC3B",145,0)
948 ;
949"RTN","TMGRPC3B",146,0)
950 ;
951"RTN","TMGRPC3B",147,0)
952XTRCTFLD(TMGOUT,TMGARRAY,TMGFLAG) ;"EXTRACT FIELDS
953"RTN","TMGRPC3B",148,0)
954 ;"Purpose: convert output from GETS^DIQ into another format
955"RTN","TMGRPC3B",149,0)
956 ;
957"RTN","TMGRPC3B",150,0)
958 NEW TMGINDEX SET TMGINDEX=1
959"RTN","TMGRPC3B",151,0)
960 NEW TMGFILE,TMGFIELD,TMGIENS
961"RTN","TMGRPC3B",152,0)
962 SET TMGFILE=""
963"RTN","TMGRPC3B",153,0)
964 FOR SET TMGFILE=$ORDER(TMGARRAY(TMGFILE)) QUIT:(TMGFILE="") DO
965"RTN","TMGRPC3B",154,0)
966 . SET TMGIENS=""
967"RTN","TMGRPC3B",155,0)
968 . FOR SET TMGIENS=$ORDER(TMGARRAY(TMGFILE,TMGIENS)) QUIT:(TMGIENS="") DO
969"RTN","TMGRPC3B",156,0)
970 . . SET TMGFIELD=0
971"RTN","TMGRPC3B",157,0)
972 . . FOR SET TMGFIELD=$ORDER(^DD(TMGFILE,TMGFIELD)) QUIT:(+TMGFIELD'>0) DO
973"RTN","TMGRPC3B",158,0)
974 . . . IF $GET(TMGARRAY(TMGFILE,TMGIENS,TMGFIELD,TMGFLAG))="" DO
975"RTN","TMGRPC3B",159,0)
976 . . . . SET TMGARRAY(TMGFILE,TMGIENS,TMGFIELD,TMGFLAG)=""
977"RTN","TMGRPC3B",160,0)
978 . . SET TMGFIELD=""
979"RTN","TMGRPC3B",161,0)
980 . . FOR SET TMGFIELD=$ORDER(TMGARRAY(TMGFILE,TMGIENS,TMGFIELD)) QUIT:(TMGFIELD="") DO
981"RTN","TMGRPC3B",162,0)
982 . . . NEW TMGVALUE SET TMGVALUE=$GET(TMGARRAY(TMGFILE,TMGIENS,TMGFIELD,TMGFLAG))
983"RTN","TMGRPC3B",163,0)
984 . . . NEW TMGDDINFO SET TMGDDINFO=$PIECE($GET(^DD(TMGFILE,TMGFIELD,0)),"^",1,4)
985"RTN","TMGRPC3B",164,0)
986 . . . IF $PIECE(TMGDDINFO,"^",2)["D" DO ;"convert data format to one Delphi can use
987"RTN","TMGRPC3B",165,0)
988 . . . . IF TMGFLAG="I" QUIT
989"RTN","TMGRPC3B",166,0)
990 . . . . NEW X SET X=$GET(TMGARRAY(TMGFILE,TMGIENS,TMGFIELD,"I"))
991"RTN","TMGRPC3B",167,0)
992 . . . . SET TMGVALUE=$$FMTE^XLFDT(X,5)
993"RTN","TMGRPC3B",168,0)
994 . . . SET TMGOUT(TMGINDEX)=TMGFILE_"^"_TMGIENS_"^"_TMGFIELD_"^"_TMGVALUE
995"RTN","TMGRPC3B",169,0)
996 . . . SET TMGOUT(TMGINDEX)=TMGOUT(TMGINDEX)_"^"_TMGDDINFO
997"RTN","TMGRPC3B",170,0)
998 . . . SET TMGINDEX=TMGINDEX+1
999"RTN","TMGRPC3B",171,0)
1000 ;
1001"RTN","TMGRPC3B",172,0)
1002 QUIT
1003"RTN","TMGRPC3B",173,0)
1004 ;
1005"RTN","TMGRPC3B",174,0)
1006GFLSUBST(TMGOUT,TMGPARAMS) ;"GET FILE SUBSET
1007"RTN","TMGRPC3B",175,0)
1008 ;"Purpose: to return a subset of entries a file's .01 names
1009"RTN","TMGRPC3B",176,0)
1010 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
1011"RTN","TMGRPC3B",177,0)
1012 ;" TMGPARAMS -- FileNum^StartFrom^Direction^maxCount
1013"RTN","TMGRPC3B",178,0)
1014 ;" TMGFNUM - filename file to traverse
1015"RTN","TMGRPC3B",179,0)
1016 ;" StartFrom -- text to $ORDER() from -- OPTIONAL
1017"RTN","TMGRPC3B",180,0)
1018 ;" Direction -- $ORDER(xx,Direction) direction (should be 1 or -1) -- OPTIONAL
1019"RTN","TMGRPC3B",181,0)
1020 ;" maxCt -- OPTIONAL -- the max number of entries to return.
1021"RTN","TMGRPC3B",182,0)
1022 ;"Output: TMGOUT is filled as follows:
1023"RTN","TMGRPC3B",183,0)
1024 ;" TMGOUT(0)="1^Success" or "-1^Message"
1025"RTN","TMGRPC3B",184,0)
1026 ;" TMGOUT(1)=IEN^Value
1027"RTN","TMGRPC3B",185,0)
1028 ;" TMGOUT(2)=IEN^Value
1029"RTN","TMGRPC3B",186,0)
1030 ;" ...
1031"RTN","TMGRPC3B",187,0)
1032 ;"Results: none
1033"RTN","TMGRPC3B",188,0)
1034 ;"NOTE: does NOT work with sub files.
1035"RTN","TMGRPC3B",189,0)
1036 ;
1037"RTN","TMGRPC3B",190,0)
1038 NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
1039"RTN","TMGRPC3B",191,0)
1040 IF TMGFILE'>0 DO GOTO GFSDONE
1041"RTN","TMGRPC3B",192,0)
1042 . SET TMGOUT(0)="-1^No file number supplied"
1043"RTN","TMGRPC3B",193,0)
1044 NEW TMGFROM SET TMGFROM=$PIECE(TMGPARAMS,"^",2)
1045"RTN","TMGRPC3B",194,0)
1046 NEW TMGDIR SET TMGDIR=$PIECE(TMGPARAMS,"^",3)
1047"RTN","TMGRPC3B",195,0)
1048 IF TMGDIR'=-1 SET TMGDIR=1
1049"RTN","TMGRPC3B",196,0)
1050 NEW TMGMAXCT SET TMGMAXCT=+$PIECE(TMGPARAMS,"^",4)
1051"RTN","TMGRPC3B",197,0)
1052 IF TMGMAXCT=0 SET TMGMAXCT=44
1053"RTN","TMGRPC3B",198,0)
1054 ;
1055"RTN","TMGRPC3B",199,0)
1056 NEW TMGI SET TMGI=0
1057"RTN","TMGRPC3B",200,0)
1058 ;"NEW TMGLAST SET TMGLAST=""
1059"RTN","TMGRPC3B",201,0)
1060 ;"NEW prev SET prev=""
1061"RTN","TMGRPC3B",202,0)
1062 NEW TMGREF SET TMGREF=$GET(^DIC(TMGFILE,0,"GL"))
1063"RTN","TMGRPC3B",203,0)
1064 SET TMGREF=$$CREF^DILF(TMGREF) ;"convert open --> closed reference
1065"RTN","TMGRPC3B",204,0)
1066 IF TMGREF="" DO GOTO GFSDONE
1067"RTN","TMGRPC3B",205,0)
1068 . SET TMGOUT(0)="-1^Unable to obtain global ref for file #"_TMGFILE
1069"RTN","TMGRPC3B",206,0)
1070 ;
1071"RTN","TMGRPC3B",207,0)
1072 FOR SET TMGFROM=$ORDER(@TMGREF@("B",TMGFROM),TMGDIR) QUIT:(TMGFROM="")!(TMGI=TMGMAXCT) DO
1073"RTN","TMGRPC3B",208,0)
1074 . NEW TMGIEN SET TMGIEN=""
1075"RTN","TMGRPC3B",209,0)
1076 . FOR SET TMGIEN=$ORDER(@TMGREF@("B",TMGFROM,TMGIEN),TMGDIR) QUIT:(+TMGIEN'>0) DO
1077"RTN","TMGRPC3B",210,0)
1078 . . SET TMGI=TMGI+1
1079"RTN","TMGRPC3B",211,0)
1080 . . SET TMGOUT(TMGI)=TMGIEN_"^"_$$GET1^DIQ(TMGFILE,TMGIEN_",",.01)
1081"RTN","TMGRPC3B",212,0)
1082 . . ;"SET TMGOUT(TMGI)=$$GET1^DIQ(TMGFILE,IEN_",",.01)
1083"RTN","TMGRPC3B",213,0)
1084 ;
1085"RTN","TMGRPC3B",214,0)
1086 SET TMGOUT(0)="1^Success"
1087"RTN","TMGRPC3B",215,0)
1088GFSDONE ;
1089"RTN","TMGRPC3B",216,0)
1090 QUIT
1091"RTN","TMGRPC3B",217,0)
1092 ;
1093"RTN","TMGRPC3B",218,0)
1094 ;
1095"RTN","TMGRPC3C")
10960^3^B54917889
1097"RTN","TMGRPC3C",1,0)
1098TMGRPC3C ;TMG/kst/Support Functions for GUI_Config ;08/31/08
1099"RTN","TMGRPC3C",2,0)
1100 ;;1.0;TMG-LIB;**1**;08/31/08
1101"RTN","TMGRPC3C",3,0)
1102 ;
1103"RTN","TMGRPC3C",4,0)
1104 ;"TMG RPC FUNCTIONS for a GUI config program
1105"RTN","TMGRPC3C",5,0)
1106 ;
1107"RTN","TMGRPC3C",6,0)
1108 ;"Kevin Toppenberg MD
1109"RTN","TMGRPC3C",7,0)
1110 ;"GNU Lessor General Public License (LGPL) applies
1111"RTN","TMGRPC3C",8,0)
1112 ;"7/20/08
1113"RTN","TMGRPC3C",9,0)
1114 ;
1115"RTN","TMGRPC3C",10,0)
1116 ;"=======================================================================
1117"RTN","TMGRPC3C",11,0)
1118 ;" RPC -- Public Functions.
1119"RTN","TMGRPC3C",12,0)
1120 ;"=======================================================================
1121"RTN","TMGRPC3C",13,0)
1122 ;" <none>
1123"RTN","TMGRPC3C",14,0)
1124 ;"=======================================================================
1125"RTN","TMGRPC3C",15,0)
1126 ;"PRIVATE API FUNCTIONS
1127"RTN","TMGRPC3C",16,0)
1128 ;"=======================================================================
1129"RTN","TMGRPC3C",17,0)
1130 ;"POSTDATA(TMGOUT,TMGDATA) -- Post Changes to database via Fileman
1131"RTN","TMGRPC3C",18,0)
1132 ;
1133"RTN","TMGRPC3C",19,0)
1134 ;"=======================================================================
1135"RTN","TMGRPC3C",20,0)
1136 ;"Dependencies:
1137"RTN","TMGRPC3C",21,0)
1138 ;" TMGRPC3* only
1139"RTN","TMGRPC3C",22,0)
1140 ;
1141"RTN","TMGRPC3C",23,0)
1142 ;"=======================================================================
1143"RTN","TMGRPC3C",24,0)
1144 ;
1145"RTN","TMGRPC3C",25,0)
1146POSTDATA(TMGOUT,TMGDATA,TMGFLAG) ;
1147"RTN","TMGRPC3C",26,0)
1148 ;"Post Changes to database via Fileman
1149"RTN","TMGRPC3C",27,0)
1150 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
1151"RTN","TMGRPC3C",28,0)
1152 ;" TMGDATA -- Entries to be filed. Format:
1153"RTN","TMGRPC3C",29,0)
1154 ;" TMGDATA(0)=FileNum^IENS^FieldNum^FieldName^newValue^oldValue
1155"RTN","TMGRPC3C",30,0)
1156 ;" TMGDATA(1)=FileNum^IENS^FieldNum^FieldName^newValue^oldValue
1157"RTN","TMGRPC3C",31,0)
1158 ;" TMGDATA(2)=FileNum^IENS^FieldNum^FieldName^newValue^oldValue
1159"RTN","TMGRPC3C",32,0)
1160 ;" ...
1161"RTN","TMGRPC3C",33,0)
1162 ;" Note: FieldName, oldValue pieces are not used (optional)
1163"RTN","TMGRPC3C",34,0)
1164 ;" TMGFLAG -- OPTIONAL, "E" is default. Flag passed to FILE^DIE or UPDATE^DIE
1165"RTN","TMGRPC3C",35,0)
1166 ;" should be "E" or "I"
1167"RTN","TMGRPC3C",36,0)
1168 ;"Output: TMGOUT is filled as follows:
1169"RTN","TMGRPC3C",37,0)
1170 ;" TMGOUT(0)="1^Success" or "-1^Short Message"
1171"RTN","TMGRPC3C",38,0)
1172 ;" TMGOUT(1)=Fileman message (long)
1173"RTN","TMGRPC3C",39,0)
1174 ;" -or if new records added:
1175"RTN","TMGRPC3C",40,0)
1176 ;" TMGOUT(1)=5^1234 <-- results of IEN array returned (+5 converted to record 1234)
1177"RTN","TMGRPC3C",41,0)
1178 ;" TMGOUT(2)=3^2341 <-- results of IEN array returned (+3 converted to record 2341)
1179"RTN","TMGRPC3C",42,0)
1180 ;" ...
1181"RTN","TMGRPC3C",43,0)
1182 ;"Results: none
1183"RTN","TMGRPC3C",44,0)
1184 ;
1185"RTN","TMGRPC3C",45,0)
1186 NEW TMGAVC SET TMGAVC=0 ;"TMGAVC=AccessVerifyCode. Default to no change.
1187"RTN","TMGRPC3C",46,0)
1188 NEW TMGINACTUSER,TMGREACTUSER
1189"RTN","TMGRPC3C",47,0)
1190 SET TMGFLAG=$GET(TMGFLAG,"E")
1191"RTN","TMGRPC3C",48,0)
1192 NEW TMGI SET TMGI=""
1193"RTN","TMGRPC3C",49,0)
1194 NEW TMGFDA,TMGNEWFDA,TMGMSG,TMGIEN,DIC
1195"RTN","TMGRPC3C",50,0)
1196 NEW TMGINTFDA
1197"RTN","TMGRPC3C",51,0)
1198 FOR SET TMGI=$ORDER(TMGDATA(TMGI)) QUIT:(TMGI="") DO
1199"RTN","TMGRPC3C",52,0)
1200 . NEW TMGFILE,TMGIENS,TMGFIELD,TMGVALUE,TMGONEENTRY
1201"RTN","TMGRPC3C",53,0)
1202 . NEW TMGINTVALUE SET TMGINTVALUE=0
1203"RTN","TMGRPC3C",54,0)
1204 . NEW TMGCONTINUE SET TMGCONTINUE=0
1205"RTN","TMGRPC3C",55,0)
1206 . SET TMGONEENTRY=$GET(TMGDATA(TMGI))
1207"RTN","TMGRPC3C",56,0)
1208 . SET TMGFILE=$PIECE(TMGONEENTRY,"^",1)
1209"RTN","TMGRPC3C",57,0)
1210 . SET TMGIENS=$PIECE(TMGONEENTRY,"^",2)
1211"RTN","TMGRPC3C",58,0)
1212 . SET TMGFIELD=$PIECE(TMGONEENTRY,"^",3)
1213"RTN","TMGRPC3C",59,0)
1214 . SET TMGVALUE=$PIECE(TMGONEENTRY,"^",5)
1215"RTN","TMGRPC3C",60,0)
1216 . IF TMGFILE=200 DO
1217"RTN","TMGRPC3C",61,0)
1218 . . IF TMGFIELD=2 DO ;"2 = Access Code
1219"RTN","TMGRPC3C",62,0)
1220 . . . IF TMGIENS["+" DO QUIT
1221"RTN","TMGRPC3C",63,0)
1222 . . . . SET TMGCONTINUE=1
1223"RTN","TMGRPC3C",64,0)
1224 . . . . SET TMGOUT(1)="Can't set Access code when first adding new user. Try again."
1225"RTN","TMGRPC3C",65,0)
1226 . . . ;"NOTICE: currently this code DOes NOT force code of certain length etc.
1227"RTN","TMGRPC3C",66,0)
1228 . . . ;"S Y=$$VCHK(XV2,XUH) Q:Y Y ;check for valid verify code, returns 0 (for OK), or 1^msg
1229"RTN","TMGRPC3C",67,0)
1230 . . . ;"SET TMGVALUE=$$UP^XLFSTR(TMGVALUE) ;"access code must be upper case elh
1231"RTN","TMGRPC3C",68,0)
1232 . . . SET TMGVALUE=$$EN^XUSHSH(TMGVALUE) ;"access code is supposed to be hashed first
1233"RTN","TMGRPC3C",69,0)
1234 . . . SET TMGAVC=1 ;"signal change
1235"RTN","TMGRPC3C",70,0)
1236 . . . SET TMGAVC("DA")=+TMGIENS
1237"RTN","TMGRPC3C",71,0)
1238 . . . SET TMGINTVALUE=1
1239"RTN","TMGRPC3C",72,0)
1240 . . ELSE IF TMGFIELD=11 DO ;"11 = Verify Code
1241"RTN","TMGRPC3C",73,0)
1242 . . . IF TMGIENS["+" DO QUIT
1243"RTN","TMGRPC3C",74,0)
1244 . . . . SET TMGCONTINUE=1
1245"RTN","TMGRPC3C",75,0)
1246 . . . . SET TMGOUT(1)="Can't set Verify code when first adding new user. Try again."
1247"RTN","TMGRPC3C",76,0)
1248 . . . ;"NOTICE: currently this code does NOT force code of certain length etc.
1249"RTN","TMGRPC3C",77,0)
1250 . . . ;"S Y=$$VCHK(XV2,XUH) Q:Y Y ;check for valid verify code, returns 0 (for OK), or 1^msg
1251"RTN","TMGRPC3C",78,0)
1252 . . . ;"SET TMGVALUE=$$UP^XLFSTR(TMGVALUE) ;"verify code must be upper case elh
1253"RTN","TMGRPC3C",79,0)
1254 . . . SET TMGVALUE=$$EN^XUSHSH(TMGVALUE) ;"verify code is supposed to be hashed first
1255"RTN","TMGRPC3C",80,0)
1256 . . . SET TMGAVC=1 ;"signal change
1257"RTN","TMGRPC3C",81,0)
1258 . . . SET TMGAVC("DA")=+TMGIENS
1259"RTN","TMGRPC3C",82,0)
1260 . . . SET TMGINTVALUE=1
1261"RTN","TMGRPC3C",83,0)
1262 . . ELSE IF TMGFIELD=7 DO ;"7 = DISUSER Value should be 'YES' or 'NO'
1263"RTN","TMGRPC3C",84,0)
1264 . . . IF TMGIENS["+" DO QUIT
1265"RTN","TMGRPC3C",85,0)
1266 . . . . SET TMGCONTINUE=1
1267"RTN","TMGRPC3C",86,0)
1268 . . . . SET TMGOUT(1)="Can't set DISUSER code when first adding new user. Try again."
1269"RTN","TMGRPC3C",87,0)
1270 . . . IF TMGVALUE="YES" DO
1271"RTN","TMGRPC3C",88,0)
1272 . . . . SET TMGFDA(200,TMGIENS,9.2)="NOW" ;"add 9.2 = termination date
1273"RTN","TMGRPC3C",89,0)
1274 . . . . SET TMGINACTUSER("DA")=+TMGIENS
1275"RTN","TMGRPC3C",90,0)
1276 . . . IF (TMGVALUE="NO")!(TMGVALUE="@") DO
1277"RTN","TMGRPC3C",91,0)
1278 . . . . SET TMGFDA(200,TMGIENS,9.2)="@" ;"delete 9.2 = termination date
1279"RTN","TMGRPC3C",92,0)
1280 . . . . SET TMGFDA(200,TMGIENS,9.4)="@" ;"delete 9.4 = termination reason
1281"RTN","TMGRPC3C",93,0)
1282 . . . . SET TMGREACTUSER("DA")=+TMGIENS
1283"RTN","TMGRPC3C",94,0)
1284 . . ELSE IF TMGFIELD=3 DO ;"3 = FILE MANAGER ACCESS CODE (i.e. @ etc)
1285"RTN","TMGRPC3C",95,0)
1286 . . . IF TMGVALUE'["^" DO
1287"RTN","TMGRPC3C",96,0)
1288 . . . . SET $PIECE(^VA(200,+TMGIENS,0),"^",4)=TMGVALUE ;"force value in with low-level write
1289"RTN","TMGRPC3C",97,0)
1290 . . . . SET TMGCONTINUE=1
1291"RTN","TMGRPC3C",98,0)
1292 . IF TMGCONTINUE QUIT
1293"RTN","TMGRPC3C",99,0)
1294 . IF TMGIENS["+" DO
1295"RTN","TMGRPC3C",100,0)
1296 . . SET TMGNEWFDA(TMGFILE,TMGIENS,TMGFIELD)=TMGVALUE
1297"RTN","TMGRPC3C",101,0)
1298 . ELSE DO
1299"RTN","TMGRPC3C",102,0)
1300 . . IF TMGINTVALUE=1 SET TMGINTFDA(TMGFILE,TMGIENS,TMGFIELD)=TMGVALUE
1301"RTN","TMGRPC3C",103,0)
1302 . . ELSE SET TMGFDA(TMGFILE,TMGIENS,TMGFIELD)=TMGVALUE
1303"RTN","TMGRPC3C",104,0)
1304 ;
1305"RTN","TMGRPC3C",105,0)
1306 SET TMGOUT(0)="1^Success" ;"default to success
1307"RTN","TMGRPC3C",106,0)
1308 IF $DATA(TMGFDA) DO
1309"RTN","TMGRPC3C",107,0)
1310 . DO FILE^DIE(TMGFLAG_"K","TMGFDA","TMGMSG")
1311"RTN","TMGRPC3C",108,0)
1312 IF $DATA(TMGMSG("DIERR")) DO
1313"RTN","TMGRPC3C",109,0)
1314 . SET TMGOUT(0)="-1^See Fileman message re posting"
1315"RTN","TMGRPC3C",110,0)
1316 . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)_";"_$GET(TMGOUT(1))
1317"RTN","TMGRPC3C",111,0)
1318 ;
1319"RTN","TMGRPC3C",112,0)
1320 IF $DATA(TMGINTFDA) DO ;"process FDA with INTERNAL values
1321"RTN","TMGRPC3C",113,0)
1322 . DO FILE^DIE("K","TMGINTFDA","TMGMSG")
1323"RTN","TMGRPC3C",114,0)
1324 IF $DATA(TMGMSG("DIERR")) DO
1325"RTN","TMGRPC3C",115,0)
1326 . SET TMGOUT(0)="-1^See Fileman message re posting"
1327"RTN","TMGRPC3C",116,0)
1328 . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)_";"_$GET(TMGOUT(1))
1329"RTN","TMGRPC3C",117,0)
1330 ;
1331"RTN","TMGRPC3C",118,0)
1332 IF $DATA(TMGNEWFDA) DO
1333"RTN","TMGRPC3C",119,0)
1334 . DO UPDATE^DIE(TMGFLAG_"K","TMGNEWFDA","TMGIEN","TMGMSG")
1335"RTN","TMGRPC3C",120,0)
1336 IF $DATA(TMGMSG("DIERR")) DO
1337"RTN","TMGRPC3C",121,0)
1338 . SET TMGOUT(0)="-1^See Fileman message re posting"
1339"RTN","TMGRPC3C",122,0)
1340 . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)_";"_$GET(TMGOUT(1))
1341"RTN","TMGRPC3C",123,0)
1342 ;
1343"RTN","TMGRPC3C",124,0)
1344 IF ($PIECE(TMGOUT(0),"^",1)=1)&($DATA(TMGIEN)) DO
1345"RTN","TMGRPC3C",125,0)
1346 . NEW TMGCOUNT SET TMGCOUNT=1
1347"RTN","TMGRPC3C",126,0)
1348 . NEW TMGI SET TMGI=""
1349"RTN","TMGRPC3C",127,0)
1350 . FOR SET TMGI=$ORDER(TMGIEN(TMGI)) QUIT:(TMGI="") DO
1351"RTN","TMGRPC3C",128,0)
1352 . . SET TMGOUT(TMGCOUNT)=TMGI_"^"_$GET(TMGIEN(TMGI))
1353"RTN","TMGRPC3C",129,0)
1354 . . SET TMGCOUNT=TMGCOUNT+1
1355"RTN","TMGRPC3C",130,0)
1356 ;
1357"RTN","TMGRPC3C",131,0)
1358 ;"If Access code / Verify code changed, then finish some follow up business
1359"RTN","TMGRPC3C",132,0)
1360 ;" as per BRCVC^XUS2<--CVC^XUSRB<--called by RPC 'XUS CVC'
1361"RTN","TMGRPC3C",133,0)
1362 IF TMGAVC DO
1363"RTN","TMGRPC3C",134,0)
1364 . NEW DA SET DA=TMGAVC("DA")
1365"RTN","TMGRPC3C",135,0)
1366 . DO CALL^XUSERP(DA,2) ;"Call for Kernel Create, **Update**, Disuser or Terminate events
1367"RTN","TMGRPC3C",136,0)
1368 . ;"The above sets Taskman job -->DEQUE^XUSERP--> --> D HL7^ALPBGEN
1369"RTN","TMGRPC3C",137,0)
1370 ;
1371"RTN","TMGRPC3C",138,0)
1372 IF $DATA(TMGINACTUSER) DO ;"Finish up inactivating user with VistA code
1373"RTN","TMGRPC3C",139,0)
1374 . NEW TMGRESULT
1375"RTN","TMGRPC3C",140,0)
1376 . SET TMGRESULT=$$QTERMUSR^TMGRPC3D(TMGINACTUSER("DA")) ;"finish termination of user code
1377"RTN","TMGRPC3C",141,0)
1378 . IF +TMGRESULT'=0 DO
1379"RTN","TMGRPC3C",142,0)
1380 . . SET TMGOUT(0)="-1^See Fileman message re terminating user"
1381"RTN","TMGRPC3C",143,0)
1382 . . SET TMGOUT(1)=TMGOUT(1)_";"_TMGRESULT
1383"RTN","TMGRPC3C",144,0)
1384 ;
1385"RTN","TMGRPC3C",145,0)
1386 IF $DATA(TMGREACTUSER) DO ;"finish up reactivating user with VistA code
1387"RTN","TMGRPC3C",146,0)
1388 . NEW TMGRESULT
1389"RTN","TMGRPC3C",147,0)
1390 . SET TMGRESULT=$$QTREAUSR^TMGRPC3D(TMGREACTUSER("DA")) ;"launch quiet reactivation code
1391"RTN","TMGRPC3C",148,0)
1392 . IF +TMGRESULT'=0 DO
1393"RTN","TMGRPC3C",149,0)
1394 . . SET TMGOUT(0)="-1^See Fileman message re reactivating user"
1395"RTN","TMGRPC3C",150,0)
1396 . . SET TMGOUT(1)=TMGOUT(1)_";"_TMGRESULT
1397"RTN","TMGRPC3C",151,0)
1398 ;
1399"RTN","TMGRPC3C",152,0)
1400 QUIT
1401"RTN","TMGRPC3D")
14020^4^B81308711
1403"RTN","TMGRPC3D",1,0)
1404TMGRPC3D ;TMG/kst/Support Functions for GUI_Config ;08/31/08
1405"RTN","TMGRPC3D",2,0)
1406 ;;1.0;TMG-LIB;**1**;08/31/08
1407"RTN","TMGRPC3D",3,0)
1408 ;
1409"RTN","TMGRPC3D",4,0)
1410 ;"TMG RPC FUNCTIONS for a GUI config program
1411"RTN","TMGRPC3D",5,0)
1412 ;
1413"RTN","TMGRPC3D",6,0)
1414 ;"Kevin Toppenberg MD
1415"RTN","TMGRPC3D",7,0)
1416 ;"GNU Lessor General Public License (LGPL) applies
1417"RTN","TMGRPC3D",8,0)
1418 ;"7/20/08
1419"RTN","TMGRPC3D",9,0)
1420 ;
1421"RTN","TMGRPC3D",10,0)
1422 ;"=======================================================================
1423"RTN","TMGRPC3D",11,0)
1424 ;" RPC -- Public Functions.
1425"RTN","TMGRPC3D",12,0)
1426 ;"=======================================================================
1427"RTN","TMGRPC3D",13,0)
1428 ;" <none>
1429"RTN","TMGRPC3D",14,0)
1430 ;"=======================================================================
1431"RTN","TMGRPC3D",15,0)
1432 ;"PRIVATE API FUNCTIONS
1433"RTN","TMGRPC3D",16,0)
1434 ;"=======================================================================
1435"RTN","TMGRPC3D",17,0)
1436 ;"QTERMUSR(XUDA) -- quietly inactive a given user
1437"RTN","TMGRPC3D",18,0)
1438 ;"QTREAUSR(TMGDA) -- launch quiet reactivation code
1439"RTN","TMGRPC3D",19,0)
1440 ;"GETSRLST(TMGOUT,TMGPARAMS) -- Get all .01 sub record entries for a subfile
1441"RTN","TMGRPC3D",20,0)
1442 ;"CLONEUSR(TMGOUT,TMGPARAMS) -- replicate a record into a new record, including all subrecs.
1443"RTN","TMGRPC3D",21,0)
1444 ;"CLONEREC(TMGOUT,TMGPARAMS) --- replicate a record into a new record, including all subrecs.
1445"RTN","TMGRPC3D",22,0)
1446 ;
1447"RTN","TMGRPC3D",23,0)
1448 ;"=======================================================================
1449"RTN","TMGRPC3D",24,0)
1450 ;"=======================================================================
1451"RTN","TMGRPC3D",25,0)
1452 ;"Dependencies:
1453"RTN","TMGRPC3D",26,0)
1454 ;" TMGRPC3* only
1455"RTN","TMGRPC3D",27,0)
1456 ;
1457"RTN","TMGRPC3D",28,0)
1458 ;"=======================================================================
1459"RTN","TMGRPC3D",29,0)
1460 ;"=======================================================================
1461"RTN","TMGRPC3D",30,0)
1462 ;
1463"RTN","TMGRPC3D",31,0)
1464QTERMUSR(XUDA) ;"QUITELY TERMINATE USER
1465"RTN","TMGRPC3D",32,0)
1466 ;"Purpose: to quietly inactive a given user
1467"RTN","TMGRPC3D",33,0)
1468 ;" I traced through menu option XUSERDEACT --> XUSTERM to create below
1469"RTN","TMGRPC3D",34,0)
1470 ;"Input: XUDA -- the IEN in 200 of user to inactivate
1471"RTN","TMGRPC3D",35,0)
1472 ;"Note: based on code from XUSTERM
1473"RTN","TMGRPC3D",36,0)
1474 ;"Results: 0 = OK, or 1^message if error
1475"RTN","TMGRPC3D",37,0)
1476 ;
1477"RTN","TMGRPC3D",38,0)
1478 NEW TMGRESULT SET TMGRESULT=0
1479"RTN","TMGRPC3D",39,0)
1480 NEW TMGFDA,TMGMSG,XUDT,DIC
1481"RTN","TMGRPC3D",40,0)
1482 SET TMGFDA(200,+XUDA_",",9.2)="NOW"
1483"RTN","TMGRPC3D",41,0)
1484 DO FILE^DIE("EK","TMGFDA","TMGMSG")
1485"RTN","TMGRPC3D",42,0)
1486 IF $DATA(TMGMSG("DIERR")) DO GOTO QTUDONE
1487"RTN","TMGRPC3D",43,0)
1488 . SET TMGRESULT="1^"_$$GETERSTR^TMGRPC3G(.TMGMSG)_";"_$GET(TMGOUT(1))
1489"RTN","TMGRPC3D",44,0)
1490 SET XUDT=$P(^VA(200,+XUDA,0),"^",11) ;" field 9.2 termination date
1491"RTN","TMGRPC3D",45,0)
1492 DO GET^XUSTERM ;"load up info about mail, mailboxes, keys ? needed ?
1493"RTN","TMGRPC3D",46,0)
1494 SET ZTDTH=XUDT ;"Task Start time. VA FileMan or $HOROLOG format
1495"RTN","TMGRPC3D",47,0)
1496 SET ZTRTN="DQ1^XUSTERM1" ;"routine to be fired
1497"RTN","TMGRPC3D",48,0)
1498 SET ZTDESC="DEACTIVATE USER" ;"description
1499"RTN","TMGRPC3D",49,0)
1500 SET ZTSAVE("XUDA")="" ;"save variable XUDA for use in task
1501"RTN","TMGRPC3D",50,0)
1502 SET ZTIO="" ;"no IO device needed
1503"RTN","TMGRPC3D",51,0)
1504 DO ^%ZTLOAD ;"que a taskman task
1505"RTN","TMGRPC3D",52,0)
1506QTUDONE ;
1507"RTN","TMGRPC3D",53,0)
1508 QUIT TMGRESULT
1509"RTN","TMGRPC3D",54,0)
1510 ;
1511"RTN","TMGRPC3D",55,0)
1512 ;
1513"RTN","TMGRPC3D",56,0)
1514QTREAUSR(TMGDA) ;"QUITELY REACTIVE USER
1515"RTN","TMGRPC3D",57,0)
1516 ;"Purpose: launch quiet reactivation code
1517"RTN","TMGRPC3D",58,0)
1518 ;" I traced through menu option XUSERREACT --> REACT^XUSERNEW to create below
1519"RTN","TMGRPC3D",59,0)
1520 ;"Input: TMGDA -- the IEN in 200 to be reactivated
1521"RTN","TMGRPC3D",60,0)
1522 ;"Results: 0 if OK, or 1^ErrMsg
1523"RTN","TMGRPC3D",61,0)
1524 ;"NOTE: when user is deleated through VistA code, the access and verify codes
1525"RTN","TMGRPC3D",62,0)
1526 ;" are deleted. This function does NOT replace these.
1527"RTN","TMGRPC3D",63,0)
1528 ;
1529"RTN","TMGRPC3D",64,0)
1530 NEW TMGRESULT SET TMGRESULT=0
1531"RTN","TMGRPC3D",65,0)
1532 NEW TMGFDA,TMGMSG,DIC,Y
1533"RTN","TMGRPC3D",66,0)
1534 SET TMGFDA(200,TMGDA_",",9.2)="@" ;"Clear the Termination date
1535"RTN","TMGRPC3D",67,0)
1536 DO FILE^DIE("EK","TMGFDA","TMGMSG") ;"Post data
1537"RTN","TMGRPC3D",68,0)
1538 IF $DATA(TMGMSG("DIERR")) DO GOTO QRUDONE
1539"RTN","TMGRPC3D",69,0)
1540 . SET TMGRESULT="1^"_$$GETERSTR^TMGRPC3G(.TMGMSG)
1541"RTN","TMGRPC3D",70,0)
1542 ;
1543"RTN","TMGRPC3D",71,0)
1544 KILL XMZ ;" if null, then user can access old mail.
1545"RTN","TMGRPC3D",72,0)
1546 SET Y=TMGDA ;"set user to work on.
1547"RTN","TMGRPC3D",73,0)
1548 DO NEW^XM ;"mailman driver -- create a mailbox for user Y
1549"RTN","TMGRPC3D",74,0)
1550 ;
1551"RTN","TMGRPC3D",75,0)
1552 IF +$PIECE($GET(^VA(200,TMGDA,201)),"^",1)'>0 DO ;"201;1 = PRIMARY MENU OPTION (#201)
1553"RTN","TMGRPC3D",76,0)
1554 . SET TMGFDA(200,TMGDA_",",201)="EVE" ;"set default primary menu to EVE (high level!)
1555"RTN","TMGRPC3D",77,0)
1556 . DO FILE^DIE("EK","TMGFDA","TMGMSG")
1557"RTN","TMGRPC3D",78,0)
1558 . IF $DATA(TMGMSG("DIERR")) DO
1559"RTN","TMGRPC3D",79,0)
1560 . . SET TMGRESULT="1^"_$$GETERSTR^TMGRPC3G(.TMGMSG)
1561"RTN","TMGRPC3D",80,0)
1562 IF +TMGRESULT>0 GOTO QRUDONE
1563"RTN","TMGRPC3D",81,0)
1564 ;
1565"RTN","TMGRPC3D",82,0)
1566 KILL XMDT,XMM,XMZ
1567"RTN","TMGRPC3D",83,0)
1568 DO REACT^XQ84(TMGDA) ;"See if this user's menu trees need to be rebuilt
1569"RTN","TMGRPC3D",84,0)
1570QRUDONE ;
1571"RTN","TMGRPC3D",85,0)
1572 QUIT TMGRESULT
1573"RTN","TMGRPC3D",86,0)
1574 ;
1575"RTN","TMGRPC3D",87,0)
1576 ;
1577"RTN","TMGRPC3D",88,0)
1578GETSRLST(TMGOUT,TMGPARAMS) ;"GET SUB-RECS LIST
1579"RTN","TMGRPC3D",89,0)
1580 ;"Purpose: Get all .01 sub record entries for a subfile
1581"RTN","TMGRPC3D",90,0)
1582 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
1583"RTN","TMGRPC3D",91,0)
1584 ;" TMGPARAMS -- SubFileNum^ParentIENS
1585"RTN","TMGRPC3D",92,0)
1586 ;" SubFileNum - Subfile Number to get list from.
1587"RTN","TMGRPC3D",93,0)
1588 ;" ParentIENS -- IENS for parent to get list from (e.g. "73,"
1589"RTN","TMGRPC3D",94,0)
1590 ;"Output: TMGOUT is filled as follows:
1591"RTN","TMGRPC3D",95,0)
1592 ;" TMGOUT(0)="1^Success" or "-1^Message"
1593"RTN","TMGRPC3D",96,0)
1594 ;" TMGOUT(1)=IEN^Value
1595"RTN","TMGRPC3D",97,0)
1596 ;" TMGOUT(2)=IEN^Value
1597"RTN","TMGRPC3D",98,0)
1598 ;" ...
1599"RTN","TMGRPC3D",99,0)
1600 ;"Results: none
1601"RTN","TMGRPC3D",100,0)
1602 ;
1603"RTN","TMGRPC3D",101,0)
1604 SET TMGOUT(0)="1^Success"
1605"RTN","TMGRPC3D",102,0)
1606 NEW TMGSUBFILE SET TMGSUBFILE=+$PIECE(TMGPARAMS,"^",1)
1607"RTN","TMGRPC3D",103,0)
1608 IF TMGSUBFILE'>0 DO GOTO GSRLDONE
1609"RTN","TMGRPC3D",104,0)
1610 . SET TMGOUT(0)="-1^No Subfile number supplied"
1611"RTN","TMGRPC3D",105,0)
1612 NEW TMGPARIENTIENS SET TMGPARIENTIENS=$PIECE(TMGPARAMS,"^",2)
1613"RTN","TMGRPC3D",106,0)
1614 IF TMGPARIENTIENS="" DO GOTO GSRLDONE
1615"RTN","TMGRPC3D",107,0)
1616 . SET TMGOUT(0)="-1^No Parent IENS supplied"
1617"RTN","TMGRPC3D",108,0)
1618 NEW TMGIENS SET TMGIENS=","_TMGPARIENTIENS
1619"RTN","TMGRPC3D",109,0)
1620 ;
1621"RTN","TMGRPC3D",110,0)
1622 DO LIST^DIC(TMGSUBFILE,TMGIENS,,"PU","*",,,,,,"TMGMSG","TMGERR")
1623"RTN","TMGRPC3D",111,0)
1624 ;
1625"RTN","TMGRPC3D",112,0)
1626 IF $DATA(TMGMSG("DIERR")) DO GOTO GSRLDONE
1627"RTN","TMGRPC3D",113,0)
1628 . SET TMGOUT(0)="-1^See Fileman message"
1629"RTN","TMGRPC3D",114,0)
1630 . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
1631"RTN","TMGRPC3D",115,0)
1632 ;
1633"RTN","TMGRPC3D",116,0)
1634 NEW TMGCOUNT SET TMGCOUNT=1
1635"RTN","TMGRPC3D",117,0)
1636 NEW TMGI SET TMGI=0
1637"RTN","TMGRPC3D",118,0)
1638 FOR SET TMGI=$ORDER(TMGMSG("DILIST",TMGI)) QUIT:(+TMGI'>0) DO
1639"RTN","TMGRPC3D",119,0)
1640 . NEW TMGONEENTRY SET TMGONEENTRY=$GET(TMGMSG("DILIST",TMGI,0))
1641"RTN","TMGRPC3D",120,0)
1642 . IF TMGONEENTRY="" QUIT
1643"RTN","TMGRPC3D",121,0)
1644 . NEW TMGIEN SET TMGIEN=$PIECE(TMGONEENTRY,"^",1)
1645"RTN","TMGRPC3D",122,0)
1646 . SET $PIECE(TMGONEENTRY,"^",1)=TMGIEN_","_TMGPARIENTIENS
1647"RTN","TMGRPC3D",123,0)
1648 . SET TMGOUT(TMGCOUNT)=TMGONEENTRY
1649"RTN","TMGRPC3D",124,0)
1650 . SET TMGCOUNT=TMGCOUNT+1
1651"RTN","TMGRPC3D",125,0)
1652 ;
1653"RTN","TMGRPC3D",126,0)
1654GSRLDONE ;
1655"RTN","TMGRPC3D",127,0)
1656 QUIT
1657"RTN","TMGRPC3D",128,0)
1658 ;
1659"RTN","TMGRPC3D",129,0)
1660 ;
1661"RTN","TMGRPC3D",130,0)
1662CLONEUSR(TMGOUT,TMGPARAMS) ;
1663"RTN","TMGRPC3D",131,0)
1664 ;"Purpose: to replicate a record into a new record, including all subrecs.
1665"RTN","TMGRPC3D",132,0)
1666 ;" Implementation of "CLONE RECORD" request
1667"RTN","TMGRPC3D",133,0)
1668 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
1669"RTN","TMGRPC3D",134,0)
1670 ;" TMGPARAMS -- SourceIENS^New.01Value
1671"RTN","TMGRPC3D",135,0)
1672 ;" FileNum - filename file that is to be worked in
1673"RTN","TMGRPC3D",136,0)
1674 ;" SourceIENS -- source IENS for new record, (i.e. '123,' not '123')
1675"RTN","TMGRPC3D",137,0)
1676 ;" New.01Value -- new value to be put into the .01 field (to distinguish it from the old record)
1677"RTN","TMGRPC3D",138,0)
1678 ;"Output: TMGOUT is filled as follows:
1679"RTN","TMGRPC3D",139,0)
1680 ;" TMGOUT(0)="1^Success^NewIENS" or "-1^Message"
1681"RTN","TMGRPC3D",140,0)
1682 ;" TMGOUT(1)=Long Fileman message (if -1 error)
1683"RTN","TMGRPC3D",141,0)
1684 ;
1685"RTN","TMGRPC3D",142,0)
1686 SET TMGPARAMS="200^"_TMGPARAMS
1687"RTN","TMGRPC3D",143,0)
1688 DO CLONEREC(.TMGOUT,TMGPARAMS)
1689"RTN","TMGRPC3D",144,0)
1690 NEW TMGFDA,TMGMSG
1691"RTN","TMGRPC3D",145,0)
1692 IF +TMGOUT(0)'=1 GOTO CUDONE
1693"RTN","TMGRPC3D",146,0)
1694 NEW TMGNEWIEN
1695"RTN","TMGRPC3D",147,0)
1696 SET TMGNEWIEN=+$PIECE(TMGOUT(0),"^",3)
1697"RTN","TMGRPC3D",148,0)
1698 IF TMGNEWIEN="" DO GOTO CUDONE
1699"RTN","TMGRPC3D",149,0)
1700 . SET TMGOUT(0)="-1^Can't find IEN of added record"
1701"RTN","TMGRPC3D",150,0)
1702 ;
1703"RTN","TMGRPC3D",151,0)
1704 ;"Set new user to inactive (needs editing before it is active)
1705"RTN","TMGRPC3D",152,0)
1706 NEW TMGDATA
1707"RTN","TMGRPC3D",153,0)
1708 SET TMGDATA(0)="200^"_TMGNEWIEN_",^7^^YES"
1709"RTN","TMGRPC3D",154,0)
1710 DO POSTDATA^TMGRPC3C(.TMGOUT,.TMGDATA,"E")
1711"RTN","TMGRPC3D",155,0)
1712 IF +TMGOUT(0)=1 SET $PIECE(TMGOUT(0),"^",3)=TMGNEWIEN
1713"RTN","TMGRPC3D",156,0)
1714 ;
1715"RTN","TMGRPC3D",157,0)
1716CUDONE ;
1717"RTN","TMGRPC3D",158,0)
1718 QUIT
1719"RTN","TMGRPC3D",159,0)
1720 ;
1721"RTN","TMGRPC3D",160,0)
1722CLONEREC(TMGOUT,TMGPARAMS) ;
1723"RTN","TMGRPC3D",161,0)
1724 ;"Purpose: to replicate a record into a NEW record, including all subrecs.
1725"RTN","TMGRPC3D",162,0)
1726 ;" Implementation of "CLONE RECORD" request
1727"RTN","TMGRPC3D",163,0)
1728 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
1729"RTN","TMGRPC3D",164,0)
1730 ;" TMGPARAMS -- FileNum^SourceIENS^New.01Value
1731"RTN","TMGRPC3D",165,0)
1732 ;" FileNum - filename file that is to be worked in
1733"RTN","TMGRPC3D",166,0)
1734 ;" SourceIENS -- the source IENS for the new record, (i.e. 123, not 123)
1735"RTN","TMGRPC3D",167,0)
1736 ;" New.01Value -- the new value to be put into the .01 field (to distinguish it from the old record)
1737"RTN","TMGRPC3D",168,0)
1738 ;"Output: TMGOUT is filled as follows:
1739"RTN","TMGRPC3D",169,0)
1740 ;" TMGOUT(0)="1^Success^NewIENS" or "-1^Message"
1741"RTN","TMGRPC3D",170,0)
1742 ;" TMGOUT(1)=Long Fileman message (if -1 error)
1743"RTN","TMGRPC3D",171,0)
1744 ;"NOTE: This hasn't been tested on subfiles yet...
1745"RTN","TMGRPC3D",172,0)
1746 ;
1747"RTN","TMGRPC3D",173,0)
1748 NEW TMGFILE,TMGIENS,TMGNEW01VALUE
1749"RTN","TMGRPC3D",174,0)
1750 SET TMGOUT(0)="-1^Error" ;"default to error
1751"RTN","TMGRPC3D",175,0)
1752 ;
1753"RTN","TMGRPC3D",176,0)
1754 SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
1755"RTN","TMGRPC3D",177,0)
1756 IF TMGFILE'>0 DO GOTO CRDONE
1757"RTN","TMGRPC3D",178,0)
1758 . SET TMGOUT(0)="-1^No file number supplied"
1759"RTN","TMGRPC3D",179,0)
1760 SET TMGIENS=$PIECE(TMGPARAMS,"^",2)
1761"RTN","TMGRPC3D",180,0)
1762 IF TMGIENS="" DO GOTO CRDONE
1763"RTN","TMGRPC3D",181,0)
1764 . SET TMGOUT(0)="-1^IENS supplied"
1765"RTN","TMGRPC3D",182,0)
1766 IF +TMGIENS=TMGIENS DO
1767"RTN","TMGRPC3D",183,0)
1768 . IF TMGIENS'["," SET TMGIENS=TMGIENS_","
1769"RTN","TMGRPC3D",184,0)
1770 SET TMGNEW01VALUE=$PIECE(TMGPARAMS,"^",3)
1771"RTN","TMGRPC3D",185,0)
1772 IF TMGNEW01VALUE="" DO GOTO CRDONE
1773"RTN","TMGRPC3D",186,0)
1774 . SET TMGOUT(0)="-1^No new value supplied for .01 value"
1775"RTN","TMGRPC3D",187,0)
1776 ;
1777"RTN","TMGRPC3D",188,0)
1778 NEW TMGARRAY,TMGMSG,TMGTEMP
1779"RTN","TMGRPC3D",189,0)
1780 NEW TMGREF SET TMGREF="TMGARRAY"
1781"RTN","TMGRPC3D",190,0)
1782 ;
1783"RTN","TMGRPC3D",191,0)
1784 DO STUBNEWR^TMGRPC3E(TMGFILE,TMGNEW01VALUE,.TMGOUT)
1785"RTN","TMGRPC3D",192,0)
1786 IF +TMGOUT(0)'=1 DO GOTO CRDONE
1787"RTN","TMGRPC3D",193,0)
1788 . SET $PIECE(TMGOUT(0),"^",2)="Unable to stub in new record. "_$PIECE(TMGOUT(0),"^",2)
1789"RTN","TMGRPC3D",194,0)
1790 NEW TMGNEWIEN SET TMGNEWIEN=$PIECE(TMGOUT(0),"^",3)
1791"RTN","TMGRPC3D",195,0)
1792 ;"Write "The IENS of the new record is: ",TMGNEWIEN,! ;"TEMP!!!
1793"RTN","TMGRPC3D",196,0)
1794 ;
1795"RTN","TMGRPC3D",197,0)
1796 ;"Note: Using a "X" flag is VERY slow, because it reindexes
1797"RTN","TMGRPC3D",198,0)
1798 ;" ALL XREFS for ALL entries in file (e.g. 60 seconds)
1799"RTN","TMGRPC3D",199,0)
1800 ;"DO TRNMRG^TMGDIT("M",TMGFILE,TMGFILE,TMGIENS,TMGNEWIEN_",") ;"DO actual record copy.
1801"RTN","TMGRPC3D",200,0)
1802 DO TRNMRG^DIT("M",TMGFILE,TMGFILE,TMGIENS,TMGNEWIEN_",") ;"do actual record copy.
1803"RTN","TMGRPC3D",201,0)
1804 NEW DA,DIK
1805"RTN","TMGRPC3D",202,0)
1806 SET DIK=$GET(^DIC(TMGFILE,0,"GL"))
1807"RTN","TMGRPC3D",203,0)
1808 SET DA=TMGNEWIEN
1809"RTN","TMGRPC3D",204,0)
1810 IF (+DA>0)&(DIK'="") DO IX1^DIK ;"index just the new record
1811"RTN","TMGRPC3D",205,0)
1812 ;
1813"RTN","TMGRPC3D",206,0)
1814 ;"OK if we got this far (can't check error from TRNMRG)
1815"RTN","TMGRPC3D",207,0)
1816 SET TMGOUT(0)="1^Success^"_TMGNEWIEN
1817"RTN","TMGRPC3D",208,0)
1818 ;
1819"RTN","TMGRPC3D",209,0)
1820CRDONE QUIT
1821"RTN","TMGRPC3D",210,0)
1822 ;
1823"RTN","TMGRPC3D",211,0)
1824 ;
1825"RTN","TMGRPC3E")
18260^5^B73079721
1827"RTN","TMGRPC3E",1,0)
1828TMGRPC3E ;TMG/kst/Support Functions for GUI_Config ;08/31/08
1829"RTN","TMGRPC3E",2,0)
1830 ;;1.0;TMG-LIB;**1**;08/31/08
1831"RTN","TMGRPC3E",3,0)
1832 ;
1833"RTN","TMGRPC3E",4,0)
1834 ;"TMG RPC FUNCTIONS for a GUI config program
1835"RTN","TMGRPC3E",5,0)
1836 ;
1837"RTN","TMGRPC3E",6,0)
1838 ;"Kevin Toppenberg MD
1839"RTN","TMGRPC3E",7,0)
1840 ;"GNU Lessor General Public License (LGPL) applies
1841"RTN","TMGRPC3E",8,0)
1842 ;"7/20/08
1843"RTN","TMGRPC3E",9,0)
1844 ;
1845"RTN","TMGRPC3E",10,0)
1846 ;"=======================================================================
1847"RTN","TMGRPC3E",11,0)
1848 ;" RPC -- Public Functions.
1849"RTN","TMGRPC3E",12,0)
1850 ;"=======================================================================
1851"RTN","TMGRPC3E",13,0)
1852 ;" <none>
1853"RTN","TMGRPC3E",14,0)
1854 ;"=======================================================================
1855"RTN","TMGRPC3E",15,0)
1856 ;"PRIVATE API FUNCTIONS
1857"RTN","TMGRPC3E",16,0)
1858 ;"=======================================================================
1859"RTN","TMGRPC3E",17,0)
1860 ;"GETEMPTY(TMGOUT,TMGPARAMS) -- get stub entries for a file (typically a subfile)
1861"RTN","TMGRPC3E",18,0)
1862 ;"GETHELPM(TMGOUT,TMGPARAMS) -- retrieve the help message for a given field.
1863"RTN","TMGRPC3E",19,0)
1864 ;"STUBNEWR(TMGFILE,NewValue,TMGOUT) -- create a stub entry in the file (200), to be filled in elsewhere
1865"RTN","TMGRPC3E",20,0)
1866 ;"GETIFWP(TMGOUT,TMGPARAMS) -- return if filenumber is a WP subfile
1867"RTN","TMGRPC3E",21,0)
1868 ;"GETWPFLD(TMGOUT,TMGPARAMS) -- retrieve on word processing (WP) field entry
1869"RTN","TMGRPC3E",22,0)
1870 ;"PSTWPFLD(TMGOUT,TMGPARAMS,INPUT) -- store a word processing (WP) field entry
1871"RTN","TMGRPC3E",23,0)
1872 ;
1873"RTN","TMGRPC3E",24,0)
1874 ;"=======================================================================
1875"RTN","TMGRPC3E",25,0)
1876 ;"=======================================================================
1877"RTN","TMGRPC3E",26,0)
1878 ;"Dependencies:
1879"RTN","TMGRPC3E",27,0)
1880 ;" TMGRPC3* only
1881"RTN","TMGRPC3E",28,0)
1882 ;
1883"RTN","TMGRPC3E",29,0)
1884 ;"=======================================================================
1885"RTN","TMGRPC3E",30,0)
1886 ;"=======================================================================
1887"RTN","TMGRPC3E",31,0)
1888 ;
1889"RTN","TMGRPC3E",32,0)
1890GETEMPTY(TMGOUT,TMGPARAMS) ;"GET EMPTY ENTRY
1891"RTN","TMGRPC3E",33,0)
1892 ;"Purpose: to get stub entries for a file (typically a subfile)
1893"RTN","TMGRPC3E",34,0)
1894 ;" "GET EMPTY ENTRY" -- getting stub entries for subfiles typically
1895"RTN","TMGRPC3E",35,0)
1896 ;" TMGPARAMS: file entry (file or subfile number)
1897"RTN","TMGRPC3E",36,0)
1898 ;"Input: TMGOUT --an OUT ARRAY, filled as follows:
1899"RTN","TMGRPC3E",37,0)
1900 ;" TMGOUT(0)="1^Success" or "-1^Message"
1901"RTN","TMGRPC3E",38,0)
1902 ;" TMGOUT(1)=File^^FieldNum^^DDInfo...
1903"RTN","TMGRPC3E",39,0)
1904 ;" TMGOUT(2)=File^^FieldNum^^DDInfo...
1905"RTN","TMGRPC3E",40,0)
1906 ;" Etc ...
1907"RTN","TMGRPC3E",41,0)
1908 ;" Params: filenumber (typically a subfilenumber)
1909"RTN","TMGRPC3E",42,0)
1910 ;"Result: None
1911"RTN","TMGRPC3E",43,0)
1912 ;
1913"RTN","TMGRPC3E",44,0)
1914 SET TMGOUT(0)="1^Success"
1915"RTN","TMGRPC3E",45,0)
1916 NEW TMGCOUNT SET TMGCOUNT=1
1917"RTN","TMGRPC3E",46,0)
1918 NEW TMGFNUM SET TMGFNUM=+$GET(TMGPARAMS)
1919"RTN","TMGRPC3E",47,0)
1920 NEW TMGFLDNUM SET TMGFLDNUM=0
1921"RTN","TMGRPC3E",48,0)
1922 FOR SET TMGFLDNUM=$ORDER(^DD(TMGFNUM,TMGFLDNUM)) QUIT:(+TMGFLDNUM'>0) DO
1923"RTN","TMGRPC3E",49,0)
1924 . NEW TMGDDINFO SET TMGDDINFO=$PIECE($GET(^DD(TMGFNUM,TMGFLDNUM,0)),"^",1,4)
1925"RTN","TMGRPC3E",50,0)
1926 . SET TMGOUT(TMGCOUNT)=TMGFNUM_"^^"_TMGFLDNUM_"^^"_TMGDDINFO
1927"RTN","TMGRPC3E",51,0)
1928 . SET TMGCOUNT=TMGCOUNT+1
1929"RTN","TMGRPC3E",52,0)
1930 ;
1931"RTN","TMGRPC3E",53,0)
1932 QUIT
1933"RTN","TMGRPC3E",54,0)
1934 ;
1935"RTN","TMGRPC3E",55,0)
1936 ;
1937"RTN","TMGRPC3E",56,0)
1938GETHELPM(TMGOUT,TMGPARAMS) ;
1939"RTN","TMGRPC3E",57,0)
1940 ;"Purpose: to retrieve the help message for a given field.
1941"RTN","TMGRPC3E",58,0)
1942 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
1943"RTN","TMGRPC3E",59,0)
1944 ;" TMGPARAMS -- file^field^HelpType
1945"RTN","TMGRPC3E",60,0)
1946 ;"Output: TMGOUT is filled as follows:
1947"RTN","TMGRPC3E",61,0)
1948 ;" TMGOUT(0)="1^Success" or "-1^Message"
1949"RTN","TMGRPC3E",62,0)
1950 ;" TMGOUT(1...?)=Help Message
1951"RTN","TMGRPC3E",63,0)
1952 ;
1953"RTN","TMGRPC3E",64,0)
1954 NEW TMGMSG
1955"RTN","TMGRPC3E",65,0)
1956 NEW TMGINDEX SET TMGINDEX=1
1957"RTN","TMGRPC3E",66,0)
1958 NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
1959"RTN","TMGRPC3E",67,0)
1960 NEW TMGFIELD SET TMGFIELD=+$PIECE(TMGPARAMS,"^",2)
1961"RTN","TMGRPC3E",68,0)
1962 NEW TMGHELPTYPE SET TMGHELPTYPE=$PIECE(TMGPARAMS,"^",3)
1963"RTN","TMGRPC3E",69,0)
1964 IF TMGFILE'>0 DO GOTO GHMDONE
1965"RTN","TMGRPC3E",70,0)
1966 . SET TMGOUT(0)="-1^No file number supplied"
1967"RTN","TMGRPC3E",71,0)
1968 IF TMGFIELD'>0 DO GOTO GHMDONE
1969"RTN","TMGRPC3E",72,0)
1970 . SET TMGOUT(0)="-1^No Field Number supplied"
1971"RTN","TMGRPC3E",73,0)
1972 DO HELP^DIE(TMGFILE,,TMGFIELD,TMGHELPTYPE,"TMGMSG")
1973"RTN","TMGRPC3E",74,0)
1974 NEW TMGI SET TMGI=""
1975"RTN","TMGRPC3E",75,0)
1976 FOR SET TMGI=$ORDER(TMGMSG("DIHELP",TMGI)) QUIT:(TMGI="") DO
1977"RTN","TMGRPC3E",76,0)
1978 . SET TMGOUT(TMGINDEX)=TMGMSG("DIHELP",TMGI)
1979"RTN","TMGRPC3E",77,0)
1980 . SET TMGINDEX=TMGINDEX+1
1981"RTN","TMGRPC3E",78,0)
1982 ;
1983"RTN","TMGRPC3E",79,0)
1984 SET TMGOUT(0)="1^Success"
1985"RTN","TMGRPC3E",80,0)
1986 ;
1987"RTN","TMGRPC3E",81,0)
1988GHMDONE ;
1989"RTN","TMGRPC3E",82,0)
1990 QUIT
1991"RTN","TMGRPC3E",83,0)
1992 ;
1993"RTN","TMGRPC3E",84,0)
1994 ;
1995"RTN","TMGRPC3E",85,0)
1996STUBNEWR(TMGFILE,TMGNEWVALUE,TMGOUT) ;"STUB NEW RECORD
1997"RTN","TMGRPC3E",86,0)
1998 ;"Purpose: to create a stub entry in the file (200), to be filled in elsewhere
1999"RTN","TMGRPC3E",87,0)
2000 ;"Input: TMGNEWVALUE -- a value for the .01 field
2001"RTN","TMGRPC3E",88,0)
2002 ;" TMGOUT -- PASS BY REFERENCE, an OUT PARAMETER.
2003"RTN","TMGRPC3E",89,0)
2004 ;"Output: A new record will be added to file, if no errors
2005"RTN","TMGRPC3E",90,0)
2006 ;" TMGOUT(0): 1^Success^NewIEN or -1^See Fileman message
2007"RTN","TMGRPC3E",91,0)
2008 ;" TMGOUT(1) will contain Fileman error, if any
2009"RTN","TMGRPC3E",92,0)
2010 ;"Results: none
2011"RTN","TMGRPC3E",93,0)
2012 ;"NOTICE: This function makes no promise that the creation of the
2013"RTN","TMGRPC3E",94,0)
2014 ;" new record will succeed. For example, if there are required
2015"RTN","TMGRPC3E",95,0)
2016 ;" fields, the creation will fail. So users should check for success
2017"RTN","TMGRPC3E",96,0)
2018 ;" result and error feedback.
2019"RTN","TMGRPC3E",97,0)
2020 ;"Results: none
2021"RTN","TMGRPC3E",98,0)
2022 ;
2023"RTN","TMGRPC3E",99,0)
2024 NEW TMGFDA,TMGIEN,TMGMSG,DIC
2025"RTN","TMGRPC3E",100,0)
2026 SET DIC(0)="" ;"I get a crash without this, for some reason...
2027"RTN","TMGRPC3E",101,0)
2028 SET TMGFDA(TMGFILE,"+1,",.01)=TMGNEWVALUE
2029"RTN","TMGRPC3E",102,0)
2030 DO UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG")
2031"RTN","TMGRPC3E",103,0)
2032 ;
2033"RTN","TMGRPC3E",104,0)
2034 IF $DATA(TMGMSG("DIERR")) DO GOTO SNPDONE
2035"RTN","TMGRPC3E",105,0)
2036 . SET TMGOUT(0)="-1^See Fileman message"
2037"RTN","TMGRPC3E",106,0)
2038 . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
2039"RTN","TMGRPC3E",107,0)
2040 ;
2041"RTN","TMGRPC3E",108,0)
2042 SET TMGOUT(0)="1^Success^"_$GET(TMGIEN(1))
2043"RTN","TMGRPC3E",109,0)
2044 ;
2045"RTN","TMGRPC3E",110,0)
2046SNPDONE ;
2047"RTN","TMGRPC3E",111,0)
2048 QUIT
2049"RTN","TMGRPC3E",112,0)
2050 ;
2051"RTN","TMGRPC3E",113,0)
2052 ;
2053"RTN","TMGRPC3E",114,0)
2054GETIFWP(TMGOUT,TMGPARAMS) ;"GET IF WP FIELD
2055"RTN","TMGRPC3E",115,0)
2056 ;"Purpose: to return if filenumber is a WP subfile
2057"RTN","TMGRPC3E",116,0)
2058 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
2059"RTN","TMGRPC3E",117,0)
2060 ;" TMGPARAMS -- file^field
2061"RTN","TMGRPC3E",118,0)
2062 ;"Output:
2063"RTN","TMGRPC3E",119,0)
2064 ;" TMGOUT(0): "1^Success^YES/NO" or "-1^Message"
2065"RTN","TMGRPC3E",120,0)
2066 ;" "YES" if is a WP subfile, otherwise "NO"
2067"RTN","TMGRPC3E",121,0)
2068 ;" TMGOUT(1) will contain Fileman error, if any
2069"RTN","TMGRPC3E",122,0)
2070 ;"Results: none
2071"RTN","TMGRPC3E",123,0)
2072 ;
2073"RTN","TMGRPC3E",124,0)
2074 NEW TMGRESULT
2075"RTN","TMGRPC3E",125,0)
2076 NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
2077"RTN","TMGRPC3E",126,0)
2078 NEW TMGFIELD SET TMGFIELD=+$PIECE(TMGPARAMS,"^",2)
2079"RTN","TMGRPC3E",127,0)
2080 IF TMGFILE'>0 DO GOTO GWPSDONE
2081"RTN","TMGRPC3E",128,0)
2082 . SET TMGOUT(0)="-1^No file number supplied"
2083"RTN","TMGRPC3E",129,0)
2084 IF TMGFIELD'>0 DO GOTO GWPSDONE
2085"RTN","TMGRPC3E",130,0)
2086 . SET TMGOUT(0)="-1^No Field Number supplied"
2087"RTN","TMGRPC3E",131,0)
2088 ;
2089"RTN","TMGRPC3E",132,0)
2090 DO FIELD^DID(TMGFILE,TMGFIELD,"","TYPE","TMGARRAY","TMGMSG")
2091"RTN","TMGRPC3E",133,0)
2092 ;
2093"RTN","TMGRPC3E",134,0)
2094 IF $DATA(TMGMSG("DIERR")) DO GOTO GWPSDONE
2095"RTN","TMGRPC3E",135,0)
2096 . SET TMGOUT(0)="-1^See Fileman message"
2097"RTN","TMGRPC3E",136,0)
2098 . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
2099"RTN","TMGRPC3E",137,0)
2100 ;
2101"RTN","TMGRPC3E",138,0)
2102 IF $GET(TMGARRAY("TYPE"))="WORD-PROCESSING" DO
2103"RTN","TMGRPC3E",139,0)
2104 . SET TMGRESULT="YES"
2105"RTN","TMGRPC3E",140,0)
2106 ELSE DO
2107"RTN","TMGRPC3E",141,0)
2108 . SET TMGRESULT="NO"
2109"RTN","TMGRPC3E",142,0)
2110 ;
2111"RTN","TMGRPC3E",143,0)
2112 SET TMGOUT(0)="1^Success^"_TMGRESULT
2113"RTN","TMGRPC3E",144,0)
2114 ;
2115"RTN","TMGRPC3E",145,0)
2116GWPSDONE ;
2117"RTN","TMGRPC3E",146,0)
2118 QUIT
2119"RTN","TMGRPC3E",147,0)
2120 ;
2121"RTN","TMGRPC3E",148,0)
2122 ;
2123"RTN","TMGRPC3E",149,0)
2124GETWPFLD(TMGOUT,TMGPARAMS) ;"GET WP FIELD
2125"RTN","TMGRPC3E",150,0)
2126 ;"Purpose: To retrieve on word processing (WP) field entry
2127"RTN","TMGRPC3E",151,0)
2128 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
2129"RTN","TMGRPC3E",152,0)
2130 ;" TMGPARAMS -- FileNum^Field^IENS (e.g. 'GET ONE WP FIELD^200^73,')
2131"RTN","TMGRPC3E",153,0)
2132 ;"Output:
2133"RTN","TMGRPC3E",154,0)
2134 ;" TMGOUT(0): "1^Success" or "-1^Message"
2135"RTN","TMGRPC3E",155,0)
2136 ;" TMGOUT(1) will contain Fileman error, if any
2137"RTN","TMGRPC3E",156,0)
2138 ;" - or to return WP array -
2139"RTN","TMGRPC3E",157,0)
2140 ;" TMGOUT(1)=1st line of text
2141"RTN","TMGRPC3E",158,0)
2142 ;" TMGOUT(2)=2nd line of text
2143"RTN","TMGRPC3E",159,0)
2144 ;" etc..
2145"RTN","TMGRPC3E",160,0)
2146 ;"Results: None
2147"RTN","TMGRPC3E",161,0)
2148 ;
2149"RTN","TMGRPC3E",162,0)
2150 NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
2151"RTN","TMGRPC3E",163,0)
2152 NEW TMGFIELD SET TMGFIELD=+$PIECE(TMGPARAMS,"^",2)
2153"RTN","TMGRPC3E",164,0)
2154 NEW TMGIENS SET TMGIENS=+$PIECE(TMGPARAMS,"^",3)
2155"RTN","TMGRPC3E",165,0)
2156 IF TMGFILE'>0 DO GOTO GWPDONE
2157"RTN","TMGRPC3E",166,0)
2158 . SET TMGOUT(0)="-1^No file number supplied"
2159"RTN","TMGRPC3E",167,0)
2160 IF TMGFIELD'>0 DO GOTO GWPDONE
2161"RTN","TMGRPC3E",168,0)
2162 . SET TMGOUT(0)="-1^No Field Number supplied"
2163"RTN","TMGRPC3E",169,0)
2164 IF TMGIENS="" DO GOTO GWPDONE
2165"RTN","TMGRPC3E",170,0)
2166 . SET TMGOUT(0)="-1^No IENS supplied"
2167"RTN","TMGRPC3E",171,0)
2168 ;
2169"RTN","TMGRPC3E",172,0)
2170 NEW TMGTEMP
2171"RTN","TMGRPC3E",173,0)
2172 SET TMGTEMP=$$GET1^DIQ(TMGFILE,TMGIENS,TMGFIELD,"","TMGARRAY","TMGMSG")
2173"RTN","TMGRPC3E",174,0)
2174 IF $DATA(TMGMSG("DIERR")) DO GOTO GWPDONE
2175"RTN","TMGRPC3E",175,0)
2176 . SET TMGOUT(0)="-1^See Fileman message"
2177"RTN","TMGRPC3E",176,0)
2178 . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
2179"RTN","TMGRPC3E",177,0)
2180 ;
2181"RTN","TMGRPC3E",178,0)
2182 SET TMGOUT(0)="1^Success"
2183"RTN","TMGRPC3E",179,0)
2184 NEW TMGINDEX SET TMGINDEX=1
2185"RTN","TMGRPC3E",180,0)
2186 NEW TMGI SET TMGI=0
2187"RTN","TMGRPC3E",181,0)
2188 FOR SET TMGI=$ORDER(TMGARRAY(TMGI)) QUIT:(TMGI="") DO
2189"RTN","TMGRPC3E",182,0)
2190 . SET TMGOUT(TMGINDEX)=TMGARRAY(TMGI)
2191"RTN","TMGRPC3E",183,0)
2192 . SET TMGINDEX=TMGINDEX+1
2193"RTN","TMGRPC3E",184,0)
2194 ;
2195"RTN","TMGRPC3E",185,0)
2196GWPDONE ;
2197"RTN","TMGRPC3E",186,0)
2198 QUIT
2199"RTN","TMGRPC3E",187,0)
2200 ;
2201"RTN","TMGRPC3E",188,0)
2202 ;
2203"RTN","TMGRPC3E",189,0)
2204PSTWPFLD(TMGOUT,TMGPARAMS,INPUT) ;"POST WP FIELD
2205"RTN","TMGRPC3E",190,0)
2206 ;"Purpose: To store a word processing (WP) field entry
2207"RTN","TMGRPC3E",191,0)
2208 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
2209"RTN","TMGRPC3E",192,0)
2210 ;" TMGPARAMS -- FileNum^FieldNum^IENS (e.g. 'GET ONE WP FIELD^200^73,')
2211"RTN","TMGRPC3E",193,0)
2212 ;" INPUT -- holds the WP itself to be stored:
2213"RTN","TMGRPC3E",194,0)
2214 ;" INPUT(0)=0TH line
2215"RTN","TMGRPC3E",195,0)
2216 ;" INPUT(1)=1st line
2217"RTN","TMGRPC3E",196,0)
2218 ;" INPUT(2)=2nd line
2219"RTN","TMGRPC3E",197,0)
2220 ;" ...
2221"RTN","TMGRPC3E",198,0)
2222 ;"Output:
2223"RTN","TMGRPC3E",199,0)
2224 ;" TMGOUT(0): "1^Success" or "-1^Message"
2225"RTN","TMGRPC3E",200,0)
2226 ;" TMGOUT(1) will contain Fileman error, if any
2227"RTN","TMGRPC3E",201,0)
2228 ;"Results: None
2229"RTN","TMGRPC3E",202,0)
2230 ;
2231"RTN","TMGRPC3E",203,0)
2232 NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
2233"RTN","TMGRPC3E",204,0)
2234 NEW TMGFIELD SET TMGFIELD=+$PIECE(TMGPARAMS,"^",2)
2235"RTN","TMGRPC3E",205,0)
2236 NEW TMGIENS SET TMGIENS=+$PIECE(TMGPARAMS,"^",3)
2237"RTN","TMGRPC3E",206,0)
2238 IF TMGFILE'>0 DO GOTO PWPDONE
2239"RTN","TMGRPC3E",207,0)
2240 . SET TMGOUT(0)="-1^No file number supplied"
2241"RTN","TMGRPC3E",208,0)
2242 IF TMGFIELD'>0 DO GOTO PWPDONE
2243"RTN","TMGRPC3E",209,0)
2244 . SET TMGOUT(0)="-1^No Field Number supplied"
2245"RTN","TMGRPC3E",210,0)
2246 IF TMGIENS="" DO GOTO PWPDONE
2247"RTN","TMGRPC3E",211,0)
2248 . SET TMGOUT(0)="-1^No IENS supplied"
2249"RTN","TMGRPC3E",212,0)
2250 IF $LENGTH(TMGIENS,",")=1 SET TMGIENS=TMGIENS_","
2251"RTN","TMGRPC3E",213,0)
2252 ;
2253"RTN","TMGRPC3E",214,0)
2254 DO WP^DIE(TMGFILE,TMGIENS,TMGFIELD,"K","INPUT","TMGMSG")
2255"RTN","TMGRPC3E",215,0)
2256 ;
2257"RTN","TMGRPC3E",216,0)
2258 IF $DATA(TMGMSG("DIERR")) DO GOTO GWPDONE
2259"RTN","TMGRPC3E",217,0)
2260 . SET TMGOUT(0)="-1^See Fileman message"
2261"RTN","TMGRPC3E",218,0)
2262 . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
2263"RTN","TMGRPC3E",219,0)
2264 ;
2265"RTN","TMGRPC3E",220,0)
2266 SET TMGOUT(0)="1^Success"
2267"RTN","TMGRPC3E",221,0)
2268 ;
2269"RTN","TMGRPC3E",222,0)
2270PWPDONE ;
2271"RTN","TMGRPC3E",223,0)
2272 QUIT
2273"RTN","TMGRPC3E",224,0)
2274 ;
2275"RTN","TMGRPC3E",225,0)
2276 ;
2277"RTN","TMGRPC3F")
22780^6^B82393873
2279"RTN","TMGRPC3F",1,0)
2280TMGRPC3F ;TMG/kst/Support Functions for GUI_Config ;08/31/08
2281"RTN","TMGRPC3F",2,0)
2282 ;;1.0;TMG-LIB;**1**;08/31/08
2283"RTN","TMGRPC3F",3,0)
2284 ;
2285"RTN","TMGRPC3F",4,0)
2286 ;"TMG RPC FUNCTIONS for a GUI config program
2287"RTN","TMGRPC3F",5,0)
2288 ;
2289"RTN","TMGRPC3F",6,0)
2290 ;"Kevin Toppenberg MD
2291"RTN","TMGRPC3F",7,0)
2292 ;"GNU Lessor General Public License (LGPL) applies
2293"RTN","TMGRPC3F",8,0)
2294 ;"7/20/08
2295"RTN","TMGRPC3F",9,0)
2296 ;
2297"RTN","TMGRPC3F",10,0)
2298 ;"=======================================================================
2299"RTN","TMGRPC3F",11,0)
2300 ;" RPC -- Public Functions.
2301"RTN","TMGRPC3F",12,0)
2302 ;"=======================================================================
2303"RTN","TMGRPC3F",13,0)
2304 ;" <none>
2305"RTN","TMGRPC3F",14,0)
2306 ;"=======================================================================
2307"RTN","TMGRPC3F",15,0)
2308 ;"PRIVATE API FUNCTIONS
2309"RTN","TMGRPC3F",16,0)
2310 ;"=======================================================================
2311"RTN","TMGRPC3F",17,0)
2312 ;"REGPAT(TMGOUT,TMGPARAMS) -- register a new patient into VistA, providing not already been registered.
2313"RTN","TMGRPC3F",18,0)
2314 ;"SRCHPTEXACT(TMGARRAY) -- search for a preexisting patient, using an exact search
2315"RTN","TMGRPC3F",19,0)
2316 ;
2317"RTN","TMGRPC3F",20,0)
2318 ;"=======================================================================
2319"RTN","TMGRPC3F",21,0)
2320 ;"Dependencies:
2321"RTN","TMGRPC3F",22,0)
2322 ;" TMGRPC3* only
2323"RTN","TMGRPC3F",23,0)
2324 ;
2325"RTN","TMGRPC3F",24,0)
2326 ;"=======================================================================
2327"RTN","TMGRPC3F",25,0)
2328 ;
2329"RTN","TMGRPC3F",26,0)
2330REGPAT(TMGOUT,TMGPARAMS) ;"REGISTER PATIENT
2331"RTN","TMGRPC3F",27,0)
2332 ;"Purpose: to register a new patient into VistA, providing that they have not
2333"RTN","TMGRPC3F",28,0)
2334 ;" already been registered.
2335"RTN","TMGRPC3F",29,0)
2336 ;"Note: The search for preexisting records is exact, meaning that DOE,JOHN
2337"RTN","TMGRPC3F",30,0)
2338 ;" would be considered different from DOE,JOHN H
2339"RTN","TMGRPC3F",31,0)
2340 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
2341"RTN","TMGRPC3F",32,0)
2342 ;" TMGPARAMS -- FieldNum1^FieldValue1^FieldNum2^FieldValue2^FieldNum3^FieldValue3^...
2343"RTN","TMGRPC3F",33,0)
2344 ;" NOTE: Because I want to be able to specify here the HealthRecordNumber (HRN),
2345"RTN","TMGRPC3F",34,0)
2346 ;" even though it is not truly a field in the PATIENT file, I am going
2347"RTN","TMGRPC3F",35,0)
2348 ;" to manually allow a field of '0' (HRN) to be specified as a FieldNumber
2349"RTN","TMGRPC3F",36,0)
2350 ;"Output: TMGOUT is filled as follows:
2351"RTN","TMGRPC3F",37,0)
2352 ;" TMGOUT(0)="1^Success^NewIEN" or "-1^Message"
2353"RTN","TMGRPC3F",38,0)
2354 ;" TMGOUT(1)=Long Fileman message (if -1 error)
2355"RTN","TMGRPC3F",39,0)
2356 ;
2357"RTN","TMGRPC3F",40,0)
2358 NEW TMGARRAY
2359"RTN","TMGRPC3F",41,0)
2360 FOR DO QUIT:($LENGTH(TMGPARAMS,"^"))<2
2361"RTN","TMGRPC3F",42,0)
2362 . NEW TMGPAIR,TMGFIELD,TMGVALUE
2363"RTN","TMGRPC3F",43,0)
2364 . SET TMGPAIR=$PIECE(TMGPARAMS,"^",1,2)
2365"RTN","TMGRPC3F",44,0)
2366 . SET TMGFIELD=$PIECE(TMGPAIR,"^",1)
2367"RTN","TMGRPC3F",45,0)
2368 . SET TMGVALUE=$PIECE(TMGPAIR,"^",2)
2369"RTN","TMGRPC3F",46,0)
2370 . SET TMGPARAMS=$EXTRACT(TMGPARAMS,$LENGTH(TMGPAIR)+2,999)
2371"RTN","TMGRPC3F",47,0)
2372 . IF (TMGFIELD="")!(TMGVALUE="") QUIT
2373"RTN","TMGRPC3F",48,0)
2374 . SET TMGARRAY(TMGFIELD)=TMGVALUE
2375"RTN","TMGRPC3F",49,0)
2376 ;
2377"RTN","TMGRPC3F",50,0)
2378 NEW TMGIEN SET TMGIEN=$$SRCHPTEXACT(.TMGARRAY)
2379"RTN","TMGRPC3F",51,0)
2380 IF +TMGIEN>0 DO GOTO RPTDONE
2381"RTN","TMGRPC3F",52,0)
2382 . SET TMGOUT(0)="-1^Patient already registered^"_TMGIEN
2383"RTN","TMGRPC3F",53,0)
2384 ;
2385"RTN","TMGRPC3F",54,0)
2386 NEW TMGFDA,TMGMSG,TMGIEN
2387"RTN","TMGRPC3F",55,0)
2388 IF $GET(TMGARRAY(.01))="" DO GOTO RPTDONE
2389"RTN","TMGRPC3F",56,0)
2390 . SET TMGOUT(0)="-1^Patient name (.01 field) missing"
2391"RTN","TMGRPC3F",57,0)
2392 SET TMGFDA(2,"+1,",.01)=TMGARRAY(.01)
2393"RTN","TMGRPC3F",58,0)
2394 IF $GET(TMGARRAY(.02))="" DO GOTO RPTDONE
2395"RTN","TMGRPC3F",59,0)
2396 . SET TMGOUT(0)="-1^Patient sex (.02 field) missing"
2397"RTN","TMGRPC3F",60,0)
2398 SET TMGFDA(2,"+1,",.02)=TMGARRAY(.02)
2399"RTN","TMGRPC3F",61,0)
2400 IF $GET(TMGARRAY(.03))="" DO GOTO RPTDONE
2401"RTN","TMGRPC3F",62,0)
2402 . SET TMGOUT(0)="-1^Patient DOB (.03 field) missing"
2403"RTN","TMGRPC3F",63,0)
2404 SET TMGFDA(2,"+1,",.03)=TMGARRAY(.03)
2405"RTN","TMGRPC3F",64,0)
2406 IF $GET(TMGARRAY(.09))'="" DO ;"let fileman decide if field is required
2407"RTN","TMGRPC3F",65,0)
2408 . SET TMGFDA(2,"+1,",.09)=TMGARRAY(.09)
2409"RTN","TMGRPC3F",66,0)
2410 ;
2411"RTN","TMGRPC3F",67,0)
2412 ;"Create basic record first, then add other fields on subsequent post
2413"RTN","TMGRPC3F",68,0)
2414 ;"(I think I have had problems trying to load some fields when the
2415"RTN","TMGRPC3F",69,0)
2416 ;" record has not already been created.)
2417"RTN","TMGRPC3F",70,0)
2418 DO UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG")
2419"RTN","TMGRPC3F",71,0)
2420 IF $DATA(TMGMSG("DIERR")) DO GOTO RPTDONE
2421"RTN","TMGRPC3F",72,0)
2422 . SET TMGOUT(0)="-1^See Fileman message"
2423"RTN","TMGRPC3F",73,0)
2424 . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
2425"RTN","TMGRPC3F",74,0)
2426 ;
2427"RTN","TMGRPC3F",75,0)
2428 SET TMGIEN=$GET(TMGIEN(1))
2429"RTN","TMGRPC3F",76,0)
2430 IF TMGIEN'>0 DO GOTO RPTDONE
2431"RTN","TMGRPC3F",77,0)
2432 . SET TMGOUT(0)="-1^Unable to find IEN of added record"
2433"RTN","TMGRPC3F",78,0)
2434 ;
2435"RTN","TMGRPC3F",79,0)
2436 NEW TMGFIELD SET TMGFIELD=""
2437"RTN","TMGRPC3F",80,0)
2438 KILL TMGFDA,TMGIEN,TMGMSG
2439"RTN","TMGRPC3F",81,0)
2440 FOR SET TMGFIELD=$ORDER(TMGARRAY(TMGFIELD)) QUIT:(TMGFIELD="") DO
2441"RTN","TMGRPC3F",82,0)
2442 . IF (TMGFIELD=".01")!(TMGFIELD=".02")!(TMGFIELD=".03")!(TMGFIELD=".09")!(TMGFIELD="0") QUIT
2443"RTN","TMGRPC3F",83,0)
2444 . NEW TMGVALUE SET TMGVALUE=$GET(TMGARRAY(TMGFIELD))
2445"RTN","TMGRPC3F",84,0)
2446 . IF TMGVALUE="" QUIT
2447"RTN","TMGRPC3F",85,0)
2448 . SET TMGFDA(2,TMGIEN_",",TMGFIELD)=TMGVALUE
2449"RTN","TMGRPC3F",86,0)
2450 ;
2451"RTN","TMGRPC3F",87,0)
2452 IF $DATA(TMGFDA) DO
2453"RTN","TMGRPC3F",88,0)
2454 . DO FILE^DIE("E","TMGFDA","TMGMSG")
2455"RTN","TMGRPC3F",89,0)
2456 IF $DATA(TMGMSG("DIERR")) DO GOTO RPTDONE
2457"RTN","TMGRPC3F",90,0)
2458 . SET TMGOUT(0)="-1^See Fileman message"
2459"RTN","TMGRPC3F",91,0)
2460 . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
2461"RTN","TMGRPC3F",92,0)
2462 ;
2463"RTN","TMGRPC3F",93,0)
2464 SET TMGOUT(0)="1^Success^"_TMGIEN
2465"RTN","TMGRPC3F",94,0)
2466 ;
2467"RTN","TMGRPC3F",95,0)
2468 NEW TMGHRN SET TMGHRN=$GET(TMGARRAY("0"))="" ;" pseudoField '0' from client will hold HRN
2469"RTN","TMGRPC3F",96,0)
2470 IF TMGHRN="" GOTO RPTDONE
2471"RTN","TMGRPC3F",97,0)
2472 ;"Set TMGHRN field in file 9000001 (^AUPNPAT), linked to Patient entry
2473"RTN","TMGRPC3F",98,0)
2474 ;
2475"RTN","TMGRPC3F",99,0)
2476 NEW TMGLOCIEN,TMGINSTIEN
2477"RTN","TMGRPC3F",100,0)
2478 ;"Get DEFAULT INSTITUTION from KERNEL SYSTEM PARAMETERS.
2479"RTN","TMGRPC3F",101,0)
2480 SET TMGINSTIEN=$PIECE($GET(^XTV(8989.3,1,"XUS")),17) ;" XUS;17 = DEFAULT INSTITUTION
2481"RTN","TMGRPC3F",102,0)
2482 IF +TMGINSTIEN'>0 DO GOTO RPTDONE
2483"RTN","TMGRPC3F",103,0)
2484 . SET TMGOUT(0)="1^Success (but see message)^"_TMGIEN
2485"RTN","TMGRPC3F",104,0)
2486 . SET TMGOUT(1)="Unable to add HRN because couldn't find value for DEFAULT INSTITUTION in KERNEL SYSTEM PARAMETERS file."
2487"RTN","TMGRPC3F",105,0)
2488 ;
2489"RTN","TMGRPC3F",106,0)
2490 ;"Get LOCATION file entry pointing to this INSTITUTION
2491"RTN","TMGRPC3F",107,0)
2492 SET TMGLOCIEN=$ORDER(^AUTTLOC("B",TMGINSTIEN,""))
2493"RTN","TMGRPC3F",108,0)
2494 IF +TMGLOCIEN'>0 DO GOTO RPTDONE
2495"RTN","TMGRPC3F",109,0)
2496 . SET TMGOUT(0)="1^Success (but see message)^"_TMGIEN
2497"RTN","TMGRPC3F",110,0)
2498 . SET TMGOUT(1)="Unable to add HRN because couldn't find `"_TMGINSTIEN_" in LOCATION file"
2499"RTN","TMGRPC3F",111,0)
2500 ;
2501"RTN","TMGRPC3F",112,0)
2502 NEW TMGHRNIEN SET TMGHRNIEN=+$ORDER(^AUNPNPAT("B",TMGIEN,""))
2503"RTN","TMGRPC3F",113,0)
2504 IF TMGHRNIEN'>0 DO GOTO RPTDONE
2505"RTN","TMGRPC3F",114,0)
2506 . SET TMGOUT(0)="1^Success (but see message)^"_TMGIEN
2507"RTN","TMGRPC3F",115,0)
2508 . SET TMGOUT(1)="Unable to add HRN because couldn't find record in PATIENT/IHS file"
2509"RTN","TMGRPC3F",116,0)
2510 ;
2511"RTN","TMGRPC3F",117,0)
2512 KILL TMGFDA,TMGMSG,TMGIEN
2513"RTN","TMGRPC3F",118,0)
2514 ;"Now see if there already is an entry for TMGLOCIEN (DINUM in play, so subFile record#=TMGLOCIEN)
2515"RTN","TMGRPC3F",119,0)
2516 IF $GET(^AUPNPAT(TMGHRNIEN,41,TMGLOCIEN,0))="" DO
2517"RTN","TMGRPC3F",120,0)
2518 . ;"Put HRN into value for current subfile entry
2519"RTN","TMGRPC3F",121,0)
2520 . SET TMGFDA(9000001.41,TMGLOCIEN_","_TMGHRNIEN_",",.02)=TMGHRN
2521"RTN","TMGRPC3F",122,0)
2522 . DO FILE^DIE("","TMGFDA","TMGMSG")
2523"RTN","TMGRPC3F",123,0)
2524 . IF $DATA(TMGMSG("DIERR")) DO
2525"RTN","TMGRPC3F",124,0)
2526 . . SET TMGOUT(0)="1^Success (but see message)^"_TMGIEN
2527"RTN","TMGRPC3F",125,0)
2528 . . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
2529"RTN","TMGRPC3F",126,0)
2530 ELSE DO
2531"RTN","TMGRPC3F",127,0)
2532 . ;"Add new subfile entry for HRN
2533"RTN","TMGRPC3F",128,0)
2534 . SET TMGFDA(9000001.41,TMGLOCIEN_","_TMGHRNIEN_",",.01)=TMGLOCIEN
2535"RTN","TMGRPC3F",129,0)
2536 . SET TMGFDA(9000001.41,TMGLOCIEN_","_TMGHRNIEN_",",.02)=TMGHRN
2537"RTN","TMGRPC3F",130,0)
2538 . DO UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG")
2539"RTN","TMGRPC3F",131,0)
2540 . IF $DATA(TMGMSG("DIERR")) DO
2541"RTN","TMGRPC3F",132,0)
2542 . . SET TMGOUT(0)="1^Success (but see message)^"_TMGIEN
2543"RTN","TMGRPC3F",133,0)
2544 . . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
2545"RTN","TMGRPC3F",134,0)
2546 ;
2547"RTN","TMGRPC3F",135,0)
2548RPTDONE ;
2549"RTN","TMGRPC3F",136,0)
2550 QUIT
2551"RTN","TMGRPC3F",137,0)
2552 ;
2553"RTN","TMGRPC3F",138,0)
2554SRCHPTEXACT(TMGARRAY) ;
2555"RTN","TMGRPC3F",139,0)
2556 ;"Purpose: to search for a preexisting patient, using an exact search
2557"RTN","TMGRPC3F",140,0)
2558 ;" By exact search, I mean that DOE,JOHN would be considered different
2559"RTN","TMGRPC3F",141,0)
2560 ;" from DOE,JOHN H because it is a different ascii string. Etc.
2561"RTN","TMGRPC3F",142,0)
2562 ;" However, see search description below.
2563"RTN","TMGRPC3F",143,0)
2564 ;"Input: TMGARRAY -- PASS BY REFERENCE. Search info. Format:
2565"RTN","TMGRPC3F",144,0)
2566 ;" TMGARRAY(.01)=PatientName, e.g. DOE,JOHN
2567"RTN","TMGRPC3F",145,0)
2568 ;" TMGARRAY(.02)=Sex e.g. M
2569"RTN","TMGRPC3F",146,0)
2570 ;" TMGARRAY(.03)=DOB e.g. 01-04-69 (an external date format)
2571"RTN","TMGRPC3F",147,0)
2572 ;" TMGARRAY(.09)=SSNum e.g. 123-45-6789
2573"RTN","TMGRPC3F",148,0)
2574 ;"Result: returns DFN (patient IEN), or 0^Message if not found.
2575"RTN","TMGRPC3F",149,0)
2576 ;"Notes:
2577"RTN","TMGRPC3F",150,0)
2578 ;" The following are sufficient for search:
2579"RTN","TMGRPC3F",151,0)
2580 ;" -- SSNum only
2581"RTN","TMGRPC3F",152,0)
2582 ;" -- or Name-Sex-DOB
2583"RTN","TMGRPC3F",153,0)
2584 ;"
2585"RTN","TMGRPC3F",154,0)
2586 ;" Search technique:
2587"RTN","TMGRPC3F",155,0)
2588 ;" 1. Search for SSN, if found then no further comparison made.
2589"RTN","TMGRPC3F",156,0)
2590 ;" 2. Search for exact name match, no none found, then exit with 0
2591"RTN","TMGRPC3F",157,0)
2592 ;" 3. ...
2593"RTN","TMGRPC3F",158,0)
2594 ;
2595"RTN","TMGRPC3F",159,0)
2596 NEW TMGRESULT SET TMGRESULT=0
2597"RTN","TMGRPC3F",160,0)
2598 ;
2599"RTN","TMGRPC3F",161,0)
2600 ;"Search by SSN. Quit if match found
2601"RTN","TMGRPC3F",162,0)
2602 NEW TMGSSN SET TMGSSN=$TRANSLATE($GET(TMGARRAY(.09)),"-","")
2603"RTN","TMGRPC3F",163,0)
2604 IF TMGSSN'="" SET TMGRESULT=+$ORDER(^DPT("SSN",TMGSSN,""))
2605"RTN","TMGRPC3F",164,0)
2606 IF TMGRESULT>0 GOTO PSEDONE
2607"RTN","TMGRPC3F",165,0)
2608 ;
2609"RTN","TMGRPC3F",166,0)
2610 NEW TMGNAME,TMGSEX,TMGDOB
2611"RTN","TMGRPC3F",167,0)
2612 SET TMGNAME=$GET(TMGARRAY(.01))
2613"RTN","TMGRPC3F",168,0)
2614 IF TMGNAME="" DO GOTO PSEDONE
2615"RTN","TMGRPC3F",169,0)
2616 . SET TMGRESULT="0^No Name (.01 field) provided"
2617"RTN","TMGRPC3F",170,0)
2618 ;
2619"RTN","TMGRPC3F",171,0)
2620 SET TMGSEX=$GET(TMGARRAY(.02))
2621"RTN","TMGRPC3F",172,0)
2622 IF TMGSEX="" DO GOTO PSEDONE
2623"RTN","TMGRPC3F",173,0)
2624 . SET TMGRESULT="0^Sex (.02 field) not specified"
2625"RTN","TMGRPC3F",174,0)
2626 IF (TMGSEX'="M")&(TMGSEX'="F") DO GOTO PSEDONE
2627"RTN","TMGRPC3F",175,0)
2628 . SET TMGRESULT="0^Sex should be 'Y' or 'N'. Value provided="_TMGSEX
2629"RTN","TMGRPC3F",176,0)
2630 ;
2631"RTN","TMGRPC3F",177,0)
2632 SET TMGDOB=$GET(TMGARRAY(.03))
2633"RTN","TMGRPC3F",178,0)
2634 IF TMGDOB="" DO GOTO PSEDONE
2635"RTN","TMGRPC3F",179,0)
2636 . SET TMGRESULT="0^No DOB (.03 field) provided"
2637"RTN","TMGRPC3F",180,0)
2638 NEW %DT,X,Y SET %DT="P" ;"P-Post dates assumed
2639"RTN","TMGRPC3F",181,0)
2640 SET X=TMGDOB DO ^%DT SET TMGDOB=Y ;"convert external date into internal format
2641"RTN","TMGRPC3F",182,0)
2642 IF +TMGDOB'>0 DO GOTO PSEDONE
2643"RTN","TMGRPC3F",183,0)
2644 . SET TMGRESULT="0^Invalid date: "_$GET(TMGARRAY(.03))
2645"RTN","TMGRPC3F",184,0)
2646 ;
2647"RTN","TMGRPC3F",185,0)
2648 NEW TMGMATCHES MERGE TMGMATCHES=^DPT("B",TMGNAME)
2649"RTN","TMGRPC3F",186,0)
2650 IF $DATA(TMGMATCHES)=0 DO GOTO PSEDONE
2651"RTN","TMGRPC3F",187,0)
2652 . SET TMGRESULT="0^No match for name"
2653"RTN","TMGRPC3F",188,0)
2654 ;
2655"RTN","TMGRPC3F",189,0)
2656 ;"Now compare each name match for also matching sex and DOB
2657"RTN","TMGRPC3F",190,0)
2658 NEW TMGIEN SET TMGIEN=""
2659"RTN","TMGRPC3F",191,0)
2660 FOR SET TMGIEN=$ORDER(TMGMATCHES(TMGIEN)) QUIT:(+TMGIEN'>0) DO
2661"RTN","TMGRPC3F",192,0)
2662 . NEW TMGNODE0 SET TMGNODE0=$GET(^DPT(TMGIEN,0))
2663"RTN","TMGRPC3F",193,0)
2664 . IF $PIECE(TMGNODE0,"^",2)'=TMGSEX DO QUIT
2665"RTN","TMGRPC3F",194,0)
2666 . . KILL TMGMATCHES(TMGIEN)
2667"RTN","TMGRPC3F",195,0)
2668 . IF $PIECE(TMGNODE0,"^",3)'=TMGDOB DO QUIT
2669"RTN","TMGRPC3F",196,0)
2670 . . KILL TMGMATCHES(TMGIEN)
2671"RTN","TMGRPC3F",197,0)
2672 ;
2673"RTN","TMGRPC3F",198,0)
2674 ;"TMGMATCHES should contain all entries matching name+sex+DOB
2675"RTN","TMGRPC3F",199,0)
2676 SET TMGRESULT=+$ORDER(TMGMATCHES(""))
2677"RTN","TMGRPC3F",200,0)
2678 ;"Now check for more than one match
2679"RTN","TMGRPC3F",201,0)
2680 IF $ORDER(TMGMATCHES(TMGRESULT))'="" DO GOTO PSEDONE
2681"RTN","TMGRPC3F",202,0)
2682 . SET TMGRESULT="0^More than one match found for Name+Sex+DOB"
2683"RTN","TMGRPC3F",203,0)
2684 ;
2685"RTN","TMGRPC3F",204,0)
2686PSEDONE ;
2687"RTN","TMGRPC3F",205,0)
2688 QUIT TMGRESULT
2689"RTN","TMGRPC3F",206,0)
2690 ;
2691"RTN","TMGRPC3F",207,0)
2692 ;
2693"RTN","TMGRPC3G")
26940^7^B8609927
2695"RTN","TMGRPC3G",1,0)
2696TMGRPC3G ;TMG/kst/Support Functions for GUI_Config ;08/31/08
2697"RTN","TMGRPC3G",2,0)
2698 ;;1.0;TMG-LIB;**1**;08/31/08
2699"RTN","TMGRPC3G",3,0)
2700 ;
2701"RTN","TMGRPC3G",4,0)
2702 ;"TMG RPC FUNCTIONS for a GUI config program
2703"RTN","TMGRPC3G",5,0)
2704 ;
2705"RTN","TMGRPC3G",6,0)
2706 ;"Kevin Toppenberg MD
2707"RTN","TMGRPC3G",7,0)
2708 ;"GNU Lessor General Public License (LGPL) applies
2709"RTN","TMGRPC3G",8,0)
2710 ;"7/20/08
2711"RTN","TMGRPC3G",9,0)
2712 ;
2713"RTN","TMGRPC3G",10,0)
2714 ;"=======================================================================
2715"RTN","TMGRPC3G",11,0)
2716 ;" RPC -- Public Functions.
2717"RTN","TMGRPC3G",12,0)
2718 ;"=======================================================================
2719"RTN","TMGRPC3G",13,0)
2720 ;" <none>
2721"RTN","TMGRPC3G",14,0)
2722 ;"=======================================================================
2723"RTN","TMGRPC3G",15,0)
2724 ;"PRIVATE API FUNCTIONS
2725"RTN","TMGRPC3G",16,0)
2726 ;"=======================================================================
2727"RTN","TMGRPC3G",17,0)
2728 ;"GETERSTR(TMGEARRAY) -- convert a standard DIERR array into a string for output
2729"RTN","TMGRPC3G",18,0)
2730 ;
2731"RTN","TMGRPC3G",19,0)
2732 ;"=======================================================================
2733"RTN","TMGRPC3G",20,0)
2734 ;"=======================================================================
2735"RTN","TMGRPC3G",21,0)
2736 ;"Dependencies:
2737"RTN","TMGRPC3G",22,0)
2738 ;" TMGRPC3* only
2739"RTN","TMGRPC3G",23,0)
2740 ;
2741"RTN","TMGRPC3G",24,0)
2742 ;"=======================================================================
2743"RTN","TMGRPC3G",25,0)
2744 ;"=======================================================================
2745"RTN","TMGRPC3G",26,0)
2746 ;
2747"RTN","TMGRPC3G",27,0)
2748GETERSTR(TMGEARRAY) ;
2749"RTN","TMGRPC3G",28,0)
2750 ;"Purpose: convert a standard DIERR array into a string for output
2751"RTN","TMGRPC3G",29,0)
2752 ;"Input: TMGEARRAY -- PASS BY REFERENCE. example:
2753"RTN","TMGRPC3G",30,0)
2754 ;" array("DIERR")="1^1"
2755"RTN","TMGRPC3G",31,0)
2756 ;" array("DIERR",1)=311
2757"RTN","TMGRPC3G",32,0)
2758 ;" array("DIERR",1,"PARAM",0)=3
2759"RTN","TMGRPC3G",33,0)
2760 ;" array("DIERR",1,"PARAM","FIELD")=.02
2761"RTN","TMGRPC3G",34,0)
2762 ;" array("DIERR",1,"PARAM","FILE")=2
2763"RTN","TMGRPC3G",35,0)
2764 ;" array("DIERR",1,"PARAM","IENS")="+1,"
2765"RTN","TMGRPC3G",36,0)
2766 ;" array("DIERR",1,"TEXT",1)="The new record '+1,' lacks some required identifiers."
2767"RTN","TMGRPC3G",37,0)
2768 ;" array("DIERR","E",311,1)=""
2769"RTN","TMGRPC3G",38,0)
2770 ;"Results: returns one long equivalent string from above array.
2771"RTN","TMGRPC3G",39,0)
2772 ;"Note: This is a copy of the function GetErrStr^TMGDEBUG
2773"RTN","TMGRPC3G",40,0)
2774 ;" I copied it here so that this file has no TMG* dependencies.
2775"RTN","TMGRPC3G",41,0)
2776 ;
2777"RTN","TMGRPC3G",42,0)
2778 NEW TMGESTR
2779"RTN","TMGRPC3G",43,0)
2780 NEW TMGIDX
2781"RTN","TMGRPC3G",44,0)
2782 NEW TMGENUM
2783"RTN","TMGRPC3G",45,0)
2784 ;
2785"RTN","TMGRPC3G",46,0)
2786 SET TMGESTR=""
2787"RTN","TMGRPC3G",47,0)
2788 FOR TMGENUM=1:1:+$GET(TMGEARRAY("DIERR")) DO
2789"RTN","TMGRPC3G",48,0)
2790 . SET TMGESTR=TMGESTR_"Fileman says: '"
2791"RTN","TMGRPC3G",49,0)
2792 . IF TMGENUM'=1 SET TMGESTR=TMGESTR_"(Error# "_TMGENUM_") "
2793"RTN","TMGRPC3G",50,0)
2794 . SET TMGIDX=$ORDER(TMGEARRAY("DIERR",TMGENUM,"TEXT",""))
2795"RTN","TMGRPC3G",51,0)
2796 . IF TMGIDX'="" FOR DO QUIT:(TMGIDX="")
2797"RTN","TMGRPC3G",52,0)
2798 . . SET TMGESTR=TMGESTR_$GET(TMGEARRAY("DIERR",TMGENUM,"TEXT",TMGIDX))_" "
2799"RTN","TMGRPC3G",53,0)
2800 . . SET TMGIDX=$ORDER(TMGEARRAY("DIERR",TMGENUM,"TEXT",TMGIDX))
2801"RTN","TMGRPC3G",54,0)
2802 . IF $GET(TMGEARRAY("DIERR",TMGENUM,"PARAM",0))>0 DO
2803"RTN","TMGRPC3G",55,0)
2804 . . SET TMGIDX=$ORDER(TMGEARRAY("DIERR",TMGENUM,"PARAM",0))
2805"RTN","TMGRPC3G",56,0)
2806 . . SET TMGESTR=TMGESTR_"Details: "
2807"RTN","TMGRPC3G",57,0)
2808 . . FOR DO QUIT:(TMGIDX="")
2809"RTN","TMGRPC3G",58,0)
2810 . . . IF TMGIDX="" QUIT
2811"RTN","TMGRPC3G",59,0)
2812 . . . SET TMGESTR=TMGESTR_"["_TMGIDX_"]="_$GET(TMGEARRAY("DIERR",1,"PARAM",TMGIDX))_" "
2813"RTN","TMGRPC3G",60,0)
2814 . . . SET TMGIDX=$ORDER(TMGEARRAY("DIERR",TMGENUM,"PARAM",TMGIDX))
2815"RTN","TMGRPC3G",61,0)
2816 ;
2817"RTN","TMGRPC3G",62,0)
2818 QUIT TMGESTR
2819"RTN","TMGRPC3G",63,0)
2820 ;
2821"VER")
28228.0^22.0
2823**END**
2824**END**
Note: See TracBrowser for help on using the repository browser.