source: cprs/branches/tmg-cprs/Server_KIDS/TMG1-1.0-4.KIDS@ 1482

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

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