source: cprs/branches/GUI-config/KIDS Server patch/TMG_GUI_CONFIG-1.0-3.KID@ 761

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

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