source: cprs/branches/tmg-cprs/Server_KIDS/TMG1-1.0-3.KIDS@ 771

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

Patch for Server-side bug fix
File size: 78.8 KB
Line 
1KIDS Distribution saved on Feb 18, 2009@16:07:34
2Patch KIDS for TMG1-1.0-2d
3**KIDS**:TMG1*1.0*3^
4
5**INSTALL NAME**
6TMG1*1.0*3
7"BLD",6135,0)
8TMG1*1.0*3^^0^3090218^n
9"BLD",6135,1,0)
10^^2^2^3090218^^
11"BLD",6135,1,1,0)
12This is a patch for a bug fix in TMGRPC1
13"BLD",6135,1,2,0)
14It is not a complete set of server code.
15"BLD",6135,4,0)
16^9.64PA^^
17"BLD",6135,6.3)
181
19"BLD",6135,"KRN",0)
20^9.67PA^8989.52^19
21"BLD",6135,"KRN",.4,0)
22.4
23"BLD",6135,"KRN",.401,0)
24.401
25"BLD",6135,"KRN",.402,0)
26.402
27"BLD",6135,"KRN",.403,0)
28.403
29"BLD",6135,"KRN",.5,0)
30.5
31"BLD",6135,"KRN",.84,0)
32.84
33"BLD",6135,"KRN",3.6,0)
343.6
35"BLD",6135,"KRN",3.8,0)
363.8
37"BLD",6135,"KRN",9.2,0)
389.2
39"BLD",6135,"KRN",9.8,0)
409.8
41"BLD",6135,"KRN",9.8,"NM",0)
42^9.68A^1^1
43"BLD",6135,"KRN",9.8,"NM",1,0)
44TMGRPC1^^0^B6434
45"BLD",6135,"KRN",9.8,"NM","B","TMGRPC1",1)
46
47"BLD",6135,"KRN",19,0)
4819
49"BLD",6135,"KRN",19.1,0)
5019.1
51"BLD",6135,"KRN",101,0)
52101
53"BLD",6135,"KRN",409.61,0)
54409.61
55"BLD",6135,"KRN",771,0)
56771
57"BLD",6135,"KRN",870,0)
58870
59"BLD",6135,"KRN",8989.51,0)
608989.51
61"BLD",6135,"KRN",8989.52,0)
628989.52
63"BLD",6135,"KRN",8994,0)
648994
65"BLD",6135,"KRN","B",.4,.4)
66
67"BLD",6135,"KRN","B",.401,.401)
68
69"BLD",6135,"KRN","B",.402,.402)
70
71"BLD",6135,"KRN","B",.403,.403)
72
73"BLD",6135,"KRN","B",.5,.5)
74
75"BLD",6135,"KRN","B",.84,.84)
76
77"BLD",6135,"KRN","B",3.6,3.6)
78
79"BLD",6135,"KRN","B",3.8,3.8)
80
81"BLD",6135,"KRN","B",9.2,9.2)
82
83"BLD",6135,"KRN","B",9.8,9.8)
84
85"BLD",6135,"KRN","B",19,19)
86
87"BLD",6135,"KRN","B",19.1,19.1)
88
89"BLD",6135,"KRN","B",101,101)
90
91"BLD",6135,"KRN","B",409.61,409.61)
92
93"BLD",6135,"KRN","B",771,771)
94
95"BLD",6135,"KRN","B",870,870)
96
97"BLD",6135,"KRN","B",8989.51,8989.51)
98
99"BLD",6135,"KRN","B",8989.52,8989.52)
100
101"BLD",6135,"KRN","B",8994,8994)
102
103"BLD",6135,"QUES",0)
104^9.62^^
105"MBREQ")
1060
107"QUES","XPF1",0)
108Y
109"QUES","XPF1","??")
110^D REP^XPDH
111"QUES","XPF1","A")
112Shall I write over your |FLAG| File
113"QUES","XPF1","B")
114YES
115"QUES","XPF1","M")
116D XPF1^XPDIQ
117"QUES","XPF2",0)
118Y
119"QUES","XPF2","??")
120^D DTA^XPDH
121"QUES","XPF2","A")
122Want my data |FLAG| yours
123"QUES","XPF2","B")
124YES
125"QUES","XPF2","M")
126D XPF2^XPDIQ
127"QUES","XPI1",0)
128YO
129"QUES","XPI1","??")
130^D INHIBIT^XPDH
131"QUES","XPI1","A")
132Want KIDS to INHIBIT LOGONs during the install
133"QUES","XPI1","B")
134YES
135"QUES","XPI1","M")
136D XPI1^XPDIQ
137"QUES","XPM1",0)
138PO^VA(200,:EM
139"QUES","XPM1","??")
140^D MG^XPDH
141"QUES","XPM1","A")
142Enter the Coordinator for Mail Group '|FLAG|'
143"QUES","XPM1","B")
144
145"QUES","XPM1","M")
146D XPM1^XPDIQ
147"QUES","XPO1",0)
148Y
149"QUES","XPO1","??")
150^D MENU^XPDH
151"QUES","XPO1","A")
152Want KIDS to Rebuild Menu Trees Upon Completion of Install
153"QUES","XPO1","B")
154YES
155"QUES","XPO1","M")
156D XPO1^XPDIQ
157"QUES","XPZ1",0)
158Y
159"QUES","XPZ1","??")
160^D OPT^XPDH
161"QUES","XPZ1","A")
162Want to DISABLE Scheduled Options, Menu Options, and Protocols
163"QUES","XPZ1","B")
164YES
165"QUES","XPZ1","M")
166D XPZ1^XPDIQ
167"QUES","XPZ2",0)
168Y
169"QUES","XPZ2","??")
170^D RTN^XPDH
171"QUES","XPZ2","A")
172Want to MOVE routines to other CPUs
173"QUES","XPZ2","B")
174NO
175"QUES","XPZ2","M")
176D XPZ2^XPDIQ
177"RTN")
1781
179"RTN","TMGRPC1")
1800^1^B6434
181"RTN","TMGRPC1",1,0)
182TMGRPC1 ;TMG/kst-RPC Functions ;03/25/06
183"RTN","TMGRPC1",2,0)
184 ;;1.0;TMG-LIB;**1**;06/04/08;Build 1
185"RTN","TMGRPC1",3,0)
186
187"RTN","TMGRPC1",4,0)
188 ;"TMG RPC FUNCTIONS
189"RTN","TMGRPC1",5,0)
190
191"RTN","TMGRPC1",6,0)
192 ;"Kevin Toppenberg MD
193"RTN","TMGRPC1",7,0)
194 ;"GNU General Public License (GPL) applies
195"RTN","TMGRPC1",8,0)
196 ;"3/24/07
197"RTN","TMGRPC1",9,0)
198
199"RTN","TMGRPC1",10,0)
200 ;"=======================================================================
201"RTN","TMGRPC1",11,0)
202 ;" RPC -- Public Functions.
203"RTN","TMGRPC1",12,0)
204 ;"=======================================================================
205"RTN","TMGRPC1",13,0)
206 ;"DOWNLOAD(GREF,FPATH,FNAME,LOCIEN)
207"RTN","TMGRPC1",14,0)
208 ;"UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY)
209"RTN","TMGRPC1",15,0)
210 ;"DOWNDROP(RESULT,FPATH,FNAME,LOCIEN) -- Download drop box file
211"RTN","TMGRPC1",16,0)
212 ;"UPLDDROP(RESULT,FPATH,FNAME,LOCIEN) -- Upload Dropbox File
213"RTN","TMGRPC1",17,0)
214 ;"GETLONG(GREF,IMAGEIEN)
215"RTN","TMGRPC1",18,0)
216 ;"GETDFN(RESULT,RECNUM,RECFIELD,LNAME,FNAME,MNAME,DOB,SEX,SSNUM)
217"RTN","TMGRPC1",19,0)
218 ;"BLANKTIU(RESULT,DFN,PERSON,LOC,DOS,TITLE)
219"RTN","TMGRPC1",20,0)
220 ;"AUTOSIGN(RESULT,DOCIEN)
221"RTN","TMGRPC1",21,0)
222 ;"FNINFO(RESULT,DFN) -- GET PATIENT DEMOGRAPHICS
223"RTN","TMGRPC1",22,0)
224 ;"PTADD(RESULT,INFO) -- ADD PATIENT
225"RTN","TMGRPC1",23,0)
226 ;"STPTINFO(RESULT,DFN,INFO) -- SET PATIENT DEMOGRAPHICS
227"RTN","TMGRPC1",24,0)
228 ;"GETURLS(RESULT) -- TMG CPRS GET URL LIST
229"RTN","TMGRPC1",25,0)
230
231"RTN","TMGRPC1",26,0)
232 ;"=======================================================================
233"RTN","TMGRPC1",27,0)
234 ;"PRIVATE API FUNCTIONS
235"RTN","TMGRPC1",28,0)
236 ;"=======================================================================
237"RTN","TMGRPC1",29,0)
238 ;"ENCODE(GRef,incSubscr,encodeFn)
239"RTN","TMGRPC1",30,0)
240 ;"DECODE(GRef,incSubscr,decodeFn)
241"RTN","TMGRPC1",31,0)
242 ;"$$HEXCODER(INPUT) ;"encode the input string. Currently using simple hex encoding/
243"RTN","TMGRPC1",32,0)
244 ;"$$B64CODER(INPUT) ;"encode the input string via UUENCODE (actually Base64)
245"RTN","TMGRPC1",33,0)
246 ;"$$B64DECODER(INPUT) ;"encode the input string via UUDECODE (actually Base64)
247"RTN","TMGRPC1",34,0)
248
249"RTN","TMGRPC1",35,0)
250 ;"=======================================================================
251"RTN","TMGRPC1",36,0)
252 ;"=======================================================================
253"RTN","TMGRPC1",37,0)
254 ;"Dependencies:
255"RTN","TMGRPC1",38,0)
256 ;"TMGBINF
257"RTN","TMGRPC1",39,0)
258 ;"TMGSTUTL
259"RTN","TMGRPC1",40,0)
260 ;"RGUTUU
261"RTN","TMGRPC1",41,0)
262 ;"=======================================================================
263"RTN","TMGRPC1",42,0)
264 ;"=======================================================================
265"RTN","TMGRPC1",43,0)
266
267"RTN","TMGRPC1",44,0)
268DOWNLOAD(GREF,FPATH,FNAME,LOCIEN)
269"RTN","TMGRPC1",45,0)
270 ;"SCOPE: Public
271"RTN","TMGRPC1",46,0)
272 ;"Purpose: To provide an entry point for a RPC call from a client. The client
273"RTN","TMGRPC1",47,0)
274 ;" will ask for a given file, and it will be passed back in the form
275"RTN","TMGRPC1",48,0)
276 ;" of an array (in BASE64 ascii encoding)
277"RTN","TMGRPC1",49,0)
278 ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE)
279"RTN","TMGRPC1",50,0)
280 ;" FPATH -- the file path up to, but not including, the filename
281"RTN","TMGRPC1",51,0)
282 ;" Use '/' to NOT specify any subdirectory
283"RTN","TMGRPC1",52,0)
284 ;" FNAME -- the name of the file to pass back
285"RTN","TMGRPC1",53,0)
286 ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to download from
287"RTN","TMGRPC1",54,0)
288 ;" default value is 1
289"RTN","TMGRPC1",55,0)
290 ;" Note: For security reasons, all path requests will be considered relative to a root path.
291"RTN","TMGRPC1",56,0)
292 ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve:
293"RTN","TMGRPC1",57,0)
294 ;" /var/local/Dir1/Dir2/download/SomeFile.jpg
295"RTN","TMGRPC1",58,0)
296 ;" This root path is found in custom field 22701 in file 2005.2
297"RTN","TMGRPC1",59,0)
298 ;"Output: results are passed out in @GREF
299"RTN","TMGRPC1",60,0)
300 ;" @GREF@(0)=success; 1=success, 0=failure
301"RTN","TMGRPC1",61,0)
302 ;" @GREF@(1..xxx) = actual data
303"RTN","TMGRPC1",62,0)
304
305"RTN","TMGRPC1",63,0)
306 set FPATH=$get(FPATH)
307"RTN","TMGRPC1",64,0)
308 set FNAME=$get(FNAME)
309"RTN","TMGRPC1",65,0)
310 set LOCIEN=$GET(LOCIEN,1)
311"RTN","TMGRPC1",66,0)
312
313"RTN","TMGRPC1",67,0)
314 new PathRoot
315"RTN","TMGRPC1",68,0)
316 set PathRoot=$piece($get(^MAG(2005.2,LOCIEN,22700)),"^",1) ;"NOTE: CUSTOM FIELD
317"RTN","TMGRPC1",69,0)
318
319"RTN","TMGRPC1",70,0)
320 new NodeDiv
321"RTN","TMGRPC1",71,0)
322 set NodeDiv=$piece($get(^MAG(2005.2,LOCIEN,22701),"/"),"^",1) ;"default is "/" NOTE: CUSTOM FIELD
323"RTN","TMGRPC1",72,0)
324
325"RTN","TMGRPC1",73,0)
326 new EndRoot set EndRoot=$extract(PathRoot,$length(PathRoot))
327"RTN","TMGRPC1",74,0)
328 new StartPath set StartPath=$extract(FPATH,1)
329"RTN","TMGRPC1",75,0)
330
331"RTN","TMGRPC1",76,0)
332 if (EndRoot=NodeDiv)&(StartPath=NodeDiv) do
333"RTN","TMGRPC1",77,0)
334 . set FPATH=$extract(FPATH,2,1024)
335"RTN","TMGRPC1",78,0)
336 else if (EndRoot'=NodeDiv)&(StartPath'=NodeDiv) do
337"RTN","TMGRPC1",79,0)
338 . set PathRoot=PathRoot_NodeDiv
339"RTN","TMGRPC1",80,0)
340
341"RTN","TMGRPC1",81,0)
342 set FPATH=PathRoot_FPATH
343"RTN","TMGRPC1",82,0)
344
345"RTN","TMGRPC1",83,0)
346 set GREF="^TMP(""DOWNLOAD^TMGRPC1"","_$J_")"
347"RTN","TMGRPC1",84,0)
348
349"RTN","TMGRPC1",85,0)
350 kill @GREF
351"RTN","TMGRPC1",86,0)
352 set @GREF@(0)=$$BFTG^TMGBINF(.FPATH,.FNAME,$name(@GREF@(1)),3)
353"RTN","TMGRPC1",87,0)
354
355"RTN","TMGRPC1",88,0)
356 do ENCODE($name(@GREF@(1)),3)
357"RTN","TMGRPC1",89,0)
358
359"RTN","TMGRPC1",90,0)
360 quit
361"RTN","TMGRPC1",91,0)
362
363"RTN","TMGRPC1",92,0)
364
365"RTN","TMGRPC1",93,0)
366UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY)
367"RTN","TMGRPC1",94,0)
368 ;"SCOPE: Public
369"RTN","TMGRPC1",95,0)
370 ;"RPC That calls this: TMG UPLOAD FILE
371"RTN","TMGRPC1",96,0)
372 ;"Purpose: To provide an entry point for a RPC call from a client. The client
373"RTN","TMGRPC1",97,0)
374 ;" will provide a file for upload (in BASE64 ascii encoding)
375"RTN","TMGRPC1",98,0)
376 ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE)
377"RTN","TMGRPC1",99,0)
378 ;" FPATH -- the file path up to, but not including, the filename
379"RTN","TMGRPC1",100,0)
380 ;" Use '/' to NOT specify any subdirectory
381"RTN","TMGRPC1",101,0)
382 ;" FNAME -- the name of the file to pass back
383"RTN","TMGRPC1",102,0)
384 ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to upload to
385"RTN","TMGRPC1",103,0)
386 ;" default value is 1
387"RTN","TMGRPC1",104,0)
388 ;" Note: For security reasons, all path requests will be considered relative to a root path.
389"RTN","TMGRPC1",105,0)
390 ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve:
391"RTN","TMGRPC1",106,0)
392 ;" /var/local/Dir1/Dir2/download/SomeFile.jpg
393"RTN","TMGRPC1",107,0)
394 ;" This root path is found in custom field 22701 in file 2005.2
395"RTN","TMGRPC1",108,0)
396 ;" ARRAY -- the array that will hold the file, in BASE64 ascii encoding
397"RTN","TMGRPC1",109,0)
398 ;"Output: results are passed out in RESULT: 1^SuccessMessage or 0^FailureMessage
399"RTN","TMGRPC1",110,0)
400
401"RTN","TMGRPC1",111,0)
402 new result
403"RTN","TMGRPC1",112,0)
404 new resultMsg set resultMsg="1^Successful Upload"
405"RTN","TMGRPC1",113,0)
406
407"RTN","TMGRPC1",114,0)
408 set ^TMP("UPLOAD^TMGRPC1",$J,"FPATH")=$GET(FPATH)
409"RTN","TMGRPC1",115,0)
410 set ^TMP("UPLOAD^TMGRPC1",$J,"FNAME")=$GET(FNAME)
411"RTN","TMGRPC1",116,0)
412 set ^TMP("UPLOAD^TMGRPC1",$J,"LOCIEN")=$GET(LOCIEN)
413"RTN","TMGRPC1",117,0)
414
415"RTN","TMGRPC1",118,0)
416 if $data(ARRAY)=0 set resultMsg="0^No data received to upload" goto UpDone
417"RTN","TMGRPC1",119,0)
418 set FPATH=$get(FPATH)
419"RTN","TMGRPC1",120,0)
420 if FPATH="" set resultMsg="0^No file path received" goto UpDone
421"RTN","TMGRPC1",121,0)
422 set FNAME=$get(FNAME)
423"RTN","TMGRPC1",122,0)
424 if FNAME="" set resultMsg="0^No file name received" goto UpDone
425"RTN","TMGRPC1",123,0)
426 set LOCIEN=$GET(LOCIEN,1);
427"RTN","TMGRPC1",124,0)
428 new GREF
429"RTN","TMGRPC1",125,0)
430
431"RTN","TMGRPC1",126,0)
432 new PathRoot
433"RTN","TMGRPC1",127,0)
434 set PathRoot=$piece($get(^MAG(2005.2,LOCIEN,22700)),"^",1)
435"RTN","TMGRPC1",128,0)
436
437"RTN","TMGRPC1",129,0)
438 new NodeDiv
439"RTN","TMGRPC1",130,0)
440 set NodeDiv=$piece($get(^MAG(2005.2,LOCIEN,22701),"/"),"^",1) ;"default is "/"
441"RTN","TMGRPC1",131,0)
442
443"RTN","TMGRPC1",132,0)
444 new EndRoot set EndRoot=$extract(PathRoot,$length(PathRoot))
445"RTN","TMGRPC1",133,0)
446 new StartPath set StartPath=$extract(FPATH,1)
447"RTN","TMGRPC1",134,0)
448 if (EndRoot=NodeDiv)&(StartPath=NodeDiv) do
449"RTN","TMGRPC1",135,0)
450 . set FPATH=$extract(FPATH,2,1024)
451"RTN","TMGRPC1",136,0)
452 else if (EndRoot'=NodeDiv)&(StartPath'=NodeDiv) do
453"RTN","TMGRPC1",137,0)
454 . set PathRoot=PathRoot_NodeDiv
455"RTN","TMGRPC1",138,0)
456
457"RTN","TMGRPC1",139,0)
458 set FPATH=PathRoot_FPATH
459"RTN","TMGRPC1",140,0)
460
461"RTN","TMGRPC1",141,0)
462 merge ^TMP("UPLOAD^TMGRPC1",$J,"ENCODED")=ARRAY ;"//TEMP
463"RTN","TMGRPC1",142,0)
464 do DECODE("ARRAY(0)",1)
465"RTN","TMGRPC1",143,0)
466 merge ^TMP("UPLOAD^TMGRPC1",$J,"DECODED")=ARRAY ;"//TEMP
467"RTN","TMGRPC1",144,0)
468
469"RTN","TMGRPC1",145,0)
470 if $$GTBF^TMGBINF("ARRAY(0)",1,FPATH,FNAME)=0 do
471"RTN","TMGRPC1",146,0)
472 . set resultMsg="0^Error while saving file"
473"RTN","TMGRPC1",147,0)
474
475"RTN","TMGRPC1",148,0)
476UpDone
477"RTN","TMGRPC1",149,0)
478 set RESULT=resultMsg
479"RTN","TMGRPC1",150,0)
480 quit
481"RTN","TMGRPC1",151,0)
482
483"RTN","TMGRPC1",152,0)
484
485"RTN","TMGRPC1",153,0)
486DOWNDROP(RESULT,FPATH,FNAME,LOCIEN) ;"i.e. Download drop box file
487"RTN","TMGRPC1",154,0)
488 ;"SCOPE: Public
489"RTN","TMGRPC1",155,0)
490 ;"RPC That calls this: TMG DOWNLOAD FILE DROPBOX
491"RTN","TMGRPC1",156,0)
492 ;"Purpose: To provide an entry point for a RPC call from a client. The client
493"RTN","TMGRPC1",157,0)
494 ;" will request for the file to be placed into in a 'dropbox' file
495"RTN","TMGRPC1",158,0)
496 ;" location that both the client and server can access. File may be
497"RTN","TMGRPC1",159,0)
498 ;" moved from there to its final destination by the client.
499"RTN","TMGRPC1",160,0)
500 ;" This method alloows file-hiding ability on the server side.
501"RTN","TMGRPC1",161,0)
502 ;"Input: RESULT -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE)
503"RTN","TMGRPC1",162,0)
504 ;" FPATH -- the file path up to, but not including, the filename. This
505"RTN","TMGRPC1",163,0)
506 ;" is the path that the file is stored at (relative to a root path,
507"RTN","TMGRPC1",164,0)
508 ;" see comments below). It is NOT the path of the dropbox.
509"RTN","TMGRPC1",165,0)
510 ;" Use '/' to NOT specify any subdirectory
511"RTN","TMGRPC1",166,0)
512 ;" FNAME -- the name of the file to be uploaded. Note: This is also the
513"RTN","TMGRPC1",167,0)
514 ;" name of the file to be put into the dropbox. It is the
515"RTN","TMGRPC1",168,0)
516 ;" responsibility of the client to ensure that there is not already
517"RTN","TMGRPC1",169,0)
518 ;" a similarly named file in the dropbox before requesting a file
519"RTN","TMGRPC1",170,0)
520 ;" be put there. It is the responsibility of the client to delete
521"RTN","TMGRPC1",171,0)
522 ;" the file from the drop box.
523"RTN","TMGRPC1",172,0)
524 ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to download from
525"RTN","TMGRPC1",173,0)
526 ;" default value is 1
527"RTN","TMGRPC1",174,0)
528 ;" Note: For security reasons, all path requests will be considered relative to a root path.
529"RTN","TMGRPC1",175,0)
530 ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve:
531"RTN","TMGRPC1",176,0)
532 ;" /var/local/Dir1/Dir2/download/SomeFile.jpg
533"RTN","TMGRPC1",177,0)
534 ;" This root path is found in custom field 22701 in file 2005.2
535"RTN","TMGRPC1",178,0)
536 ;" Also: dropbox location is obtained from custom field 22702 in file 2005.2
537"RTN","TMGRPC1",179,0)
538 ;"NOTE RE DROPBOX:
539"RTN","TMGRPC1",180,0)
540 ;" This system is designed for a system where by the server and the client have a
541"RTN","TMGRPC1",181,0)
542 ;" shared filesystem, but the directory paths will be different. For example:
543"RTN","TMGRPC1",182,0)
544 ;" Linux server has dropbox at: /mnt/WinServer/dropbox/
545"RTN","TMGRPC1",183,0)
546 ;" Windows Client has access to dropbox at: V:\Dropbox\
547"RTN","TMGRPC1",184,0)
548
549"RTN","TMGRPC1",185,0)
550 ;"Output: results are 1^Success, or 0^Error Message
551"RTN","TMGRPC1",186,0)
552
553"RTN","TMGRPC1",187,0)
554 new resultMsg set resultMsg="1^Successful Download"
555"RTN","TMGRPC1",188,0)
556
557"RTN","TMGRPC1",189,0)
558 set FPATH=$get(FPATH)
559"RTN","TMGRPC1",190,0)
560 if FPATH="" set resultMsg="0^No file path received" goto DnDBxDone
561"RTN","TMGRPC1",191,0)
562 set FNAME=$get(FNAME)
563"RTN","TMGRPC1",192,0)
564 if FNAME="" set resultMsg="0^No file name received" goto DnDBxDone
565"RTN","TMGRPC1",193,0)
566 set LOCIEN=$GET(LOCIEN,1);
567"RTN","TMGRPC1",194,0)
568 new GREF
569"RTN","TMGRPC1",195,0)
570
571"RTN","TMGRPC1",196,0)
572 new PathRoot
573"RTN","TMGRPC1",197,0)
574 set PathRoot=$piece($get(^MAG(2005.2,LOCIEN,22700)),"^",1)
575"RTN","TMGRPC1",198,0)
576
577"RTN","TMGRPC1",199,0)
578 new NodeDiv
579"RTN","TMGRPC1",200,0)
580 set NodeDiv=$piece($get(^MAG(2005.2,LOCIEN,22701),"/"),"^",1) ;"default is "/"
581"RTN","TMGRPC1",201,0)
582
583"RTN","TMGRPC1",202,0)
584 new DropBox
585"RTN","TMGRPC1",203,0)
586 set DropBox=$piece($get(^MAG(2005.2,LOCIEN,22702)),"^",1)
587"RTN","TMGRPC1",204,0)
588 if DropBox="" do goto UpDBxDone
589"RTN","TMGRPC1",205,0)
590 . set resultMsg="0^Dropbox location not configured in file 2005.2, IEN "_LOCIEN_", field 22702"
591"RTN","TMGRPC1",206,0)
592 ;"Ensure DropBox ends in a node divider
593"RTN","TMGRPC1",207,0)
594 if $extract(DropBox,$length(DropBox))'=NodeDiv do
595"RTN","TMGRPC1",208,0)
596 . set DropBox=DropBox_NodeDiv
597"RTN","TMGRPC1",209,0)
598
599"RTN","TMGRPC1",210,0)
600 ;"Ensure PathRoot ends in a node divider
601"RTN","TMGRPC1",211,0)
602 if $extract(PathRoot,$length(PathRoot))'=NodeDiv do
603"RTN","TMGRPC1",212,0)
604 . set PathRoot=PathRoot_NodeDiv
605"RTN","TMGRPC1",213,0)
606
607"RTN","TMGRPC1",214,0)
608 ;"Ensure Fpath does NOT start in a node divider
609"RTN","TMGRPC1",215,0)
610 if $extract(FPATH,1)=NodeDiv do
611"RTN","TMGRPC1",216,0)
612 . set FPATH=$extract(FPATH,2,1024)
613"RTN","TMGRPC1",217,0)
614
615"RTN","TMGRPC1",218,0)
616 set FPATH=PathRoot_FPATH
617"RTN","TMGRPC1",219,0)
618
619"RTN","TMGRPC1",220,0)
620 new SrcNamePath set SrcNamePath=FPATH_FNAME
621"RTN","TMGRPC1",221,0)
622 ;"new DestNamePath set DestNamePath=DropBox_FNAME
623"RTN","TMGRPC1",222,0)
624
625"RTN","TMGRPC1",223,0)
626 new moveResult
627"RTN","TMGRPC1",224,0)
628 set moveResult=$$Copy^TMGKERNL(SrcNamePath,DropBox)
629"RTN","TMGRPC1",225,0)
630 if moveResult>0 do
631"RTN","TMGRPC1",226,0)
632 . set resultMsg="0^Move failed, returning OS error code: "_moveResult
633"RTN","TMGRPC1",227,0)
634
635"RTN","TMGRPC1",228,0)
636DnDBxDone
637"RTN","TMGRPC1",229,0)
638 set RESULT=resultMsg
639"RTN","TMGRPC1",230,0)
640 quit
641"RTN","TMGRPC1",231,0)
642
643"RTN","TMGRPC1",232,0)
644
645"RTN","TMGRPC1",233,0)
646UPLDDROP(RESULT,FPATH,FNAME,LOCIEN) ;"i.e. Upload Dropbox File
647"RTN","TMGRPC1",234,0)
648 ;"SCOPE: Public
649"RTN","TMGRPC1",235,0)
650 ;"RPC That calls this: TMG UPLOAD FILE DROPBOX
651"RTN","TMGRPC1",236,0)
652 ;"Purpose: To provide an entry point for a RPC call from a client. The client
653"RTN","TMGRPC1",237,0)
654 ;" will put the file in a 'dropbox' file location that both the client
655"RTN","TMGRPC1",238,0)
656 ;" and server can access. File will be moved from there to its final
657"RTN","TMGRPC1",239,0)
658 ;" destination. This will provide file-hiding ability on the server side.
659"RTN","TMGRPC1",240,0)
660 ;"Input: RESULT -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE)
661"RTN","TMGRPC1",241,0)
662 ;" FPATH -- the file path up to, but not including, the filename. This
663"RTN","TMGRPC1",242,0)
664 ;" is the path to store the file at. (relative to a root path,
665"RTN","TMGRPC1",243,0)
666 ;" see comments below). It is NOT the path of the dropbox.
667"RTN","TMGRPC1",244,0)
668 ;" Use '/' to NOT specify any subdirectory
669"RTN","TMGRPC1",245,0)
670 ;" FNAME -- the name of the file to be uploaded. Note: This is also the
671"RTN","TMGRPC1",246,0)
672 ;" name of the file to be pulled from the dropbox. It is the
673"RTN","TMGRPC1",247,0)
674 ;" responsibility of the client to ensure that there is not already
675"RTN","TMGRPC1",248,0)
676 ;" a similarly named file in the dropbox before depositing a file there.
677"RTN","TMGRPC1",249,0)
678 ;" The server will remove the file from the dropbox, unless there is
679"RTN","TMGRPC1",250,0)
680 ;" an error with the host OS (which will be returned as an error message)
681"RTN","TMGRPC1",251,0)
682 ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to upload to
683"RTN","TMGRPC1",252,0)
684 ;" default value is 1
685"RTN","TMGRPC1",253,0)
686 ;" Note: For security reasons, all path requests will be considered relative to a root path.
687"RTN","TMGRPC1",254,0)
688 ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve:
689"RTN","TMGRPC1",255,0)
690 ;" /var/local/Dir1/Dir2/download/SomeFile.jpg
691"RTN","TMGRPC1",256,0)
692 ;" This root path is found in custom field 22700 in file 2005.2
693"RTN","TMGRPC1",257,0)
694 ;" Also: dropbox location is obtained from custom field 22702 in file 2005.2
695"RTN","TMGRPC1",258,0)
696 ;"NOTE RE DROPBOX:
697"RTN","TMGRPC1",259,0)
698 ;" This system is designed for a system where by the server and the client have a
699"RTN","TMGRPC1",260,0)
700 ;" shared filesystem, but the directory paths will be different. For example:
701"RTN","TMGRPC1",261,0)
702 ;" Linux server has dropbox at: /mnt/WinServer/dropbox/
703"RTN","TMGRPC1",262,0)
704 ;" Windows Client has access to dropbox at: V:\Dropbox\
705"RTN","TMGRPC1",263,0)
706
707"RTN","TMGRPC1",264,0)
708 ;"Output: results are passed out in RESULT:
709"RTN","TMGRPC1",265,0)
710 ;" 1^SuccessMessage or 0^FailureMessage
711"RTN","TMGRPC1",266,0)
712
713"RTN","TMGRPC1",267,0)
714 new result
715"RTN","TMGRPC1",268,0)
716 new resultMsg set resultMsg="1^Successful Upload"
717"RTN","TMGRPC1",269,0)
718
719"RTN","TMGRPC1",270,0)
720 set FPATH=$get(FPATH)
721"RTN","TMGRPC1",271,0)
722 if FPATH="" set resultMsg="0^No file path received" goto UpDBxDone
723"RTN","TMGRPC1",272,0)
724 set FNAME=$get(FNAME)
725"RTN","TMGRPC1",273,0)
726 if FNAME="" set resultMsg="0^No file name received" goto UpDBxDone
727"RTN","TMGRPC1",274,0)
728 set LOCIEN=$GET(LOCIEN,1);
729"RTN","TMGRPC1",275,0)
730 new GREF
731"RTN","TMGRPC1",276,0)
732
733"RTN","TMGRPC1",277,0)
734 new PathRoot
735"RTN","TMGRPC1",278,0)
736 set PathRoot=$piece($get(^MAG(2005.2,LOCIEN,22700)),"^",1)
737"RTN","TMGRPC1",279,0)
738
739"RTN","TMGRPC1",280,0)
740 new NodeDiv
741"RTN","TMGRPC1",281,0)
742 set NodeDiv=$piece($get(^MAG(2005.2,LOCIEN,22701),"/"),"^",1) ;"default is "/"
743"RTN","TMGRPC1",282,0)
744
745"RTN","TMGRPC1",283,0)
746 new DropBox
747"RTN","TMGRPC1",284,0)
748 set DropBox=$piece($get(^MAG(2005.2,LOCIEN,22702)),"^",1)
749"RTN","TMGRPC1",285,0)
750 if DropBox="" do goto UpDBxDone
751"RTN","TMGRPC1",286,0)
752 . set resultMsg="0^Dropbox location not configured in file 2005.2, IEN "_LOCIEN_", field 22702"
753"RTN","TMGRPC1",287,0)
754 ;"Ensure DropBox ends in a node divider
755"RTN","TMGRPC1",288,0)
756 if $extract(DropBox,$length(DropBox))'=NodeDiv do
757"RTN","TMGRPC1",289,0)
758 . set DropBox=DropBox_NodeDiv
759"RTN","TMGRPC1",290,0)
760
761"RTN","TMGRPC1",291,0)
762 ;"Ensure PathRoot ends in a node divider
763"RTN","TMGRPC1",292,0)
764 if $extract(PathRoot,$length(PathRoot))'=NodeDiv do
765"RTN","TMGRPC1",293,0)
766 . set PathRoot=PathRoot_NodeDiv
767"RTN","TMGRPC1",294,0)
768
769"RTN","TMGRPC1",295,0)
770 ;"Ensure Fpath does NOT start in a node divider
771"RTN","TMGRPC1",296,0)
772 if $extract(FPATH,1)=NodeDiv do
773"RTN","TMGRPC1",297,0)
774 . set FPATH=$extract(FPATH,2,1024)
775"RTN","TMGRPC1",298,0)
776
777"RTN","TMGRPC1",299,0)
778 set FPATH=PathRoot_FPATH
779"RTN","TMGRPC1",300,0)
780
781"RTN","TMGRPC1",301,0)
782 new SrcNamePath,DestNamePath
783"RTN","TMGRPC1",302,0)
784 set SrcNamePath=DropBox_FNAME
785"RTN","TMGRPC1",303,0)
786 set DestNamePath=FPATH_FNAME
787"RTN","TMGRPC1",304,0)
788
789"RTN","TMGRPC1",305,0)
790 new moveResult
791"RTN","TMGRPC1",306,0)
792 set moveResult=$$Move^TMGKERNL(SrcNamePath,DestNamePath)
793"RTN","TMGRPC1",307,0)
794 if moveResult>0 do
795"RTN","TMGRPC1",308,0)
796 . set resultMsg="0^Move failed, returning OS error code: "_moveResult
797"RTN","TMGRPC1",309,0)
798
799"RTN","TMGRPC1",310,0)
800UpDBxDone
801"RTN","TMGRPC1",311,0)
802 set RESULT=resultMsg
803"RTN","TMGRPC1",312,0)
804 quit
805"RTN","TMGRPC1",313,0)
806
807"RTN","TMGRPC1",314,0)
808
809"RTN","TMGRPC1",315,0)
810ENCODE(GRef,incSubscr,encodeFn)
811"RTN","TMGRPC1",316,0)
812 ;"Purpose: ENCODE a BINARY GLOBAL.
813"RTN","TMGRPC1",317,0)
814 ;"Input:
815"RTN","TMGRPC1",318,0)
816 ;" GRef-- Global reference of the SOURCE binary global array, in fully resolved
817"RTN","TMGRPC1",319,0)
818 ;" (closed root) format.
819"RTN","TMGRPC1",320,0)
820 ;" Note:
821"RTN","TMGRPC1",321,0)
822 ;" At least one subscript must be numeric. This will be the incrementing
823"RTN","TMGRPC1",322,0)
824 ;" subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment
825"RTN","TMGRPC1",323,0)
826 ;" to store each new global node). This subscript need not be the final
827"RTN","TMGRPC1",324,0)
828 ;" subscript. For example, to load into a WORD PROCESSING field, the
829"RTN","TMGRPC1",325,0)
830 ;" incrementing node is the second-to-last subscript; the final subscript
831"RTN","TMGRPC1",326,0)
832 ;" is always zero.
833"RTN","TMGRPC1",327,0)
834 ;" REQUIRED
835"RTN","TMGRPC1",328,0)
836 ;" incSubscr-- (required) Identifies the incrementing subscript level, for the source global
837"RTN","TMGRPC1",329,0)
838 ;" For example, if you pass ^TMP(115,1,1,0) as the global_ref parameter and
839"RTN","TMGRPC1",330,0)
840 ;" pass 3 as the inc_subscr parameter, $$BIN2GBL will increment the third
841"RTN","TMGRPC1",331,0)
842 ;" subscript, such as ^TMP(115,1,x), but will WRITE notes at the full global
843"RTN","TMGRPC1",332,0)
844 ;" reference, such as ^TMP(115,1,x,0).
845"RTN","TMGRPC1",333,0)
846 ;" REQUIRED
847"RTN","TMGRPC1",334,0)
848 ;" encodeFn- (OPTIONAL) the name of a function that will encode a line of data.
849"RTN","TMGRPC1",335,0)
850 ;" e.g. "CODER^ZZZCODER" or "LOCALCODER". The function should
851"RTN","TMGRPC1",336,0)
852 ;" take one input variable (the line of raw binary data), and return a converted
853"RTN","TMGRPC1",337,0)
854 ;" line. e.g.
855"RTN","TMGRPC1",338,0)
856 ;" CODER(INPUT)
857"RTN","TMGRPC1",339,0)
858 ;" ... ;"convert INPUT to RESULT
859"RTN","TMGRPC1",340,0)
860 ;" QUIT RESULT
861"RTN","TMGRPC1",341,0)
862 ;" default value is B64CODER^TMGRPC1
863"RTN","TMGRPC1",342,0)
864 ;"
865"RTN","TMGRPC1",343,0)
866 ;"Output: @GRef is converted to encoded data
867"RTN","TMGRPC1",344,0)
868 ;"Result: None
869"RTN","TMGRPC1",345,0)
870
871"RTN","TMGRPC1",346,0)
872 if $get(GRef)="" goto EncodeDone
873"RTN","TMGRPC1",347,0)
874 if $get(incSubscr)="" goto EncodeDone
875"RTN","TMGRPC1",348,0)
876
877"RTN","TMGRPC1",349,0)
878 set encodeFn=$get(encodeFn,"B64CODER")
879"RTN","TMGRPC1",350,0)
880
881"RTN","TMGRPC1",351,0)
882 new encoder
883"RTN","TMGRPC1",352,0)
884 set encoder="set temp=$$"_encodeFn_"(.temp)"
885"RTN","TMGRPC1",353,0)
886
887"RTN","TMGRPC1",354,0)
888 for do quit:(GRef="")
889"RTN","TMGRPC1",355,0)
890 . new temp
891"RTN","TMGRPC1",356,0)
892 . set temp=$get(@GRef)
893"RTN","TMGRPC1",357,0)
894 . if temp="" set GRef="" quit
895"RTN","TMGRPC1",358,0)
896 . xecute encoder ;"i.e. set temp=$$encoderFn(.temp)
897"RTN","TMGRPC1",359,0)
898 . set @GRef=temp
899"RTN","TMGRPC1",360,0)
900 . set GRef=$$NEXTNODE^TMGBINF(GRef,incSubscr,1,1)
901"RTN","TMGRPC1",361,0)
902
903"RTN","TMGRPC1",362,0)
904EncodeDone
905"RTN","TMGRPC1",363,0)
906 quit
907"RTN","TMGRPC1",364,0)
908
909"RTN","TMGRPC1",365,0)
910
911"RTN","TMGRPC1",366,0)
912HEXCODER(INPUT)
913"RTN","TMGRPC1",367,0)
914 ;"Purpose: to encode the input string. Currently using simple hex encoding/
915"RTN","TMGRPC1",368,0)
916 quit $$STRB2H^TMGSTUTL(.INPUT,0,1)
917"RTN","TMGRPC1",369,0)
918
919"RTN","TMGRPC1",370,0)
920
921"RTN","TMGRPC1",371,0)
922B64CODER(INPUT)
923"RTN","TMGRPC1",372,0)
924 ;"Purpose: to encode the input string via UUENCODE (actually Base64)
925"RTN","TMGRPC1",373,0)
926 quit $$ENCODE^RGUTUU(.INPUT)
927"RTN","TMGRPC1",374,0)
928
929"RTN","TMGRPC1",375,0)
930B64DECODER(INPUT)
931"RTN","TMGRPC1",376,0)
932 ;"Purpose: to encode the input string via UUENCODE (actually Base64)
933"RTN","TMGRPC1",377,0)
934 quit $$DECODE^RGUTUU(.INPUT)
935"RTN","TMGRPC1",378,0)
936
937"RTN","TMGRPC1",379,0)
938
939"RTN","TMGRPC1",380,0)
940DECODE(GRef,incSubscr,decodeFn)
941"RTN","TMGRPC1",381,0)
942 ;"Purpose: ENCODE a BINARY GLOBAL.
943"RTN","TMGRPC1",382,0)
944 ;"Input:
945"RTN","TMGRPC1",383,0)
946 ;" GRef-- Global reference of the SOURCE binary global array, in fully resolved
947"RTN","TMGRPC1",384,0)
948 ;" (closed root) format.
949"RTN","TMGRPC1",385,0)
950 ;" Note:
951"RTN","TMGRPC1",386,0)
952 ;" At least one subscript must be numeric. This will be the incrementing
953"RTN","TMGRPC1",387,0)
954 ;" subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment
955"RTN","TMGRPC1",388,0)
956 ;" to store each new global node). This subscript need not be the final
957"RTN","TMGRPC1",389,0)
958 ;" subscript. For example, to load into a WORD PROCESSING field, the
959"RTN","TMGRPC1",390,0)
960 ;" incrementing node is the second-to-last subscript; the final subscript
961"RTN","TMGRPC1",391,0)
962 ;" is always zero.
963"RTN","TMGRPC1",392,0)
964 ;" REQUIRED
965"RTN","TMGRPC1",393,0)
966 ;" incSubscr-- (required) Identifies the incrementing subscript level, for the source global
967"RTN","TMGRPC1",394,0)
968 ;" For example, if you pass ^TMP(115,1,1,0) as the global_ref parameter and
969"RTN","TMGRPC1",395,0)
970 ;" pass 3 as the inc_subscr parameter, $$BIN2GBL will increment the third
971"RTN","TMGRPC1",396,0)
972 ;" subscript, such as ^TMP(115,1,x), but will WRITE notes at the full global
973"RTN","TMGRPC1",397,0)
974 ;" reference, such as ^TMP(115,1,x,0).
975"RTN","TMGRPC1",398,0)
976 ;" REQUIRED
977"RTN","TMGRPC1",399,0)
978 ;" decodeFn- (OPTIONAL) the name of a function that will decode a line of data.
979"RTN","TMGRPC1",400,0)
980 ;" e.g. "DECODER^ZZZCODER" or "DECODER". The function should take
981"RTN","TMGRPC1",401,0)
982 ;" one input variable (the line of encoded data), and return a decoded line. e.g.
983"RTN","TMGRPC1",402,0)
984 ;" DECODER(INPUT)
985"RTN","TMGRPC1",403,0)
986 ;" ... ;"convert INPUT to RESULT
987"RTN","TMGRPC1",404,0)
988 ;" QUIT RESULT
989"RTN","TMGRPC1",405,0)
990 ;" default value is B64DECODER^TMGRPC1
991"RTN","TMGRPC1",406,0)
992 ;"
993"RTN","TMGRPC1",407,0)
994 ;"Output: @GRef is converted to decoded data
995"RTN","TMGRPC1",408,0)
996 ;"Result: None
997"RTN","TMGRPC1",409,0)
998
999"RTN","TMGRPC1",410,0)
1000 if $get(GRef)="" goto DecodeDone
1001"RTN","TMGRPC1",411,0)
1002 if $get(incSubscr)="" goto DecodeDone
1003"RTN","TMGRPC1",412,0)
1004 set decodeFn=$get(decodeFn,"B64DECODER")
1005"RTN","TMGRPC1",413,0)
1006
1007"RTN","TMGRPC1",414,0)
1008 new decoder
1009"RTN","TMGRPC1",415,0)
1010 set decoder="set temp=$$"_decodeFn_"(.temp)"
1011"RTN","TMGRPC1",416,0)
1012
1013"RTN","TMGRPC1",417,0)
1014 for do quit:(GRef="")
1015"RTN","TMGRPC1",418,0)
1016 . new temp
1017"RTN","TMGRPC1",419,0)
1018 . set temp=$get(@GRef)
1019"RTN","TMGRPC1",420,0)
1020 . if temp="" set GRef="" quit
1021"RTN","TMGRPC1",421,0)
1022 . xecute decoder ;"i.e. set temp=$$decoderFn(.temp)
1023"RTN","TMGRPC1",422,0)
1024 . set @GRef=temp
1025"RTN","TMGRPC1",423,0)
1026 . set GRef=$$NEXTNODE^TMGBINF(GRef,incSubscr,1,1)
1027"RTN","TMGRPC1",424,0)
1028
1029"RTN","TMGRPC1",425,0)
1030DecodeDone
1031"RTN","TMGRPC1",426,0)
1032 quit
1033"RTN","TMGRPC1",427,0)
1034
1035"RTN","TMGRPC1",428,0)
1036
1037"RTN","TMGRPC1",429,0)
1038GETLONG(GREF,IMAGEIEN)
1039"RTN","TMGRPC1",430,0)
1040 ;"SCOPE: Public
1041"RTN","TMGRPC1",431,0)
1042 ;"Purpose: To provide an entry point for a RPC call from a client.
1043"RTN","TMGRPC1",432,0)
1044 ;" Will return results of field 11 (LONG DESCRIPTION) from file IMAGE(2005)
1045"RTN","TMGRPC1",433,0)
1046 ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE)
1047"RTN","TMGRPC1",434,0)
1048 ;" IMAGEIEN-- The IEN (record number) from file 2005 (IMAGE)
1049"RTN","TMGRPC1",435,0)
1050 ;"Output: results are passed out in @GREF
1051"RTN","TMGRPC1",436,0)
1052 ;" @GREF@(0) = WP header line: format is: ^^MaxLine^MaxLine^TimeStamp(FM Date/Time Format)
1053"RTN","TMGRPC1",437,0)
1054 ;" @GREF@(1) = WP line 1
1055"RTN","TMGRPC1",438,0)
1056 ;" @GREF@(2) = WP line 2
1057"RTN","TMGRPC1",439,0)
1058 ;" @GREF@(3) = WP line 3
1059"RTN","TMGRPC1",440,0)
1060 ;" @GREF@(4) = WP line 4 ... etc.
1061"RTN","TMGRPC1",441,0)
1062
1063"RTN","TMGRPC1",442,0)
1064 set GREF="^TMP(""GETLONG^TMGRPC1"","_$J_")"
1065"RTN","TMGRPC1",443,0)
1066
1067"RTN","TMGRPC1",444,0)
1068 kill @GREF
1069"RTN","TMGRPC1",445,0)
1070
1071"RTN","TMGRPC1",446,0)
1072 new i,s,MaxLines,header
1073"RTN","TMGRPC1",447,0)
1074 set header=""
1075"RTN","TMGRPC1",448,0)
1076 if +$get(IMAGEIEN)>0 do
1077"RTN","TMGRPC1",449,0)
1078 . set header=$get(^MAG(2005,IMAGEIEN,3,0)) ;"NOTE: Field 11 held in node 3;0
1079"RTN","TMGRPC1",450,0)
1080 set @GREF@(0)=header
1081"RTN","TMGRPC1",451,0)
1082 set MaxLines=+$piece(header,"^",3)
1083"RTN","TMGRPC1",452,0)
1084 for i=1:1:MaxLines do
1085"RTN","TMGRPC1",453,0)
1086 . set @GREF@(i)=$get(^MAG(2005,IMAGEIEN,3,i,0))
1087"RTN","TMGRPC1",454,0)
1088
1089"RTN","TMGRPC1",455,0)
1090 quit
1091"RTN","TMGRPC1",456,0)
1092
1093"RTN","TMGRPC1",457,0)
1094
1095"RTN","TMGRPC1",458,0)
1096
1097"RTN","TMGRPC1",459,0)
1098GETDFN(RESULT,RECNUM,PMS,FNAME,LNAME,MNAME,DOB,SEX,SSNUM,AUTOADD)
1099"RTN","TMGRPC1",460,0)
1100 ;"Purpose: This is a RPC entry point for looking up a patient.
1101"RTN","TMGRPC1",461,0)
1102 ;"Input:
1103"RTN","TMGRPC1",462,0)
1104 ;" RESULT -- an OUT PARAMETER
1105"RTN","TMGRPC1",463,0)
1106 ;" RECNUM -- Record number from a PMS
1107"RTN","TMGRPC1",464,0)
1108 ;" PMS -- Which PMS RECNUM refers to (1=Medic,2=Sequel,3=Paradigm)
1109"RTN","TMGRPC1",465,0)
1110 ;" FNAME -- First Name
1111"RTN","TMGRPC1",466,0)
1112 ;" LNAME -- Last name
1113"RTN","TMGRPC1",467,0)
1114 ;" MNAME -- Middle Name or initial
1115"RTN","TMGRPC1",468,0)
1116 ;" DOB -- Date of birth in EXTERNAL format
1117"RTN","TMGRPC1",469,0)
1118 ;" SEX -- Patient sex: M or F
1119"RTN","TMGRPC1",470,0)
1120 ;" SSNUM -- Social security number (digits only)
1121"RTN","TMGRPC1",471,0)
1122 ;" AUTOADD -- Automatically register patient if needed (if value=1)
1123"RTN","TMGRPC1",472,0)
1124 ;"Output: Patient may be added to database if AUTOADD=1
1125"RTN","TMGRPC1",473,0)
1126 ;"Results: Returns DFN (i.e. IEN in PATIENT file) or -1 if not found or error
1127"RTN","TMGRPC1",474,0)
1128
1129"RTN","TMGRPC1",475,0)
1130 new Patient,TMGFREG
1131"RTN","TMGRPC1",476,0)
1132 set RESULT=-1 ;"default to not found
1133"RTN","TMGRPC1",477,0)
1134
1135"RTN","TMGRPC1",478,0)
1136 if $get(LNAME)'="" do
1137"RTN","TMGRPC1",479,0)
1138 . set Patient("NAME")=$get(LNAME)
1139"RTN","TMGRPC1",480,0)
1140 . if $get(FNAME)'="" set Patient("NAME")=Patient("NAME")_","_FNAME
1141"RTN","TMGRPC1",481,0)
1142 . if $get(MNAME)'="" set Patient("NAME")=Patient("NAME")_" "_MNAME
1143"RTN","TMGRPC1",482,0)
1144 set Patient("DOB")=$get(DOB)
1145"RTN","TMGRPC1",483,0)
1146 set Patient("SEX")=$get(SEX)
1147"RTN","TMGRPC1",484,0)
1148 set Patient("SSNUM")=$get(SSNUM)
1149"RTN","TMGRPC1",485,0)
1150test if $get(AUTOADD)=1 set TMGFREG=1
1151"RTN","TMGRPC1",486,0)
1152
1153"RTN","TMGRPC1",487,0)
1154 if $get(PMS)=1 set Patient("PATIENTNUM")=$get(RECNUM) ;" <-- Medic account number
1155"RTN","TMGRPC1",488,0)
1156 if $get(PMS)=2 set Patient("SEQUELNUM")=$get(RECNUM) ;" <-- Sequel or other account number
1157"RTN","TMGRPC1",489,0)
1158 if $get(PMS)=3 set Patient("PARADIGMNUM")=$get(RECNUM) ;" <-- Paradigm or other account number
1159"RTN","TMGRPC1",490,0)
1160
1161"RTN","TMGRPC1",491,0)
1162 ;"temp
1163"RTN","TMGRPC1",492,0)
1164 ;"merge ^TMG("TMP","GETDFN","KILLLATER")=Patient
1165"RTN","TMGRPC1",493,0)
1166 ;"set ^TMG("TMP","GETDFN","KILLLATER","FNAME")=FNAME
1167"RTN","TMGRPC1",494,0)
1168 ;"set ^TMG("TMP","GETDFN","KILLLATER","LNAME")=LNAME
1169"RTN","TMGRPC1",495,0)
1170 ;"set ^TMG("TMP","GETDFN","KILLLATER","MNAME")=MNAME
1171"RTN","TMGRPC1",496,0)
1172
1173"RTN","TMGRPC1",497,0)
1174 set RESULT=$$GetDFN^TMGGDFN(.Patient)
1175"RTN","TMGRPC1",498,0)
1176
1177"RTN","TMGRPC1",499,0)
1178 quit
1179"RTN","TMGRPC1",500,0)
1180
1181"RTN","TMGRPC1",501,0)
1182
1183"RTN","TMGRPC1",502,0)
1184BLANKTIU(RESULT,DFN,PERSON,LOC,DOS,TITLE)
1185"RTN","TMGRPC1",503,0)
1186 ;"Purpose: To create a new, blank TIU note and return it's IEN
1187"RTN","TMGRPC1",504,0)
1188 ;"Input: DFN -- IEN in PATIENT file of patient
1189"RTN","TMGRPC1",505,0)
1190 ;" PERSON -- Provider NAME
1191"RTN","TMGRPC1",506,0)
1192 ;" LOC -- Location for new document
1193"RTN","TMGRPC1",507,0)
1194 ;" DOS -- Date of Service
1195"RTN","TMGRPC1",508,0)
1196 ;" TITLE -- Title of new document
1197"RTN","TMGRPC1",509,0)
1198 ;"Results: IEN in file 8925 is returned in RESULT,
1199"RTN","TMGRPC1",510,0)
1200 ;" or -1^ErrMsg1;ErrMsg2... if failure
1201"RTN","TMGRPC1",511,0)
1202 ;"Note: This functionality probably duplicates that of RPC call:
1203"RTN","TMGRPC1",512,0)
1204 ;" TIU CREATE NOTE -- found after writing this...
1205"RTN","TMGRPC1",513,0)
1206
1207"RTN","TMGRPC1",514,0)
1208 new Document,Flag
1209"RTN","TMGRPC1",515,0)
1210
1211"RTN","TMGRPC1",516,0)
1212 set Document("DFN")=DFN
1213"RTN","TMGRPC1",517,0)
1214 set Document("PROVIDER IEN")=$$GetProvIEN^TMGPUTN0(PERSON)
1215"RTN","TMGRPC1",518,0)
1216 set Document("LOCATION")=$get(LOC)
1217"RTN","TMGRPC1",519,0)
1218 set Document("DATE")=$get(DOS)
1219"RTN","TMGRPC1",520,0)
1220 set Document("TITLE")=$get(TITLE)
1221"RTN","TMGRPC1",521,0)
1222 set Document("TRANSCRIPTIONIST")=""
1223"RTN","TMGRPC1",522,0)
1224 set Document("CHARACTER COUNT - TRANSCRIPTIONIST'S")=0
1225"RTN","TMGRPC1",523,0)
1226
1227"RTN","TMGRPC1",524,0)
1228 set RESULT=$$PrepDoc^TMGPUTN0(.Document)
1229"RTN","TMGRPC1",525,0)
1230 if +RESULT>0 do ;"change capture method from Upload (default) to RPC
1231"RTN","TMGRPC1",526,0)
1232 . new TMGFDA,TMGMSG
1233"RTN","TMGRPC1",527,0)
1234 . set TMGFDA(8925,RESULT_",",1303)="R" ;"1303 = capture method. "R" = RPC
1235"RTN","TMGRPC1",528,0)
1236 . do FILE^DIE("E","TMGFDA","TMGMSG") ;"ignore any errors.
1237"RTN","TMGRPC1",529,0)
1238 else do
1239"RTN","TMGRPC1",530,0)
1240 . new i,ErrMsg set ErrMsg=""
1241"RTN","TMGRPC1",531,0)
1242 . for i=1:1:+$get(Document("ERROR","NUM")) do
1243"RTN","TMGRPC1",532,0)
1244 . . set ErrMsg=ErrMsg_$get(Document("ERROR",i))_" ||"
1245"RTN","TMGRPC1",533,0)
1246 . if $data(Document("ERROR","FM INFO"))>0 do
1247"RTN","TMGRPC1",534,0)
1248 . . new ref set ref="Document(""ERROR"",""FM INFO"")"
1249"RTN","TMGRPC1",535,0)
1250 . . set ErrMsg=ErrMsg_"FILEMAN SAYS:"
1251"RTN","TMGRPC1",536,0)
1252 . . for set ref=$query(@ref) quit:(ref="")!(ref'["FM INFO") do
1253"RTN","TMGRPC1",537,0)
1254 . . . if ErrMsg'="" set ErrMsg=ErrMsg_" ||"
1255"RTN","TMGRPC1",538,0)
1256 . . . set ErrMsg=ErrMsg_$piece(ref,"DIERR",2)_"="_$get(@ref)
1257"RTN","TMGRPC1",539,0)
1258 . if ErrMsg="" set ErrMsg="Unknown error"
1259"RTN","TMGRPC1",540,0)
1260 . set ErrMsg=$translate(ErrMsg,"^","@")
1261"RTN","TMGRPC1",541,0)
1262 . set $piece(RESULT,"^",2)=ErrMsg
1263"RTN","TMGRPC1",542,0)
1264
1265"RTN","TMGRPC1",543,0)
1266 ;"temp
1267"RTN","TMGRPC1",544,0)
1268 merge ^TMG("TMP","BLANKTIU","RESULT")=RESULT
1269"RTN","TMGRPC1",545,0)
1270 merge ^TMG("TMP","BLANKTIU","Document")=Document
1271"RTN","TMGRPC1",546,0)
1272
1273"RTN","TMGRPC1",547,0)
1274
1275"RTN","TMGRPC1",548,0)
1276 quit
1277"RTN","TMGRPC1",549,0)
1278
1279"RTN","TMGRPC1",550,0)
1280
1281"RTN","TMGRPC1",551,0)
1282AUTOSIGN(RESULT,DOCIEN)
1283"RTN","TMGRPC1",552,0)
1284 ;"Purpose: To automatically sign TIU note (8925).
1285"RTN","TMGRPC1",553,0)
1286 ;"Input: DOCIEN -- the IEN in 8925 of the file to be automatically signed.
1287"RTN","TMGRPC1",554,0)
1288 ;"Note: This function will not succeed unless field 1303 holds "R"
1289"RTN","TMGRPC1",555,0)
1290 ;" and an Author found for note
1291"RTN","TMGRPC1",556,0)
1292 ;"Results: Results passed back in RESULT(0) ARRAY
1293"RTN","TMGRPC1",557,0)
1294 ;" -1 = failure. 1= success
1295"RTN","TMGRPC1",558,0)
1296 ;" Any error message is passed back in RESULT("DIERR")
1297"RTN","TMGRPC1",559,0)
1298 ;"Note: This differs from RPC CALL: TIU SIGN RECORD in that a signiture
1299"RTN","TMGRPC1",560,0)
1300 ;" code is NOT required
1301"RTN","TMGRPC1",561,0)
1302
1303"RTN","TMGRPC1",562,0)
1304 new TMGFDA,TMGMSG
1305"RTN","TMGRPC1",563,0)
1306 new AuthorIEN,AuthorName
1307"RTN","TMGRPC1",564,0)
1308 new CaptureMethod
1309"RTN","TMGRPC1",565,0)
1310
1311"RTN","TMGRPC1",566,0)
1312 set DOCIEN=+$get(DOCIEN)
1313"RTN","TMGRPC1",567,0)
1314 set RESULT=-1 ;"default to failure
1315"RTN","TMGRPC1",568,0)
1316
1317"RTN","TMGRPC1",569,0)
1318 set CaptureMethod=$piece($get(^TIU(8925,DOCIEN,13)),"^",3)
1319"RTN","TMGRPC1",570,0)
1320 if CaptureMethod'="R" do goto ASDone
1321"RTN","TMGRPC1",571,0)
1322 . set RESULT("DIERR")="Unable to auto-sign. Upload-Method was not 'R'."
1323"RTN","TMGRPC1",572,0)
1324 set AuthorIEN=$piece($get(^TIU(8925,DOCIEN,12)),"^",2)
1325"RTN","TMGRPC1",573,0)
1326 if AuthorIEN'>0 do goto ASDone
1327"RTN","TMGRPC1",574,0)
1328 . set RESULT("DIERR")="Unable to find author of document."
1329"RTN","TMGRPC1",575,0)
1330 set AuthorName=$piece($get(^VA(200,AuthorIEN,0)),"^",1)
1331"RTN","TMGRPC1",576,0)
1332
1333"RTN","TMGRPC1",577,0)
1334 set TMGFDA(8925,DOCIEN_",",.05)="COMPLETED" ;"field .05 = STATUS
1335"RTN","TMGRPC1",578,0)
1336 set TMGFDA(8925,DOCIEN_",",1501)="NOW" ;"field 1501 = Signed date
1337"RTN","TMGRPC1",579,0)
1338 set TMGFDA(8925,DOCIEN_",",1502)="`"_AuthorIEN ;"field 1502 = signed by
1339"RTN","TMGRPC1",580,0)
1340 set TMGFDA(8925,DOCIEN_",",1503)=AuthorName ;"field 1503 = Signature block name
1341"RTN","TMGRPC1",581,0)
1342 set TMGFDA(8925,DOCIEN_",",1504)="[Scanned image auto-signed]" ;"field 1504 = Signature block title
1343"RTN","TMGRPC1",582,0)
1344 set TMGFDA(8925,DOCIEN_",",1505)="C" ;C=Chart ;"field 1505 = Signature mode
1345"RTN","TMGRPC1",583,0)
1346 do FILE^DIE("E","TMGFDA","TMGMSG")
1347"RTN","TMGRPC1",584,0)
1348 if $data(TMGMSG("DIERR")) do goto ASDone
1349"RTN","TMGRPC1",585,0)
1350 . merge RESULT("DIERR")=TMGMSG("DIERR")
1351"RTN","TMGRPC1",586,0)
1352
1353"RTN","TMGRPC1",587,0)
1354 set RESULT(0)=1 ;"set success if we got this far.
1355"RTN","TMGRPC1",588,0)
1356ASDone
1357"RTN","TMGRPC1",589,0)
1358 quit
1359"RTN","TMGRPC1",590,0)
1360
1361"RTN","TMGRPC1",591,0)
1362
1363"RTN","TMGRPC1",592,0)
1364DFNINFO(RESULT,DFN)
1365"RTN","TMGRPC1",593,0)
1366 ;"Purpose: To return array with demographcs details about patient
1367"RTN","TMGRPC1",594,0)
1368 ;"Input: RESULT (this is the output array)
1369"RTN","TMGRPC1",595,0)
1370 ;" DFN : The record number in file #2 of the patient to inquire about.
1371"RTN","TMGRPC1",596,0)
1372 ;"Results: Results passed back in RESULT array. Format as follows:
1373"RTN","TMGRPC1",597,0)
1374 ;" The results are in format: KeyName=Value,
1375"RTN","TMGRPC1",598,0)
1376 ;" There is no set order these will appear.
1377"RTN","TMGRPC1",599,0)
1378 ;" Here are the KeyName names that will be provided.
1379"RTN","TMGRPC1",600,0)
1380 ;" If the record has no value, then value will be empty
1381"RTN","TMGRPC1",601,0)
1382 ;" IEN=record#
1383"RTN","TMGRPC1",602,0)
1384 ;" COMBINED_NAME=
1385"RTN","TMGRPC1",603,0)
1386 ;" LNAME=
1387"RTN","TMGRPC1",604,0)
1388 ;" FNAME=
1389"RTN","TMGRPC1",605,0)
1390 ;" MNAME=
1391"RTN","TMGRPC1",606,0)
1392 ;" PREFIX=
1393"RTN","TMGRPC1",607,0)
1394 ;" SUFFIX=
1395"RTN","TMGRPC1",608,0)
1396 ;" DEGREE
1397"RTN","TMGRPC1",609,0)
1398 ;" DOB=
1399"RTN","TMGRPC1",610,0)
1400 ;" SEX=
1401"RTN","TMGRPC1",611,0)
1402 ;" SS_NUM=
1403"RTN","TMGRPC1",612,0)
1404 ;" ADDRESS_LINE_1=
1405"RTN","TMGRPC1",613,0)
1406 ;" ADDRESS_LINE_2=
1407"RTN","TMGRPC1",614,0)
1408 ;" ADDRESS_LINE_3=
1409"RTN","TMGRPC1",615,0)
1410 ;" CITY=
1411"RTN","TMGRPC1",616,0)
1412 ;" STATE=
1413"RTN","TMGRPC1",617,0)
1414 ;" ZIP4=
1415"RTN","TMGRPC1",618,0)
1416 ;" BAD_ADDRESS=
1417"RTN","TMGRPC1",619,0)
1418 ;" TEMP_ADDRESS_LINE_1=
1419"RTN","TMGRPC1",620,0)
1420 ;" TEMP_ADDRESS_LINE_2=
1421"RTN","TMGRPC1",621,0)
1422 ;" TEMP_ADDRESS_LINE_3=
1423"RTN","TMGRPC1",622,0)
1424 ;" TEMP_CITY=
1425"RTN","TMGRPC1",623,0)
1426 ;" TEMP_STATE=
1427"RTN","TMGRPC1",624,0)
1428 ;" TEMP_ZIP4=
1429"RTN","TMGRPC1",625,0)
1430 ;" TEMP_STARTING_DATE=
1431"RTN","TMGRPC1",626,0)
1432 ;" TEMP_ENDING_DATE=
1433"RTN","TMGRPC1",627,0)
1434 ;" TEMP_ADDRESS_ACTIVE=
1435"RTN","TMGRPC1",628,0)
1436 ;" CONF_ADDRESS_LINE_1=
1437"RTN","TMGRPC1",629,0)
1438 ;" CONF_ADDRESS_LINE_2=
1439"RTN","TMGRPC1",630,0)
1440 ;" CONF_ADDRESS_LINE_3=
1441"RTN","TMGRPC1",631,0)
1442 ;" CONF_CITY=
1443"RTN","TMGRPC1",632,0)
1444 ;" CONF_STATE=
1445"RTN","TMGRPC1",633,0)
1446 ;" CONF_ZIP4=
1447"RTN","TMGRPC1",634,0)
1448 ;" CONF_STARTING_DATE=
1449"RTN","TMGRPC1",635,0)
1450 ;" CONF_ENDING_DATE=
1451"RTN","TMGRPC1",636,0)
1452 ;" CONF_ADDRESS_ACTIVE=
1453"RTN","TMGRPC1",637,0)
1454 ;" PHONE_RESIDENCE=
1455"RTN","TMGRPC1",638,0)
1456 ;" PHONE_WORK=
1457"RTN","TMGRPC1",639,0)
1458 ;" PHONE_CELL=
1459"RTN","TMGRPC1",640,0)
1460 ;" PHONE_TEMP=
1461"RTN","TMGRPC1",641,0)
1462
1463"RTN","TMGRPC1",642,0)
1464 ;"Note, for the following, there may be multiple entries. # is record number
1465"RTN","TMGRPC1",643,0)
1466 ;" ALIAS # NAME
1467"RTN","TMGRPC1",644,0)
1468 ;" ALIAS # SSN
1469"RTN","TMGRPC1",645,0)
1470
1471"RTN","TMGRPC1",646,0)
1472 new TMGFDA,TMGMSG,IENS
1473"RTN","TMGRPC1",647,0)
1474 set IENS=""
1475"RTN","TMGRPC1",648,0)
1476 new ptrParts set ptrParts=0
1477"RTN","TMGRPC1",649,0)
1478 set DFN=+$get(DFN)
1479"RTN","TMGRPC1",650,0)
1480 if DFN>0 do
1481"RTN","TMGRPC1",651,0)
1482 . set ptrParts=+$piece($get(^DPT(DFN,"NAME")),"^",1) ;"ptr to file #20, NAME COMPONENTS
1483"RTN","TMGRPC1",652,0)
1484 . set IENS=DFN_","
1485"RTN","TMGRPC1",653,0)
1486 . do GETS^DIQ(2,IENS,"**","N","TMGFDA","TMGMSG")
1487"RTN","TMGRPC1",654,0)
1488
1489"RTN","TMGRPC1",655,0)
1490 new line set line=0
1491"RTN","TMGRPC1",656,0)
1492 set RESULT(line)="IEN="_DFN set line=line+1
1493"RTN","TMGRPC1",657,0)
1494 set RESULT(line)="COMBINED_NAME="_$get(TMGFDA(2,IENS,.01)) set line=line+1
1495"RTN","TMGRPC1",658,0)
1496 new s set s=""
1497"RTN","TMGRPC1",659,0)
1498 if ptrParts>0 set s=$get(^VA(20,ptrParts,1))
1499"RTN","TMGRPC1",660,0)
1500 set RESULT(line)="LNAME="_$piece(s,"^",1) set line=line+1
1501"RTN","TMGRPC1",661,0)
1502 set RESULT(line)="FNAME="_$piece(s,"^",2) set line=line+1
1503"RTN","TMGRPC1",662,0)
1504 set RESULT(line)="MNAME="_$piece(s,"^",3) set line=line+1
1505"RTN","TMGRPC1",663,0)
1506 set RESULT(line)="PREFIX="_$piece(s,"^",4) set line=line+1
1507"RTN","TMGRPC1",664,0)
1508 set RESULT(line)="SUFFIX="_$piece(s,"^",5) set line=line+1
1509"RTN","TMGRPC1",665,0)
1510 set RESULT(line)="DEGREE="_$piece(s,"^",5) set line=line+1
1511"RTN","TMGRPC1",666,0)
1512 set RESULT(line)="DOB="_$get(TMGFDA(2,IENS,.03)) set line=line+1
1513"RTN","TMGRPC1",667,0)
1514 set RESULT(line)="SEX="_$get(TMGFDA(2,IENS,.02)) set line=line+1
1515"RTN","TMGRPC1",668,0)
1516 set RESULT(line)="SS_NUM="_$get(TMGFDA(2,IENS,.09)) set line=line+1
1517"RTN","TMGRPC1",669,0)
1518 set RESULT(line)="ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.111)) set line=line+1
1519"RTN","TMGRPC1",670,0)
1520 set RESULT(line)="ADDRESS_LINE_2="_$get(TMGFDA(2,IENS,.112)) set line=line+1
1521"RTN","TMGRPC1",671,0)
1522 set RESULT(line)="ADDRESS_LINE_3="_$get(TMGFDA(2,IENS,.113)) set line=line+1
1523"RTN","TMGRPC1",672,0)
1524 set RESULT(line)="CITY="_$get(TMGFDA(2,IENS,.114)) set line=line+1
1525"RTN","TMGRPC1",673,0)
1526 set RESULT(line)="STATE="_$get(TMGFDA(2,IENS,.115)) set line=line+1
1527"RTN","TMGRPC1",674,0)
1528 if $get(TMGFDA(2,IENS,.1112))'="" do
1529"RTN","TMGRPC1",675,0)
1530 . set RESULT(line)="ZIP4="_$get(TMGFDA(2,IENS,.1112)) set line=line+1
1531"RTN","TMGRPC1",676,0)
1532 else if $get(TMGFDA(2,IENS,.1116))'="" do
1533"RTN","TMGRPC1",677,0)
1534 . set RESULT(line)="ZIP4="_$get(TMGFDA(2,IENS,.1116)) set line=line+1
1535"RTN","TMGRPC1",678,0)
1536 set RESULT(line)="BAD_ADDRESS="_$get(TMGFDA(2,IENS,.121)) set line=line+1
1537"RTN","TMGRPC1",679,0)
1538 set RESULT(line)="TEMP_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1211)) set line=line+1
1539"RTN","TMGRPC1",680,0)
1540 set RESULT(line)="TEMP_ADDRESS_LINE_2="_$get(TMGFDA(2,IENS,.1212)) set line=line+1
1541"RTN","TMGRPC1",681,0)
1542 set RESULT(line)="TEMP_ADDRESS_LINE_3="_$get(TMGFDA(2,IENS,.1213)) set line=line+1
1543"RTN","TMGRPC1",682,0)
1544 set RESULT(line)="TEMP_CITY="_$get(TMGFDA(2,IENS,.1214)) set line=line+1
1545"RTN","TMGRPC1",683,0)
1546 set RESULT(line)="TEMP_STATE="_$get(TMGFDA(2,IENS,.1215)) set line=line+1
1547"RTN","TMGRPC1",684,0)
1548 set RESULT(line)="TEMP_ZIP4="_$get(TMGFDA(2,IENS,.1216)) set line=line+1
1549"RTN","TMGRPC1",685,0)
1550 set RESULT(line)="TEMP_STARTING_DATE="_$get(TMGFDA(2,IENS,.1217)) set line=line+1
1551"RTN","TMGRPC1",686,0)
1552 set RESULT(line)="TEMP_ENDING_DATE="_$get(TMGFDA(2,IENS,.1218)) set line=line+1
1553"RTN","TMGRPC1",687,0)
1554 set RESULT(line)="TEMP_ADDRESS_ACTIVE="_$get(TMGFDA(2,IENS,.12105)) set line=line+1
1555"RTN","TMGRPC1",688,0)
1556 set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1411)) set line=line+1
1557"RTN","TMGRPC1",689,0)
1558 set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1412)) set line=line+1
1559"RTN","TMGRPC1",690,0)
1560 set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1413)) set line=line+1
1561"RTN","TMGRPC1",691,0)
1562 set RESULT(line)="CONF_CITY="_$get(TMGFDA(2,IENS,.1414)) set line=line+1
1563"RTN","TMGRPC1",692,0)
1564 set RESULT(line)="CONF_STATE="_$get(TMGFDA(2,IENS,.1415)) set line=line+1
1565"RTN","TMGRPC1",693,0)
1566 set RESULT(line)="CONF_ZIP4="_$get(TMGFDA(2,IENS,.1416)) set line=line+1
1567"RTN","TMGRPC1",694,0)
1568 set RESULT(line)="CONF_STARTING_DATE="_$get(TMGFDA(2,IENS,.1417)) set line=line+1
1569"RTN","TMGRPC1",695,0)
1570 set RESULT(line)="CONF_ENDING_DATE="_$get(TMGFDA(2,IENS,.1418)) set line=line+1
1571"RTN","TMGRPC1",696,0)
1572 set RESULT(line)="CONF_ADDRESS_ACTIVE="_$get(TMGFDA(2,IENS,.14105)) set line=line+1
1573"RTN","TMGRPC1",697,0)
1574 set RESULT(line)="PHONE_RESIDENCE="_$get(TMGFDA(2,IENS,.131)) set line=line+1
1575"RTN","TMGRPC1",698,0)
1576 set RESULT(line)="PHONE_WORK="_$get(TMGFDA(2,IENS,.132)) set line=line+1
1577"RTN","TMGRPC1",699,0)
1578 set RESULT(line)="PHONE_CELL="_$get(TMGFDA(2,IENS,.133)) set line=line+1
1579"RTN","TMGRPC1",700,0)
1580 set RESULT(line)="PHONE_TEMP="_$get(TMGFDA(2,IENS,.1219)) set line=line+1
1581"RTN","TMGRPC1",701,0)
1582
1583"RTN","TMGRPC1",702,0)
1584 ;"the GETS doesn't return ALIAS entries, so will do manually:
1585"RTN","TMGRPC1",703,0)
1586 new Itr,IEN
1587"RTN","TMGRPC1",704,0)
1588 set IEN=$$ItrInit^TMGITR(2.01,.Itr,DFN_",")
1589"RTN","TMGRPC1",705,0)
1590 if IEN'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN)'>0)
1591"RTN","TMGRPC1",706,0)
1592 . new s set s=$get(^DPT(DFN,.01,IEN,0))
1593"RTN","TMGRPC1",707,0)
1594 . if s="" quit
1595"RTN","TMGRPC1",708,0)
1596 . set RESULT(line)="ALIAS "_IEN_" NAME="_$piece(s,"^",1) set line=line+1
1597"RTN","TMGRPC1",709,0)
1598 . set RESULT(line)="ALIAS "_IEN_" SSN="_$piece(s,"^",2) set line=line+1
1599"RTN","TMGRPC1",710,0)
1600 . ;"maybe later do something with NAME COMPONENTS in Alias.
1601"RTN","TMGRPC1",711,0)
1602
1603"RTN","TMGRPC1",712,0)
1604 quit
1605"RTN","TMGRPC1",713,0)
1606
1607"RTN","TMGRPC1",714,0)
1608
1609"RTN","TMGRPC1",715,0)
1610STPTINFO(RESULT,DFN,INFO) ;" SET PATIENT INFO
1611"RTN","TMGRPC1",716,0)
1612 ;"Purpose: To set demographcs details about patient
1613"RTN","TMGRPC1",717,0)
1614 ;"Input: RESULT (this is the output array)
1615"RTN","TMGRPC1",718,0)
1616 ;" DFN : The record number in file #2 of the patient to inquire about.
1617"RTN","TMGRPC1",719,0)
1618 ;" INFO: Format as follows:
1619"RTN","TMGRPC1",720,0)
1620 ;" The results are in format: INFO("KeyName")=Value,
1621"RTN","TMGRPC1",721,0)
1622 ;" There is no set order these will appear.
1623"RTN","TMGRPC1",722,0)
1624 ;" Here are the KeyName names that will be provided.
1625"RTN","TMGRPC1",723,0)
1626 ;" If the record has no value, then value will be empty
1627"RTN","TMGRPC1",724,0)
1628 ;" If a record should be deleted, its value will be @
1629"RTN","TMGRPC1",725,0)
1630 ;" INFO("COMBINED_NAME")=
1631"RTN","TMGRPC1",726,0)
1632 ;" INFO("PREFIX")=
1633"RTN","TMGRPC1",727,0)
1634 ;" INFO("SUFFIX")=
1635"RTN","TMGRPC1",728,0)
1636 ;" INFO("DEGREE")=
1637"RTN","TMGRPC1",729,0)
1638 ;" INFO("DOB")=
1639"RTN","TMGRPC1",730,0)
1640 ;" INFO("SEX")=
1641"RTN","TMGRPC1",731,0)
1642 ;" INFO("SS_NUM")=
1643"RTN","TMGRPC1",732,0)
1644 ;" INFO("ADDRESS_LINE_1")=
1645"RTN","TMGRPC1",733,0)
1646 ;" INFO("ADDRESS_LINE_2")=
1647"RTN","TMGRPC1",734,0)
1648 ;" INFO("ADDRESS_LINE_3")=
1649"RTN","TMGRPC1",735,0)
1650 ;" INFO("CITY")=
1651"RTN","TMGRPC1",736,0)
1652 ;" INFO("STATE")=
1653"RTN","TMGRPC1",737,0)
1654 ;" INFO("ZIP4")=
1655"RTN","TMGRPC1",738,0)
1656 ;" INFO("BAD_ADDRESS")=
1657"RTN","TMGRPC1",739,0)
1658 ;" INFO("TEMP_ADDRESS_LINE_1")=
1659"RTN","TMGRPC1",740,0)
1660 ;" INFO("TEMP_ADDRESS_LINE_2")=
1661"RTN","TMGRPC1",741,0)
1662 ;" INFO("TEMP_ADDRESS_LINE_3")=
1663"RTN","TMGRPC1",742,0)
1664 ;" INFO("TEMP_CITY")=
1665"RTN","TMGRPC1",743,0)
1666 ;" INFO("TEMP_STATE")=
1667"RTN","TMGRPC1",744,0)
1668 ;" INFO("TEMP_ZIP4")=
1669"RTN","TMGRPC1",745,0)
1670 ;" INFO("TEMP_STARTING_DATE")=
1671"RTN","TMGRPC1",746,0)
1672 ;" INFO("TEMP_ENDING_DATE")=
1673"RTN","TMGRPC1",747,0)
1674 ;" INFO("TEMP_ADDRESS_ACTIVE")=
1675"RTN","TMGRPC1",748,0)
1676 ;" INFO("CONF_ADDRESS_LINE_1")=
1677"RTN","TMGRPC1",749,0)
1678 ;" INFO("CONF_ADDRESS_LINE_2")=
1679"RTN","TMGRPC1",750,0)
1680 ;" INFO("CONF_ADDRESS_LINE_3")=
1681"RTN","TMGRPC1",751,0)
1682 ;" INFO("CONF_CITY")=
1683"RTN","TMGRPC1",752,0)
1684 ;" INFO("CONF_STATE")=
1685"RTN","TMGRPC1",753,0)
1686 ;" INFO("CONF_ZIP4")=
1687"RTN","TMGRPC1",754,0)
1688 ;" INFO("CONF_STARTING_DATE")=
1689"RTN","TMGRPC1",755,0)
1690 ;" INFO("CONF_ENDING_DATE")=
1691"RTN","TMGRPC1",756,0)
1692 ;" INFO("CONF_ADDRESS_ACTIVE")=
1693"RTN","TMGRPC1",757,0)
1694 ;" INFO("PHONE_RESIDENCE")=
1695"RTN","TMGRPC1",758,0)
1696 ;" INFO("PHONE_WORK")=
1697"RTN","TMGRPC1",759,0)
1698 ;" INFO("PHONE_CELL")=
1699"RTN","TMGRPC1",760,0)
1700 ;" INFO("PHONE_TEMP")=
1701"RTN","TMGRPC1",761,0)
1702 ;"Note, for the following, there may be multiple entries. # is record number
1703"RTN","TMGRPC1",762,0)
1704 ;" If a record should be added, it will be marked +1, +2 etc.
1705"RTN","TMGRPC1",763,0)
1706 ;" INFO("ALIAS # NAME")=
1707"RTN","TMGRPC1",764,0)
1708 ;" INFO("ALIAS # SSN")=
1709"RTN","TMGRPC1",765,0)
1710 ;"
1711"RTN","TMGRPC1",766,0)
1712 ;"Results: Results passed back in RESULT string:
1713"RTN","TMGRPC1",767,0)
1714 ;" 1 = success
1715"RTN","TMGRPC1",768,0)
1716 ;" -1^Message = failure
1717"RTN","TMGRPC1",769,0)
1718
1719"RTN","TMGRPC1",770,0)
1720 set RESULT=1 ;"default to success
1721"RTN","TMGRPC1",771,0)
1722
1723"RTN","TMGRPC1",772,0)
1724 ;"kill ^TMG("TMP","RPC")
1725"RTN","TMGRPC1",773,0)
1726 ;"merge ^TMG("TMP","RPC")=INFO ;"temp... remove later
1727"RTN","TMGRPC1",774,0)
1728
1729"RTN","TMGRPC1",775,0)
1730 new TMGFDA,TMGMSG,IENS
1731"RTN","TMGRPC1",776,0)
1732 set IENS=DFN_","
1733"RTN","TMGRPC1",777,0)
1734 new key set key=""
1735"RTN","TMGRPC1",778,0)
1736 for set key=$order(INFO(key)) quit:(key="") do
1737"RTN","TMGRPC1",779,0)
1738 . if key="COMBINED_NAME" set TMGFDA(2,IENS,.01)=INFO("COMBINED_NAME")
1739"RTN","TMGRPC1",780,0)
1740 . else if +key=key set TMGFDA(2,IENS,key)=INFO(key)
1741"RTN","TMGRPC1",781,0)
1742 . else if key="DOB" set TMGFDA(2,IENS,.03)=INFO("DOB")
1743"RTN","TMGRPC1",782,0)
1744 . else if key="SEX" set TMGFDA(2,IENS,.02)=INFO("SEX")
1745"RTN","TMGRPC1",783,0)
1746 . else if key="SS_NUM" set TMGFDA(2,IENS,.09)=INFO("SS_NUM")
1747"RTN","TMGRPC1",784,0)
1748 . else if key="ADDRESS_LINE_1" set TMGFDA(2,IENS,.111)=INFO("ADDRESS_LINE_1")
1749"RTN","TMGRPC1",785,0)
1750 . else if key="ADDRESS_LINE_2" set TMGFDA(2,IENS,.112)=INFO("ADDRESS_LINE_2")
1751"RTN","TMGRPC1",786,0)
1752 . else if key="ADDRESS_LINE_3" set TMGFDA(2,IENS,.113)=INFO("ADDRESS_LINE_3")
1753"RTN","TMGRPC1",787,0)
1754 . else if key="CITY" set TMGFDA(2,IENS,.114)=INFO("CITY")
1755"RTN","TMGRPC1",788,0)
1756 . else if key="STATE" set TMGFDA(2,IENS,.115)=INFO("STATE")
1757"RTN","TMGRPC1",789,0)
1758 . else if key="ZIP4" set TMGFDA(2,IENS,.1112)=INFO("ZIP4")
1759"RTN","TMGRPC1",790,0)
1760 . else if key="BAD_ADDRESS" set TMGFDA(2,IENS,.121)=INFO("BAD_ADDRESS")
1761"RTN","TMGRPC1",791,0)
1762 . else if key="TEMP_ADDRESS_LINE_1" set TMGFDA(2,IENS,.1211)=INFO("TEMP_ADDRESS_LINE_1")
1763"RTN","TMGRPC1",792,0)
1764 . else if key="TEMP_ADDRESS_LINE_2" set TMGFDA(2,IENS,.1212)=INFO("TEMP_ADDRESS_LINE_2")
1765"RTN","TMGRPC1",793,0)
1766 . else if key="TEMP_ADDRESS_LINE_3" set TMGFDA(2,IENS,.1213)=INFO("TEMP_ADDRESS_LINE_3")
1767"RTN","TMGRPC1",794,0)
1768 . else if key="TEMP_CITY" set TMGFDA(2,IENS,.1214)=INFO("TEMP_CITY")
1769"RTN","TMGRPC1",795,0)
1770 . else if key="TEMP_STATE" set TMGFDA(2,IENS,.1215)=INFO("TEMP_STATE")
1771"RTN","TMGRPC1",796,0)
1772 . else if key="TEMP_ZIP4" set TMGFDA(2,IENS,.12112)=INFO("TEMP_ZIP4")
1773"RTN","TMGRPC1",797,0)
1774 . else if key="TEMP_STARTING_DATE" set TMGFDA(2,IENS,.1217)=INFO("TEMP_STARTING_DATE")
1775"RTN","TMGRPC1",798,0)
1776 . else if key="TEMP_ENDING_DATE" set TMGFDA(2,IENS,.1218)=INFO("TEMP_ENDING_DATE")
1777"RTN","TMGRPC1",799,0)
1778 . else if key="TEMP_ADDRESS_ACTIVE" set TMGFDA(2,IENS,.12105)=INFO("TEMP_ADDRESS_ACTIVE")
1779"RTN","TMGRPC1",800,0)
1780 . else if key="CONF_ADDRESS_LINE_1" set TMGFDA(2,IENS,.1411)=INFO("CONF_ADDRESS_LINE_1")
1781"RTN","TMGRPC1",801,0)
1782 . else if key="CONF_ADDRESS_LINE_2" set TMGFDA(2,IENS,.1412)=INFO("CONF_ADDRESS_LINE_2")
1783"RTN","TMGRPC1",802,0)
1784 . else if key="CONF_ADDRESS_LINE_3" set TMGFDA(2,IENS,.1413)=INFO("CONF_ADDRESS_LINE_3")
1785"RTN","TMGRPC1",803,0)
1786 . else if key="CONF_CITY" set TMGFDA(2,IENS,.1414)=INFO("CONF_CITY")
1787"RTN","TMGRPC1",804,0)
1788 . else if key="CONF_STATE" set TMGFDA(2,IENS,.1415)=INFO("CONF_STATE")
1789"RTN","TMGRPC1",805,0)
1790 . else if key="CONF_ZIP" set TMGFDA(2,IENS,.1416)=INFO("CONF_ZIP")
1791"RTN","TMGRPC1",806,0)
1792 . else if key="CONF_STARTING_DATE" set TMGFDA(2,IENS,.1417)=INFO("CONF_STARTING_DATE")
1793"RTN","TMGRPC1",807,0)
1794 . else if key="CONF_ENDING_DATE" set TMGFDA(2,IENS,.1418)=INFO("CONF_ENDING_DATE")
1795"RTN","TMGRPC1",808,0)
1796 . else if key="CONF_ADDRESS_ACTIVE" set TMGFDA(2,IENS,.14105)=INFO("CONF_ADDRESS_ACTIVE")
1797"RTN","TMGRPC1",809,0)
1798 . else if key="PHONE_RESIDENCE" set TMGFDA(2,IENS,.131)=INFO("PHONE_RESIDENCE")
1799"RTN","TMGRPC1",810,0)
1800 . else if key="PHONE_WORK" set TMGFDA(2,IENS,.132)=INFO("PHONE_WORK")
1801"RTN","TMGRPC1",811,0)
1802 . else if key="PHONE_CELL" set TMGFDA(2,IENS,.133)=INFO("PHONE_CELL")
1803"RTN","TMGRPC1",812,0)
1804 . else if key="PHONE_TEMP" set TMGFDA(2,IENS,.1219)=INFO("PHONE_TEMP")
1805"RTN","TMGRPC1",813,0)
1806 . else if key="EMAIL" set TMGFDA(2,IENS,.133)=INFO("EMAIL")
1807"RTN","TMGRPC1",814,0)
1808
1809"RTN","TMGRPC1",815,0)
1810 if $data(TMGFDA) do
1811"RTN","TMGRPC1",816,0)
1812 . do FILE^DIE("EKST","TMGFDA","TMGMSG")
1813"RTN","TMGRPC1",817,0)
1814 . if $data(TMGMSG("DIERR")) do
1815"RTN","TMGRPC1",818,0)
1816 . . set RESULT="-1^Filing Error Occured: "_$get(TMGMSG("DIERR",1,"TEXT",1))
1817"RTN","TMGRPC1",819,0)
1818 . . ;"merge ^TMG("TMP","RPC","DIERR")=TMGMSG("DIERR")
1819"RTN","TMGRPC1",820,0)
1820 . . ;"merge ^TMG("TMP","RPC","FDA")=TMGFDA
1821"RTN","TMGRPC1",821,0)
1822
1823"RTN","TMGRPC1",822,0)
1824 ;"now file Alias info separately
1825"RTN","TMGRPC1",823,0)
1826 if RESULT=1 do
1827"RTN","TMGRPC1",824,0)
1828 . new tempArray,index,key2
1829"RTN","TMGRPC1",825,0)
1830 . new key set key=""
1831"RTN","TMGRPC1",826,0)
1832 . for set key=$order(INFO(key)) quit:(key="") do
1833"RTN","TMGRPC1",827,0)
1834 . . if key["ALIAS" do
1835"RTN","TMGRPC1",828,0)
1836 . . . set index=$piece(key," ",2) quit:(index="")
1837"RTN","TMGRPC1",829,0)
1838 . . . set key2=$piece(key," ",3)
1839"RTN","TMGRPC1",830,0)
1840 . . . set tempArray(index,key2)=INFO(key)
1841"RTN","TMGRPC1",831,0)
1842 . set index=0 for set index=$order(tempArray(index)) quit:(index="")!(RESULT'=1) do
1843"RTN","TMGRPC1",832,0)
1844 . . new TMGFDA,TMGMSG,TMGIEN,newRec
1845"RTN","TMGRPC1",833,0)
1846 . . set newRec=0
1847"RTN","TMGRPC1",834,0)
1848 . . set key="" for set key=$order(tempArray(index,key)) quit:(key="")!(RESULT'=1) do
1849"RTN","TMGRPC1",835,0)
1850 . . . if key="NAME" set TMGFDA(2.01,index_","_DFN_",",.01)=$get(tempArray(index,"NAME"))
1851"RTN","TMGRPC1",836,0)
1852 . . . if key="SSN" set TMGFDA(2.01,index_","_DFN_",",1)=$get(tempArray(index,"SSN"))
1853"RTN","TMGRPC1",837,0)
1854 . . . if index["+" set newRec=1
1855"RTN","TMGRPC1",838,0)
1856 . . if $data(TMGFDA) do
1857"RTN","TMGRPC1",839,0)
1858 . . . if newRec=0 do FILE^DIE("EKST","TMGFDA","TMGMSG")
1859"RTN","TMGRPC1",840,0)
1860 . . . else do UPDATE^DIE("ES","TMGFDA","TMGIEN","TMGMSG")
1861"RTN","TMGRPC1",841,0)
1862 . . if $data(TMGMSG("DIERR")) do
1863"RTN","TMGRPC1",842,0)
1864 . . . set RESULT="-1^Filing Error Occured: "_$get(TMGMSG("DIERR",1,"TEXT",1))
1865"RTN","TMGRPC1",843,0)
1866 . . . ;"merge ^TMG("TMP","RPC","DIERR")=TMGMSG("DIERR")
1867"RTN","TMGRPC1",844,0)
1868 . . . ;"merge ^TMG("TMP","RPC","FDA")=TMGFDA
1869"RTN","TMGRPC1",845,0)
1870
1871"RTN","TMGRPC1",846,0)
1872 quit
1873"RTN","TMGRPC1",847,0)
1874
1875"RTN","TMGRPC1",848,0)
1876PTADD(RESULT,INFO) ;" ADD PATIENT
1877"RTN","TMGRPC1",849,0)
1878 ;"Purpose: To add a patient
1879"RTN","TMGRPC1",850,0)
1880 ;"Input: RESULT (this is the output array)
1881"RTN","TMGRPC1",851,0)
1882 ;"
1883"RTN","TMGRPC1",852,0)
1884 ;" INFO: Format as follows:
1885"RTN","TMGRPC1",853,0)
1886 ;" The results are in format: INFO("KeyName")=Value,
1887"RTN","TMGRPC1",854,0)
1888 ;" There is no set order these will appear.
1889"RTN","TMGRPC1",855,0)
1890 ;" Here are the KeyName names that will be provided.
1891"RTN","TMGRPC1",856,0)
1892 ;" If the record has no value, then value will be empty
1893"RTN","TMGRPC1",857,0)
1894 ;" If a record should be deleted, its value will be @
1895"RTN","TMGRPC1",858,0)
1896 ;" INFO("COMBINED_NAME")=
1897"RTN","TMGRPC1",859,0)
1898 ;" INFO("DOB")=
1899"RTN","TMGRPC1",860,0)
1900 ;" INFO("SEX")=
1901"RTN","TMGRPC1",861,0)
1902 ;" INFO("SS_NUM")=
1903"RTN","TMGRPC1",862,0)
1904 ;" INFO("Veteran")=
1905"RTN","TMGRPC1",863,0)
1906 ;" INFO("PtType")=
1907"RTN","TMGRPC1",864,0)
1908 ;"Results: Results passed back in RESULT string:
1909"RTN","TMGRPC1",865,0)
1910 ;" DFN = success
1911"RTN","TMGRPC1",866,0)
1912 ;" -1^Message = failure
1913"RTN","TMGRPC1",867,0)
1914 ;" 0^DFN = already exists
1915"RTN","TMGRPC1",868,0)
1916
1917"RTN","TMGRPC1",869,0)
1918 set RESULT=1 ;"default to success
1919"RTN","TMGRPC1",870,0)
1920
1921"RTN","TMGRPC1",871,0)
1922 kill ^TMG("TMP","RPC")
1923"RTN","TMGRPC1",872,0)
1924 merge ^TMG("TMP","RPC")=INFO ;"temp... remove later
1925"RTN","TMGRPC1",873,0)
1926
1927"RTN","TMGRPC1",874,0)
1928 new TMGFDA,TMGMSG,IENS,PATIENT,DFN,TMGFREG
1929"RTN","TMGRPC1",875,0)
1930 ;" set IENS=DFN_","
1931"RTN","TMGRPC1",876,0)
1932 new key set key=""
1933"RTN","TMGRPC1",877,0)
1934 for set key=$order(INFO(key)) quit:(key="") do
1935"RTN","TMGRPC1",878,0)
1936 . if key="COMBINED_NAME" set PATIENT("NAME")=INFO("COMBINED_NAME")
1937"RTN","TMGRPC1",879,0)
1938 . else if key="DOB" set PATIENT("DOB")=INFO("DOB")
1939"RTN","TMGRPC1",880,0)
1940 . else if key="SEX" set PATIENT("SEX")=INFO("SEX")
1941"RTN","TMGRPC1",881,0)
1942 . else if key="SS_NUM" set PATIENT("SSNUM")=INFO("SS_NUM")
1943"RTN","TMGRPC1",882,0)
1944 . else if key="Veteran" set PATIENT("VETERAN")=INFO("Veteran")
1945"RTN","TMGRPC1",883,0)
1946 . else if key="PtType" set PATIENT("PT_TYPE")=INFO("PtType")
1947"RTN","TMGRPC1",884,0)
1948 set DFN=$$GetDFN^TMGGDFN(.PATIENT)
1949"RTN","TMGRPC1",885,0)
1950 if DFN=-1 do
1951"RTN","TMGRPC1",886,0)
1952 . new Entry,result,ErrMsg
1953"RTN","TMGRPC1",887,0)
1954 . do Pat2Entry^TMGGDFN(.PATIENT,.Entry)
1955"RTN","TMGRPC1",888,0)
1956 . set DFN=$$AddNewPt^TMGGDFN(.Entry,.ErrMsg)
1957"RTN","TMGRPC1",889,0)
1958 . ;"set DFN=$$GetDFN^TMGGDFN(.PATIENT)
1959"RTN","TMGRPC1",890,0)
1960 . if DFN'>0 do
1961"RTN","TMGRPC1",891,0)
1962 . . set RESULT="-1^ERROR ADDING" ;"should use ErrMsg from above. Fix later
1963"RTN","TMGRPC1",892,0)
1964 . . set RESULT=RESULT_". "_$$GetErrStr^TMGDEBUG(.ErrMsg)
1965"RTN","TMGRPC1",893,0)
1966 . else do
1967"RTN","TMGRPC1",894,0)
1968 .. set RESULT=DFN
1969"RTN","TMGRPC1",895,0)
1970 else do
1971"RTN","TMGRPC1",896,0)
1972 . set RESULT="0^"_DFN
1973"RTN","TMGRPC1",897,0)
1974
1975"RTN","TMGRPC1",898,0)
1976 quit
1977"RTN","TMGRPC1",899,0)
1978
1979"RTN","TMGRPC1",900,0)
1980
1981"RTN","TMGRPC1",901,0)
1982GETBARCD(GREF,MESSAGE,OPTION)
1983"RTN","TMGRPC1",902,0)
1984 ;"SCOPE: Public
1985"RTN","TMGRPC1",903,0)
1986 ;"RPC that calls this: TMG BARCODE ENCODE
1987"RTN","TMGRPC1",904,0)
1988 ;"Purpose: To provide an entry point for a RPC call from a client.
1989"RTN","TMGRPC1",905,0)
1990 ;" A 2D DataMatrix Bar Code will be create and passed to client.
1991"RTN","TMGRPC1",906,0)
1992 ;" It will not be stored on server
1993"RTN","TMGRPC1",907,0)
1994 ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE)
1995"RTN","TMGRPC1",908,0)
1996 ;" MESSAGE-- The text to use to create the barcode
1997"RTN","TMGRPC1",909,0)
1998 ;" OPTION -- Array that may hold optional settings, as follows:
1999"RTN","TMGRPC1",910,0)
2000 ;" OPTION("IMAGE TYPE")="jpg" <-- if not specified, then default is "png"
2001"RTN","TMGRPC1",911,0)
2002 ;"Output: results are passed out in @GREF
2003"RTN","TMGRPC1",912,0)
2004 ;" @GREF@(0)=success; 1=success, 0=failure
2005"RTN","TMGRPC1",913,0)
2006 ;" @GREF@(1..xxx) = actual data
2007"RTN","TMGRPC1",914,0)
2008
2009"RTN","TMGRPC1",915,0)
2010 ;"NOTE: dmtxread must be installed on linux host.
2011"RTN","TMGRPC1",916,0)
2012 ;" I found source code here:
2013"RTN","TMGRPC1",917,0)
2014 ;" http://sourceforge.net/projects/libdmtx/
2015"RTN","TMGRPC1",918,0)
2016 ;" After installing (./configure --> make --> make install), I
2017"RTN","TMGRPC1",919,0)
2018 ;" copied dmtxread and dmtxwrite, which were found in the
2019"RTN","TMGRPC1",920,0)
2020 ;" (installdir)/util/dmtxread/.libs and (installdir)/util/dmtxwrite/.libs
2021"RTN","TMGRPC1",921,0)
2022 ;" folders, into a folder on the system path. I chose /usr/bin/
2023"RTN","TMGRPC1",922,0)
2024 ;" Also, to achieve compile of above, I had to install required libs.
2025"RTN","TMGRPC1",923,0)
2026 ;" See notes included with dmtx source code.
2027"RTN","TMGRPC1",924,0)
2028
2029"RTN","TMGRPC1",925,0)
2030 new FileSpec
2031"RTN","TMGRPC1",926,0)
2032 new file
2033"RTN","TMGRPC1",927,0)
2034 new FName,FPath
2035"RTN","TMGRPC1",928,0)
2036
2037"RTN","TMGRPC1",929,0)
2038 set GREF="^TMP(""GETBARCD^TMGRPC1"","_$J_")"
2039"RTN","TMGRPC1",930,0)
2040 kill @GREF
2041"RTN","TMGRPC1",931,0)
2042 set @GREF@(0)="" ;"default to failure
2043"RTN","TMGRPC1",932,0)
2044 set MESSAGE=$get(MESSAGE)
2045"RTN","TMGRPC1",933,0)
2046 if MESSAGE="" goto GBCDone
2047"RTN","TMGRPC1",934,0)
2048
2049"RTN","TMGRPC1",935,0)
2050 ;"Create the barcode and get file name and path
2051"RTN","TMGRPC1",936,0)
2052 set file=$$MAKEBC^TMGBARC(MESSAGE,.OPTION)
2053"RTN","TMGRPC1",937,0)
2054 do SplitFNamePath^TMGIOUTL(file,.FPath,.FName,"/")
2055"RTN","TMGRPC1",938,0)
2056
2057"RTN","TMGRPC1",939,0)
2058 ;"Load binary image into global array
2059"RTN","TMGRPC1",940,0)
2060 set @GREF@(0)=$$BFTG^TMGBINF(.FPath,.FName,$name(@GREF@(1)),3)
2061"RTN","TMGRPC1",941,0)
2062
2063"RTN","TMGRPC1",942,0)
2064 ;"convert binary data to ascii encoded data
2065"RTN","TMGRPC1",943,0)
2066 do ENCODE($name(@GREF@(1)),3)
2067"RTN","TMGRPC1",944,0)
2068
2069"RTN","TMGRPC1",945,0)
2070 ;"delete temp image file
2071"RTN","TMGRPC1",946,0)
2072 do SplitFNamePath^TMGIOUTL(file,.FPath,.FName,"/")
2073"RTN","TMGRPC1",947,0)
2074 set FileSpec(FName)=""
2075"RTN","TMGRPC1",948,0)
2076 new temp set temp=$$DEL^%ZISH(FPath,"FileSpec")
2077"RTN","TMGRPC1",949,0)
2078
2079"RTN","TMGRPC1",950,0)
2080GBCDone
2081"RTN","TMGRPC1",951,0)
2082 quit
2083"RTN","TMGRPC1",952,0)
2084
2085"RTN","TMGRPC1",953,0)
2086
2087"RTN","TMGRPC1",954,0)
2088DECODEBC(RESULT,ARRAY,IMGTYPE)
2089"RTN","TMGRPC1",955,0)
2090 ;"SCOPE: Public
2091"RTN","TMGRPC1",956,0)
2092 ;"RPC that calls this: TMG BARCODE DECODE
2093"RTN","TMGRPC1",957,0)
2094 ;"Purpose: To provide an entry point for a RPC call from a client. The client
2095"RTN","TMGRPC1",958,0)
2096 ;" will upload an image file (.png format only) of a barcode (Datamatrix
2097"RTN","TMGRPC1",959,0)
2098 ;" format) for decoding. Decoded message is passed back.
2099"RTN","TMGRPC1",960,0)
2100 ;"Input: RESULT -- an OUT PARAMETER. See output below.
2101"RTN","TMGRPC1",961,0)
2102 ;" ARRAY -- the array that will hold the image file, in BASE64 ascii encoding
2103"RTN","TMGRPC1",962,0)
2104 ;" IMGTYPE -- Image type, e.g. "jpg" (Note: don't include any '.')
2105"RTN","TMGRPC1",963,0)
2106 ;"Output: results are passed out in RESULT: 1^Decoded Message or 0^FailureMessage
2107"RTN","TMGRPC1",964,0)
2108
2109"RTN","TMGRPC1",965,0)
2110 ;"NOTE: dmtxread must be installed on linux host.
2111"RTN","TMGRPC1",966,0)
2112 ;" I found source code here:
2113"RTN","TMGRPC1",967,0)
2114 ;" http://sourceforge.net/projects/libdmtx/
2115"RTN","TMGRPC1",968,0)
2116 ;" After installing (./configure --> make --> make install), I
2117"RTN","TMGRPC1",969,0)
2118 ;" copied dmtxread and dmtxwrite, which were found in the
2119"RTN","TMGRPC1",970,0)
2120 ;" (installdir)/util/dmtxread/.libs and (installdir)/util/dmtxwrite/.libs
2121"RTN","TMGRPC1",971,0)
2122 ;" folders, into a folder on the system path. I chose /usr/bin/
2123"RTN","TMGRPC1",972,0)
2124 ;" Also, to achieve compile of above, I had to install required libs.
2125"RTN","TMGRPC1",973,0)
2126 ;" See notes included with dmtx source code.
2127"RTN","TMGRPC1",974,0)
2128 ;"NOTE: if image types other than .png will be uploaded, then the linux host
2129"RTN","TMGRPC1",975,0)
2130 ;" must have ImageMagick utility 'convert' installed for conversion
2131"RTN","TMGRPC1",976,0)
2132 ;" between image types.
2133"RTN","TMGRPC1",977,0)
2134
2135"RTN","TMGRPC1",978,0)
2136 kill ^TMG("TMP","BARCODE")
2137"RTN","TMGRPC1",979,0)
2138 ;"set ^TMG("TMP","BARCODE","LOG")=1 ;"temp
2139"RTN","TMGRPC1",980,0)
2140
2141"RTN","TMGRPC1",981,0)
2142 ;"new Stack do GetStackInfo^TMGIDE2(.Stack)
2143"RTN","TMGRPC1",982,0)
2144 ;"merge ^TMG("TMP","BARCODE","STACK")=Stack
2145"RTN","TMGRPC1",983,0)
2146
2147"RTN","TMGRPC1",984,0)
2148 new resultMsg
2149"RTN","TMGRPC1",985,0)
2150 if $data(ARRAY)=0 set resultMsg="0^No image data received to decode" goto DBCDone
2151"RTN","TMGRPC1",986,0)
2152
2153"RTN","TMGRPC1",987,0)
2154 new imageType set imageType=$$LOW^XLFSTR($get(IMGTYPE))
2155"RTN","TMGRPC1",988,0)
2156 if imageType="" set resultMsg="0^Image type not specified" goto DBCDone
2157"RTN","TMGRPC1",989,0)
2158
2159"RTN","TMGRPC1",990,0)
2160 new imageFName set imageFName="/tmp/barcode."_imageType
2161"RTN","TMGRPC1",991,0)
2162 set imageFName=$$UNIQUE^%ZISUTL(imageFName)
2163"RTN","TMGRPC1",992,0)
2164 new FName,FPath,FileSpec
2165"RTN","TMGRPC1",993,0)
2166 do SplitFNamePath^TMGIOUTL(imageFName,.FPath,.FName,"/")
2167"RTN","TMGRPC1",994,0)
2168 set FileSpec(FName)=""
2169"RTN","TMGRPC1",995,0)
2170
2171"RTN","TMGRPC1",996,0)
2172 ;"temp...
2173"RTN","TMGRPC1",997,0)
2174 ;"merge ^TMG("TMP","BARCODE","DATA")=ARRAY
2175"RTN","TMGRPC1",998,0)
2176 ;"merge ^TMG("TMP","BARCODE","IMGTYPE")=IMGTYPE
2177"RTN","TMGRPC1",999,0)
2178
2179"RTN","TMGRPC1",1000,0)
2180 ;"set ^TMG("TMP","BARCODE","LOG")=2 ;"temp
2181"RTN","TMGRPC1",1001,0)
2182 ;"Remove BASE64 ascii encoding
2183"RTN","TMGRPC1",1002,0)
2184 do DECODE("ARRAY(0)",1)
2185"RTN","TMGRPC1",1003,0)
2186
2187"RTN","TMGRPC1",1004,0)
2188 ;"set ^TMG("TMP","BARCODE","LOG")=3 ;"temp
2189"RTN","TMGRPC1",1005,0)
2190 ;"set ^TMG("TMP","BARCODE","LOG","Orig file: "_FPath_FName)=""
2191"RTN","TMGRPC1",1006,0)
2192
2193"RTN","TMGRPC1",1007,0)
2194 ;"Save to host file system
2195"RTN","TMGRPC1",1008,0)
2196 if $$GTBF^TMGBINF("ARRAY(0)",1,FPath,FName)=0 do goto DBCDone
2197"RTN","TMGRPC1",1009,0)
2198 . set resultMsg="0^Error while saving file to HFS"
2199"RTN","TMGRPC1",1010,0)
2200
2201"RTN","TMGRPC1",1011,0)
2202 ;"set ^TMG("TMP","BARCODE","LOG")=4 ;"temp
2203"RTN","TMGRPC1",1012,0)
2204
2205"RTN","TMGRPC1",1013,0)
2206 ;"convert image file to .png format, if needed
2207"RTN","TMGRPC1",1014,0)
2208 if imageType'="png" do
2209"RTN","TMGRPC1",1015,0)
2210 . set imageFName=$$Convert^TMGKERNL(imageFName,"png")
2211"RTN","TMGRPC1",1016,0)
2212 . if imageFName="" do quit
2213"RTN","TMGRPC1",1017,0)
2214 . . set resultMsg="0^Error while converting image from ."_imageType_" to .png format."
2215"RTN","TMGRPC1",1018,0)
2216 . do SplitFNamePath^TMGIOUTL(imageFName,.FPath,.FName,"/")
2217"RTN","TMGRPC1",1019,0)
2218 . set FileSpec(FName)=""
2219"RTN","TMGRPC1",1020,0)
2220 if imageFName="" goto DBCDone
2221"RTN","TMGRPC1",1021,0)
2222
2223"RTN","TMGRPC1",1022,0)
2224 ;"set ^TMG("TMP","BARCODE","LOG")=5 ;"temp
2225"RTN","TMGRPC1",1023,0)
2226
2227"RTN","TMGRPC1",1024,0)
2228 ;"Decode the barcode.png image
2229"RTN","TMGRPC1",1025,0)
2230 new result set result=$$READBC^TMGBARC(imageFName)
2231"RTN","TMGRPC1",1026,0)
2232 if result'="" set resultMsg="1^"_result
2233"RTN","TMGRPC1",1027,0)
2234 else set resultMsg="0^Unable to Decode Image"
2235"RTN","TMGRPC1",1028,0)
2236
2237"RTN","TMGRPC1",1029,0)
2238 ;"delete temp image file
2239"RTN","TMGRPC1",1030,0)
2240 ;"temp REMOVE COMMENTS LATER TO DELETE FILE. !!!!!
2241"RTN","TMGRPC1",1031,0)
2242 ;"set result=$$DEL^%ZISH(FPath,"FileSpec")
2243"RTN","TMGRPC1",1032,0)
2244
2245"RTN","TMGRPC1",1033,0)
2246DBCDone
2247"RTN","TMGRPC1",1034,0)
2248 ;"set ^TMG("TMP","BARCODE","LOG")=6 ;"temp
2249"RTN","TMGRPC1",1035,0)
2250
2251"RTN","TMGRPC1",1036,0)
2252 set RESULT=resultMsg
2253"RTN","TMGRPC1",1037,0)
2254 quit
2255"RTN","TMGRPC1",1038,0)
2256
2257"RTN","TMGRPC1",1039,0)
2258 ;"--------------------
2259"RTN","TMGRPC1",1040,0)
2260GETURLS(RESULT)
2261"RTN","TMGRPC1",1041,0)
2262 ;"SCOPE: Public
2263"RTN","TMGRPC1",1042,0)
2264 ;"RPC that calls this: TMG CPRS GET URL LIST
2265"RTN","TMGRPC1",1043,0)
2266 ;"Purpose: To provide an entry point for a RPC call from a client. The client
2267"RTN","TMGRPC1",1044,0)
2268 ;" will request URLs to display in custom tabs inside CPRS, in an
2269"RTN","TMGRPC1",1045,0)
2270 ;" imbedded web browser
2271"RTN","TMGRPC1",1046,0)
2272 ;"Input: RESULT -- an OUT PARAMETER. See output below.
2273"RTN","TMGRPC1",1047,0)
2274 ;"Output: results are passed out in RESULT:
2275"RTN","TMGRPC1",1048,0)
2276 ;" RESULT(0)="1^Success" or "0^SomeFailureMessage"
2277"RTN","TMGRPC1",1049,0)
2278 ;" RESULT(1)="Name1^URL#1" ; shows URL#1 in tab #1, named 'Name1'
2279"RTN","TMGRPC1",1050,0)
2280 ;" RESULT(2)="Name2^URL#2" ; etc.
2281"RTN","TMGRPC1",1051,0)
2282 ;" RESULT(3)="Name3^URL#3"
2283"RTN","TMGRPC1",1052,0)
2284 ;"
2285"RTN","TMGRPC1",1053,0)
2286 ;" E.g. RESULT(1)="cnn^www.cnn.com"
2287"RTN","TMGRPC1",1054,0)
2288 ;" RESULT(2)="INFO^192.168.0.1/home.html"
2289"RTN","TMGRPC1",1055,0)
2290 ;"
2291"RTN","TMGRPC1",1056,0)
2292 ;" The number of allowed tabs is determined by code in CPRS
2293"RTN","TMGRPC1",1057,0)
2294 ;" Reference to tab numbers > specified in CPRS will be ignored by CPRS
2295"RTN","TMGRPC1",1058,0)
2296 ;" If a web tab is NOT specified, then the page previously
2297"RTN","TMGRPC1",1059,0)
2298 ;" displayed will be left in place. It will not be cleared.
2299"RTN","TMGRPC1",1060,0)
2300 ;" To clear a given page, a url of "about:blank" will cause a
2301"RTN","TMGRPC1",1061,0)
2302 ;" blank page to be displayed. e.g.
2303"RTN","TMGRPC1",1062,0)
2304 ;" RESULT(3)="^about:blank"
2305"RTN","TMGRPC1",1063,0)
2306 ;" To HIDE a tab on CPRS use this:
2307"RTN","TMGRPC1",1064,0)
2308 ;" RESULT(3)="^<!HIDE!>" ;triggers tab #3 to be hidden
2309"RTN","TMGRPC1",1065,0)
2310 ;" To have the browser remain UNCHANGED use this:
2311"RTN","TMGRPC1",1066,0)
2312 ;" RESULT(3)="^<!NOCHANGE!>" ;triggers tab #3 to remain unchanged.
2313"RTN","TMGRPC1",1067,0)
2314 ;" Note: the rationale for this is that the web tab may have info
2315"RTN","TMGRPC1",1068,0)
2316 ;" that should not be refreshed when the patient info is refreshed
2317"RTN","TMGRPC1",1069,0)
2318 ;" i.e. the user may have navigated somewhere, and doesn't want
2319"RTN","TMGRPC1",1070,0)
2320 ;" to loose their location.
2321"RTN","TMGRPC1",1071,0)
2322 ;" --to be implemented.
2323"RTN","TMGRPC1",1072,0)
2324 ;" Note: The other way to do this, as above, is to simply have NO
2325"RTN","TMGRPC1",1073,0)
2326 ;" entry for a given tab. I.e. don't have any value for RESULT(3)
2327"RTN","TMGRPC1",1074,0)
2328 ;" --already implemented.
2329"RTN","TMGRPC1",1075,0)
2330 ;"Notice to others: Below is where code should be added to return
2331"RTN","TMGRPC1",1076,0)
2332 ;" proper URL's to CPRS. This will be called whenever a new patient
2333"RTN","TMGRPC1",1077,0)
2334 ;" is opened, or a Refresh Information is requested.
2335"RTN","TMGRPC1",1078,0)
2336 ;" FYI, 'DFN' should be defined as a globally-scoped variable that can be used
2337"RTN","TMGRPC1",1079,0)
2338 ;" to pass back URLS specific for a given patient.
2339"RTN","TMGRPC1",1080,0)
2340
2341"RTN","TMGRPC1",1081,0)
2342 set RESULT(0)="1^Success"
2343"RTN","TMGRPC1",1082,0)
2344 set RESULT(1)="Yahoo^www.yahoo.com"
2345"RTN","TMGRPC1",1083,0)
2346 set RESULT(2)="(x)^about:blank"
2347"RTN","TMGRPC1",1084,0)
2348 set RESULT(3)="^<!HIDE!>"
2349"RTN","TMGRPC1",1085,0)
2350
2351"RTN","TMGRPC1",1086,0)
2352 ;"kill RESULT
2353"RTN","TMGRPC1",1087,0)
2354 ;"merge RESULT=^TMG("TMP","URLS") ;"TEMP!!!
2355"RTN","TMGRPC1",1088,0)
2356
2357"RTN","TMGRPC1",1089,0)
2358 quit
2359"VER")
23608.0^22.0
2361**END**
2362**END**
Note: See TracBrowser for help on using the repository browser.