source: cprs/branches/tmg-cprs/Server_KIDS/TMG-CPRS-IMAGING-1.0-1.KIDS@ 1406

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

Server support for deleting images:
File size: 115.0 KB
RevLine 
[893]1KIDS Distribution saved on Jul 21, 2010@17:07:45
2TMG-CPRS-IMAGING*1.0*1
3**KIDS**:TMG-CPRS-IMAGING*1.0*1^
4
5**INSTALL NAME**
6TMG-CPRS-IMAGING*1.0*1
7"BLD",7638,0)
8TMG-CPRS-IMAGING*1.0*1^^0^3100721^n
9"BLD",7638,1,0)
10^^10^10^3100721^^
11"BLD",7638,1,1,0)
12Prior patches for imaging support were in TMG1 namespace
13"BLD",7638,1,2,0)
14(e.g. TMG1*1.0*6). This patch changes to TMG-CPRS
15"BLD",7638,1,3,0)
16namespace.
17"BLD",7638,1,4,0)
18
19"BLD",7638,1,5,0)
20This patch provides further support for extended imaging
21"BLD",7638,1,6,0)
22functionality in CPRS, namely ability to directly add
23"BLD",7638,1,7,0)
24images into notes, and then delete them later if needed.
25"BLD",7638,1,8,0)
26
27"BLD",7638,1,9,0)
28Image deletion business rules mirror those for deleting
29"BLD",7638,1,10,0)
30notes in general.
31"BLD",7638,4,0)
32^9.64PA^^
33"BLD",7638,6.3)
342
35"BLD",7638,"INID")
36^n
37"BLD",7638,"INIT")
38PINST1^TMGRPC1D
39"BLD",7638,"KRN",0)
40^9.67PA^8989.52^19
41"BLD",7638,"KRN",.4,0)
42.4
43"BLD",7638,"KRN",.401,0)
44.401
45"BLD",7638,"KRN",.402,0)
46.402
47"BLD",7638,"KRN",.403,0)
48.403
49"BLD",7638,"KRN",.5,0)
50.5
51"BLD",7638,"KRN",.84,0)
52.84
53"BLD",7638,"KRN",3.6,0)
543.6
55"BLD",7638,"KRN",3.8,0)
563.8
57"BLD",7638,"KRN",9.2,0)
589.2
59"BLD",7638,"KRN",9.8,0)
609.8
61"BLD",7638,"KRN",9.8,"NM",0)
62^9.68A^4^4
63"BLD",7638,"KRN",9.8,"NM",1,0)
64TMGRPC1^^0^B6434
65"BLD",7638,"KRN",9.8,"NM",2,0)
66TMGRPC1B^^0^B3028
67"BLD",7638,"KRN",9.8,"NM",3,0)
68TMGRPC1C^^0^B4701
69"BLD",7638,"KRN",9.8,"NM",4,0)
70TMGRPC1D^^0^B69776678
71"BLD",7638,"KRN",9.8,"NM","B","TMGRPC1",1)
72
73"BLD",7638,"KRN",9.8,"NM","B","TMGRPC1B",2)
74
75"BLD",7638,"KRN",9.8,"NM","B","TMGRPC1C",3)
76
77"BLD",7638,"KRN",9.8,"NM","B","TMGRPC1D",4)
78
79"BLD",7638,"KRN",19,0)
8019
81"BLD",7638,"KRN",19.1,0)
8219.1
83"BLD",7638,"KRN",101,0)
84101
85"BLD",7638,"KRN",409.61,0)
86409.61
87"BLD",7638,"KRN",771,0)
88771
89"BLD",7638,"KRN",870,0)
90870
91"BLD",7638,"KRN",8989.51,0)
928989.51
93"BLD",7638,"KRN",8989.52,0)
948989.52
95"BLD",7638,"KRN",8994,0)
968994
97"BLD",7638,"KRN",8994,"NM",0)
98^9.68A^1^1
99"BLD",7638,"KRN",8994,"NM",1,0)
100TMG IMAGE DELETE^^0
101"BLD",7638,"KRN",8994,"NM","B","TMG IMAGE DELETE",1)
102
103"BLD",7638,"KRN","B",.4,.4)
104
105"BLD",7638,"KRN","B",.401,.401)
106
107"BLD",7638,"KRN","B",.402,.402)
108
109"BLD",7638,"KRN","B",.403,.403)
110
111"BLD",7638,"KRN","B",.5,.5)
112
113"BLD",7638,"KRN","B",.84,.84)
114
115"BLD",7638,"KRN","B",3.6,3.6)
116
117"BLD",7638,"KRN","B",3.8,3.8)
118
119"BLD",7638,"KRN","B",9.2,9.2)
120
121"BLD",7638,"KRN","B",9.8,9.8)
122
123"BLD",7638,"KRN","B",19,19)
124
125"BLD",7638,"KRN","B",19.1,19.1)
126
127"BLD",7638,"KRN","B",101,101)
128
129"BLD",7638,"KRN","B",409.61,409.61)
130
131"BLD",7638,"KRN","B",771,771)
132
133"BLD",7638,"KRN","B",870,870)
134
135"BLD",7638,"KRN","B",8989.51,8989.51)
136
137"BLD",7638,"KRN","B",8989.52,8989.52)
138
139"BLD",7638,"KRN","B",8994,8994)
140
141"BLD",7638,"QDEF")
142^^^^NO^^^^NO^^NO
143"BLD",7638,"QUES",0)
144^9.62^^
145"BLD",7638,"REQB",0)
146^9.611^1^1
147"BLD",7638,"REQB",1,0)
148TMG1*1.0*6^0
149"BLD",7638,"REQB","B","TMG1*1.0*6",1)
150
151"INIT")
152PINST1^TMGRPC1D
153"KRN",8994,2500,-1)
1540^1
155"KRN",8994,2500,0)
156TMG IMAGE DELETE^DELIMAGE^TMGRPC1C^1^R^^^^1
157"KRN",8994,2500,1,0)
158^8994.01^16^16^3100711^^^
159"KRN",8994,2500,1,1,0)
160Provides functionality for deleting or retracting
161"KRN",8994,2500,1,2,0)
162an image (or other attached file) added through TMG-CPRS.
163"KRN",8994,2500,1,3,0)
164
165"KRN",8994,2500,1,4,0)
166NOTE: This function DOES NOT CHECK PERMISSIONS for
167"KRN",8994,2500,1,5,0)
168deleting/retracting image. Programmer is responsible
169"KRN",8994,2500,1,6,0)
170for ensuring the user has proper permission to use this
171"KRN",8994,2500,1,7,0)
172function.
173"KRN",8994,2500,1,8,0)
174
175"KRN",8994,2500,1,9,0)
176NOTE: If mode is to retract (see below), then the image
177"KRN",8994,2500,1,10,0)
178will not be deleted. It will just be marked as retracted,
179"KRN",8994,2500,1,11,0)
180and set so that it doesn't appear in CPRS. But if mode
181"KRN",8994,2500,1,12,0)
182is DELETE, then the record in the IMAGE file will be
183"KRN",8994,2500,1,13,0)
184deleted, AND ALSO the source image will be deleted (with
185"KRN",8994,2500,1,14,0)
186no backup). Delete mode is intended for deletion before
187"KRN",8994,2500,1,15,0)
188the image has been signed and formally added into the
189"KRN",8994,2500,1,16,0)
190medical record.
191"KRN",8994,2500,2,0)
192^8994.02A^3^3
193"KRN",8994,2500,2,1,0)
194TMGIEN^1^^1^1
195"KRN",8994,2500,2,1,1,0)
196^^2^2^3100711^^
197"KRN",8994,2500,2,1,1,1,0)
198This is the IEN in the IMAGE file (file #2005)
199"KRN",8994,2500,2,1,1,2,0)
200to be removed.
201"KRN",8994,2500,2,2,0)
202TMGMODE^1^^0^2
203"KRN",8994,2500,2,2,1,0)
204^8994.021^7^7^3100711^^^
205"KRN",8994,2500,2,2,1,1,0)
206Should be one of the following values:
207"KRN",8994,2500,2,2,1,2,0)
208 '0' for NONE -- will cause function to exit, no action
209"KRN",8994,2500,2,2,1,3,0)
210 '1' for DELETE -- delete record and image/file
211"KRN",8994,2500,2,2,1,4,0)
212 '2' for RETRACT -- mark record as retracted, but NO
213"KRN",8994,2500,2,2,1,5,0)
214 actual deletion effected.
215"KRN",8994,2500,2,2,1,6,0)
216
217"KRN",8994,2500,2,2,1,7,0)
218Default value is 0
219"KRN",8994,2500,2,3,0)
220TMGREASON^1^60^0^3
221"KRN",8994,2500,2,3,1,0)
222^8994.021^3^3^3100711^^^
223"KRN",8994,2500,2,3,1,1,0)
224This is used only for RETRACT mode (TMGMODE=2).
225"KRN",8994,2500,2,3,1,2,0)
226
227"KRN",8994,2500,2,3,1,3,0)
228Must be 10-60 characters giving reason for retraction.
229"KRN",8994,2500,2,"B","TMGIEN",1)
230
231"KRN",8994,2500,2,"B","TMGMODE",2)
232
233"KRN",8994,2500,2,"B","TMGREASON",3)
234
235"KRN",8994,2500,2,"PARAMSEQ",1,1)
236
237"KRN",8994,2500,2,"PARAMSEQ",2,2)
238
239"KRN",8994,2500,2,"PARAMSEQ",3,3)
240
241"KRN",8994,2500,3,0)
242^^2^2^3100711^^
243"KRN",8994,2500,3,1,0)
244Return value will be:
245"KRN",8994,2500,3,2,0)
246'1^Success' or '-1^Error Message'
247"MBREQ")
2480
249"ORD",16,8994)
2508994;16;1;;;;;;;RPCDEL^XPDIA1
251"ORD",16,8994,0)
252REMOTE PROCEDURE
253"QUES","XPF1",0)
254Y
255"QUES","XPF1","??")
256^D REP^XPDH
257"QUES","XPF1","A")
258Shall I write over your |FLAG| File
259"QUES","XPF1","B")
260YES
261"QUES","XPF1","M")
262D XPF1^XPDIQ
263"QUES","XPF2",0)
264Y
265"QUES","XPF2","??")
266^D DTA^XPDH
267"QUES","XPF2","A")
268Want my data |FLAG| yours
269"QUES","XPF2","B")
270YES
271"QUES","XPF2","M")
272D XPF2^XPDIQ
273"QUES","XPI1",0)
274YO
275"QUES","XPI1","??")
276^D INHIBIT^XPDH
277"QUES","XPI1","A")
278Want KIDS to INHIBIT LOGONs during the install
279"QUES","XPI1","B")
280NO
281"QUES","XPI1","M")
282D XPI1^XPDIQ
283"QUES","XPM1",0)
284PO^VA(200,:EM
285"QUES","XPM1","??")
286^D MG^XPDH
287"QUES","XPM1","A")
288Enter the Coordinator for Mail Group '|FLAG|'
289"QUES","XPM1","B")
290
291"QUES","XPM1","M")
292D XPM1^XPDIQ
293"QUES","XPO1",0)
294Y
295"QUES","XPO1","??")
296^D MENU^XPDH
297"QUES","XPO1","A")
298Want KIDS to Rebuild Menu Trees Upon Completion of Install
299"QUES","XPO1","B")
300NO
301"QUES","XPO1","M")
302D XPO1^XPDIQ
303"QUES","XPZ1",0)
304Y
305"QUES","XPZ1","??")
306^D OPT^XPDH
307"QUES","XPZ1","A")
308Want to DISABLE Scheduled Options, Menu Options, and Protocols
309"QUES","XPZ1","B")
310NO
311"QUES","XPZ1","M")
312D XPZ1^XPDIQ
313"QUES","XPZ2",0)
314Y
315"QUES","XPZ2","??")
316^D RTN^XPDH
317"QUES","XPZ2","A")
318Want to MOVE routines to other CPUs
319"QUES","XPZ2","B")
320NO
321"QUES","XPZ2","M")
322D XPZ2^XPDIQ
323"RTN")
3244
325"RTN","TMGRPC1")
3260^1^B6434
327"RTN","TMGRPC1",1,0)
328TMGRPC1 ;TMG/kst-RPC Functions ;03/25/06
329"RTN","TMGRPC1",2,0)
330 ;;1.0;TMG-LIB;**1**;08/18/09;Build 2
331"RTN","TMGRPC1",3,0)
332
333"RTN","TMGRPC1",4,0)
334 ;"TMG RPC FUNCTIONS
335"RTN","TMGRPC1",5,0)
336
337"RTN","TMGRPC1",6,0)
338 ;"Kevin Toppenberg MD
339"RTN","TMGRPC1",7,0)
340 ;"GNU General Public License (GPL) applies
341"RTN","TMGRPC1",8,0)
342 ;"3/24/07
343"RTN","TMGRPC1",9,0)
344
345"RTN","TMGRPC1",10,0)
346 ;"=======================================================================
347"RTN","TMGRPC1",11,0)
348 ;" RPC -- Public Functions.
349"RTN","TMGRPC1",12,0)
350 ;"=======================================================================
351"RTN","TMGRPC1",13,0)
352 ;"DOWNLOAD(GREF,FPATH,FNAME,LOCIEN)
353"RTN","TMGRPC1",14,0)
354 ;"UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY)
355"RTN","TMGRPC1",15,0)
356 ;"DOWNDROP(RESULT,FPATH,FNAME,LOCIEN) -- Download drop box file
357"RTN","TMGRPC1",16,0)
358 ;"UPLDDROP(RESULT,FPATH,FNAME,LOCIEN) -- Upload Dropbox File
359"RTN","TMGRPC1",17,0)
360 ;"GETLONG(GREF,IMAGEIEN)
361"RTN","TMGRPC1",18,0)
362 ;"GETDFN(RESULT,RECNUM,RECFIELD,LNAME,FNAME,MNAME,DOB,SEX,SSNUM)
363"RTN","TMGRPC1",19,0)
364 ;"BLANKTIU(RESULT,DFN,PERSON,LOC,DOS,TITLE)
365"RTN","TMGRPC1",20,0)
366 ;"AUTOSIGN(RESULT,DOCIEN)
367"RTN","TMGRPC1",21,0)
368 ;"FNINFO(RESULT,DFN) -- GET PATIENT DEMOGRAPHICS
369"RTN","TMGRPC1",22,0)
370 ;"PTADD(RESULT,INFO) -- ADD PATIENT
371"RTN","TMGRPC1",23,0)
372 ;"STPTINFO(RESULT,DFN,INFO) -- SET PATIENT DEMOGRAPHICS
373"RTN","TMGRPC1",24,0)
374 ;"GETURLS(RESULT) -- TMG CPRS GET URL LIST
375"RTN","TMGRPC1",25,0)
376
377"RTN","TMGRPC1",26,0)
378 ;"=======================================================================
379"RTN","TMGRPC1",27,0)
380 ;"PRIVATE API FUNCTIONS
381"RTN","TMGRPC1",28,0)
382 ;"=======================================================================
383"RTN","TMGRPC1",29,0)
384 ;"ENCODE(GRef,incSubscr,encodeFn)
385"RTN","TMGRPC1",30,0)
386 ;"DECODE(GRef,incSubscr,decodeFn)
387"RTN","TMGRPC1",31,0)
388 ;"$$HEXCODER(INPUT) ;"encode the input string. Currently using simple hex encoding/
389"RTN","TMGRPC1",32,0)
390 ;"$$B64CODER(INPUT) ;"encode the input string via UUENCODE (actually Base64)
391"RTN","TMGRPC1",33,0)
392 ;"$$B64DECODER(INPUT) ;"encode the input string via UUDECODE (actually Base64)
393"RTN","TMGRPC1",34,0)
394
395"RTN","TMGRPC1",35,0)
396 ;"=======================================================================
397"RTN","TMGRPC1",36,0)
398 ;"=======================================================================
399"RTN","TMGRPC1",37,0)
400 ;"Dependencies:
401"RTN","TMGRPC1",38,0)
402 ;"TMGBINF
403"RTN","TMGRPC1",39,0)
404 ;"TMGSTUTL
405"RTN","TMGRPC1",40,0)
406 ;"RGUTUU
407"RTN","TMGRPC1",41,0)
408 ;"=======================================================================
409"RTN","TMGRPC1",42,0)
410 ;"=======================================================================
411"RTN","TMGRPC1",43,0)
412
413"RTN","TMGRPC1",44,0)
414DOWNLOAD(GREF,FPATH,FNAME,LOCIEN)
415"RTN","TMGRPC1",45,0)
416 GOTO DOWNLOAD+1^TMGRPC1C
417"RTN","TMGRPC1",46,0)
418 ;
419"RTN","TMGRPC1",47,0)
420UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY)
421"RTN","TMGRPC1",48,0)
422 GOTO UPLOAD+1^TMGRPC1C
423"RTN","TMGRPC1",49,0)
424 ;
425"RTN","TMGRPC1",50,0)
426DOWNDROP(RESULT,FPATH,FNAME,LOCIEN) ;"i.e. Download drop box file
427"RTN","TMGRPC1",51,0)
428 GOTO DOWNDROP+1^TMGRPC1C
429"RTN","TMGRPC1",52,0)
430 ;
431"RTN","TMGRPC1",53,0)
432UPLDDROP(RESULT,FPATH,FNAME,LOCIEN) ;"i.e. Upload Dropbox File
433"RTN","TMGRPC1",54,0)
434 GOTO UPLDDROP+1^TMGRPC1C
435"RTN","TMGRPC1",55,0)
436 ;
437"RTN","TMGRPC1",56,0)
438ENCODE(GRef,incSubscr,encodeFn) ;"Purpose: ENCODE a BINARY GLOBAL.
439"RTN","TMGRPC1",57,0)
440 GOTO ENCODE+1^TMGRPC1C
441"RTN","TMGRPC1",58,0)
442 ;
443"RTN","TMGRPC1",59,0)
444DECODE(GRef,incSubscr,decodeFn) ;"Purpose: ENCODE a BINARY GLOBAL.
445"RTN","TMGRPC1",60,0)
446 GOTO DECODE+1^TMGRPC1C
447"RTN","TMGRPC1",61,0)
448 ;
449"RTN","TMGRPC1",62,0)
450GETLONG(GREF,IMAGEIEN)
451"RTN","TMGRPC1",63,0)
452 ;"SCOPE: Public
453"RTN","TMGRPC1",64,0)
454 ;"Purpose: To provide an entry point for a RPC call from a client.
455"RTN","TMGRPC1",65,0)
456 ;" Will return results of field 11 (LONG DESCRIPTION) from file IMAGE(2005)
457"RTN","TMGRPC1",66,0)
458 ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE)
459"RTN","TMGRPC1",67,0)
460 ;" IMAGEIEN-- The IEN (record number) from file 2005 (IMAGE)
461"RTN","TMGRPC1",68,0)
462 ;"Output: results are passed out in @GREF
463"RTN","TMGRPC1",69,0)
464 ;" @GREF@(0) = WP header line: format is: ^^MaxLine^MaxLine^TimeStamp(FM Date/Time Format)
465"RTN","TMGRPC1",70,0)
466 ;" @GREF@(1) = WP line 1
467"RTN","TMGRPC1",71,0)
468 ;" @GREF@(2) = WP line 2
469"RTN","TMGRPC1",72,0)
470 ;" @GREF@(3) = WP line 3
471"RTN","TMGRPC1",73,0)
472 ;" @GREF@(4) = WP line 4 ... etc.
473"RTN","TMGRPC1",74,0)
474
475"RTN","TMGRPC1",75,0)
476 set GREF="^TMP(""GETLONG^TMGRPC1"","_$J_")"
477"RTN","TMGRPC1",76,0)
478
479"RTN","TMGRPC1",77,0)
480 kill @GREF
481"RTN","TMGRPC1",78,0)
482
483"RTN","TMGRPC1",79,0)
484 new i,s,MaxLines,header
485"RTN","TMGRPC1",80,0)
486 set header=""
487"RTN","TMGRPC1",81,0)
488 if +$get(IMAGEIEN)>0 do
489"RTN","TMGRPC1",82,0)
490 . set header=$get(^MAG(2005,IMAGEIEN,3,0)) ;"NOTE: Field 11 held in node 3;0
491"RTN","TMGRPC1",83,0)
492 set @GREF@(0)=header
493"RTN","TMGRPC1",84,0)
494 set MaxLines=+$piece(header,"^",3)
495"RTN","TMGRPC1",85,0)
496 for i=1:1:MaxLines do
497"RTN","TMGRPC1",86,0)
498 . set @GREF@(i)=$get(^MAG(2005,IMAGEIEN,3,i,0))
499"RTN","TMGRPC1",87,0)
500
501"RTN","TMGRPC1",88,0)
502 quit
503"RTN","TMGRPC1",89,0)
504
505"RTN","TMGRPC1",90,0)
506
507"RTN","TMGRPC1",91,0)
508
509"RTN","TMGRPC1",92,0)
510GETDFN(RESULT,RECNUM,PMS,FNAME,LNAME,MNAME,DOB,SEX,SSNUM,AUTOADD)
511"RTN","TMGRPC1",93,0)
512 ;"Purpose: This is a RPC entry point for looking up a patient.
513"RTN","TMGRPC1",94,0)
514 ;"Input:
515"RTN","TMGRPC1",95,0)
516 ;" RESULT -- an OUT PARAMETER
517"RTN","TMGRPC1",96,0)
518 ;" RECNUM -- Record number from a PMS
519"RTN","TMGRPC1",97,0)
520 ;" PMS -- Which PMS RECNUM refers to (1=Medic,2=Sequel,3=Paradigm)
521"RTN","TMGRPC1",98,0)
522 ;" FNAME -- First Name
523"RTN","TMGRPC1",99,0)
524 ;" LNAME -- Last name
525"RTN","TMGRPC1",100,0)
526 ;" MNAME -- Middle Name or initial
527"RTN","TMGRPC1",101,0)
528 ;" DOB -- Date of birth in EXTERNAL format
529"RTN","TMGRPC1",102,0)
530 ;" SEX -- Patient sex: M or F
531"RTN","TMGRPC1",103,0)
532 ;" SSNUM -- Social security number (digits only)
533"RTN","TMGRPC1",104,0)
534 ;" AUTOADD -- Automatically register patient if needed (if value=1)
535"RTN","TMGRPC1",105,0)
536 ;"Output: Patient may be added to database if AUTOADD=1
537"RTN","TMGRPC1",106,0)
538 ;"Results: Returns DFN (i.e. IEN in PATIENT file) or -1 if not found or error
539"RTN","TMGRPC1",107,0)
540
541"RTN","TMGRPC1",108,0)
542 new Patient,TMGFREG
543"RTN","TMGRPC1",109,0)
544 set RESULT=-1 ;"default to not found
545"RTN","TMGRPC1",110,0)
546
547"RTN","TMGRPC1",111,0)
548 if $get(LNAME)'="" do
549"RTN","TMGRPC1",112,0)
550 . set Patient("NAME")=$get(LNAME)
551"RTN","TMGRPC1",113,0)
552 . if $get(FNAME)'="" set Patient("NAME")=Patient("NAME")_","_FNAME
553"RTN","TMGRPC1",114,0)
554 . if $get(MNAME)'="" set Patient("NAME")=Patient("NAME")_" "_MNAME
555"RTN","TMGRPC1",115,0)
556 set Patient("DOB")=$get(DOB)
557"RTN","TMGRPC1",116,0)
558 set Patient("SEX")=$get(SEX)
559"RTN","TMGRPC1",117,0)
560 set Patient("SSNUM")=$get(SSNUM)
561"RTN","TMGRPC1",118,0)
562test if $get(AUTOADD)=1 set TMGFREG=1
563"RTN","TMGRPC1",119,0)
564
565"RTN","TMGRPC1",120,0)
566 if $get(PMS)=1 set Patient("PATIENTNUM")=$get(RECNUM) ;" <-- Medic account number
567"RTN","TMGRPC1",121,0)
568 if $get(PMS)=2 set Patient("SEQUELNUM")=$get(RECNUM) ;" <-- Sequel or other account number
569"RTN","TMGRPC1",122,0)
570 if $get(PMS)=3 set Patient("PARADIGMNUM")=$get(RECNUM) ;" <-- Paradigm or other account number
571"RTN","TMGRPC1",123,0)
572
573"RTN","TMGRPC1",124,0)
574 ;"temp
575"RTN","TMGRPC1",125,0)
576 ;"merge ^TMG("TMP","GETDFN","KILLLATER")=Patient
577"RTN","TMGRPC1",126,0)
578 ;"set ^TMG("TMP","GETDFN","KILLLATER","FNAME")=FNAME
579"RTN","TMGRPC1",127,0)
580 ;"set ^TMG("TMP","GETDFN","KILLLATER","LNAME")=LNAME
581"RTN","TMGRPC1",128,0)
582 ;"set ^TMG("TMP","GETDFN","KILLLATER","MNAME")=MNAME
583"RTN","TMGRPC1",129,0)
584
585"RTN","TMGRPC1",130,0)
586 set RESULT=$$GetDFN^TMGGDFN(.Patient)
587"RTN","TMGRPC1",131,0)
588
589"RTN","TMGRPC1",132,0)
590 quit
591"RTN","TMGRPC1",133,0)
592
593"RTN","TMGRPC1",134,0)
594
595"RTN","TMGRPC1",135,0)
596BLANKTIU(RESULT,DFN,PERSON,LOC,DOS,TITLE)
597"RTN","TMGRPC1",136,0)
598 ;"Purpose: To create a new, blank TIU note and return it's IEN
599"RTN","TMGRPC1",137,0)
600 ;"Input: DFN -- IEN in PATIENT file of patient
601"RTN","TMGRPC1",138,0)
602 ;" PERSON -- Provider NAME
603"RTN","TMGRPC1",139,0)
604 ;" LOC -- Location for new document
605"RTN","TMGRPC1",140,0)
606 ;" DOS -- Date of Service
607"RTN","TMGRPC1",141,0)
608 ;" TITLE -- Title of new document
609"RTN","TMGRPC1",142,0)
610 ;"Results: IEN in file 8925 is returned in RESULT,
611"RTN","TMGRPC1",143,0)
612 ;" or -1^ErrMsg1;ErrMsg2... if failure
613"RTN","TMGRPC1",144,0)
614 ;"Note: This functionality probably duplicates that of RPC call:
615"RTN","TMGRPC1",145,0)
616 ;" TIU CREATE NOTE -- found after writing this...
617"RTN","TMGRPC1",146,0)
618
619"RTN","TMGRPC1",147,0)
620 new Document,Flag
621"RTN","TMGRPC1",148,0)
622
623"RTN","TMGRPC1",149,0)
624 kill ^TMG("TMP","BLANKTIU")
625"RTN","TMGRPC1",150,0)
626 set ^TMG("TMP","BLANKTIU","DFN")=$G(DFN)
627"RTN","TMGRPC1",151,0)
628 set ^TMG("TMP","BLANKTIU","PERSON")=$G(PERSON)
629"RTN","TMGRPC1",152,0)
630 set ^TMG("TMP","BLANKTIU","LOC")=$G(LOC)
631"RTN","TMGRPC1",153,0)
632 set ^TMG("TMP","BLANKTIU","DOS")=$G(DOS)
633"RTN","TMGRPC1",154,0)
634 set ^TMG("TMP","BLANKTIU","TITLE")=$G(TITLE)
635"RTN","TMGRPC1",155,0)
636
637"RTN","TMGRPC1",156,0)
638 set Document("DFN")=DFN
639"RTN","TMGRPC1",157,0)
640 set Document("PROVIDER IEN")=$$GetProvIEN^TMGPUTN0(PERSON)
641"RTN","TMGRPC1",158,0)
642 if +LOC=LOC s LOC="`"_LOC
643"RTN","TMGRPC1",159,0)
644 set Document("LOCATION")=$get(LOC)
645"RTN","TMGRPC1",160,0)
646 set Document("DATE")=$get(DOS)
647"RTN","TMGRPC1",161,0)
648 set Document("TITLE")=$get(TITLE)
649"RTN","TMGRPC1",162,0)
650 set Document("TRANSCRIPTIONIST")=""
651"RTN","TMGRPC1",163,0)
652 set Document("CHARACTER COUNT - TRANSCRIPTIONIST'S")=0
653"RTN","TMGRPC1",164,0)
654
655"RTN","TMGRPC1",165,0)
656 set RESULT=$$PrepDoc^TMGPUTN0(.Document)
657"RTN","TMGRPC1",166,0)
658 if +RESULT>0 do ;"change capture method from Upload (default) to RPC
659"RTN","TMGRPC1",167,0)
660 . new TMGFDA,TMGMSG
661"RTN","TMGRPC1",168,0)
662 . set TMGFDA(8925,RESULT_",",1303)="R" ;"1303 = capture method. "R" = RPC
663"RTN","TMGRPC1",169,0)
664 . merge ^TMG("TMP","BLANKTIU","TMGFDA")=TMGFDA
665"RTN","TMGRPC1",170,0)
666 . do FILE^DIE("E","TMGFDA","TMGMSG") ;"ignore any errors.
667"RTN","TMGRPC1",171,0)
668 else do
669"RTN","TMGRPC1",172,0)
670 . new i,ErrMsg set ErrMsg=""
671"RTN","TMGRPC1",173,0)
672 . for i=1:1:+$get(Document("ERROR","NUM")) do
673"RTN","TMGRPC1",174,0)
674 . . set ErrMsg=ErrMsg_$get(Document("ERROR",i))_" ||"
675"RTN","TMGRPC1",175,0)
676 . if $data(Document("ERROR","FM INFO"))>0 do
677"RTN","TMGRPC1",176,0)
678 . . new ref set ref="Document(""ERROR"",""FM INFO"")"
679"RTN","TMGRPC1",177,0)
680 . . set ErrMsg=ErrMsg_"FILEMAN SAYS:"
681"RTN","TMGRPC1",178,0)
682 . . for set ref=$query(@ref) quit:(ref="")!(ref'["FM INFO") do
683"RTN","TMGRPC1",179,0)
684 . . . if ErrMsg'="" set ErrMsg=ErrMsg_" ||"
685"RTN","TMGRPC1",180,0)
686 . . . set ErrMsg=ErrMsg_$piece(ref,"DIERR",2)_"="_$get(@ref)
687"RTN","TMGRPC1",181,0)
688 . if ErrMsg="" set ErrMsg="Unknown error"
689"RTN","TMGRPC1",182,0)
690 . set ErrMsg=$translate(ErrMsg,"^","@")
691"RTN","TMGRPC1",183,0)
692 . set $piece(RESULT,"^",2)=ErrMsg
693"RTN","TMGRPC1",184,0)
694
695"RTN","TMGRPC1",185,0)
696 ;"temp
697"RTN","TMGRPC1",186,0)
698 merge ^TMG("TMP","BLANKTIU","RESULT")=RESULT
699"RTN","TMGRPC1",187,0)
700 merge ^TMG("TMP","BLANKTIU","Document")=Document
701"RTN","TMGRPC1",188,0)
702
703"RTN","TMGRPC1",189,0)
704
705"RTN","TMGRPC1",190,0)
706 quit
707"RTN","TMGRPC1",191,0)
708
709"RTN","TMGRPC1",192,0)
710
711"RTN","TMGRPC1",193,0)
712AUTOSIGN(RESULT,DOCIEN)
713"RTN","TMGRPC1",194,0)
714 ;"Purpose: To automatically sign TIU note (8925).
715"RTN","TMGRPC1",195,0)
716 ;"Input: DOCIEN -- the IEN in 8925 of the file to be automatically signed.
717"RTN","TMGRPC1",196,0)
718 ;"Note: This function will not succeed unless field 1303 holds "R"
719"RTN","TMGRPC1",197,0)
720 ;" and an Author found for note
721"RTN","TMGRPC1",198,0)
722 ;"Results: Results passed back in RESULT(0) ARRAY
723"RTN","TMGRPC1",199,0)
724 ;" -1 = failure. 1= success
725"RTN","TMGRPC1",200,0)
726 ;" Any error message is passed back in RESULT("DIERR")
727"RTN","TMGRPC1",201,0)
728 ;"Note: This differs from RPC CALL: TIU SIGN RECORD in that a signiture
729"RTN","TMGRPC1",202,0)
730 ;" code is NOT required
731"RTN","TMGRPC1",203,0)
732
733"RTN","TMGRPC1",204,0)
734 new TMGFDA,TMGMSG
735"RTN","TMGRPC1",205,0)
736 new AuthorIEN,AuthorName
737"RTN","TMGRPC1",206,0)
738 new CaptureMethod
739"RTN","TMGRPC1",207,0)
740
741"RTN","TMGRPC1",208,0)
742 set DOCIEN=+$get(DOCIEN)
743"RTN","TMGRPC1",209,0)
744 set RESULT=-1 ;"default to failure
745"RTN","TMGRPC1",210,0)
746
747"RTN","TMGRPC1",211,0)
748 set CaptureMethod=$piece($get(^TIU(8925,DOCIEN,13)),"^",3)
749"RTN","TMGRPC1",212,0)
750 if CaptureMethod'="R" do goto ASDone
751"RTN","TMGRPC1",213,0)
752 . set RESULT("DIERR")="Unable to auto-sign. Upload-Method was not 'R'."
753"RTN","TMGRPC1",214,0)
754 set AuthorIEN=$piece($get(^TIU(8925,DOCIEN,12)),"^",2)
755"RTN","TMGRPC1",215,0)
756 if AuthorIEN'>0 do goto ASDone
757"RTN","TMGRPC1",216,0)
758 . set RESULT("DIERR")="Unable to find author of document."
759"RTN","TMGRPC1",217,0)
760 set AuthorName=$piece($get(^VA(200,AuthorIEN,0)),"^",1)
761"RTN","TMGRPC1",218,0)
762
763"RTN","TMGRPC1",219,0)
764 set TMGFDA(8925,DOCIEN_",",.05)="COMPLETED" ;"field .05 = STATUS
765"RTN","TMGRPC1",220,0)
766 set TMGFDA(8925,DOCIEN_",",1501)="NOW" ;"field 1501 = Signed date
767"RTN","TMGRPC1",221,0)
768 set TMGFDA(8925,DOCIEN_",",1502)="`"_AuthorIEN ;"field 1502 = signed by
769"RTN","TMGRPC1",222,0)
770 set TMGFDA(8925,DOCIEN_",",1503)=AuthorName ;"field 1503 = Signature block name
771"RTN","TMGRPC1",223,0)
772 set TMGFDA(8925,DOCIEN_",",1504)="[Scanned image auto-signed]" ;"field 1504 = Signature block title
773"RTN","TMGRPC1",224,0)
774 set TMGFDA(8925,DOCIEN_",",1505)="C" ;C=Chart ;"field 1505 = Signature mode
775"RTN","TMGRPC1",225,0)
776 do FILE^DIE("E","TMGFDA","TMGMSG")
777"RTN","TMGRPC1",226,0)
778 if $data(TMGMSG("DIERR")) do goto ASDone
779"RTN","TMGRPC1",227,0)
780 . merge RESULT("DIERR")=TMGMSG("DIERR")
781"RTN","TMGRPC1",228,0)
782
783"RTN","TMGRPC1",229,0)
784 set RESULT(0)=1 ;"set success if we got this far.
785"RTN","TMGRPC1",230,0)
786ASDone
787"RTN","TMGRPC1",231,0)
788 quit
789"RTN","TMGRPC1",232,0)
790
791"RTN","TMGRPC1",233,0)
792
793"RTN","TMGRPC1",234,0)
794DFNINFO(RESULT,DFN)
795"RTN","TMGRPC1",235,0)
796 ;"Purpose: To return array with demographcs details about patient
797"RTN","TMGRPC1",236,0)
798 ;"Input: RESULT (this is the output array)
799"RTN","TMGRPC1",237,0)
800 ;" DFN : The record number in file #2 of the patient to inquire about.
801"RTN","TMGRPC1",238,0)
802 ;"Results: Results passed back in RESULT array. Format as follows:
803"RTN","TMGRPC1",239,0)
804 ;" The results are in format: KeyName=Value,
805"RTN","TMGRPC1",240,0)
806 ;" There is no set order these will appear.
807"RTN","TMGRPC1",241,0)
808 ;" Here are the KeyName names that will be provided.
809"RTN","TMGRPC1",242,0)
810 ;" If the record has no value, then value will be empty
811"RTN","TMGRPC1",243,0)
812 ;" IEN=record#
813"RTN","TMGRPC1",244,0)
814 ;" COMBINED_NAME=
815"RTN","TMGRPC1",245,0)
816 ;" LNAME=
817"RTN","TMGRPC1",246,0)
818 ;" FNAME=
819"RTN","TMGRPC1",247,0)
820 ;" MNAME=
821"RTN","TMGRPC1",248,0)
822 ;" PREFIX=
823"RTN","TMGRPC1",249,0)
824 ;" SUFFIX=
825"RTN","TMGRPC1",250,0)
826 ;" DEGREE
827"RTN","TMGRPC1",251,0)
828 ;" DOB=
829"RTN","TMGRPC1",252,0)
830 ;" SEX=
831"RTN","TMGRPC1",253,0)
832 ;" SS_NUM=
833"RTN","TMGRPC1",254,0)
834 ;" ADDRESS_LINE_1=
835"RTN","TMGRPC1",255,0)
836 ;" ADDRESS_LINE_2=
837"RTN","TMGRPC1",256,0)
838 ;" ADDRESS_LINE_3=
839"RTN","TMGRPC1",257,0)
840 ;" CITY=
841"RTN","TMGRPC1",258,0)
842 ;" STATE=
843"RTN","TMGRPC1",259,0)
844 ;" ZIP4=
845"RTN","TMGRPC1",260,0)
846 ;" BAD_ADDRESS=
847"RTN","TMGRPC1",261,0)
848 ;" TEMP_ADDRESS_LINE_1=
849"RTN","TMGRPC1",262,0)
850 ;" TEMP_ADDRESS_LINE_2=
851"RTN","TMGRPC1",263,0)
852 ;" TEMP_ADDRESS_LINE_3=
853"RTN","TMGRPC1",264,0)
854 ;" TEMP_CITY=
855"RTN","TMGRPC1",265,0)
856 ;" TEMP_STATE=
857"RTN","TMGRPC1",266,0)
858 ;" TEMP_ZIP4=
859"RTN","TMGRPC1",267,0)
860 ;" TEMP_STARTING_DATE=
861"RTN","TMGRPC1",268,0)
862 ;" TEMP_ENDING_DATE=
863"RTN","TMGRPC1",269,0)
864 ;" TEMP_ADDRESS_ACTIVE=
865"RTN","TMGRPC1",270,0)
866 ;" CONF_ADDRESS_LINE_1=
867"RTN","TMGRPC1",271,0)
868 ;" CONF_ADDRESS_LINE_2=
869"RTN","TMGRPC1",272,0)
870 ;" CONF_ADDRESS_LINE_3=
871"RTN","TMGRPC1",273,0)
872 ;" CONF_CITY=
873"RTN","TMGRPC1",274,0)
874 ;" CONF_STATE=
875"RTN","TMGRPC1",275,0)
876 ;" CONF_ZIP4=
877"RTN","TMGRPC1",276,0)
878 ;" CONF_STARTING_DATE=
879"RTN","TMGRPC1",277,0)
880 ;" CONF_ENDING_DATE=
881"RTN","TMGRPC1",278,0)
882 ;" CONF_ADDRESS_ACTIVE=
883"RTN","TMGRPC1",279,0)
884 ;" PHONE_RESIDENCE=
885"RTN","TMGRPC1",280,0)
886 ;" PHONE_WORK=
887"RTN","TMGRPC1",281,0)
888 ;" PHONE_CELL=
889"RTN","TMGRPC1",282,0)
890 ;" PHONE_TEMP=
891"RTN","TMGRPC1",283,0)
892
893"RTN","TMGRPC1",284,0)
894 ;"Note, for the following, there may be multiple entries. # is record number
895"RTN","TMGRPC1",285,0)
896 ;" ALIAS # NAME
897"RTN","TMGRPC1",286,0)
898 ;" ALIAS # SSN
899"RTN","TMGRPC1",287,0)
900
901"RTN","TMGRPC1",288,0)
902 new TMGFDA,TMGMSG,IENS
903"RTN","TMGRPC1",289,0)
904 set IENS=""
905"RTN","TMGRPC1",290,0)
906 new ptrParts set ptrParts=0
907"RTN","TMGRPC1",291,0)
908 set DFN=+$get(DFN)
909"RTN","TMGRPC1",292,0)
910 if DFN>0 do
911"RTN","TMGRPC1",293,0)
912 . set ptrParts=+$piece($get(^DPT(DFN,"NAME")),"^",1) ;"ptr to file #20, NAME COMPONENTS
913"RTN","TMGRPC1",294,0)
914 . set IENS=DFN_","
915"RTN","TMGRPC1",295,0)
916 . do GETS^DIQ(2,IENS,"**","N","TMGFDA","TMGMSG")
917"RTN","TMGRPC1",296,0)
918
919"RTN","TMGRPC1",297,0)
920 new line set line=0
921"RTN","TMGRPC1",298,0)
922 set RESULT(line)="IEN="_DFN set line=line+1
923"RTN","TMGRPC1",299,0)
924 set RESULT(line)="COMBINED_NAME="_$get(TMGFDA(2,IENS,.01)) set line=line+1
925"RTN","TMGRPC1",300,0)
926 new s set s=""
927"RTN","TMGRPC1",301,0)
928 if ptrParts>0 set s=$get(^VA(20,ptrParts,1))
929"RTN","TMGRPC1",302,0)
930 set RESULT(line)="LNAME="_$piece(s,"^",1) set line=line+1
931"RTN","TMGRPC1",303,0)
932 set RESULT(line)="FNAME="_$piece(s,"^",2) set line=line+1
933"RTN","TMGRPC1",304,0)
934 set RESULT(line)="MNAME="_$piece(s,"^",3) set line=line+1
935"RTN","TMGRPC1",305,0)
936 set RESULT(line)="PREFIX="_$piece(s,"^",4) set line=line+1
937"RTN","TMGRPC1",306,0)
938 set RESULT(line)="SUFFIX="_$piece(s,"^",5) set line=line+1
939"RTN","TMGRPC1",307,0)
940 set RESULT(line)="DEGREE="_$piece(s,"^",5) set line=line+1
941"RTN","TMGRPC1",308,0)
942 set RESULT(line)="DOB="_$get(TMGFDA(2,IENS,.03)) set line=line+1
943"RTN","TMGRPC1",309,0)
944 set RESULT(line)="SEX="_$get(TMGFDA(2,IENS,.02)) set line=line+1
945"RTN","TMGRPC1",310,0)
946 set RESULT(line)="SS_NUM="_$get(TMGFDA(2,IENS,.09)) set line=line+1
947"RTN","TMGRPC1",311,0)
948 set RESULT(line)="EMAIL="_$get(TMGFDA(2,IENS,.133)) set line=line+1
949"RTN","TMGRPC1",312,0)
950 set RESULT(line)="ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.111)) set line=line+1
951"RTN","TMGRPC1",313,0)
952 set RESULT(line)="ADDRESS_LINE_2="_$get(TMGFDA(2,IENS,.112)) set line=line+1
953"RTN","TMGRPC1",314,0)
954 set RESULT(line)="ADDRESS_LINE_3="_$get(TMGFDA(2,IENS,.113)) set line=line+1
955"RTN","TMGRPC1",315,0)
956 set RESULT(line)="CITY="_$get(TMGFDA(2,IENS,.114)) set line=line+1
957"RTN","TMGRPC1",316,0)
958 set RESULT(line)="STATE="_$get(TMGFDA(2,IENS,.115)) set line=line+1
959"RTN","TMGRPC1",317,0)
960 if $get(TMGFDA(2,IENS,.1122))'="" do
961"RTN","TMGRPC1",318,0)
962 . set RESULT(line)="ZIP4="_$get(TMGFDA(2,IENS,.1122)) set line=line+1
963"RTN","TMGRPC1",319,0)
964 else if $get(TMGFDA(2,IENS,.1116))'="" do
965"RTN","TMGRPC1",320,0)
966 . set RESULT(line)="ZIP4="_$get(TMGFDA(2,IENS,.1116)) set line=line+1
967"RTN","TMGRPC1",321,0)
968 set RESULT(line)="BAD_ADDRESS="_$get(TMGFDA(2,IENS,.121)) set line=line+1
969"RTN","TMGRPC1",322,0)
970 set RESULT(line)="TEMP_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1211)) set line=line+1
971"RTN","TMGRPC1",323,0)
972 set RESULT(line)="TEMP_ADDRESS_LINE_2="_$get(TMGFDA(2,IENS,.1212)) set line=line+1
973"RTN","TMGRPC1",324,0)
974 set RESULT(line)="TEMP_ADDRESS_LINE_3="_$get(TMGFDA(2,IENS,.1213)) set line=line+1
975"RTN","TMGRPC1",325,0)
976 set RESULT(line)="TEMP_CITY="_$get(TMGFDA(2,IENS,.1214)) set line=line+1
977"RTN","TMGRPC1",326,0)
978 set RESULT(line)="TEMP_STATE="_$get(TMGFDA(2,IENS,.1215)) set line=line+1
979"RTN","TMGRPC1",327,0)
980 set RESULT(line)="TEMP_ZIP4="_$get(TMGFDA(2,IENS,.1216)) set line=line+1
981"RTN","TMGRPC1",328,0)
982 set RESULT(line)="TEMP_STARTING_DATE="_$get(TMGFDA(2,IENS,.1217)) set line=line+1
983"RTN","TMGRPC1",329,0)
984 set RESULT(line)="TEMP_ENDING_DATE="_$get(TMGFDA(2,IENS,.1218)) set line=line+1
985"RTN","TMGRPC1",330,0)
986 set RESULT(line)="TEMP_ADDRESS_ACTIVE="_$get(TMGFDA(2,IENS,.12105)) set line=line+1
987"RTN","TMGRPC1",331,0)
988 set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1411)) set line=line+1
989"RTN","TMGRPC1",332,0)
990 set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1412)) set line=line+1
991"RTN","TMGRPC1",333,0)
992 set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1413)) set line=line+1
993"RTN","TMGRPC1",334,0)
994 set RESULT(line)="CONF_CITY="_$get(TMGFDA(2,IENS,.1414)) set line=line+1
995"RTN","TMGRPC1",335,0)
996 set RESULT(line)="CONF_STATE="_$get(TMGFDA(2,IENS,.1415)) set line=line+1
997"RTN","TMGRPC1",336,0)
998 set RESULT(line)="CONF_ZIP4="_$get(TMGFDA(2,IENS,.1416)) set line=line+1
999"RTN","TMGRPC1",337,0)
1000 set RESULT(line)="CONF_STARTING_DATE="_$get(TMGFDA(2,IENS,.1417)) set line=line+1
1001"RTN","TMGRPC1",338,0)
1002 set RESULT(line)="CONF_ENDING_DATE="_$get(TMGFDA(2,IENS,.1418)) set line=line+1
1003"RTN","TMGRPC1",339,0)
1004 set RESULT(line)="CONF_ADDRESS_ACTIVE="_$get(TMGFDA(2,IENS,.14105)) set line=line+1
1005"RTN","TMGRPC1",340,0)
1006 set RESULT(line)="PHONE_RESIDENCE="_$get(TMGFDA(2,IENS,.131)) set line=line+1
1007"RTN","TMGRPC1",341,0)
1008 set RESULT(line)="PHONE_WORK="_$get(TMGFDA(2,IENS,.132)) set line=line+1
1009"RTN","TMGRPC1",342,0)
1010 set RESULT(line)="PHONE_CELL="_$get(TMGFDA(2,IENS,.134)) set line=line+1
1011"RTN","TMGRPC1",343,0)
1012 set RESULT(line)="PHONE_TEMP="_$get(TMGFDA(2,IENS,.1219)) set line=line+1
1013"RTN","TMGRPC1",344,0)
1014
1015"RTN","TMGRPC1",345,0)
1016 ;"the GETS doesn't return ALIAS entries, so will do manually:
1017"RTN","TMGRPC1",346,0)
1018 new Itr,IEN
1019"RTN","TMGRPC1",347,0)
1020 set IEN=$$ItrInit^TMGITR(2.01,.Itr,DFN_",")
1021"RTN","TMGRPC1",348,0)
1022 if IEN'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN)'>0)
1023"RTN","TMGRPC1",349,0)
1024 . new s set s=$get(^DPT(DFN,.01,IEN,0))
1025"RTN","TMGRPC1",350,0)
1026 . if s="" quit
1027"RTN","TMGRPC1",351,0)
1028 . set RESULT(line)="ALIAS "_IEN_" NAME="_$piece(s,"^",1) set line=line+1
1029"RTN","TMGRPC1",352,0)
1030 . set RESULT(line)="ALIAS "_IEN_" SSN="_$piece(s,"^",2) set line=line+1
1031"RTN","TMGRPC1",353,0)
1032 . ;"maybe later do something with NAME COMPONENTS in Alias.
1033"RTN","TMGRPC1",354,0)
1034
1035"RTN","TMGRPC1",355,0)
1036 quit
1037"RTN","TMGRPC1",356,0)
1038
1039"RTN","TMGRPC1",357,0)
1040
1041"RTN","TMGRPC1",358,0)
1042STPTINFO(RESULT,DFN,INFO) ;" SET PATIENT INFO
1043"RTN","TMGRPC1",359,0)
1044 ;"Purpose: To set demographcs details about patient
1045"RTN","TMGRPC1",360,0)
1046 ;"Input: RESULT (this is the output array)
1047"RTN","TMGRPC1",361,0)
1048 ;" DFN : The record number in file #2 of the patient to inquire about.
1049"RTN","TMGRPC1",362,0)
1050 ;" INFO: Format as follows:
1051"RTN","TMGRPC1",363,0)
1052 ;" The results are in format: INFO("KeyName")=Value,
1053"RTN","TMGRPC1",364,0)
1054 ;" There is no set order these will appear.
1055"RTN","TMGRPC1",365,0)
1056 ;" Here are the KeyName names that will be provided.
1057"RTN","TMGRPC1",366,0)
1058 ;" If the record has no value, then value will be empty
1059"RTN","TMGRPC1",367,0)
1060 ;" If a record should be deleted, its value will be @
1061"RTN","TMGRPC1",368,0)
1062 ;" INFO("COMBINED_NAME")=
1063"RTN","TMGRPC1",369,0)
1064 ;" INFO("PREFIX")=
1065"RTN","TMGRPC1",370,0)
1066 ;" INFO("SUFFIX")=
1067"RTN","TMGRPC1",371,0)
1068 ;" INFO("DEGREE")=
1069"RTN","TMGRPC1",372,0)
1070 ;" INFO("DOB")=
1071"RTN","TMGRPC1",373,0)
1072 ;" INFO("SEX")=
1073"RTN","TMGRPC1",374,0)
1074 ;" INFO("SS_NUM")=
1075"RTN","TMGRPC1",375,0)
1076 ;" INFO("ADDRESS_LINE_1")=
1077"RTN","TMGRPC1",376,0)
1078 ;" INFO("ADDRESS_LINE_2")=
1079"RTN","TMGRPC1",377,0)
1080 ;" INFO("ADDRESS_LINE_3")=
1081"RTN","TMGRPC1",378,0)
1082 ;" INFO("CITY")=
1083"RTN","TMGRPC1",379,0)
1084 ;" INFO("STATE")=
1085"RTN","TMGRPC1",380,0)
1086 ;" INFO("ZIP4")=
1087"RTN","TMGRPC1",381,0)
1088 ;" INFO("BAD_ADDRESS")=
1089"RTN","TMGRPC1",382,0)
1090 ;" INFO("TEMP_ADDRESS_LINE_1")=
1091"RTN","TMGRPC1",383,0)
1092 ;" INFO("TEMP_ADDRESS_LINE_2")=
1093"RTN","TMGRPC1",384,0)
1094 ;" INFO("TEMP_ADDRESS_LINE_3")=
1095"RTN","TMGRPC1",385,0)
1096 ;" INFO("TEMP_CITY")=
1097"RTN","TMGRPC1",386,0)
1098 ;" INFO("TEMP_STATE")=
1099"RTN","TMGRPC1",387,0)
1100 ;" INFO("TEMP_ZIP4")=
1101"RTN","TMGRPC1",388,0)
1102 ;" INFO("TEMP_STARTING_DATE")=
1103"RTN","TMGRPC1",389,0)
1104 ;" INFO("TEMP_ENDING_DATE")=
1105"RTN","TMGRPC1",390,0)
1106 ;" INFO("TEMP_ADDRESS_ACTIVE")=
1107"RTN","TMGRPC1",391,0)
1108 ;" INFO("CONF_ADDRESS_LINE_1")=
1109"RTN","TMGRPC1",392,0)
1110 ;" INFO("CONF_ADDRESS_LINE_2")=
1111"RTN","TMGRPC1",393,0)
1112 ;" INFO("CONF_ADDRESS_LINE_3")=
1113"RTN","TMGRPC1",394,0)
1114 ;" INFO("CONF_CITY")=
1115"RTN","TMGRPC1",395,0)
1116 ;" INFO("CONF_STATE")=
1117"RTN","TMGRPC1",396,0)
1118 ;" INFO("CONF_ZIP4")=
1119"RTN","TMGRPC1",397,0)
1120 ;" INFO("CONF_STARTING_DATE")=
1121"RTN","TMGRPC1",398,0)
1122 ;" INFO("CONF_ENDING_DATE")=
1123"RTN","TMGRPC1",399,0)
1124 ;" INFO("CONF_ADDRESS_ACTIVE")=
1125"RTN","TMGRPC1",400,0)
1126 ;" INFO("PHONE_RESIDENCE")=
1127"RTN","TMGRPC1",401,0)
1128 ;" INFO("PHONE_WORK")=
1129"RTN","TMGRPC1",402,0)
1130 ;" INFO("PHONE_CELL")=
1131"RTN","TMGRPC1",403,0)
1132 ;" INFO("PHONE_TEMP")=
1133"RTN","TMGRPC1",404,0)
1134 ;"Note, for the following, there may be multiple entries. # is record number
1135"RTN","TMGRPC1",405,0)
1136 ;" If a record should be added, it will be marked +1, +2 etc.
1137"RTN","TMGRPC1",406,0)
1138 ;" INFO("ALIAS # NAME")=
1139"RTN","TMGRPC1",407,0)
1140 ;" INFO("ALIAS # SSN")=
1141"RTN","TMGRPC1",408,0)
1142 ;"
1143"RTN","TMGRPC1",409,0)
1144 ;"Results: Results passed back in RESULT string:
1145"RTN","TMGRPC1",410,0)
1146 ;" 1 = success
1147"RTN","TMGRPC1",411,0)
1148 ;" -1^Message = failure
1149"RTN","TMGRPC1",412,0)
1150
1151"RTN","TMGRPC1",413,0)
1152 set RESULT=1 ;"default to success
1153"RTN","TMGRPC1",414,0)
1154
1155"RTN","TMGRPC1",415,0)
1156 ;"kill ^TMG("TMP","RPC")
1157"RTN","TMGRPC1",416,0)
1158 ;"merge ^TMG("TMP","RPC")=INFO ;"temp... remove later
1159"RTN","TMGRPC1",417,0)
1160
1161"RTN","TMGRPC1",418,0)
1162 new TMGFDA,TMGMSG,IENS
1163"RTN","TMGRPC1",419,0)
1164 set IENS=DFN_","
1165"RTN","TMGRPC1",420,0)
1166 new key set key=""
1167"RTN","TMGRPC1",421,0)
1168 for set key=$order(INFO(key)) quit:(key="") do
1169"RTN","TMGRPC1",422,0)
1170 . if key="COMBINED_NAME" set TMGFDA(2,IENS,.01)=INFO("COMBINED_NAME")
1171"RTN","TMGRPC1",423,0)
1172 . else if +key=key set TMGFDA(2,IENS,key)=INFO(key)
1173"RTN","TMGRPC1",424,0)
1174 . else if key="DOB" set TMGFDA(2,IENS,.03)=INFO("DOB")
1175"RTN","TMGRPC1",425,0)
1176 . else if key="SEX" set TMGFDA(2,IENS,.02)=INFO("SEX")
1177"RTN","TMGRPC1",426,0)
1178 . else if key="SS_NUM" set TMGFDA(2,IENS,.09)=INFO("SS_NUM")
1179"RTN","TMGRPC1",427,0)
1180 . else if key="ADDRESS_LINE_1" set TMGFDA(2,IENS,.111)=INFO("ADDRESS_LINE_1")
1181"RTN","TMGRPC1",428,0)
1182 . else if key="ADDRESS_LINE_2" set TMGFDA(2,IENS,.112)=INFO("ADDRESS_LINE_2")
1183"RTN","TMGRPC1",429,0)
1184 . else if key="ADDRESS_LINE_3" set TMGFDA(2,IENS,.113)=INFO("ADDRESS_LINE_3")
1185"RTN","TMGRPC1",430,0)
1186 . else if key="CITY" set TMGFDA(2,IENS,.114)=INFO("CITY")
1187"RTN","TMGRPC1",431,0)
1188 . else if key="STATE" set TMGFDA(2,IENS,.115)=INFO("STATE")
1189"RTN","TMGRPC1",432,0)
1190 . else if key="ZIP4" set TMGFDA(2,IENS,.1112)=INFO("ZIP4")
1191"RTN","TMGRPC1",433,0)
1192 . else if key="BAD_ADDRESS" set TMGFDA(2,IENS,.121)=INFO("BAD_ADDRESS")
1193"RTN","TMGRPC1",434,0)
1194 . else if key="TEMP_ADDRESS_LINE_1" set TMGFDA(2,IENS,.1211)=INFO("TEMP_ADDRESS_LINE_1")
1195"RTN","TMGRPC1",435,0)
1196 . else if key="TEMP_ADDRESS_LINE_2" set TMGFDA(2,IENS,.1212)=INFO("TEMP_ADDRESS_LINE_2")
1197"RTN","TMGRPC1",436,0)
1198 . else if key="TEMP_ADDRESS_LINE_3" set TMGFDA(2,IENS,.1213)=INFO("TEMP_ADDRESS_LINE_3")
1199"RTN","TMGRPC1",437,0)
1200 . else if key="TEMP_CITY" set TMGFDA(2,IENS,.1214)=INFO("TEMP_CITY")
1201"RTN","TMGRPC1",438,0)
1202 . else if key="TEMP_STATE" set TMGFDA(2,IENS,.1215)=INFO("TEMP_STATE")
1203"RTN","TMGRPC1",439,0)
1204 . else if key="TEMP_ZIP4" set TMGFDA(2,IENS,.12112)=INFO("TEMP_ZIP4")
1205"RTN","TMGRPC1",440,0)
1206 . else if key="TEMP_STARTING_DATE" set TMGFDA(2,IENS,.1217)=INFO("TEMP_STARTING_DATE")
1207"RTN","TMGRPC1",441,0)
1208 . else if key="TEMP_ENDING_DATE" set TMGFDA(2,IENS,.1218)=INFO("TEMP_ENDING_DATE")
1209"RTN","TMGRPC1",442,0)
1210 . else if key="TEMP_ADDRESS_ACTIVE" set TMGFDA(2,IENS,.12105)=INFO("TEMP_ADDRESS_ACTIVE")
1211"RTN","TMGRPC1",443,0)
1212 . else if key="CONF_ADDRESS_LINE_1" set TMGFDA(2,IENS,.1411)=INFO("CONF_ADDRESS_LINE_1")
1213"RTN","TMGRPC1",444,0)
1214 . else if key="CONF_ADDRESS_LINE_2" set TMGFDA(2,IENS,.1412)=INFO("CONF_ADDRESS_LINE_2")
1215"RTN","TMGRPC1",445,0)
1216 . else if key="CONF_ADDRESS_LINE_3" set TMGFDA(2,IENS,.1413)=INFO("CONF_ADDRESS_LINE_3")
1217"RTN","TMGRPC1",446,0)
1218 . else if key="CONF_CITY" set TMGFDA(2,IENS,.1414)=INFO("CONF_CITY")
1219"RTN","TMGRPC1",447,0)
1220 . else if key="CONF_STATE" set TMGFDA(2,IENS,.1415)=INFO("CONF_STATE")
1221"RTN","TMGRPC1",448,0)
1222 . else if key="CONF_ZIP" set TMGFDA(2,IENS,.1416)=INFO("CONF_ZIP")
1223"RTN","TMGRPC1",449,0)
1224 . else if key="CONF_STARTING_DATE" set TMGFDA(2,IENS,.1417)=INFO("CONF_STARTING_DATE")
1225"RTN","TMGRPC1",450,0)
1226 . else if key="CONF_ENDING_DATE" set TMGFDA(2,IENS,.1418)=INFO("CONF_ENDING_DATE")
1227"RTN","TMGRPC1",451,0)
1228 . else if key="CONF_ADDRESS_ACTIVE" set TMGFDA(2,IENS,.14105)=INFO("CONF_ADDRESS_ACTIVE")
1229"RTN","TMGRPC1",452,0)
1230 . else if key="PHONE_RESIDENCE" set TMGFDA(2,IENS,.131)=INFO("PHONE_RESIDENCE")
1231"RTN","TMGRPC1",453,0)
1232 . else if key="PHONE_WORK" set TMGFDA(2,IENS,.132)=INFO("PHONE_WORK")
1233"RTN","TMGRPC1",454,0)
1234 . else if key="PHONE_CELL" set TMGFDA(2,IENS,.134)=INFO("PHONE_CELL")
1235"RTN","TMGRPC1",455,0)
1236 . else if key="PHONE_TEMP" set TMGFDA(2,IENS,.1219)=INFO("PHONE_TEMP")
1237"RTN","TMGRPC1",456,0)
1238 . else if key="EMAIL" set TMGFDA(2,IENS,.133)=INFO("EMAIL")
1239"RTN","TMGRPC1",457,0)
1240
1241"RTN","TMGRPC1",458,0)
1242 if $data(TMGFDA) do
1243"RTN","TMGRPC1",459,0)
1244 . do FILE^DIE("EKST","TMGFDA","TMGMSG")
1245"RTN","TMGRPC1",460,0)
1246 . if $data(TMGMSG("DIERR")) do
1247"RTN","TMGRPC1",461,0)
1248 . . set RESULT="-1^Filing Error Occured: "_$get(TMGMSG("DIERR",1,"TEXT",1))
1249"RTN","TMGRPC1",462,0)
1250 . . ;"merge ^TMG("TMP","RPC","DIERR")=TMGMSG("DIERR")
1251"RTN","TMGRPC1",463,0)
1252 . . ;"merge ^TMG("TMP","RPC","FDA")=TMGFDA
1253"RTN","TMGRPC1",464,0)
1254
1255"RTN","TMGRPC1",465,0)
1256 ;"now file Alias info separately
1257"RTN","TMGRPC1",466,0)
1258 if RESULT=1 do
1259"RTN","TMGRPC1",467,0)
1260 . new tempArray,index,key2
1261"RTN","TMGRPC1",468,0)
1262 . new key set key=""
1263"RTN","TMGRPC1",469,0)
1264 . for set key=$order(INFO(key)) quit:(key="") do
1265"RTN","TMGRPC1",470,0)
1266 . . if key["ALIAS" do
1267"RTN","TMGRPC1",471,0)
1268 . . . set index=$piece(key," ",2) quit:(index="")
1269"RTN","TMGRPC1",472,0)
1270 . . . set key2=$piece(key," ",3)
1271"RTN","TMGRPC1",473,0)
1272 . . . set tempArray(index,key2)=INFO(key)
1273"RTN","TMGRPC1",474,0)
1274 . set index=0 for set index=$order(tempArray(index)) quit:(index="")!(RESULT'=1) do
1275"RTN","TMGRPC1",475,0)
1276 . . new TMGFDA,TMGMSG,TMGIEN,newRec
1277"RTN","TMGRPC1",476,0)
1278 . . set newRec=0
1279"RTN","TMGRPC1",477,0)
1280 . . set key="" for set key=$order(tempArray(index,key)) quit:(key="")!(RESULT'=1) do
1281"RTN","TMGRPC1",478,0)
1282 . . . if key="NAME" set TMGFDA(2.01,index_","_DFN_",",.01)=$get(tempArray(index,"NAME"))
1283"RTN","TMGRPC1",479,0)
1284 . . . if key="SSN" set TMGFDA(2.01,index_","_DFN_",",1)=$get(tempArray(index,"SSN"))
1285"RTN","TMGRPC1",480,0)
1286 . . . if index["+" set newRec=1
1287"RTN","TMGRPC1",481,0)
1288 . . if $data(TMGFDA) do
1289"RTN","TMGRPC1",482,0)
1290 . . . if newRec=0 do FILE^DIE("EKST","TMGFDA","TMGMSG")
1291"RTN","TMGRPC1",483,0)
1292 . . . else do UPDATE^DIE("ES","TMGFDA","TMGIEN","TMGMSG")
1293"RTN","TMGRPC1",484,0)
1294 . . if $data(TMGMSG("DIERR")) do
1295"RTN","TMGRPC1",485,0)
1296 . . . set RESULT="-1^Filing Error Occured: "_$get(TMGMSG("DIERR",1,"TEXT",1))
1297"RTN","TMGRPC1",486,0)
1298 . . . ;"merge ^TMG("TMP","RPC","DIERR")=TMGMSG("DIERR")
1299"RTN","TMGRPC1",487,0)
1300 . . . ;"merge ^TMG("TMP","RPC","FDA")=TMGFDA
1301"RTN","TMGRPC1",488,0)
1302
1303"RTN","TMGRPC1",489,0)
1304 quit
1305"RTN","TMGRPC1",490,0)
1306
1307"RTN","TMGRPC1",491,0)
1308PTADD(RESULT,INFO) ;" ADD PATIENT
1309"RTN","TMGRPC1",492,0)
1310 ;"Purpose: To add a patient
1311"RTN","TMGRPC1",493,0)
1312 ;"Input: RESULT (this is the output array)
1313"RTN","TMGRPC1",494,0)
1314 ;"
1315"RTN","TMGRPC1",495,0)
1316 ;" INFO: Format as follows:
1317"RTN","TMGRPC1",496,0)
1318 ;" The results are in format: INFO("KeyName")=Value,
1319"RTN","TMGRPC1",497,0)
1320 ;" There is no set order these will appear.
1321"RTN","TMGRPC1",498,0)
1322 ;" Here are the KeyName names that will be provided.
1323"RTN","TMGRPC1",499,0)
1324 ;" If the record has no value, then value will be empty
1325"RTN","TMGRPC1",500,0)
1326 ;" If a record should be deleted, its value will be @
1327"RTN","TMGRPC1",501,0)
1328 ;" INFO("COMBINED_NAME")=
1329"RTN","TMGRPC1",502,0)
1330 ;" INFO("DOB")=
1331"RTN","TMGRPC1",503,0)
1332 ;" INFO("SEX")=
1333"RTN","TMGRPC1",504,0)
1334 ;" INFO("SS_NUM")=
1335"RTN","TMGRPC1",505,0)
1336 ;" INFO("Veteran")=
1337"RTN","TMGRPC1",506,0)
1338 ;" INFO("PtType")=
1339"RTN","TMGRPC1",507,0)
1340 ;"Results: Results passed back in RESULT string:
1341"RTN","TMGRPC1",508,0)
1342 ;" DFN = success
1343"RTN","TMGRPC1",509,0)
1344 ;" -1^Message = failure
1345"RTN","TMGRPC1",510,0)
1346 ;" 0^DFN = already exists
1347"RTN","TMGRPC1",511,0)
1348
1349"RTN","TMGRPC1",512,0)
1350 set RESULT=1 ;"default to success
1351"RTN","TMGRPC1",513,0)
1352
1353"RTN","TMGRPC1",514,0)
1354 kill ^TMG("TMP","RPC")
1355"RTN","TMGRPC1",515,0)
1356 merge ^TMG("TMP","RPC")=INFO ;"temp... remove later
1357"RTN","TMGRPC1",516,0)
1358
1359"RTN","TMGRPC1",517,0)
1360 new TMGFDA,TMGMSG,IENS,PATIENT,DFN,TMGFREG
1361"RTN","TMGRPC1",518,0)
1362 ;" set IENS=DFN_","
1363"RTN","TMGRPC1",519,0)
1364 new key set key=""
1365"RTN","TMGRPC1",520,0)
1366 for set key=$order(INFO(key)) quit:(key="") do
1367"RTN","TMGRPC1",521,0)
1368 . if key="COMBINED_NAME" set PATIENT("NAME")=INFO("COMBINED_NAME")
1369"RTN","TMGRPC1",522,0)
1370 . else if key="DOB" set PATIENT("DOB")=INFO("DOB")
1371"RTN","TMGRPC1",523,0)
1372 . else if key="SEX" set PATIENT("SEX")=INFO("SEX")
1373"RTN","TMGRPC1",524,0)
1374 . else if key="SS_NUM" set PATIENT("SSNUM")=INFO("SS_NUM")
1375"RTN","TMGRPC1",525,0)
1376 . else if key="Veteran" set PATIENT("VETERAN")=INFO("Veteran")
1377"RTN","TMGRPC1",526,0)
1378 . else if key="PtType" set PATIENT("PT_TYPE")=INFO("PtType")
1379"RTN","TMGRPC1",527,0)
1380 set DFN=$$GetDFN^TMGGDFN(.PATIENT)
1381"RTN","TMGRPC1",528,0)
1382 if DFN=-1 do
1383"RTN","TMGRPC1",529,0)
1384 . new Entry,result,ErrMsg
1385"RTN","TMGRPC1",530,0)
1386 . do Pat2Entry^TMGGDFN(.PATIENT,.Entry)
1387"RTN","TMGRPC1",531,0)
1388 . set DFN=$$AddNewPt^TMGGDFN(.Entry,.ErrMsg)
1389"RTN","TMGRPC1",532,0)
1390 . ;"set DFN=$$GetDFN^TMGGDFN(.PATIENT)
1391"RTN","TMGRPC1",533,0)
1392 . if DFN'>0 do
1393"RTN","TMGRPC1",534,0)
1394 . . set RESULT="-1^ERROR ADDING" ;"should use ErrMsg from above. Fix later
1395"RTN","TMGRPC1",535,0)
1396 . . set RESULT=RESULT_". "_$$GetErrStr^TMGDEBUG(.ErrMsg)
1397"RTN","TMGRPC1",536,0)
1398 . else do
1399"RTN","TMGRPC1",537,0)
1400 .. set RESULT=DFN
1401"RTN","TMGRPC1",538,0)
1402 else do
1403"RTN","TMGRPC1",539,0)
1404 . set RESULT="0^"_DFN
1405"RTN","TMGRPC1",540,0)
1406
1407"RTN","TMGRPC1",541,0)
1408 quit
1409"RTN","TMGRPC1",542,0)
1410
1411"RTN","TMGRPC1",543,0)
1412
1413"RTN","TMGRPC1",544,0)
1414GETBARCD(GREF,MESSAGE,OPTION)
1415"RTN","TMGRPC1",545,0)
1416 ;"SCOPE: Public
1417"RTN","TMGRPC1",546,0)
1418 ;"RPC that calls this: TMG BARCODE ENCODE
1419"RTN","TMGRPC1",547,0)
1420 ;"Purpose: To provide an entry point for a RPC call from a client.
1421"RTN","TMGRPC1",548,0)
1422 ;" A 2D DataMatrix Bar Code will be create and passed to client.
1423"RTN","TMGRPC1",549,0)
1424 ;" It will not be stored on server
1425"RTN","TMGRPC1",550,0)
1426 ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE)
1427"RTN","TMGRPC1",551,0)
1428 ;" MESSAGE-- The text to use to create the barcode
1429"RTN","TMGRPC1",552,0)
1430 ;" OPTION -- Array that may hold optional settings, as follows:
1431"RTN","TMGRPC1",553,0)
1432 ;" OPTION("IMAGE TYPE")="jpg" <-- if not specified, then default is "png"
1433"RTN","TMGRPC1",554,0)
1434 ;"Output: results are passed out in @GREF
1435"RTN","TMGRPC1",555,0)
1436 ;" @GREF@(0)=success; 1=success, 0=failure
1437"RTN","TMGRPC1",556,0)
1438 ;" @GREF@(1..xxx) = actual data
1439"RTN","TMGRPC1",557,0)
1440
1441"RTN","TMGRPC1",558,0)
1442 ;"NOTE: dmtxread must be installed on linux host.
1443"RTN","TMGRPC1",559,0)
1444 ;" I found source code here:
1445"RTN","TMGRPC1",560,0)
1446 ;" http://sourceforge.net/projects/libdmtx/
1447"RTN","TMGRPC1",561,0)
1448 ;" After installing (./configure --> make --> make install), I
1449"RTN","TMGRPC1",562,0)
1450 ;" copied dmtxread and dmtxwrite, which were found in the
1451"RTN","TMGRPC1",563,0)
1452 ;" (installdir)/util/dmtxread/.libs and (installdir)/util/dmtxwrite/.libs
1453"RTN","TMGRPC1",564,0)
1454 ;" folders, into a folder on the system path. I chose /usr/bin/
1455"RTN","TMGRPC1",565,0)
1456 ;" Also, to achieve compile of above, I had to install required libs.
1457"RTN","TMGRPC1",566,0)
1458 ;" See notes included with dmtx source code.
1459"RTN","TMGRPC1",567,0)
1460
1461"RTN","TMGRPC1",568,0)
1462 new FileSpec
1463"RTN","TMGRPC1",569,0)
1464 new file
1465"RTN","TMGRPC1",570,0)
1466 new FName,FPath
1467"RTN","TMGRPC1",571,0)
1468
1469"RTN","TMGRPC1",572,0)
1470 set GREF="^TMP(""GETBARCD^TMGRPC1"","_$J_")"
1471"RTN","TMGRPC1",573,0)
1472 kill @GREF
1473"RTN","TMGRPC1",574,0)
1474 set @GREF@(0)="" ;"default to failure
1475"RTN","TMGRPC1",575,0)
1476 set MESSAGE=$get(MESSAGE)
1477"RTN","TMGRPC1",576,0)
1478 if MESSAGE="" goto GBCDone
1479"RTN","TMGRPC1",577,0)
1480
1481"RTN","TMGRPC1",578,0)
1482 ;"Create the barcode and get file name and path
1483"RTN","TMGRPC1",579,0)
1484 set file=$$MAKEBC^TMGBARC(MESSAGE,.OPTION)
1485"RTN","TMGRPC1",580,0)
1486 do SplitFNamePath^TMGIOUTL(file,.FPath,.FName,"/")
1487"RTN","TMGRPC1",581,0)
1488
1489"RTN","TMGRPC1",582,0)
1490 ;"Load binary image into global array
1491"RTN","TMGRPC1",583,0)
1492 set @GREF@(0)=$$BFTG^TMGBINF(.FPath,.FName,$name(@GREF@(1)),3)
1493"RTN","TMGRPC1",584,0)
1494
1495"RTN","TMGRPC1",585,0)
1496 ;"convert binary data to ascii encoded data
1497"RTN","TMGRPC1",586,0)
1498 do ENCODE($name(@GREF@(1)),3)
1499"RTN","TMGRPC1",587,0)
1500
1501"RTN","TMGRPC1",588,0)
1502 ;"delete temp image file
1503"RTN","TMGRPC1",589,0)
1504 do SplitFNamePath^TMGIOUTL(file,.FPath,.FName,"/")
1505"RTN","TMGRPC1",590,0)
1506 set FileSpec(FName)=""
1507"RTN","TMGRPC1",591,0)
1508 new temp set temp=$$DEL^%ZISH(FPath,"FileSpec")
1509"RTN","TMGRPC1",592,0)
1510
1511"RTN","TMGRPC1",593,0)
1512GBCDone
1513"RTN","TMGRPC1",594,0)
1514 quit
1515"RTN","TMGRPC1",595,0)
1516
1517"RTN","TMGRPC1",596,0)
1518
1519"RTN","TMGRPC1",597,0)
1520DECODEBC(RESULT,ARRAY,IMGTYPE)
1521"RTN","TMGRPC1",598,0)
1522 ;"SCOPE: Public
1523"RTN","TMGRPC1",599,0)
1524 ;"RPC that calls this: TMG BARCODE DECODE
1525"RTN","TMGRPC1",600,0)
1526 ;"Purpose: To provide an entry point for a RPC call from a client. The client
1527"RTN","TMGRPC1",601,0)
1528 ;" will upload an image file (.png format only) of a barcode (Datamatrix
1529"RTN","TMGRPC1",602,0)
1530 ;" format) for decoding. Decoded message is passed back.
1531"RTN","TMGRPC1",603,0)
1532 ;"Input: RESULT -- an OUT PARAMETER. See output below.
1533"RTN","TMGRPC1",604,0)
1534 ;" ARRAY -- the array that will hold the image file, in BASE64 ascii encoding
1535"RTN","TMGRPC1",605,0)
1536 ;" IMGTYPE -- Image type, e.g. "jpg" (Note: don't include any '.')
1537"RTN","TMGRPC1",606,0)
1538 ;"Output: results are passed out in RESULT: 1^Decoded Message or 0^FailureMessage
1539"RTN","TMGRPC1",607,0)
1540
1541"RTN","TMGRPC1",608,0)
1542 ;"NOTE: dmtxread must be installed on linux host.
1543"RTN","TMGRPC1",609,0)
1544 ;" I found source code here:
1545"RTN","TMGRPC1",610,0)
1546 ;" http://sourceforge.net/projects/libdmtx/
1547"RTN","TMGRPC1",611,0)
1548 ;" After installing (./configure --> make --> make install), I
1549"RTN","TMGRPC1",612,0)
1550 ;" copied dmtxread and dmtxwrite, which were found in the
1551"RTN","TMGRPC1",613,0)
1552 ;" (installdir)/util/dmtxread/.libs and (installdir)/util/dmtxwrite/.libs
1553"RTN","TMGRPC1",614,0)
1554 ;" folders, into a folder on the system path. I chose /usr/bin/
1555"RTN","TMGRPC1",615,0)
1556 ;" Also, to achieve compile of above, I had to install required libs.
1557"RTN","TMGRPC1",616,0)
1558 ;" See notes included with dmtx source code.
1559"RTN","TMGRPC1",617,0)
1560 ;"NOTE: if image types other than .png will be uploaded, then the linux host
1561"RTN","TMGRPC1",618,0)
1562 ;" must have ImageMagick utility 'convert' installed for conversion
1563"RTN","TMGRPC1",619,0)
1564 ;" between image types.
1565"RTN","TMGRPC1",620,0)
1566
1567"RTN","TMGRPC1",621,0)
1568 kill ^TMG("TMP","BARCODE")
1569"RTN","TMGRPC1",622,0)
1570 ;"set ^TMG("TMP","BARCODE","LOG")=1 ;"temp
1571"RTN","TMGRPC1",623,0)
1572
1573"RTN","TMGRPC1",624,0)
1574 ;"new Stack do GetStackInfo^TMGIDE2(.Stack)
1575"RTN","TMGRPC1",625,0)
1576 ;"merge ^TMG("TMP","BARCODE","STACK")=Stack
1577"RTN","TMGRPC1",626,0)
1578
1579"RTN","TMGRPC1",627,0)
1580 new resultMsg
1581"RTN","TMGRPC1",628,0)
1582 if $data(ARRAY)=0 set resultMsg="0^No image data received to decode" goto DBCDone
1583"RTN","TMGRPC1",629,0)
1584
1585"RTN","TMGRPC1",630,0)
1586 new imageType set imageType=$$LOW^XLFSTR($get(IMGTYPE))
1587"RTN","TMGRPC1",631,0)
1588 if imageType="" set resultMsg="0^Image type not specified" goto DBCDone
1589"RTN","TMGRPC1",632,0)
1590
1591"RTN","TMGRPC1",633,0)
1592 new imageFName set imageFName="/tmp/barcode."_imageType
1593"RTN","TMGRPC1",634,0)
1594 set imageFName=$$UNIQUE^%ZISUTL(imageFName)
1595"RTN","TMGRPC1",635,0)
1596 new FName,FPath,FileSpec
1597"RTN","TMGRPC1",636,0)
1598 do SplitFNamePath^TMGIOUTL(imageFName,.FPath,.FName,"/")
1599"RTN","TMGRPC1",637,0)
1600 set FileSpec(FName)=""
1601"RTN","TMGRPC1",638,0)
1602
1603"RTN","TMGRPC1",639,0)
1604 ;"temp...
1605"RTN","TMGRPC1",640,0)
1606 ;"merge ^TMG("TMP","BARCODE","DATA")=ARRAY
1607"RTN","TMGRPC1",641,0)
1608 ;"merge ^TMG("TMP","BARCODE","IMGTYPE")=IMGTYPE
1609"RTN","TMGRPC1",642,0)
1610
1611"RTN","TMGRPC1",643,0)
1612 ;"set ^TMG("TMP","BARCODE","LOG")=2 ;"temp
1613"RTN","TMGRPC1",644,0)
1614 ;"Remove BASE64 ascii encoding
1615"RTN","TMGRPC1",645,0)
1616 do DECODE("ARRAY(0)",1)
1617"RTN","TMGRPC1",646,0)
1618
1619"RTN","TMGRPC1",647,0)
1620 ;"set ^TMG("TMP","BARCODE","LOG")=3 ;"temp
1621"RTN","TMGRPC1",648,0)
1622 ;"set ^TMG("TMP","BARCODE","LOG","Orig file: "_FPath_FName)=""
1623"RTN","TMGRPC1",649,0)
1624
1625"RTN","TMGRPC1",650,0)
1626 ;"Save to host file system
1627"RTN","TMGRPC1",651,0)
1628 if $$GTBF^TMGBINF("ARRAY(0)",1,FPath,FName)=0 do goto DBCDone
1629"RTN","TMGRPC1",652,0)
1630 . set resultMsg="0^Error while saving file to HFS"
1631"RTN","TMGRPC1",653,0)
1632
1633"RTN","TMGRPC1",654,0)
1634 ;"set ^TMG("TMP","BARCODE","LOG")=4 ;"temp
1635"RTN","TMGRPC1",655,0)
1636
1637"RTN","TMGRPC1",656,0)
1638 ;"convert image file to .png format, if needed
1639"RTN","TMGRPC1",657,0)
1640 if imageType'="png" do
1641"RTN","TMGRPC1",658,0)
1642 . set imageFName=$$Convert^TMGKERNL(imageFName,"png")
1643"RTN","TMGRPC1",659,0)
1644 . if imageFName="" do quit
1645"RTN","TMGRPC1",660,0)
1646 . . set resultMsg="0^Error while converting image from ."_imageType_" to .png format."
1647"RTN","TMGRPC1",661,0)
1648 . do SplitFNamePath^TMGIOUTL(imageFName,.FPath,.FName,"/")
1649"RTN","TMGRPC1",662,0)
1650 . set FileSpec(FName)=""
1651"RTN","TMGRPC1",663,0)
1652 if imageFName="" goto DBCDone
1653"RTN","TMGRPC1",664,0)
1654
1655"RTN","TMGRPC1",665,0)
1656 ;"set ^TMG("TMP","BARCODE","LOG")=5 ;"temp
1657"RTN","TMGRPC1",666,0)
1658
1659"RTN","TMGRPC1",667,0)
1660 ;"Decode the barcode.png image
1661"RTN","TMGRPC1",668,0)
1662 new result set result=$$READBC^TMGBARC(imageFName)
1663"RTN","TMGRPC1",669,0)
1664 if result'="" set resultMsg="1^"_result
1665"RTN","TMGRPC1",670,0)
1666 else set resultMsg="0^Unable to Decode Image"
1667"RTN","TMGRPC1",671,0)
1668
1669"RTN","TMGRPC1",672,0)
1670 ;"delete temp image file
1671"RTN","TMGRPC1",673,0)
1672 ;"temp REMOVE COMMENTS LATER TO DELETE FILE. !!!!!
1673"RTN","TMGRPC1",674,0)
1674 ;"set result=$$DEL^%ZISH(FPath,"FileSpec")
1675"RTN","TMGRPC1",675,0)
1676
1677"RTN","TMGRPC1",676,0)
1678DBCDone
1679"RTN","TMGRPC1",677,0)
1680 ;"set ^TMG("TMP","BARCODE","LOG")=6 ;"temp
1681"RTN","TMGRPC1",678,0)
1682
1683"RTN","TMGRPC1",679,0)
1684 set RESULT=resultMsg
1685"RTN","TMGRPC1",680,0)
1686 quit
1687"RTN","TMGRPC1",681,0)
1688
1689"RTN","TMGRPC1",682,0)
1690 ;"--------------------
1691"RTN","TMGRPC1",683,0)
1692GETURLS(RESULT)
1693"RTN","TMGRPC1",684,0)
1694 ;"SCOPE: Public
1695"RTN","TMGRPC1",685,0)
1696 ;"RPC that calls this: TMG CPRS GET URL LIST
1697"RTN","TMGRPC1",686,0)
1698 ;"Purpose: To provide an entry point for a RPC call from a client. The client
1699"RTN","TMGRPC1",687,0)
1700 ;" will request URLs to display in custom tabs inside CPRS, in an
1701"RTN","TMGRPC1",688,0)
1702 ;" imbedded web browser
1703"RTN","TMGRPC1",689,0)
1704 ;"Input: RESULT -- an OUT PARAMETER. See output below.
1705"RTN","TMGRPC1",690,0)
1706 ;"Output: results are passed out in RESULT:
1707"RTN","TMGRPC1",691,0)
1708 ;" RESULT(0)="1^Success" or "0^SomeFailureMessage"
1709"RTN","TMGRPC1",692,0)
1710 ;" RESULT(1)="Name1^URL#1" ; shows URL#1 in tab #1, named 'Name1'
1711"RTN","TMGRPC1",693,0)
1712 ;" RESULT(2)="Name2^URL#2" ; etc.
1713"RTN","TMGRPC1",694,0)
1714 ;" RESULT(3)="Name3^URL#3"
1715"RTN","TMGRPC1",695,0)
1716 ;"
1717"RTN","TMGRPC1",696,0)
1718 ;" E.g. RESULT(1)="cnn^www.cnn.com"
1719"RTN","TMGRPC1",697,0)
1720 ;" RESULT(2)="INFO^192.168.0.1/home.html"
1721"RTN","TMGRPC1",698,0)
1722 ;"
1723"RTN","TMGRPC1",699,0)
1724 ;" The number of allowed tabs is determined by code in CPRS
1725"RTN","TMGRPC1",700,0)
1726 ;" Reference to tab numbers > specified in CPRS will be ignored by CPRS
1727"RTN","TMGRPC1",701,0)
1728 ;" If a web tab is NOT specified, then the page previously
1729"RTN","TMGRPC1",702,0)
1730 ;" displayed will be left in place. It will not be cleared.
1731"RTN","TMGRPC1",703,0)
1732 ;" To clear a given page, a url of "about:blank" will cause a
1733"RTN","TMGRPC1",704,0)
1734 ;" blank page to be displayed. e.g.
1735"RTN","TMGRPC1",705,0)
1736 ;" RESULT(3)="^about:blank"
1737"RTN","TMGRPC1",706,0)
1738 ;" To HIDE a tab on CPRS use this:
1739"RTN","TMGRPC1",707,0)
1740 ;" RESULT(3)="^<!HIDE!>" ;triggers tab #3 to be hidden
1741"RTN","TMGRPC1",708,0)
1742 ;" To have the browser remain UNCHANGED use this:
1743"RTN","TMGRPC1",709,0)
1744 ;" RESULT(3)="^<!NOCHANGE!>" ;triggers tab #3 to remain unchanged.
1745"RTN","TMGRPC1",710,0)
1746 ;" Note: the rationale for this is that the web tab may have info
1747"RTN","TMGRPC1",711,0)
1748 ;" that should not be refreshed when the patient info is refreshed
1749"RTN","TMGRPC1",712,0)
1750 ;" i.e. the user may have navigated somewhere, and doesn't want
1751"RTN","TMGRPC1",713,0)
1752 ;" to loose their location.
1753"RTN","TMGRPC1",714,0)
1754 ;" --to be implemented.
1755"RTN","TMGRPC1",715,0)
1756 ;" Note: The other way to do this, acs above, is to simply have NO
1757"RTN","TMGRPC1",716,0)
1758 ;" entry for a given tab. I.e. don't have any value for RESULT(3)
1759"RTN","TMGRPC1",717,0)
1760 ;" --already implemented.
1761"RTN","TMGRPC1",718,0)
1762 ;"Notice to others: Below is where code should be added to return
1763"RTN","TMGRPC1",719,0)
1764 ;" proper URL's to CPRS. This will be called whenever a new patient
1765"RTN","TMGRPC1",720,0)
1766 ;" is opened, or a Refresh Information is requested.
1767"RTN","TMGRPC1",721,0)
1768 ;" FYI, 'DFN' should be defined as a globally-scoped variable that can be used
1769"RTN","TMGRPC1",722,0)
1770 ;" to pass back URLS specific for a given patient.
1771"RTN","TMGRPC1",723,0)
1772
1773"RTN","TMGRPC1",724,0)
1774 set RESULT(0)="1^Success"
1775"RTN","TMGRPC1",725,0)
1776 set RESULT(1)="MerkMedicus^http://www.merckmedicus.com/pp/us/hcp/hcp_home.jsp"
1777"RTN","TMGRPC1",726,0)
1778 set RESULT(2)="Pathgroup^http://pathgroup.com/"
1779"RTN","TMGRPC1",727,0)
1780 set RESULT(3)="AAFP^http://search.aafp.org/search?access=p&output=xml_no_dtd&site=a&filter=0&ie=UTF-8&oe=UTF-8&client=aafp&proxystylesheet=aafp&proxycustom=%3CADVANCED/%3E"
1781"RTN","TMGRPC1",728,0)
1782 set RESULT(4)="EMedicine^http://emedicine.medscape.com/"
1783"RTN","TMGRPC1",729,0)
1784
1785"RTN","TMGRPC1",730,0)
1786 ;"kill RESULT
1787"RTN","TMGRPC1",731,0)
1788 ;"merge RESULT=^TMG("TMP","URLS") ;"TEMP!!!
1789"RTN","TMGRPC1",732,0)
1790
1791"RTN","TMGRPC1",733,0)
1792 quit
1793"RTN","TMGRPC1",734,0)
1794
1795"RTN","TMGRPC1",735,0)
1796 ;
1797"RTN","TMGRPC1B")
17980^2^B3028
1799"RTN","TMGRPC1B",1,0)
1800TMGRPC1B ;TMG/kst-RPC Functions ;3/28/10, 7/11/10
1801"RTN","TMGRPC1B",2,0)
1802 ;;1.0;TMG-LIB;**1**;3/28/10;Build 2
1803"RTN","TMGRPC1B",3,0)
1804 ;
1805"RTN","TMGRPC1B",4,0)
1806 ;"TMG RPC FUNCTIONS
1807"RTN","TMGRPC1B",5,0)
1808 ;
1809"RTN","TMGRPC1B",6,0)
1810 ;"Copyright Kevin Toppenberg MD
1811"RTN","TMGRPC1B",7,0)
1812 ;"Released under GNU General Public License (GPL)
1813"RTN","TMGRPC1B",8,0)
1814 ;"
1815"RTN","TMGRPC1B",9,0)
1816 ;"=======================================================================
1817"RTN","TMGRPC1B",10,0)
1818 ;" RPC -- Public Functions.
1819"RTN","TMGRPC1B",11,0)
1820 ;"=======================================================================
1821"RTN","TMGRPC1B",12,0)
1822 ;"ENSUREALL -- Ensure all needed TMG RPC entries have been added
1823"RTN","TMGRPC1B",13,0)
1824 ;
1825"RTN","TMGRPC1B",14,0)
1826 ;"=======================================================================
1827"RTN","TMGRPC1B",15,0)
1828 ;"PRIVATE API FUNCTIONS
1829"RTN","TMGRPC1B",16,0)
1830 ;"=======================================================================
1831"RTN","TMGRPC1B",17,0)
1832 ;"ENSURE1(RPCNAME) -- ensure 1 RPC is in OPTION record OR CPRS GUI CHART
1833"RTN","TMGRPC1B",18,0)
1834 ;
1835"RTN","TMGRPC1B",19,0)
1836 ;"=======================================================================
1837"RTN","TMGRPC1B",20,0)
1838 ;"=======================================================================
1839"RTN","TMGRPC1B",21,0)
1840 ;"Dependencies:
1841"RTN","TMGRPC1B",22,0)
1842 ;" DIC
1843"RTN","TMGRPC1B",23,0)
1844 ;"=======================================================================
1845"RTN","TMGRPC1B",24,0)
1846 ;"=======================================================================
1847"RTN","TMGRPC1B",25,0)
1848 ;
1849"RTN","TMGRPC1B",26,0)
1850ENSUREAL
1851"RTN","TMGRPC1B",27,0)
1852 ;"Ensure all needed TMG RPC entries have been added
1853"RTN","TMGRPC1B",28,0)
1854L1 ;;TMG ADD PATIENT
1855"RTN","TMGRPC1B",29,0)
1856 ;;TMG AUTOSIGN TIU DOCUMENT
1857"RTN","TMGRPC1B",30,0)
1858 ;;TMG BARCODE DECODE
1859"RTN","TMGRPC1B",31,0)
1860 ;;TMG BARCODE ENCODE
1861"RTN","TMGRPC1B",32,0)
1862 ;;TMG CHANNEL
1863"RTN","TMGRPC1B",33,0)
1864 ;;TMG CPRS GET URL LIST
1865"RTN","TMGRPC1B",34,0)
1866 ;;TMG DOWNLOAD FILE
1867"RTN","TMGRPC1B",35,0)
1868 ;;TMG DOWNLOAD FILE DROPBOX
1869"RTN","TMGRPC1B",36,0)
1870 ;;TMG GET BLANK TIU DOCUMENT
1871"RTN","TMGRPC1B",37,0)
1872 ;;TMG GET DFN
1873"RTN","TMGRPC1B",38,0)
1874 ;;TMG GET IMAGE LONG DESCRIPTION
1875"RTN","TMGRPC1B",39,0)
1876 ;;TMG GET PATIENT DEMOGRAPHICS
1877"RTN","TMGRPC1B",40,0)
1878 ;;TMG INIFILE GET
1879"RTN","TMGRPC1B",41,0)
1880 ;;TMG INIFILE SET
1881"RTN","TMGRPC1B",42,0)
1882 ;;TMG MSGLINK CHANNEL
1883"RTN","TMGRPC1B",43,0)
1884 ;;TMG SEARCH CHANNEL
1885"RTN","TMGRPC1B",44,0)
1886 ;;TMG SET PATIENT DEMOGRAPHICS
1887"RTN","TMGRPC1B",45,0)
1888 ;;TMG UPLOAD FILE
1889"RTN","TMGRPC1B",46,0)
1890 ;;TMG UPLOAD FILE DROPBOX
1891"RTN","TMGRPC1B",47,0)
1892 ;;TMG IMAGE DELETE
1893"RTN","TMGRPC1B",48,0)
1894 ;;MAGGADDIMAGE
1895"RTN","TMGRPC1B",49,0)
1896 ;;MAG3 TIU IMAGE
1897"RTN","TMGRPC1B",50,0)
1898 ;;MAG3 CPRS TIU NOTE
1899"RTN","TMGRPC1B",51,0)
1900 ;;<END>
1901"RTN","TMGRPC1B",52,0)
1902 ;
1903"RTN","TMGRPC1B",53,0)
1904 NEW TMGI
1905"RTN","TMGRPC1B",54,0)
1906 NEW DONE SET DONE=0
1907"RTN","TMGRPC1B",55,0)
1908 FOR TMGI=0:1 DO QUIT:DONE
1909"RTN","TMGRPC1B",56,0)
1910 . NEW RPC SET RPC=$PIECE($TEXT(L1+TMGI^TMGRPC1B),";;",2)
1911"RTN","TMGRPC1B",57,0)
1912 . IF (RPC="")!(RPC="<END>") SET DONE=1 QUIT
1913"RTN","TMGRPC1B",58,0)
1914 . DO ENSURE1(RPC)
1915"RTN","TMGRPC1B",59,0)
1916 QUIT
1917"RTN","TMGRPC1B",60,0)
1918 ;
1919"RTN","TMGRPC1B",61,0)
1920ENSURE1(RPCNAME) ;
1921"RTN","TMGRPC1B",62,0)
1922 ;"Purpose: to ensure 1 RPC is in OPTION record OR CPRS GUI CHART
1923"RTN","TMGRPC1B",63,0)
1924 ;" (add if needed)
1925"RTN","TMGRPC1B",64,0)
1926 NEW DIC,X,Y,DA
1927"RTN","TMGRPC1B",65,0)
1928 SET DIC="^DIC(19,",DIC(0)="M"
1929"RTN","TMGRPC1B",66,0)
1930 SET X="OR CPRS GUI CHART"
1931"RTN","TMGRPC1B",67,0)
1932 DO ^DIC
1933"RTN","TMGRPC1B",68,0)
1934 IF +Y'>0 DO QUIT
1935"RTN","TMGRPC1B",69,0)
1936 . WRITE "ERROR. Unable to find [OR CPRS GUI CHART] in file OPTION (#19)",!
1937"RTN","TMGRPC1B",70,0)
1938 . NEW TEMP READ "Press [ENTER] to continue...",TEMP:($GET(DTIME,3600))
1939"RTN","TMGRPC1B",71,0)
1940 . WRITE !
1941"RTN","TMGRPC1B",72,0)
1942 SET DA(1)=+Y
1943"RTN","TMGRPC1B",73,0)
1944 SET DIC=DIC_DA(1)_",""RPC"","
1945"RTN","TMGRPC1B",74,0)
1946 SET DIC(0)="ML" ;"LAYGO --> add entry if not found
1947"RTN","TMGRPC1B",75,0)
1948 SET X=RPCNAME
1949"RTN","TMGRPC1B",76,0)
1950 DO ^DIC
1951"RTN","TMGRPC1B",77,0)
1952 IF +Y'>0 DO
1953"RTN","TMGRPC1B",78,0)
1954 . WRITE "ERROR. Unable to add or find "_RPCNAME_" for subfile RPC in record",!
1955"RTN","TMGRPC1B",79,0)
1956 . WRITE "OR CPRS GUI CHART in file OPTION (#19)",!
1957"RTN","TMGRPC1B",80,0)
1958 . NEW TEMP READ "Press [ENTER] to continue...",TEMP:($GET(DTIME,3600))
1959"RTN","TMGRPC1B",81,0)
1960 . WRITE !
1961"RTN","TMGRPC1B",82,0)
1962 QUIT
1963"RTN","TMGRPC1B",83,0)
1964
1965"RTN","TMGRPC1B",84,0)
1966
1967"RTN","TMGRPC1C")
19680^3^B4701
1969"RTN","TMGRPC1C",1,0)
1970TMGRPC1C ;TMG/kst-RPC Functions ;07/09/10
1971"RTN","TMGRPC1C",2,0)
1972 ;;1.0;TMG-LIB;**1**;07/09/10;Build 2
1973"RTN","TMGRPC1C",3,0)
1974
1975"RTN","TMGRPC1C",4,0)
1976 ;"TMG RPC FUNCTIONS especially related to imaging.
1977"RTN","TMGRPC1C",5,0)
1978
1979"RTN","TMGRPC1C",6,0)
1980 ;"Kevin Toppenberg MD
1981"RTN","TMGRPC1C",7,0)
1982 ;"GNU General Public License (GPL) applies
1983"RTN","TMGRPC1C",8,0)
1984 ;"7/09/10
1985"RTN","TMGRPC1C",9,0)
1986
1987"RTN","TMGRPC1C",10,0)
1988 ;"=======================================================================
1989"RTN","TMGRPC1C",11,0)
1990 ;" RPC -- Public Functions.
1991"RTN","TMGRPC1C",12,0)
1992 ;"=======================================================================
1993"RTN","TMGRPC1C",13,0)
1994 ;"GETDEFNL() -- return the default Network Location (file 2005.2) entry
1995"RTN","TMGRPC1C",14,0)
1996 ;"GETLOCFPATH(FPATH,LOCIEN) -- get local (absolute) path for storing on host file system
1997"RTN","TMGRPC1C",15,0)
1998 ;"GETDROPPATH(LOCIEN,DropBox) -- return path to local dropbox.
1999"RTN","TMGRPC1C",16,0)
2000 ;"DOWNLOAD(GREF,FPATH,FNAMEW $$,LOCIEN)
2001"RTN","TMGRPC1C",17,0)
2002 ;"UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY)
2003"RTN","TMGRPC1C",18,0)
2004 ;"DOWNDROP(RESULT,FPATH,FNAME,LOCIEN) -- Download drop box file
2005"RTN","TMGRPC1C",19,0)
2006 ;"UPLDDROP(RESULT,FPATH,FNAME,LOCIEN) -- Upload Dropbox File
2007"RTN","TMGRPC1C",20,0)
2008 ;"DELIMAGE(RESULT,IMGIEN,MODE,REASON) -- Delete or Retract Image
2009"RTN","TMGRPC1C",21,0)
2010 ;"UNRETRACT(RESULT,TMGIEN) -- reverse retraction process from DELIMAGE above.
2011"RTN","TMGRPC1C",22,0)
2012 ;"=======================================================================
2013"RTN","TMGRPC1C",23,0)
2014 ;"PRIVATE API FUNCTIONS
2015"RTN","TMGRPC1C",24,0)
2016 ;"=======================================================================
2017"RTN","TMGRPC1C",25,0)
2018 ;"ENCODE(GRef,incSubscr,encodeFn)
2019"RTN","TMGRPC1C",26,0)
2020 ;"DECODE(GRef,incSubscr,decodeFn)
2021"RTN","TMGRPC1C",27,0)
2022 ;"$$HEXCODER(INPUT) ;encode the input string. Currently using simple hex encoding/
2023"RTN","TMGRPC1C",28,0)
2024 ;"$$B64CODER(INPUT) ;encode the input string via UUENCODE (actually Base64)
2025"RTN","TMGRPC1C",29,0)
2026 ;"$$B64DECODER(INPUT) ;encode the input string via UUDECODE (actually Base64)
2027"RTN","TMGRPC1C",30,0)
2028 ;"ENSUREDIV(FPATH,LOCIEN) ;Ensure that the path ends with an appropriate node divider.
2029"RTN","TMGRPC1C",31,0)
2030
2031"RTN","TMGRPC1C",32,0)
2032 ;"=======================================================================
2033"RTN","TMGRPC1C",33,0)
2034 ;"Dependancies:
2035"RTN","TMGRPC1C",34,0)
2036 ;" DIK, TMGDEBUG
2037"RTN","TMGRPC1C",35,0)
2038 ;"=======================================================================
2039"RTN","TMGRPC1C",36,0)
2040 ;
2041"RTN","TMGRPC1C",37,0)
2042GETDEFNL()
2043"RTN","TMGRPC1C",38,0)
2044 ;"Purpose: to return the default Network Location (file 2005.2) entry
2045"RTN","TMGRPC1C",39,0)
2046 ;"Input: None
2047"RTN","TMGRPC1C",40,0)
2048 ;"Results: Returns IEN in file 2005.2, or 1 if some problem.
2049"RTN","TMGRPC1C",41,0)
2050 ;
2051"RTN","TMGRPC1C",42,0)
2052 NEW RESULT SET RESULT=1 ;"Default
2053"RTN","TMGRPC1C",43,0)
2054 ;
2055"RTN","TMGRPC1C",44,0)
2056 ;"First get default INSTITUTION, stored in KERNEL SYSTEM PARAMETERS file.
2057"RTN","TMGRPC1C",45,0)
2058 NEW INSTPTR SET INSTPTR=+$PIECE($GET(^XTV(8989.3,1,"XUS")),"^",17) ;"Ptr to file $4 (Institution)
2059"RTN","TMGRPC1C",46,0)
2060 IF INSTPTR'>0 GOTO GDFNDN
2061"RTN","TMGRPC1C",47,0)
2062 ;
2063"RTN","TMGRPC1C",48,0)
2064 ;"Now get IMAGING SITE PARAMETERS for Institution Name
2065"RTN","TMGRPC1C",49,0)
2066 NEW IMGSPPTR SET IMGSPPTR=+$ORDER(^MAG(2006.1,"B",INSTPTR,0))
2067"RTN","TMGRPC1C",50,0)
2068 IF IMGSPPTR'>0 GOTO GDFNDN
2069"RTN","TMGRPC1C",51,0)
2070 ;
2071"RTN","TMGRPC1C",52,0)
2072 ;"Now get NETWORK LOCATION stored in IMAGING SITE PARAMETERS record
2073"RTN","TMGRPC1C",53,0)
2074 NEW LOCPTR SET LOCPTR=+$PIECE($GET(^MAG(2006.1,IMGSPPTR,0)),"^",3)
2075"RTN","TMGRPC1C",54,0)
2076 IF LOCPTR>0 SET RESULT=LOCPTR
2077"RTN","TMGRPC1C",55,0)
2078 ;
2079"RTN","TMGRPC1C",56,0)
2080GDFNDN QUIT RESULT
2081"RTN","TMGRPC1C",57,0)
2082 ;
2083"RTN","TMGRPC1C",58,0)
2084 ;
2085"RTN","TMGRPC1C",59,0)
2086ENSUREDIV(FPATH,LOCIEN) ;
2087"RTN","TMGRPC1C",60,0)
2088 ;"Purpose: Ensure that the path ends with an appropriate node divider.
2089"RTN","TMGRPC1C",61,0)
2090 set FPATH=$GET(FPATH,"/")
2091"RTN","TMGRPC1C",62,0)
2092 set LOCIEN=+$GET(LOCIEN) if LOCIEN'>0 set LOCIEN=$$GETDEFNL()
2093"RTN","TMGRPC1C",63,0)
2094
2095"RTN","TMGRPC1C",64,0)
2096 ;"default is "/" NOTE: CUSTOM FIELD
2097"RTN","TMGRPC1C",65,0)
2098 new NodeDiv set NodeDiv=$piece($get(^MAG(2005.2,LOCIEN,22701),"/"),"^",1)
2099"RTN","TMGRPC1C",66,0)
2100
2101"RTN","TMGRPC1C",67,0)
2102 new EndChar set EndChar=$extract(FPATH,$length(FPATH))
2103"RTN","TMGRPC1C",68,0)
2104 if EndChar'=NodeDiv set FPATH=FPATH_NodeDiv
2105"RTN","TMGRPC1C",69,0)
2106 quit FPATH
2107"RTN","TMGRPC1C",70,0)
2108 ;
2109"RTN","TMGRPC1C",71,0)
2110GETLOCFPATH(FPATH,LOCIEN) ;
2111"RTN","TMGRPC1C",72,0)
2112 ;"Purpose: to get local (absolute) path for storing on host file system
2113"RTN","TMGRPC1C",73,0)
2114 ;"Input: FPATH -- the file path up to, but not including, the filename
2115"RTN","TMGRPC1C",74,0)
2116 ;" Use '/' to NOT specify any subdirectory
2117"RTN","TMGRPC1C",75,0)
2118 ;" [optional] default is '/'
2119"RTN","TMGRPC1C",76,0)
2120 ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to download from
2121"RTN","TMGRPC1C",77,0)
2122 ;" NOTE: DEPRECIATED. Should pass "" to allow code to lookup default
2123"RTN","TMGRPC1C",78,0)
2124 ;" values stored in KERNEL SYSTEM PARAMETERS etc.
2125"RTN","TMGRPC1C",79,0)
2126 ;" Note: For security reasons, all path requests will be considered relative to a root path.
2127"RTN","TMGRPC1C",80,0)
2128 ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve:
2129"RTN","TMGRPC1C",81,0)
2130 ;" /var/local/Dir1/Dir2/download/SomeFile.jpg
2131"RTN","TMGRPC1C",82,0)
2132 ;" This root path is found in custom field 22701 in file 2005.2
2133"RTN","TMGRPC1C",83,0)
2134 ;"Returns: A path, that can be passed to KERNEL calls for HFS calls.
2135"RTN","TMGRPC1C",84,0)
2136 ;" NOTE: Result WILL end with a node divider
2137"RTN","TMGRPC1C",85,0)
2138 ;
2139"RTN","TMGRPC1C",86,0)
2140 set FPATH=$GET(FPATH,"/")
2141"RTN","TMGRPC1C",87,0)
2142 set LOCIEN=+$GET(LOCIEN) if LOCIEN'>0 set LOCIEN=$$GETDEFNL()
2143"RTN","TMGRPC1C",88,0)
2144
2145"RTN","TMGRPC1C",89,0)
2146 ;"NOTE: CUSTOM FIELD
2147"RTN","TMGRPC1C",90,0)
2148 new PathRoot set PathRoot=$piece($get(^MAG(2005.2,LOCIEN,22700)),"^",1)
2149"RTN","TMGRPC1C",91,0)
2150
2151"RTN","TMGRPC1C",92,0)
2152 ;"default is "/" NOTE: CUSTOM FIELD
2153"RTN","TMGRPC1C",93,0)
2154 new NodeDiv set NodeDiv=$piece($get(^MAG(2005.2,LOCIEN,22701),"/"),"^",1)
2155"RTN","TMGRPC1C",94,0)
2156
2157"RTN","TMGRPC1C",95,0)
2158 new EndRoot set EndRoot=$extract(PathRoot,$length(PathRoot))
2159"RTN","TMGRPC1C",96,0)
2160 new StartPath set StartPath=$extract(FPATH,1)
2161"RTN","TMGRPC1C",97,0)
2162
2163"RTN","TMGRPC1C",98,0)
2164 if (EndRoot=NodeDiv)&(StartPath=NodeDiv) do
2165"RTN","TMGRPC1C",99,0)
2166 . set FPATH=$extract(FPATH,2,1024)
2167"RTN","TMGRPC1C",100,0)
2168 else if (EndRoot'=NodeDiv)&(StartPath'=NodeDiv) do
2169"RTN","TMGRPC1C",101,0)
2170 . set PathRoot=PathRoot_NodeDiv
2171"RTN","TMGRPC1C",102,0)
2172
2173"RTN","TMGRPC1C",103,0)
2174 set FPATH=$$ENSUREDIV(PathRoot_FPATH,LOCIEN)
2175"RTN","TMGRPC1C",104,0)
2176 quit FPATH
2177"RTN","TMGRPC1C",105,0)
2178 ;
2179"RTN","TMGRPC1C",106,0)
2180 ;
2181"RTN","TMGRPC1C",107,0)
2182GETDROPPATH(LOCIEN,DropBox) ;
2183"RTN","TMGRPC1C",108,0)
2184 ;"Purpose: return path to local dropbox.
2185"RTN","TMGRPC1C",109,0)
2186 ;"Input: LOCIEN -- the IEN from file 2005.2 (network location)
2187"RTN","TMGRPC1C",110,0)
2188 ;" DropBox -- PASS BY REFERENCE. AN OUT PARAMETER.
2189"RTN","TMGRPC1C",111,0)
2190 ;"Results: 1 if OK, -1 if error
2191"RTN","TMGRPC1C",112,0)
2192 set LOCIEN=+$GET(LOCIEN)
2193"RTN","TMGRPC1C",113,0)
2194 if LOCIEN'>0 set LOCIEN=$$GETDEFNL()
2195"RTN","TMGRPC1C",114,0)
2196 new Result set Result=1
2197"RTN","TMGRPC1C",115,0)
2198 set DropBox=$piece($get(^MAG(2005.2,LOCIEN,22702)),"^",1)
2199"RTN","TMGRPC1C",116,0)
2200 if DropBox="" do goto GDPDN
2201"RTN","TMGRPC1C",117,0)
2202 . set Result=-1
2203"RTN","TMGRPC1C",118,0)
2204 set DropBox=$$ENSUREDIV(DropBox,LOCIEN)
2205"RTN","TMGRPC1C",119,0)
2206GDPDN quit Result
2207"RTN","TMGRPC1C",120,0)
2208
2209"RTN","TMGRPC1C",121,0)
2210
2211"RTN","TMGRPC1C",122,0)
2212DOWNLOAD(GREF,FPATH,FNAME,LOCIEN)
2213"RTN","TMGRPC1C",123,0)
2214 ;"SCOPE: Public
2215"RTN","TMGRPC1C",124,0)
2216 ;"Purpose: To provide an entry point for a RPC call from a client. The client
2217"RTN","TMGRPC1C",125,0)
2218 ;" will ask for a given file, and it will be passed back in the form
2219"RTN","TMGRPC1C",126,0)
2220 ;" of an array (in BASE64 ascii encoding)
2221"RTN","TMGRPC1C",127,0)
2222 ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE)
2223"RTN","TMGRPC1C",128,0)
2224 ;" FPATH -- the file path up to, but not including, the filename
2225"RTN","TMGRPC1C",129,0)
2226 ;" Use '/' to NOT specify any subdirectory
2227"RTN","TMGRPC1C",130,0)
2228 ;" [optional] default is '/'
2229"RTN","TMGRPC1C",131,0)
2230 ;" FNAME -- the name of the file to pass back
2231"RTN","TMGRPC1C",132,0)
2232 ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to download from
2233"RTN","TMGRPC1C",133,0)
2234 ;" NOTE: DEPRECIATED. Should pass "" to allow code to lookup default
2235"RTN","TMGRPC1C",134,0)
2236 ;" values stored in KERNEL SYSTEM PARAMETERS etc.
2237"RTN","TMGRPC1C",135,0)
2238 ;" Note: For security reasons, all path requests will be considered relative to a root path.
2239"RTN","TMGRPC1C",136,0)
2240 ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve:
2241"RTN","TMGRPC1C",137,0)
2242 ;" /var/local/Dir1/Dir2/download/SomeFile.jpg
2243"RTN","TMGRPC1C",138,0)
2244 ;" This root path is found in custom field 22701 in file 2005.2
2245"RTN","TMGRPC1C",139,0)
2246 ;"Output: results are passed out in @GREF
2247"RTN","TMGRPC1C",140,0)
2248 ;" @GREF@(0)=success; 1=success, 0=failure
2249"RTN","TMGRPC1C",141,0)
2250 ;" @GREF@(1..xxx) = actual data
2251"RTN","TMGRPC1C",142,0)
2252
2253"RTN","TMGRPC1C",143,0)
2254 set FNAME=$get(FNAME)
2255"RTN","TMGRPC1C",144,0)
2256 set LOCIEN=+$GET(LOCIEN)
2257"RTN","TMGRPC1C",145,0)
2258 if LOCIEN'>0 set LOCIEN=$$GETDEFNL()
2259"RTN","TMGRPC1C",146,0)
2260 set FPATH=$$GETLOCFPATH($GET(FPATH),LOCIEN) ;
2261"RTN","TMGRPC1C",147,0)
2262
2263"RTN","TMGRPC1C",148,0)
2264 set GREF="^TMP(""DOWNLOAD^TMGRPC1"","_$J_")"
2265"RTN","TMGRPC1C",149,0)
2266 kill @GREF
2267"RTN","TMGRPC1C",150,0)
2268 set @GREF@(0)=$$BFTG^TMGBINF(.FPATH,.FNAME,$name(@GREF@(1)),3)
2269"RTN","TMGRPC1C",151,0)
2270
2271"RTN","TMGRPC1C",152,0)
2272 do ENCODE($name(@GREF@(1)),3)
2273"RTN","TMGRPC1C",153,0)
2274
2275"RTN","TMGRPC1C",154,0)
2276 quit
2277"RTN","TMGRPC1C",155,0)
2278
2279"RTN","TMGRPC1C",156,0)
2280
2281"RTN","TMGRPC1C",157,0)
2282UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY)
2283"RTN","TMGRPC1C",158,0)
2284 ;"SCOPE: Public
2285"RTN","TMGRPC1C",159,0)
2286 ;"RPC That calls this: TMG UPLOAD FILE
2287"RTN","TMGRPC1C",160,0)
2288 ;"Purpose: To provide an entry point for a RPC call from a client. The client
2289"RTN","TMGRPC1C",161,0)
2290 ;" will provide a file for upload (in BASE64 ascii encoding)
2291"RTN","TMGRPC1C",162,0)
2292 ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE)
2293"RTN","TMGRPC1C",163,0)
2294 ;" FPATH -- the file path up to, but not including, the filename
2295"RTN","TMGRPC1C",164,0)
2296 ;" Use '/' to NOT specify any subdirectory
2297"RTN","TMGRPC1C",165,0)
2298 ;" [optional] default is '/'
2299"RTN","TMGRPC1C",166,0)
2300 ;" FNAME -- the name of the file to pass back
2301"RTN","TMGRPC1C",167,0)
2302 ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to upload to
2303"RTN","TMGRPC1C",168,0)
2304 ;" NOTE: DEPRECIATED. Should pass "" to allow code to lookup default
2305"RTN","TMGRPC1C",169,0)
2306 ;" Note: For security reasons, all path requests will be considered relative to a root path.
2307"RTN","TMGRPC1C",170,0)
2308 ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve:
2309"RTN","TMGRPC1C",171,0)
2310 ;" /var/local/Dir1/Dir2/download/SomeFile.jpg
2311"RTN","TMGRPC1C",172,0)
2312 ;" This root path is found in custom field 22701 in file 2005.2
2313"RTN","TMGRPC1C",173,0)
2314 ;" ARRAY -- the array that will hold the file, in BASE64 ascii encoding
2315"RTN","TMGRPC1C",174,0)
2316 ;"Output: results are passed out in RESULT: 1^SuccessMessage or 0^FailureMessage
2317"RTN","TMGRPC1C",175,0)
2318
2319"RTN","TMGRPC1C",176,0)
2320 new result
2321"RTN","TMGRPC1C",177,0)
2322 new resultMsg set resultMsg="1^Successful Upload"
2323"RTN","TMGRPC1C",178,0)
2324
2325"RTN","TMGRPC1C",179,0)
2326 set ^TMP("UPLOAD^TMGRPC1",$J,"FPATH")=$GET(FPATH)
2327"RTN","TMGRPC1C",180,0)
2328 set ^TMP("UPLOAD^TMGRPC1",$J,"FNAME")=$GET(FNAME)
2329"RTN","TMGRPC1C",181,0)
2330 set ^TMP("UPLOAD^TMGRPC1",$J,"LOCIEN")=$GET(LOCIEN)
2331"RTN","TMGRPC1C",182,0)
2332
2333"RTN","TMGRPC1C",183,0)
2334 if $data(ARRAY)=0 set resultMsg="0^No data received to upload" goto UpDone
2335"RTN","TMGRPC1C",184,0)
2336 set FNAME=$get(FNAME)
2337"RTN","TMGRPC1C",185,0)
2338 if FNAME="" do goto UpDone
2339"RTN","TMGRPC1C",186,0)
2340 . set resultMsg="0^No file name received"
2341"RTN","TMGRPC1C",187,0)
2342
2343"RTN","TMGRPC1C",188,0)
2344 set LOCIEN=+$GET(LOCIEN) if LOCIEN'>0 set LOCIEN=$$GETDEFNL()
2345"RTN","TMGRPC1C",189,0)
2346
2347"RTN","TMGRPC1C",190,0)
2348 set FPATH=$$GETLOCFPATH($GET(FPATH),LOCIEN) ;
2349"RTN","TMGRPC1C",191,0)
2350
2351"RTN","TMGRPC1C",192,0)
2352 do DECODE("ARRAY(0)",1)
2353"RTN","TMGRPC1C",193,0)
2354
2355"RTN","TMGRPC1C",194,0)
2356 if $$GTBF^TMGBINF("ARRAY(0)",1,FPATH,FNAME)=0 do
2357"RTN","TMGRPC1C",195,0)
2358 . set resultMsg="0^Error while saving file"
2359"RTN","TMGRPC1C",196,0)
2360
2361"RTN","TMGRPC1C",197,0)
2362UpDone set RESULT=resultMsg
2363"RTN","TMGRPC1C",198,0)
2364 quit
2365"RTN","TMGRPC1C",199,0)
2366
2367"RTN","TMGRPC1C",200,0)
2368
2369"RTN","TMGRPC1C",201,0)
2370DOWNDROP(RESULT,FPATH,FNAME,LOCIEN) ;"i.e. Download drop box file
2371"RTN","TMGRPC1C",202,0)
2372 ;"SCOPE: Public
2373"RTN","TMGRPC1C",203,0)
2374 ;"RPC That calls this: TMG DOWNLOAD FILE DROPBOX
2375"RTN","TMGRPC1C",204,0)
2376 ;"Purpose: To provide an entry point for a RPC call from a client. The client
2377"RTN","TMGRPC1C",205,0)
2378 ;" will request for the file to be placed into in a 'dropbox' file
2379"RTN","TMGRPC1C",206,0)
2380 ;" location that both the client and server can access. File may be
2381"RTN","TMGRPC1C",207,0)
2382 ;" moved from there to its final destination by the client.
2383"RTN","TMGRPC1C",208,0)
2384 ;" This method alloows file-hiding ability on the server side.
2385"RTN","TMGRPC1C",209,0)
2386 ;"Input: RESULT -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE)
2387"RTN","TMGRPC1C",210,0)
2388 ;" FPATH -- the file path up to, but not including, the filename. This
2389"RTN","TMGRPC1C",211,0)
2390 ;" is the path that the file is stored at (relative to a root path,
2391"RTN","TMGRPC1C",212,0)
2392 ;" see comments below). It is NOT the path of the dropbox.
2393"RTN","TMGRPC1C",213,0)
2394 ;" Use '/' to NOT specify any subdirectory
2395"RTN","TMGRPC1C",214,0)
2396 ;" [optional] default is '/'
2397"RTN","TMGRPC1C",215,0)
2398 ;" FNAME -- the name of the file to be uploaded. Note: This is also the
2399"RTN","TMGRPC1C",216,0)
2400 ;" name of the file to be put into the dropbox. It is the
2401"RTN","TMGRPC1C",217,0)
2402 ;" responsibility of the client to ensure that there is not already
2403"RTN","TMGRPC1C",218,0)
2404 ;" a similarly named file in the dropbox before requesting a file
2405"RTN","TMGRPC1C",219,0)
2406 ;" be put there. It is the responsibility of the client to delete
2407"RTN","TMGRPC1C",220,0)
2408 ;" the file from the drop box.
2409"RTN","TMGRPC1C",221,0)
2410 ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to download from
2411"RTN","TMGRPC1C",222,0)
2412 ;" NOTE: DEPRECIATED. Should pass "" to allow code to lookup default
2413"RTN","TMGRPC1C",223,0)
2414 ;" Note: For security reasons, all path requests will be considered relative to a root path.
2415"RTN","TMGRPC1C",224,0)
2416 ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve:
2417"RTN","TMGRPC1C",225,0)
2418 ;" /var/local/Dir1/Dir2/download/SomeFile.jpg
2419"RTN","TMGRPC1C",226,0)
2420 ;" This root path is found in custom field 22701 in file 2005.2
2421"RTN","TMGRPC1C",227,0)
2422 ;" Also: dropbox location is obtained from custom field 22702 in file 2005.2
2423"RTN","TMGRPC1C",228,0)
2424 ;"NOTE RE DROPBOX:
2425"RTN","TMGRPC1C",229,0)
2426 ;" This system is designed for a system where by the server and the client have a
2427"RTN","TMGRPC1C",230,0)
2428 ;" shared filesystem, but the directory paths will be different. For example:
2429"RTN","TMGRPC1C",231,0)
2430 ;" Linux server has dropbox at: /mnt/WinServer/dropbox/
2431"RTN","TMGRPC1C",232,0)
2432 ;" Windows Client has access to dropbox at: V:\Dropbox\
2433"RTN","TMGRPC1C",233,0)
2434
2435"RTN","TMGRPC1C",234,0)
2436 ;"Output: results are 1^Success^FileSize (in bytes), or 0^Error Message
2437"RTN","TMGRPC1C",235,0)
2438
2439"RTN","TMGRPC1C",236,0)
2440 new DropBox,moveResult,SrcNamePath
2441"RTN","TMGRPC1C",237,0)
2442
2443"RTN","TMGRPC1C",238,0)
2444 new resultMsg set resultMsg="1^Successful Download"
2445"RTN","TMGRPC1C",239,0)
2446
2447"RTN","TMGRPC1C",240,0)
2448 set FNAME=$get(FNAME) if FNAME="" do goto DnDBxDone
2449"RTN","TMGRPC1C",241,0)
2450 . set resultMsg="0^No file name received"
2451"RTN","TMGRPC1C",242,0)
2452
2453"RTN","TMGRPC1C",243,0)
2454 set FPATH=$$GETLOCFPATH(.FPATH,.LOCIEN) ;
2455"RTN","TMGRPC1C",244,0)
2456
2457"RTN","TMGRPC1C",245,0)
2458 if $$GETDROPPATH(.LOCIEN,.DropBox)=-1 do goto DnDBxDone
2459"RTN","TMGRPC1C",246,0)
2460 . set resultMsg="0^Dropbox location not configured in file 2005.2, IEN "_LOCIEN_", field 22702"
2461"RTN","TMGRPC1C",247,0)
2462
2463"RTN","TMGRPC1C",248,0)
2464 set SrcNamePath=FPATH_FNAME
2465"RTN","TMGRPC1C",249,0)
2466
2467"RTN","TMGRPC1C",250,0)
2468 set moveResult=$$Copy^TMGKERNL(SrcNamePath,DropBox)
2469"RTN","TMGRPC1C",251,0)
2470 if moveResult>0 do
2471"RTN","TMGRPC1C",252,0)
2472 . set resultMsg="0^Move failed, returning OS error code: "_moveResult
2473"RTN","TMGRPC1C",253,0)
2474 else do
2475"RTN","TMGRPC1C",254,0)
2476 . set resultMsg=resultMsg_"^"_$$FileSize^TMGKERNL(SrcNamePath)
2477"RTN","TMGRPC1C",255,0)
2478
2479"RTN","TMGRPC1C",256,0)
2480DnDBxDone
2481"RTN","TMGRPC1C",257,0)
2482 set RESULT=resultMsg
2483"RTN","TMGRPC1C",258,0)
2484 quit
2485"RTN","TMGRPC1C",259,0)
2486
2487"RTN","TMGRPC1C",260,0)
2488
2489"RTN","TMGRPC1C",261,0)
2490UPLDDROP(RESULT,FPATH,FNAME,LOCIEN) ;"i.e. Upload Dropbox File
2491"RTN","TMGRPC1C",262,0)
2492 ;"SCOPE: Public
2493"RTN","TMGRPC1C",263,0)
2494 ;"RPC That calls this: TMG UPLOAD FILE DROPBOX
2495"RTN","TMGRPC1C",264,0)
2496 ;"Purpose: To provide an entry point for a RPC call from a client. The client
2497"RTN","TMGRPC1C",265,0)
2498 ;" will put the file in a 'dropbox' file location that both the client
2499"RTN","TMGRPC1C",266,0)
2500 ;" and server can access. File will be moved from there to its final
2501"RTN","TMGRPC1C",267,0)
2502 ;" destination. This will provide file-hiding ability on the server side.
2503"RTN","TMGRPC1C",268,0)
2504 ;"Input: RESULT -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE)
2505"RTN","TMGRPC1C",269,0)
2506 ;" FPATH -- the file path up to, but not including, the filename. This
2507"RTN","TMGRPC1C",270,0)
2508 ;" is the path to store the file at. (relative to a root path,
2509"RTN","TMGRPC1C",271,0)
2510 ;" see comments below). It is NOT the path of the dropbox.
2511"RTN","TMGRPC1C",272,0)
2512 ;" Use '/' to NOT specify any subdirectory
2513"RTN","TMGRPC1C",273,0)
2514 ;" [optional] default is '/'
2515"RTN","TMGRPC1C",274,0)
2516 ;" FNAME -- the name of the file to be uploaded. Note: This is also the
2517"RTN","TMGRPC1C",275,0)
2518 ;" name of the file to be pulled from the dropbox. It is the
2519"RTN","TMGRPC1C",276,0)
2520 ;" responsibility of the client to ensure that there is not already
2521"RTN","TMGRPC1C",277,0)
2522 ;" a similarly named file in the dropbox before depositing a file there.
2523"RTN","TMGRPC1C",278,0)
2524 ;" The server will remove the file from the dropbox, unless there is
2525"RTN","TMGRPC1C",279,0)
2526 ;" an error with the host OS (which will be returned as an error message)
2527"RTN","TMGRPC1C",280,0)
2528 ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to upload to
2529"RTN","TMGRPC1C",281,0)
2530 ;" NOTE: DEPRECIATED. Should pass "" to allow code to lookup default
2531"RTN","TMGRPC1C",282,0)
2532 ;" Note: For security reasons, all path requests will be considered relative to a root path.
2533"RTN","TMGRPC1C",283,0)
2534 ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve:
2535"RTN","TMGRPC1C",284,0)
2536 ;" /var/local/Dir1/Dir2/download/SomeFile.jpg
2537"RTN","TMGRPC1C",285,0)
2538 ;" This root path is found in custom field 22700 in file 2005.2
2539"RTN","TMGRPC1C",286,0)
2540 ;" Also: dropbox location is obtained from custom field 22702 in file 2005.2
2541"RTN","TMGRPC1C",287,0)
2542 ;"NOTE RE DROPBOX:
2543"RTN","TMGRPC1C",288,0)
2544 ;" This system is designed for a system where by the server and the client have a
2545"RTN","TMGRPC1C",289,0)
2546 ;" shared filesystem, but the directory paths will be different. For example:
2547"RTN","TMGRPC1C",290,0)
2548 ;" Linux server has dropbox at: /mnt/WinServer/dropbox/
2549"RTN","TMGRPC1C",291,0)
2550 ;" Windows Client has access to dropbox at: V:\Dropbox\
2551"RTN","TMGRPC1C",292,0)
2552
2553"RTN","TMGRPC1C",293,0)
2554 ;"Output: results are passed out in RESULT:
2555"RTN","TMGRPC1C",294,0)
2556 ;" 1^SuccessMessage or 0^FailureMessage
2557"RTN","TMGRPC1C",295,0)
2558
2559"RTN","TMGRPC1C",296,0)
2560 new SrcNamePath,DestNamePath,moveResult
2561"RTN","TMGRPC1C",297,0)
2562 new resultMsg set resultMsg="1^Successful Upload"
2563"RTN","TMGRPC1C",298,0)
2564
2565"RTN","TMGRPC1C",299,0)
2566 set FNAME=$get(FNAME)
2567"RTN","TMGRPC1C",300,0)
2568 if FNAME="" set resultMsg="0^No file name received" goto UpDBxDone
2569"RTN","TMGRPC1C",301,0)
2570
2571"RTN","TMGRPC1C",302,0)
2572 new DropBox
2573"RTN","TMGRPC1C",303,0)
2574 if $$GETDROPPATH(.LOCIEN,.DropBox)=-1 do goto UpDBxDone
2575"RTN","TMGRPC1C",304,0)
2576 . set resultMsg="0^Dropbox location not configured in file 2005.2, IEN "_LOCIEN_", field 22702"
2577"RTN","TMGRPC1C",305,0)
2578
2579"RTN","TMGRPC1C",306,0)
2580 set FPATH=$$GETLOCFPATH($GET(FPATH),LOCIEN) ;
2581"RTN","TMGRPC1C",307,0)
2582
2583"RTN","TMGRPC1C",308,0)
2584 set SrcNamePath=DropBox_FNAME
2585"RTN","TMGRPC1C",309,0)
2586 set DestNamePath=FPATH_FNAME
2587"RTN","TMGRPC1C",310,0)
2588
2589"RTN","TMGRPC1C",311,0)
2590 set moveResult=$$Move^TMGKERNL(SrcNamePath,DestNamePath)
2591"RTN","TMGRPC1C",312,0)
2592 if moveResult>0 do
2593"RTN","TMGRPC1C",313,0)
2594 . set resultMsg="0^Move failed, returning OS error code: "_moveResult
2595"RTN","TMGRPC1C",314,0)
2596
2597"RTN","TMGRPC1C",315,0)
2598UpDBxDone
2599"RTN","TMGRPC1C",316,0)
2600 set RESULT=resultMsg
2601"RTN","TMGRPC1C",317,0)
2602 quit
2603"RTN","TMGRPC1C",318,0)
2604
2605"RTN","TMGRPC1C",319,0)
2606
2607"RTN","TMGRPC1C",320,0)
2608ENCODE(GRef,incSubscr,encodeFn)
2609"RTN","TMGRPC1C",321,0)
2610 ;"Purpose: ENCODE a BINARY GLOBAL.
2611"RTN","TMGRPC1C",322,0)
2612 ;"Input:
2613"RTN","TMGRPC1C",323,0)
2614 ;" GRef-- Global reference of the SOURCE binary global array, in fully resolved
2615"RTN","TMGRPC1C",324,0)
2616 ;" (closed root) format.
2617"RTN","TMGRPC1C",325,0)
2618 ;" Note:
2619"RTN","TMGRPC1C",326,0)
2620 ;" At least one subscript must be numeric. This will be the incrementing
2621"RTN","TMGRPC1C",327,0)
2622 ;" subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment
2623"RTN","TMGRPC1C",328,0)
2624 ;" to store each new global node). This subscript need not be the final
2625"RTN","TMGRPC1C",329,0)
2626 ;" subscript. For example, to load into a WORD PROCESSING field, the
2627"RTN","TMGRPC1C",330,0)
2628 ;" incrementing node is the second-to-last subscript; the final subscript
2629"RTN","TMGRPC1C",331,0)
2630 ;" is always zero.
2631"RTN","TMGRPC1C",332,0)
2632 ;" REQUIRED
2633"RTN","TMGRPC1C",333,0)
2634 ;" incSubscr-- (required) Identifies the incrementing subscript level, for the source global
2635"RTN","TMGRPC1C",334,0)
2636 ;" For example, if you pass ^TMP(115,1,1,0) as the global_ref parameter and
2637"RTN","TMGRPC1C",335,0)
2638 ;" pass 3 as the inc_subscr parameter, $$BIN2GBL will increment the third
2639"RTN","TMGRPC1C",336,0)
2640 ;" subscript, such as ^TMP(115,1,x), but will WRITE notes at the full global
2641"RTN","TMGRPC1C",337,0)
2642 ;" reference, such as ^TMP(115,1,x,0).
2643"RTN","TMGRPC1C",338,0)
2644 ;" REQUIRED
2645"RTN","TMGRPC1C",339,0)
2646 ;" encodeFn- (OPTIONAL) the name of a function that will encode a line of data.
2647"RTN","TMGRPC1C",340,0)
2648 ;" e.g. "CODER^ZZZCODER" or "LOCALCODER". The function should
2649"RTN","TMGRPC1C",341,0)
2650 ;" take one input variable (the line of raw binary data), and return a converted
2651"RTN","TMGRPC1C",342,0)
2652 ;" line. e.g.
2653"RTN","TMGRPC1C",343,0)
2654 ;" CODER(INPUT)
2655"RTN","TMGRPC1C",344,0)
2656 ;" ... ;"convert INPUT to RESULT
2657"RTN","TMGRPC1C",345,0)
2658 ;" QUIT RESULT
2659"RTN","TMGRPC1C",346,0)
2660 ;" default value is B64CODER^TMGRPC1
2661"RTN","TMGRPC1C",347,0)
2662 ;"
2663"RTN","TMGRPC1C",348,0)
2664 ;"Output: @GRef is converted to encoded data
2665"RTN","TMGRPC1C",349,0)
2666 ;"Result: None
2667"RTN","TMGRPC1C",350,0)
2668
2669"RTN","TMGRPC1C",351,0)
2670 if $get(GRef)="" goto EncodeDone
2671"RTN","TMGRPC1C",352,0)
2672 if $get(incSubscr)="" goto EncodeDone
2673"RTN","TMGRPC1C",353,0)
2674
2675"RTN","TMGRPC1C",354,0)
2676 set encodeFn=$get(encodeFn,"B64CODER")
2677"RTN","TMGRPC1C",355,0)
2678
2679"RTN","TMGRPC1C",356,0)
2680 new encoder
2681"RTN","TMGRPC1C",357,0)
2682 set encoder="set temp=$$"_encodeFn_"(.temp)"
2683"RTN","TMGRPC1C",358,0)
2684
2685"RTN","TMGRPC1C",359,0)
2686 for do quit:(GRef="")
2687"RTN","TMGRPC1C",360,0)
2688 . new temp
2689"RTN","TMGRPC1C",361,0)
2690 . set temp=$get(@GRef)
2691"RTN","TMGRPC1C",362,0)
2692 . if temp="" set GRef="" quit
2693"RTN","TMGRPC1C",363,0)
2694 . xecute encoder ;"i.e. set temp=$$encoderFn(.temp)
2695"RTN","TMGRPC1C",364,0)
2696 . set @GRef=temp
2697"RTN","TMGRPC1C",365,0)
2698 . set GRef=$$NEXTNODE^TMGBINF(GRef,incSubscr,1,1)
2699"RTN","TMGRPC1C",366,0)
2700
2701"RTN","TMGRPC1C",367,0)
2702EncodeDone
2703"RTN","TMGRPC1C",368,0)
2704 quit
2705"RTN","TMGRPC1C",369,0)
2706
2707"RTN","TMGRPC1C",370,0)
2708
2709"RTN","TMGRPC1C",371,0)
2710HEXCODER(INPUT)
2711"RTN","TMGRPC1C",372,0)
2712 ;"Purpose: to encode the input string. Currently using simple hex encoding/
2713"RTN","TMGRPC1C",373,0)
2714 quit $$STRB2H^TMGSTUTL(.INPUT,0,1)
2715"RTN","TMGRPC1C",374,0)
2716
2717"RTN","TMGRPC1C",375,0)
2718
2719"RTN","TMGRPC1C",376,0)
2720B64CODER(INPUT)
2721"RTN","TMGRPC1C",377,0)
2722 ;"Purpose: to encode the input string via UUENCODE (actually Base64)
2723"RTN","TMGRPC1C",378,0)
2724 quit $$ENCODE^RGUTUU(.INPUT)
2725"RTN","TMGRPC1C",379,0)
2726
2727"RTN","TMGRPC1C",380,0)
2728B64DECODER(INPUT)
2729"RTN","TMGRPC1C",381,0)
2730 ;"Purpose: to encode the input string via UUENCODE (actually Base64)
2731"RTN","TMGRPC1C",382,0)
2732 quit $$DECODE^RGUTUU(.INPUT)
2733"RTN","TMGRPC1C",383,0)
2734
2735"RTN","TMGRPC1C",384,0)
2736
2737"RTN","TMGRPC1C",385,0)
2738DECODE(GRef,incSubscr,decodeFn)
2739"RTN","TMGRPC1C",386,0)
2740 ;"Purpose: ENCODE a BINARY GLOBAL.
2741"RTN","TMGRPC1C",387,0)
2742 ;"Input:
2743"RTN","TMGRPC1C",388,0)
2744 ;" GRef-- Global reference of the SOURCE binary global array, in fully resolved
2745"RTN","TMGRPC1C",389,0)
2746 ;" (closed root) format.
2747"RTN","TMGRPC1C",390,0)
2748 ;" Note:
2749"RTN","TMGRPC1C",391,0)
2750 ;" At least one subscript must be numeric. This will be the incrementing
2751"RTN","TMGRPC1C",392,0)
2752 ;" subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment
2753"RTN","TMGRPC1C",393,0)
2754 ;" to store each new global node). This subscript need not be the final
2755"RTN","TMGRPC1C",394,0)
2756 ;" subscript. For example, to load into a WORD PROCESSING field, the
2757"RTN","TMGRPC1C",395,0)
2758 ;" incrementing node is the second-to-last subscript; the final subscript
2759"RTN","TMGRPC1C",396,0)
2760 ;" is always zero.
2761"RTN","TMGRPC1C",397,0)
2762 ;" REQUIRED
2763"RTN","TMGRPC1C",398,0)
2764 ;" incSubscr-- (required) Identifies the incrementing subscript level, for the source global
2765"RTN","TMGRPC1C",399,0)
2766 ;" For example, if you pass ^TMP(115,1,1,0) as the global_ref parameter and
2767"RTN","TMGRPC1C",400,0)
2768 ;" pass 3 as the inc_subscr parameter, $$BIN2GBL will increment the third
2769"RTN","TMGRPC1C",401,0)
2770 ;" subscript, such as ^TMP(115,1,x), but will WRITE notes at the full global
2771"RTN","TMGRPC1C",402,0)
2772 ;" reference, such as ^TMP(115,1,x,0).
2773"RTN","TMGRPC1C",403,0)
2774 ;" REQUIRED
2775"RTN","TMGRPC1C",404,0)
2776 ;" decodeFn- (OPTIONAL) the name of a function that will decode a line of data.
2777"RTN","TMGRPC1C",405,0)
2778 ;" e.g. "DECODER^ZZZCODER" or "DECODER". The function should take
2779"RTN","TMGRPC1C",406,0)
2780 ;" one input variable (the line of encoded data), and return a decoded line. e.g.
2781"RTN","TMGRPC1C",407,0)
2782 ;" DECODER(INPUT)
2783"RTN","TMGRPC1C",408,0)
2784 ;" ... ;"convert INPUT to RESULT
2785"RTN","TMGRPC1C",409,0)
2786 ;" QUIT RESULT
2787"RTN","TMGRPC1C",410,0)
2788 ;" default value is B64DECODER^TMGRPC1
2789"RTN","TMGRPC1C",411,0)
2790 ;"
2791"RTN","TMGRPC1C",412,0)
2792 ;"Output: @GRef is converted to decoded data
2793"RTN","TMGRPC1C",413,0)
2794 ;"Result: None
2795"RTN","TMGRPC1C",414,0)
2796
2797"RTN","TMGRPC1C",415,0)
2798 if $get(GRef)="" goto DecodeDone
2799"RTN","TMGRPC1C",416,0)
2800 if $get(incSubscr)="" goto DecodeDone
2801"RTN","TMGRPC1C",417,0)
2802 set decodeFn=$get(decodeFn,"B64DECODER")
2803"RTN","TMGRPC1C",418,0)
2804
2805"RTN","TMGRPC1C",419,0)
2806 new decoder
2807"RTN","TMGRPC1C",420,0)
2808 set decoder="set temp=$$"_decodeFn_"(.temp)"
2809"RTN","TMGRPC1C",421,0)
2810
2811"RTN","TMGRPC1C",422,0)
2812 for do quit:(GRef="")
2813"RTN","TMGRPC1C",423,0)
2814 . new temp
2815"RTN","TMGRPC1C",424,0)
2816 . set temp=$get(@GRef)
2817"RTN","TMGRPC1C",425,0)
2818 . if temp="" set GRef="" quit
2819"RTN","TMGRPC1C",426,0)
2820 . xecute decoder ;"i.e. set temp=$$decoderFn(.temp)
2821"RTN","TMGRPC1C",427,0)
2822 . set @GRef=temp
2823"RTN","TMGRPC1C",428,0)
2824 . set GRef=$$NEXTNODE^TMGBINF(GRef,incSubscr,1,1)
2825"RTN","TMGRPC1C",429,0)
2826
2827"RTN","TMGRPC1C",430,0)
2828DecodeDone
2829"RTN","TMGRPC1C",431,0)
2830 quit
2831"RTN","TMGRPC1C",432,0)
2832 ;
2833"RTN","TMGRPC1C",433,0)
2834 ;
2835"RTN","TMGRPC1C",434,0)
2836DELIMAGE(RESULT,TMGIEN,TMGMODE,TMGREASON) ;
2837"RTN","TMGRPC1C",435,0)
2838 ;"Purpose: Provide functionality for deleting or retacting an image from CPRS
2839"RTN","TMGRPC1C",436,0)
2840 ;"NOTE: MAGG IMAGE DELETE is not used because it does things like archive
2841"RTN","TMGRPC1C",437,0)
2842 ;" the images before deletion. I don't have this system fully integrated
2843"RTN","TMGRPC1C",438,0)
2844 ;" In the future, that could possibly be used.
2845"RTN","TMGRPC1C",439,0)
2846 ;"NOTE: This function DOES NOT CHECK PERMISSIONS for deleting the images.
2847"RTN","TMGRPC1C",440,0)
2848 ;" It is assumed that that has been doine PRIOR to calling this function.
2849"RTN","TMGRPC1C",441,0)
2850 ;"NOTE: It mode is to retract (see below), then the image will not be
2851"RTN","TMGRPC1C",442,0)
2852 ;" actually be deleted. It will just be marked as retracted and
2853"RTN","TMGRPC1C",443,0)
2854 ;" set so that it doesn't appear in CPRS.
2855"RTN","TMGRPC1C",444,0)
2856 ;" --But if mode is to delete, then the record in the IMAGE file
2857"RTN","TMGRPC1C",445,0)
2858 ;" will be deleted AND ALSO the actual image (with no backup.) This
2859"RTN","TMGRPC1C",446,0)
2860 ;" mode is for deletion before signing, and the image has not been
2861"RTN","TMGRPC1C",447,0)
2862 ;" formally entered into the record.
2863"RTN","TMGRPC1C",448,0)
2864 ;"Input: RESULT -- an OUT Parameter. (See results below)
2865"RTN","TMGRPC1C",449,0)
2866 ;" TMGIEN -- the IEN in the IMAGE file (2005) to remove
2867"RTN","TMGRPC1C",450,0)
2868 ;" TMGMODE -- 0 for NONE <-- just exit and do nothing
2869"RTN","TMGRPC1C",451,0)
2870 ;" 1 for DELETE <-- delete record and image file
2871"RTN","TMGRPC1C",452,0)
2872 ;" 2 for RETRACT <-- mark record as retracted, don't delete iamge file.
2873"RTN","TMGRPC1C",453,0)
2874 ;" TMGREASON -- String (10-60 chars) giving reason for deletion.
2875"RTN","TMGRPC1C",454,0)
2876 ;" This is only used for mode RETRACT.
2877"RTN","TMGRPC1C",455,0)
2878 ;"Output: RESULT="1^Success" or "-1^Some Failure Message" <-- set up as SINGLE VALUE type in RPC BROKER
2879"RTN","TMGRPC1C",456,0)
2880 ;
2881"RTN","TMGRPC1C",457,0)
2882 SET RESULT="1^Success" ;"Default to success
2883"RTN","TMGRPC1C",458,0)
2884 SET TMGIEN=$GET(TMGIEN,0)
2885"RTN","TMGRPC1C",459,0)
2886 IF +TMGIEN'>0 DO GOTO DIDN
2887"RTN","TMGRPC1C",460,0)
2888 . SET RESULT="-1^Invalid IEN: "_TMGIEN
2889"RTN","TMGRPC1C",461,0)
2890 SET TMGIEN=+TMGIEN
2891"RTN","TMGRPC1C",462,0)
2892 SET TMGMODE=+$GET(TMGMODE)
2893"RTN","TMGRPC1C",463,0)
2894 IF TMGMODE=0 DO GOTO DIDN
2895"RTN","TMGRPC1C",464,0)
2896 . SET RESULT="1^Delete not done because mode=0"
2897"RTN","TMGRPC1C",465,0)
2898 SET TMGREASON=$GET(TMGREASON,"(Not Specified)")
2899"RTN","TMGRPC1C",466,0)
2900 NEW TMGPTR SET TMGPTR=+$PIECE($GET(^MAG(2005,TMGIEN,2)),"^",8) ;"2;8 ==> Field 18 = PARENT DATA FILE IMAGE POINTER
2901"RTN","TMGRPC1C",467,0)
2902 IF TMGPTR'>0 DO GOTO DIDN
2903"RTN","TMGRPC1C",468,0)
2904 . SET RESULT="-1^FILE 2005, IEN "_TMGIEN_", Field 18 does not point to valid record in file 8925.91"
2905"RTN","TMGRPC1C",469,0)
2906 NEW TMGTIUPTR SET TMGTIUPTR=+$PIECE($GET(^TIU(8925.91,TMGPTR,0)),"^",1) ;"0;1 ==> Field .01 = DOCUMENT (ptr to 8925)
2907"RTN","TMGRPC1C",470,0)
2908 IF TMGMODE=1 DO GOTO:(+RESULT'>0) DIDN ;"Delete mode
2909"RTN","TMGRPC1C",471,0)
2910 . NEW FNAME SET FNAME=$PIECE($GET(^MAG(2005,TMGIEN,0)),"^",2)
2911"RTN","TMGRPC1C",472,0)
2912 . NEW TMGPATH SET TMGPATH=$$GETLOCFPATH()
2913"RTN","TMGRPC1C",473,0)
2914 . NEW TMGARRAY,DELRSLT
2915"RTN","TMGRPC1C",474,0)
2916 . SET TMGARRAY(FNAME)=""
2917"RTN","TMGRPC1C",475,0)
2918 . SET DELRSLT=$$DEL^%ZISH(TMGPATH,"TMGARRAY")
2919"RTN","TMGRPC1C",476,0)
2920 . IF DELRSLT=0 DO QUIT
2921"RTN","TMGRPC1C",477,0)
2922 . . SET RESULT="-1^Unable to delete file: "_TMGPATH_FNAME
2923"RTN","TMGRPC1C",478,0)
2924 . KILL TMGARRAY
2925"RTN","TMGRPC1C",479,0)
2926 . NEW FNAME2 SET FNAME2=FNAME
2927"RTN","TMGRPC1C",480,0)
2928 . SET $PIECE(FNAME2,",",$LENGTH(FNAME2,"."))="ABS"
2929"RTN","TMGRPC1C",481,0)
2930 . SET TMGARRAY(FNAME2)=""
2931"RTN","TMGRPC1C",482,0)
2932 . SET DELRSLT=$$DEL^%ZISH(TMGPATH,"TMGARRAY") ;"Ingnore results. Thumbnail not always present
2933"RTN","TMGRPC1C",483,0)
2934 . NEW DIK SET DIK="^MAG(2005,"
2935"RTN","TMGRPC1C",484,0)
2936 . NEW DA SET DA=TMGIEN
2937"RTN","TMGRPC1C",485,0)
2938 . DO ^DIK ;"Kill Record in 2005
2939"RTN","TMGRPC1C",486,0)
2940 ELSE IF TMGMODE=2 DO GOTO:(+RESULT'>0) DIDN ;"Retract mode
2941"RTN","TMGRPC1C",487,0)
2942 . NEW TMGFDA,TMGMSG,TMGIENS
2943"RTN","TMGRPC1C",488,0)
2944 . SET TMGIENS=TMGIEN_","
2945"RTN","TMGRPC1C",489,0)
2946 . SET TMGFDA(2005,TMGIENS,30)="`"_+DUZ
2947"RTN","TMGRPC1C",490,0)
2948 . SET TMGFDA(2005,TMGIENS,30.1)="NOW"
2949"RTN","TMGRPC1C",491,0)
2950 . SET TMGFDA(2005,TMGIENS,30.2)=TMGREASON
2951"RTN","TMGRPC1C",492,0)
2952 . SET TMGFDA(2005,TMGIENS,18)="@"
2953"RTN","TMGRPC1C",493,0)
2954 . ;"NOTE: Fld 17 already holds IEN of linked 8925 document
2955"RTN","TMGRPC1C",494,0)
2956 . DO FILE^DIE("EKT","TMGFDA","TMGMSG")
2957"RTN","TMGRPC1C",495,0)
2958 . IF $DATA(TMGMSG("DIERR")) DO
2959"RTN","TMGRPC1C",496,0)
2960 . . SET RESULT="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
2961"RTN","TMGRPC1C",497,0)
2962 DO ;"Do this for both DELETE and RETRACT modes.
2963"RTN","TMGRPC1C",498,0)
2964 . NEW DIK SET DIK="^TIU(8925.91,"
2965"RTN","TMGRPC1C",499,0)
2966 . NEW DA SET DA=TMGPTR
2967"RTN","TMGRPC1C",500,0)
2968 . DO ^DIK ;"Kill record in 8925.91
2969"RTN","TMGRPC1C",501,0)
2970 ;
2971"RTN","TMGRPC1C",502,0)
2972DIDN QUIT
2973"RTN","TMGRPC1C",503,0)
2974 ;
2975"RTN","TMGRPC1C",504,0)
2976UNRETRACT(RESULT,TMGIEN) ;
2977"RTN","TMGRPC1C",505,0)
2978 ;"Purpose: to reverse retraction process from DELIMAGE above.
2979"RTN","TMGRPC1C",506,0)
2980 ;"Input: RESULT -- an OUT Parameter. (See results below)
2981"RTN","TMGRPC1C",507,0)
2982 ;" TMGIEN -- the IEN in the IMAGE file (2005) to remove
2983"RTN","TMGRPC1C",508,0)
2984 ;"Output: RESULT="1^Success" or "-1^Some Failure Message" <-- set up as SINGLE VALUE type in RPC BROKER
2985"RTN","TMGRPC1C",509,0)
2986 SET TMGIEN=$GET(TMGIEN)
2987"RTN","TMGRPC1C",510,0)
2988 IF +TMGIEN'>0 DO GOTO URDN
2989"RTN","TMGRPC1C",511,0)
2990 . SET RESULT="-1^Invalid IEN supplied: "_TMGIEN
2991"RTN","TMGRPC1C",512,0)
2992 SET TMGIEN=+TMGIEN
2993"RTN","TMGRPC1C",513,0)
2994 NEW TIUPTR SET TIUPTR=+$PIECE($GET(^MAG(2005,TMGIEN,2)),"^",7)
2995"RTN","TMGRPC1C",514,0)
2996 IF TIUPTR'>0 DO GOTO URDN
2997"RTN","TMGRPC1C",515,0)
2998 . SET RESULT="-1^Record 2005 doesn't hold link to TIU DOCUMENT in field 17"
2999"RTN","TMGRPC1C",516,0)
3000 NEW TMGFDA,TMGFDA,TMGIENS
3001"RTN","TMGRPC1C",517,0)
3002 ;"-- Recreate TIU EXTERNAL DATA LINK record
3003"RTN","TMGRPC1C",518,0)
3004 KILL TMGFDA
3005"RTN","TMGRPC1C",519,0)
3006 SET TMGIENS="+1,"
3007"RTN","TMGRPC1C",520,0)
3008 SET TMGFDA(8925.91,TMGIENS,.01)=TIUPTR
3009"RTN","TMGRPC1C",521,0)
3010 SET TMGFDA(8925.91,TMGIENS,.02)=TMGIEN
3011"RTN","TMGRPC1C",522,0)
3012 DO UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG")
3013"RTN","TMGRPC1C",523,0)
3014 IF $DATA(TMGMSG("DIERR")) DO GOTO URDN
3015"RTN","TMGRPC1C",524,0)
3016 . SET RESULT="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
3017"RTN","TMGRPC1C",525,0)
3018 NEW TIUIMGPTR SET TIUIMGPTR=+$GET(TMGIEN(1))
3019"RTN","TMGRPC1C",526,0)
3020 IF TIUIMGPTR'>0 DO GOTO URDN
3021"RTN","TMGRPC1C",527,0)
3022 . SET RESULT="-1^Unable to locate recreated TIU EXTERNAL DATA LINK record"
3023"RTN","TMGRPC1C",528,0)
3024 ;"-- remove DELETED info from IMAGE record --
3025"RTN","TMGRPC1C",529,0)
3026 NEW TMGFDA,TMGFDA,TMGIENS
3027"RTN","TMGRPC1C",530,0)
3028 SET TMGIENS=TMGIEN_","
3029"RTN","TMGRPC1C",531,0)
3030 SET TMGFDA(2005,TMGIENS,30)="@"
3031"RTN","TMGRPC1C",532,0)
3032 SET TMGFDA(2005,TMGIENS,30.1)="@"
3033"RTN","TMGRPC1C",533,0)
3034 SET TMGFDA(2005,TMGIENS,30.2)="@"
3035"RTN","TMGRPC1C",534,0)
3036 SET TMGFDA(2005,TMGIENS,18)=TIUIMGPTR
3037"RTN","TMGRPC1C",535,0)
3038 DO FILE^DIE("EKT","TMGFDA","TMGMSG")
3039"RTN","TMGRPC1C",536,0)
3040 IF $DATA(TMGMSG("DIERR")) DO GOTO URDN
3041"RTN","TMGRPC1C",537,0)
3042 . SET RESULT="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
3043"RTN","TMGRPC1C",538,0)
3044
3045"RTN","TMGRPC1C",539,0)
3046URDN QUIT
3047"RTN","TMGRPC1D")
30480^4^B69776678
3049"RTN","TMGRPC1D",1,0)
3050TMGRPC1D ;TMG/kst-RPC Functions ;07/21/10
3051"RTN","TMGRPC1D",2,0)
3052 ;;1.0;TMG-LIB;**1**;07/21/10;Build 2
3053"RTN","TMGRPC1D",3,0)
3054
3055"RTN","TMGRPC1D",4,0)
3056 ;"TMG RPC FUNCTIONS especially related to imaging.
3057"RTN","TMGRPC1D",5,0)
3058
3059"RTN","TMGRPC1D",6,0)
3060 ;"Kevin Toppenberg MD
3061"RTN","TMGRPC1D",7,0)
3062 ;"GNU General Public License (GPL) applies
3063"RTN","TMGRPC1D",8,0)
3064 ;"7/21/10
3065"RTN","TMGRPC1D",9,0)
3066
3067"RTN","TMGRPC1D",10,0)
3068 ;"=======================================================================
3069"RTN","TMGRPC1D",11,0)
3070 ;" RPC -- Public Functions.
3071"RTN","TMGRPC1D",12,0)
3072 ;"=======================================================================
3073"RTN","TMGRPC1D",13,0)
3074 ;"CONFIG -- Set up imaging site parameters, so that TMG-CPRS works.
3075"RTN","TMGRPC1D",14,0)
3076 ;"TESTCFG -- Test configuration
3077"RTN","TMGRPC1D",15,0)
3078 ;"=======================================================================
3079"RTN","TMGRPC1D",16,0)
3080 ;"PRIVATE API FUNCTIONS
3081"RTN","TMGRPC1D",17,0)
3082 ;"=======================================================================
3083"RTN","TMGRPC1D",18,0)
3084 ;"PINST1 - entry point for POST-INSTALL routine for patch TMG-CPRS-IMAGING*1.0*1
3085"RTN","TMGRPC1D",19,0)
3086 ;
3087"RTN","TMGRPC1D",20,0)
3088 ;"=======================================================================
3089"RTN","TMGRPC1D",21,0)
3090 ;"Dependancies: TMGKERNL,TMGUSRIF
3091"RTN","TMGRPC1D",22,0)
3092 ;"=======================================================================
3093"RTN","TMGRPC1D",23,0)
3094 ;
3095"RTN","TMGRPC1D",24,0)
3096CONFIG ;
3097"RTN","TMGRPC1D",25,0)
3098 ;"Purpose: Set up imaging site parameters, so that TMG-CPRS works.
3099"RTN","TMGRPC1D",26,0)
3100 ;"Input: None
3101"RTN","TMGRPC1D",27,0)
3102 ;"Results: none
3103"RTN","TMGRPC1D",28,0)
3104 ;
3105"RTN","TMGRPC1D",29,0)
3106 WRITE " ------------------------------------------",!
3107"RTN","TMGRPC1D",30,0)
3108 WRITE " - Configuration of TMG Imaging -",!
3109"RTN","TMGRPC1D",31,0)
3110 WRITE " ------------------------------------------",!,!
3111"RTN","TMGRPC1D",32,0)
3112 ;
3113"RTN","TMGRPC1D",33,0)
3114 ;"First get default INSTITUTION, stored in KERNEL SYSTEM PARAMETERS file.
3115"RTN","TMGRPC1D",34,0)
3116 NEW %,DA,DR,DIE,DIC,X,Y,DIK
3117"RTN","TMGRPC1D",35,0)
3118 NEW TMGFDA,TMGMSG,TMGDIV,TMGDROP,TMGSTORE,TMGNODIV
3119"RTN","TMGRPC1D",36,0)
3120 NEW INSTPTR,IMGSPPTR
3121"RTN","TMGRPC1D",37,0)
3122CF1 SET INSTPTR=+$PIECE($GET(^XTV(8989.3,1,"XUS")),"^",17) ;"Ptr to file $4 (Institution)
3123"RTN","TMGRPC1D",38,0)
3124 IF INSTPTR>0 DO GOTO CF2
3125"RTN","TMGRPC1D",39,0)
3126 . WRITE "Using DEFAULT INSTITUTION: ",$$GET1^DIQ(4,INSTPTR,.01),!
3127"RTN","TMGRPC1D",40,0)
3128 WRITE "No value for DEFAULT INSTITUTION found in field 217 in file KERNEL SYSTEM PARAMETERS",!
3129"RTN","TMGRPC1D",41,0)
3130 WRITE "Edit settings now to correct this"
3131"RTN","TMGRPC1D",42,0)
3132 SET %=1 DO YN^DICN WRITE !
3133"RTN","TMGRPC1D",43,0)
3134 IF %'=1 GOTO CFDN
3135"RTN","TMGRPC1D",44,0)
3136 SET DA=1,DR="[XUSITEPARM]",DIE=8989.3
3137"RTN","TMGRPC1D",45,0)
3138 DO XUDIE^XUS5 ;"Launch screenman form to edit KERNEL SYSTEM PARAMETERS.
3139"RTN","TMGRPC1D",46,0)
3140 GOTO CF1
3141"RTN","TMGRPC1D",47,0)
3142 ;
3143"RTN","TMGRPC1D",48,0)
3144CF2 ;"Now get IMAGING SITE PARAMETERS for Institution Name
3145"RTN","TMGRPC1D",49,0)
3146 SET IMGSPPTR=+$ORDER(^MAG(2006.1,"B",INSTPTR,0))
3147"RTN","TMGRPC1D",50,0)
3148 IF IMGSPPTR>0 DO GOTO CF3
3149"RTN","TMGRPC1D",51,0)
3150 . WRITE "Using IMAGING SITE PARAMETERS IEN #",IMGSPPTR,", "
3151"RTN","TMGRPC1D",52,0)
3152 . WRITE $$GET1^DIQ(2006.1,IMGSPPTR,.01),!
3153"RTN","TMGRPC1D",53,0)
3154 WRITE "Next, a entry in IMAGING SITE PARAMENTERS file must be linked in.",!
3155"RTN","TMGRPC1D",54,0)
3156 WRITE "Please select entry to use, or add a new one if needed.",!
3157"RTN","TMGRPC1D",55,0)
3158 DO PRESSTOCONT^TMGUSRIF
3159"RTN","TMGRPC1D",56,0)
3160 SET DIC=2006.1,DIC(0)="MAEQL"
3161"RTN","TMGRPC1D",57,0)
3162 DO ^DIC WRITE !
3163"RTN","TMGRPC1D",58,0)
3164 IF Y>-1 SET IMGSPPTR=+Y GOTO CF2B
3165"RTN","TMGRPC1D",59,0)
3166 WRITE "Valid entry in IMAGING SITE PARAMETERS file not selected.",!
3167"RTN","TMGRPC1D",60,0)
3168 SET %=1
3169"RTN","TMGRPC1D",61,0)
3170 WRITE "Start over" DO YN^DICN WRITE !
3171"RTN","TMGRPC1D",62,0)
3172 IF %=1 GOTO CF1
3173"RTN","TMGRPC1D",63,0)
3174 GOTO ABORT
3175"RTN","TMGRPC1D",64,0)
3176CF2B KILL TMGFDA,TMGMSG
3177"RTN","TMGRPC1D",65,0)
3178 SET TMGFDA(2006.1,IMGSPPTR_",",.01)=INSTPTR
3179"RTN","TMGRPC1D",66,0)
3180 DO FILE^DIE("K","TMGFDA","TMGMSG")
3181"RTN","TMGRPC1D",67,0)
3182 IF $DATA(TMGMSG("DIERR")) DO GOTO ABORT
3183"RTN","TMGRPC1D",68,0)
3184 . DO ShowDIERR^TMGDEBUG(.TMGMSG)
3185"RTN","TMGRPC1D",69,0)
3186 GOTO CF2 ;"loop back just be sure the B index is setup.
3187"RTN","TMGRPC1D",70,0)
3188 ;
3189"RTN","TMGRPC1D",71,0)
3190CF3 ;"Now get NETWORK LOCATION stored in IMAGING SITE PARAMETERS record
3191"RTN","TMGRPC1D",72,0)
3192 NEW LOCPTR SET LOCPTR=+$PIECE($GET(^MAG(2006.1,IMGSPPTR,0)),"^",3)
3193"RTN","TMGRPC1D",73,0)
3194 IF LOCPTR>0 DO GOTO CF4
3195"RTN","TMGRPC1D",74,0)
3196 . WRITE "Using NETWORK LOCATION IEN #",LOCPTR,", "
3197"RTN","TMGRPC1D",75,0)
3198 . WRITE $$GET1^DIQ(2005.2,LOCPTR,.01),!
3199"RTN","TMGRPC1D",76,0)
3200 WRITE "Next, a entry in NETWORK LOCATION file must be linked in.",!
3201"RTN","TMGRPC1D",77,0)
3202 WRITE "Please select entry to use, or add a new one if needed.",!
3203"RTN","TMGRPC1D",78,0)
3204 DO PRESSTOCONT^TMGUSRIF
3205"RTN","TMGRPC1D",79,0)
3206 SET DIC=2005.1,DIC(0)="MAEQL"
3207"RTN","TMGRPC1D",80,0)
3208 IF Y>-1 SET LOCPTR=+Y GOTO CF4
3209"RTN","TMGRPC1D",81,0)
3210 WRITE "Valid entry in NETWORK LOCATION file not selected.",!
3211"RTN","TMGRPC1D",82,0)
3212 SET %=1
3213"RTN","TMGRPC1D",83,0)
3214 WRITE "Start over" DO YN^DICN WRITE !
3215"RTN","TMGRPC1D",84,0)
3216 IF %=1 GOTO CF1
3217"RTN","TMGRPC1D",85,0)
3218 GOTO ABORT
3219"RTN","TMGRPC1D",86,0)
3220 ;
3221"RTN","TMGRPC1D",87,0)
3222CF4 ;"Now set up NETWORK LOCATION file.
3223"RTN","TMGRPC1D",88,0)
3224 WRITE !,"A NODE DIVIDER is the symbol used to separt folders in a path",!
3225"RTN","TMGRPC1D",89,0)
3226 WRITE "E.g. for UNIX, with a sample path of '/opt/var/me', uses '/'",!
3227"RTN","TMGRPC1D",90,0)
3228 WRITE "For Windows, with sample path of 'c:\temp\me', uses '\'",!
3229"RTN","TMGRPC1D",91,0)
3230 SET %=1,TMGNODIV=0
3231"RTN","TMGRPC1D",92,0)
3232 SET TMGDIV=$$GET1^DIQ(2005.2,LOCPTR,22701)
3233"RTN","TMGRPC1D",93,0)
3234 IF TMGDIV'="" DO
3235"RTN","TMGRPC1D",94,0)
3236 . WRITE "Current Node divider= '",TMGDIV,"'"
3237"RTN","TMGRPC1D",95,0)
3238 . SET %=2
3239"RTN","TMGRPC1D",96,0)
3240 . IF TMGDIV="/" WRITE " (UNIX filesystem)",!
3241"RTN","TMGRPC1D",97,0)
3242 . ELSE IF TMGDIV="\" WRITE " (WINDOWS filesystem)",!
3243"RTN","TMGRPC1D",98,0)
3244 . ELSE WRITE " (?? filesystem)",! SET %=1
3245"RTN","TMGRPC1D",99,0)
3246 WRITE "Do you want to specify a NODE DIVIDER" DO YN^DICN WRITE !
3247"RTN","TMGRPC1D",100,0)
3248 IF %=-1 GOTO ABORT
3249"RTN","TMGRPC1D",101,0)
3250 IF %=2 SET TMGNODIV=1 GOTO CF4A
3251"RTN","TMGRPC1D",102,0)
3252 ;
3253"RTN","TMGRPC1D",103,0)
3254 WRITE "Is the server running on a Linux/Unix box" DO YN^DICN WRITE !
3255"RTN","TMGRPC1D",104,0)
3256 IF %=-1 GOTO ABORT
3257"RTN","TMGRPC1D",105,0)
3258 IF %=1 SET TMGDIV="/"
3259"RTN","TMGRPC1D",106,0)
3260 ELSE SET TMGDIV="\"
3261"RTN","TMGRPC1D",107,0)
3262 ;
3263"RTN","TMGRPC1D",108,0)
3264CF4A WRITE !,"A DROPBOX is a file folder where the server may place files for",!
3265"RTN","TMGRPC1D",109,0)
3266 WRITE "pick up by a client (i.e. CPRS). This folder could be on a ",!
3267"RTN","TMGRPC1D",110,0)
3268 WRITE "separate file system (e.g. a windows file system mounted into",!
3269"RTN","TMGRPC1D",111,0)
3270 WRITE "the server file system.) This is a security measure that negates",!
3271"RTN","TMGRPC1D",112,0)
3272 WRITE "a need for the client to have read access to the entire images",!
3273"RTN","TMGRPC1D",113,0)
3274 WRITE "folder. A dropbox path is only required if client is configured",!
3275"RTN","TMGRPC1D",114,0)
3276 WRITE "to use it.",!
3277"RTN","TMGRPC1D",115,0)
3278 SET %=1
3279"RTN","TMGRPC1D",116,0)
3280 SET TMGDROP=$$GET1^DIQ(2005.2,LOCPTR,22702)
3281"RTN","TMGRPC1D",117,0)
3282 IF TMGDROP'="" DO
3283"RTN","TMGRPC1D",118,0)
3284 . WRITE "Current DROPBOX: ",TMGDROP,!,!
3285"RTN","TMGRPC1D",119,0)
3286 . SET %=2
3287"RTN","TMGRPC1D",120,0)
3288 WRITE "Do you want to specify a DROPBOX FOLDER" DO YN^DICN WRITE !
3289"RTN","TMGRPC1D",121,0)
3290 IF %=-1 GOTO ABORT
3291"RTN","TMGRPC1D",122,0)
3292 IF %=2 SET TMGDROP="" GOTO CF4C
3293"RTN","TMGRPC1D",123,0)
3294 ;
3295"RTN","TMGRPC1D",124,0)
3296CF4B WRITE "Enter full path of the DROPBOX is it would be accessed on the ",!
3297"RTN","TMGRPC1D",125,0)
3298 WRITE "server (**NOT the path that the client would use**)",!
3299"RTN","TMGRPC1D",126,0)
3300 READ "Enter full DROPBOX path (^ to abort): ",TMGDROP:DTIME,!
3301"RTN","TMGRPC1D",127,0)
3302 IF TMGDROP="^" GOTO ABORT
3303"RTN","TMGRPC1D",128,0)
3304 IF TMGDROP="" WRITE ! GOTO CF4A
3305"RTN","TMGRPC1D",129,0)
3306 IF $$IsDir^TMGKERNL(TMGDROP,TMGDIV)=1 GOTO CF4B
3307"RTN","TMGRPC1D",130,0)
3308 WRITE "ERROR: Path specified is not valid. Does folder exist?",!,!
3309"RTN","TMGRPC1D",131,0)
3310 GOTO CF4B
3311"RTN","TMGRPC1D",132,0)
3312 ;
3313"RTN","TMGRPC1D",133,0)
3314CF4C WRITE !,"A STORE PATH is the file folder that the server will use to",!
3315"RTN","TMGRPC1D",134,0)
3316 WRITE "store images. This should be a complete and valid path.",!
3317"RTN","TMGRPC1D",135,0)
3318 SET %=1
3319"RTN","TMGRPC1D",136,0)
3320 SET TMGSTORE=$$GET1^DIQ(2005.2,LOCPTR,22700)
3321"RTN","TMGRPC1D",137,0)
3322 IF TMGSTORE'="" DO
3323"RTN","TMGRPC1D",138,0)
3324 . WRITE "Current image file storage path: ",TMGSTORE,!
3325"RTN","TMGRPC1D",139,0)
3326 . SET %=2
3327"RTN","TMGRPC1D",140,0)
3328 WRITE "Do you want to specify a STORE FOLDER" DO YN^DICN WRITE !
3329"RTN","TMGRPC1D",141,0)
3330 IF %=-1 GOTO ABORT
3331"RTN","TMGRPC1D",142,0)
3332 IF %=2 SET TMGSTORE="" GOTO CF4D
3333"RTN","TMGRPC1D",143,0)
3334 ;
3335"RTN","TMGRPC1D",144,0)
3336 READ "Enter store path (^ to abort): ",TMGSTORE:DTIME,!
3337"RTN","TMGRPC1D",145,0)
3338 IF TMGDROP="^" GOTO ABORT
3339"RTN","TMGRPC1D",146,0)
3340 IF TMGSTORE="" WRITE ! GOTO CF4C
3341"RTN","TMGRPC1D",147,0)
3342 IF $$IsDir^TMGKERNL(TMGSTORE,TMGDIV)=1 GOTO CF4D
3343"RTN","TMGRPC1D",148,0)
3344 WRITE "ERROR: Path specified is not valid. Does folder exist?",!,!
3345"RTN","TMGRPC1D",149,0)
3346 GOTO CF4C
3347"RTN","TMGRPC1D",150,0)
3348 ;
3349"RTN","TMGRPC1D",151,0)
3350CF4D ;"Next force field 1 (PHYSICAL REFERENCE) to be same as TMGDIV
3351"RTN","TMGRPC1D",152,0)
3352 IF $PIECE($GET(^MAG(2005.2,LOCPTR,0)),"^",2)=TMGDIV GOTO CF4E
3353"RTN","TMGRPC1D",153,0)
3354 SET DIK="^MAG(2005.2,"
3355"RTN","TMGRPC1D",154,0)
3356 SET DA=LOCPTR
3357"RTN","TMGRPC1D",155,0)
3358 DO ^DIK ;"Kill prior entry. Leaves DIK and DA unchanged
3359"RTN","TMGRPC1D",156,0)
3360 ;"Note: Input transform doesn't allow the value I put in here.
3361"RTN","TMGRPC1D",157,0)
3362 SET $PIECE(^MAG(2005.2,LOCPTR,0),"^",2)=TMGDIV ;"NOTE!! Low-level write
3363"RTN","TMGRPC1D",158,0)
3364 SET DIK(1)=1 ;"Field 1 = PHYSICAL REFERENCE
3365"RTN","TMGRPC1D",159,0)
3366 DO EN^DIK ;"Reindex field, to populate crossrefences with new value.
3367"RTN","TMGRPC1D",160,0)
3368 ;
3369"RTN","TMGRPC1D",161,0)
3370CF4E KILL TMGFDA,TMGMSG
3371"RTN","TMGRPC1D",162,0)
3372 IF TMGSTORE'="" SET TMGFDA(2005.2,LOCPTR_",",22700)=TMGSTORE
3373"RTN","TMGRPC1D",163,0)
3374 IF TMGNODIV=0 SET TMGFDA(2005.2,LOCPTR_",",22701)=TMGDIV
3375"RTN","TMGRPC1D",164,0)
3376 IF TMGDROP'="" SET TMGFDA(2005.2,LOCPTR_",",22702)=TMGDROP
3377"RTN","TMGRPC1D",165,0)
3378 IF $DATA(TMGFDA) DO FILE^DIE("K","TMGFDA","TMGMSG")
3379"RTN","TMGRPC1D",166,0)
3380 IF $DATA(TMGMSG("DIERR")) DO GOTO ABORT
3381"RTN","TMGRPC1D",167,0)
3382 . DO ShowDIERR^TMGDEBUG(.TMGMSG)
3383"RTN","TMGRPC1D",168,0)
3384 WRITE !,"Done with configuration.",!,!
3385"RTN","TMGRPC1D",169,0)
3386 DO TESTCFG
3387"RTN","TMGRPC1D",170,0)
3388 GOTO CFDN
3389"RTN","TMGRPC1D",171,0)
3390 ;
3391"RTN","TMGRPC1D",172,0)
3392ABORT WRITE "Aborting configuration process.",!
3393"RTN","TMGRPC1D",173,0)
3394 WRITE "Try again later, using 'DO CONFIG^TMGRPC1D'",!
3395"RTN","TMGRPC1D",174,0)
3396CFDN QUIT
3397"RTN","TMGRPC1D",175,0)
3398 ;
3399"RTN","TMGRPC1D",176,0)
3400 ;
3401"RTN","TMGRPC1D",177,0)
3402TESTCFG ;
3403"RTN","TMGRPC1D",178,0)
3404 ;"Purpose: Test configuration
3405"RTN","TMGRPC1D",179,0)
3406 NEW LOCPTR SET LOCPTR=$$GETDEFNL^TMGRPC1C()
3407"RTN","TMGRPC1D",180,0)
3408 IF LOCPTR'>0 DO QUIT
3409"RTN","TMGRPC1D",181,0)
3410 . WRITE "ERROR: Can't find NETWORK LOCATION to use",!
3411"RTN","TMGRPC1D",182,0)
3412 WRITE "Storage path: ",$$GETLOCFPATH^TMGRPC1C("/"),!
3413"RTN","TMGRPC1D",183,0)
3414 NEW DROPPATH
3415"RTN","TMGRPC1D",184,0)
3416 IF $$GETDROPPATH^TMGRPC1C(LOCPTR,.DROPPATH)=-1 DO QUIT
3417"RTN","TMGRPC1D",185,0)
3418 . WRITE "ERROR: Unable to get Dropbox path",!
3419"RTN","TMGRPC1D",186,0)
3420 WRITE "Dropbox path: ",DROPPATH,!
3421"RTN","TMGRPC1D",187,0)
3422 QUIT
3423"RTN","TMGRPC1D",188,0)
3424 ;
3425"RTN","TMGRPC1D",189,0)
3426PINST1 ;
3427"RTN","TMGRPC1D",190,0)
3428 ;"Purpose: This is an entry point for POST-INSTALL routine for patch
3429"RTN","TMGRPC1D",191,0)
3430 ;" TMG-CPRS-IMAGING*1.0*1
3431"RTN","TMGRPC1D",192,0)
3432 DO ENSUREAL^TMGRPC1B
3433"RTN","TMGRPC1D",193,0)
3434 DO CONFIG
3435"RTN","TMGRPC1D",194,0)
3436 QUIT
3437"RTN","TMGRPC1D",195,0)
3438 ;
3439"VER")
34408.0^22.0
3441**END**
3442**END**
Note: See TracBrowser for help on using the repository browser.