source: cprs/branches/tmg-cprs/m_files/TMGRPC1.m@ 1083

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

replacing soft links with actual files
File size: 33.8 KB
Line 
1TMGRPC1 ;TMG/kst-RPC Functions ;03/25/06
2 ;;1.0;TMG-LIB;**1**;08/18/09
3
4 ;"TMG RPC FUNCTIONS
5
6 ;"Kevin Toppenberg MD
7 ;"GNU General Public License (GPL) applies
8 ;"3/24/07
9
10 ;"=======================================================================
11 ;" RPC -- Public Functions.
12 ;"=======================================================================
13 ;"DOWNLOAD(GREF,FPATH,FNAME,LOCIEN) ; Depreciated MOVED to TMGRPC1C
14 ;"UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY) ; Depreciated MOVED to TMGRPC1C
15 ;"DOWNDROP(RESULT,FPATH,FNAME,LOCIEN) ; Depreciated MOVED to TMGRPC1C
16 ;"UPLDDROP(RESULT,FPATH,FNAME,LOCIEN) ; Depreciated MOVED to TMGRPC1C
17 ;"GETLONG(GREF,IMAGEIEN)
18 ;"GETDFN(RESULT,RECNUM,RECFIELD,LNAME,FNAME,MNAME,DOB,SEX,SSNUM)
19 ;"BLANKTIU(RESULT,DFN,PERSON,LOC,DOS,TITLE)
20 ;"AUTOSIGN(RESULT,DOCIEN)
21 ;"FNINFO(RESULT,DFN) -- GET PATIENT DEMOGRAPHICS
22 ;"PTADD(RESULT,INFO) -- ADD PATIENT
23 ;"STPTINFO(RESULT,DFN,INFO) -- SET PATIENT DEMOGRAPHICS
24 ;"GETURLS(RESULT) -- TMG CPRS GET URL LIST
25
26 ;"=======================================================================
27 ;"PRIVATE API FUNCTIONS
28 ;"=======================================================================
29 ;"ENCODE(GRef,incSubscr,encodeFn) ; Depreciated MOVED to TMGRPC1C
30 ;"DECODE(GRef,incSubscr,decodeFn) ; Depreciated MOVED to TMGRPC1C
31 ;"$$HEXCODER(INPUT) ;encode the input string. Currently using simple hex encoding/
32 ;"$$B64CODER(INPUT) ;encode the input string via UUENCODE (actually Base64)
33 ;"$$B64DECODER(INPUT) ;encode the input string via UUDECODE (actually Base64)
34
35 ;"=======================================================================
36 ;"=======================================================================
37 ;"Dependencies:
38 ;"TMGBINF
39 ;"TMGSTUTL
40 ;"RGUTUU
41 ;"=======================================================================
42 ;"=======================================================================
43
44DOWNLOAD(GREF,FPATH,FNAME,LOCIEN)
45 GOTO DOWNLOAD+1^TMGRPC1C
46 ;
47UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY)
48 GOTO UPLOAD+1^TMGRPC1C
49 ;
50DOWNDROP(RESULT,FPATH,FNAME,LOCIEN) ;"i.e. Download drop box file
51 GOTO DOWNDROP+1^TMGRPC1C
52 ;
53UPLDDROP(RESULT,FPATH,FNAME,LOCIEN) ;"i.e. Upload Dropbox File
54 GOTO UPLDDROP+1^TMGRPC1C
55 ;
56ENCODE(GRef,incSubscr,encodeFn) ;"Purpose: ENCODE a BINARY GLOBAL.
57 GOTO ENCODE+1^TMGRPC1C
58 ;
59DECODE(GRef,incSubscr,decodeFn) ;"Purpose: ENCODE a BINARY GLOBAL.
60 GOTO DECODE+1^TMGRPC1C
61 ;
62GETLONG(GREF,IMAGEIEN)
63 ;"SCOPE: Public
64 ;"Purpose: To provide an entry point for a RPC call from a client.
65 ;" Will return results of field 11 (LONG DESCRIPTION) from file IMAGE(2005)
66 ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE)
67 ;" IMAGEIEN-- The IEN (record number) from file 2005 (IMAGE)
68 ;"Output: results are passed out in @GREF
69 ;" @GREF@(0) = WP header line: format is: ^^MaxLine^MaxLine^TimeStamp(FM Date/Time Format)
70 ;" @GREF@(1) = WP line 1
71 ;" @GREF@(2) = WP line 2
72 ;" @GREF@(3) = WP line 3
73 ;" @GREF@(4) = WP line 4 ... etc.
74
75 set GREF="^TMP(""GETLONG^TMGRPC1"","_$J_")"
76
77 kill @GREF
78
79 new i,s,MaxLines,header
80 set header=""
81 if +$get(IMAGEIEN)>0 do
82 . set header=$get(^MAG(2005,IMAGEIEN,3,0)) ;"NOTE: Field 11 held in node 3;0
83 set @GREF@(0)=header
84 set MaxLines=+$piece(header,"^",3)
85 for i=1:1:MaxLines do
86 . set @GREF@(i)=$get(^MAG(2005,IMAGEIEN,3,i,0))
87
88 quit
89
90
91
92GETDFN(RESULT,RECNUM,PMS,FNAME,LNAME,MNAME,DOB,SEX,SSNUM,AUTOADD)
93 ;"Purpose: This is a RPC entry point for looking up a patient.
94 ;"Input:
95 ;" RESULT -- an OUT PARAMETER
96 ;" RECNUM -- Record number from a PMS
97 ;" PMS -- Which PMS RECNUM refers to (1=Medic,2=Sequel,3=Paradigm)
98 ;" FNAME -- First Name
99 ;" LNAME -- Last name
100 ;" MNAME -- Middle Name or initial
101 ;" DOB -- Date of birth in EXTERNAL format
102 ;" SEX -- Patient sex: M or F
103 ;" SSNUM -- Social security number (digits only)
104 ;" AUTOADD -- Automatically register patient if needed (if value=1)
105 ;"Output: Patient may be added to database if AUTOADD=1
106 ;"Results: Returns DFN (i.e. IEN in PATIENT file) or -1 if not found or error
107
108 new Patient,TMGFREG
109 set RESULT=-1 ;"default to not found
110
111 if $get(LNAME)'="" do
112 . set Patient("NAME")=$get(LNAME)
113 . if $get(FNAME)'="" set Patient("NAME")=Patient("NAME")_","_FNAME
114 . if $get(MNAME)'="" set Patient("NAME")=Patient("NAME")_" "_MNAME
115 set Patient("DOB")=$get(DOB)
116 set Patient("SEX")=$get(SEX)
117 set Patient("SSNUM")=$get(SSNUM)
118test if $get(AUTOADD)=1 set TMGFREG=1
119
120 if $get(PMS)=1 set Patient("PATIENTNUM")=$get(RECNUM) ;" <-- Medic account number
121 if $get(PMS)=2 set Patient("SEQUELNUM")=$get(RECNUM) ;" <-- Sequel or other account number
122 if $get(PMS)=3 set Patient("PARADIGMNUM")=$get(RECNUM) ;" <-- Paradigm or other account number
123
124 ;"temp
125 ;"merge ^TMG("TMP","GETDFN","KILLLATER")=Patient
126 ;"set ^TMG("TMP","GETDFN","KILLLATER","FNAME")=FNAME
127 ;"set ^TMG("TMP","GETDFN","KILLLATER","LNAME")=LNAME
128 ;"set ^TMG("TMP","GETDFN","KILLLATER","MNAME")=MNAME
129
130 set RESULT=$$GetDFN^TMGGDFN(.Patient)
131
132 quit
133
134
135BLANKTIU(RESULT,DFN,PERSON,LOC,DOS,TITLE)
136 ;"Purpose: To create a new, blank TIU note and return it's IEN
137 ;"Input: DFN -- IEN in PATIENT file of patient
138 ;" PERSON -- Provider NAME
139 ;" LOC -- Location for new document
140 ;" DOS -- Date of Service
141 ;" TITLE -- Title of new document
142 ;"Results: IEN in file 8925 is returned in RESULT,
143 ;" or -1^ErrMsg1;ErrMsg2... if failure
144 ;"Note: This functionality probably duplicates that of RPC call:
145 ;" TIU CREATE NOTE -- found after writing this...
146
147 new Document,Flag
148
149 kill ^TMG("TMP","BLANKTIU")
150 set ^TMG("TMP","BLANKTIU","DFN")=$G(DFN)
151 set ^TMG("TMP","BLANKTIU","PERSON")=$G(PERSON)
152 set ^TMG("TMP","BLANKTIU","LOC")=$G(LOC)
153 set ^TMG("TMP","BLANKTIU","DOS")=$G(DOS)
154 set ^TMG("TMP","BLANKTIU","TITLE")=$G(TITLE)
155
156 set Document("DFN")=DFN
157 set Document("PROVIDER IEN")=$$GetProvIEN^TMGPUTN0(PERSON)
158 if +LOC=LOC s LOC="`"_LOC
159 set Document("LOCATION")=$get(LOC)
160 set Document("DATE")=$get(DOS)
161 set Document("TITLE")=$get(TITLE)
162 set Document("TRANSCRIPTIONIST")=""
163 set Document("CHARACTER COUNT - TRANSCRIPTIONIST'S")=0
164
165 set RESULT=$$PrepDoc^TMGPUTN0(.Document)
166 if +RESULT>0 do ;"change capture method from Upload (default) to RPC
167 . new TMGFDA,TMGMSG
168 . set TMGFDA(8925,RESULT_",",1303)="R" ;"1303 = capture method. "R" = RPC
169 . merge ^TMG("TMP","BLANKTIU","TMGFDA")=TMGFDA
170 . do FILE^DIE("E","TMGFDA","TMGMSG") ;"ignore any errors.
171 else do
172 . new i,ErrMsg set ErrMsg=""
173 . for i=1:1:+$get(Document("ERROR","NUM")) do
174 . . set ErrMsg=ErrMsg_$get(Document("ERROR",i))_" ||"
175 . if $data(Document("ERROR","FM INFO"))>0 do
176 . . new ref set ref="Document(""ERROR"",""FM INFO"")"
177 . . set ErrMsg=ErrMsg_"FILEMAN SAYS:"
178 . . for set ref=$query(@ref) quit:(ref="")!(ref'["FM INFO") do
179 . . . if ErrMsg'="" set ErrMsg=ErrMsg_" ||"
180 . . . set ErrMsg=ErrMsg_$piece(ref,"DIERR",2)_"="_$get(@ref)
181 . if ErrMsg="" set ErrMsg="Unknown error"
182 . set ErrMsg=$translate(ErrMsg,"^","@")
183 . set $piece(RESULT,"^",2)=ErrMsg
184
185 ;"temp
186 merge ^TMG("TMP","BLANKTIU","RESULT")=RESULT
187 merge ^TMG("TMP","BLANKTIU","Document")=Document
188
189
190 quit
191
192
193AUTOSIGN(RESULT,DOCIEN)
194 ;"Purpose: To automatically sign TIU note (8925).
195 ;"Input: DOCIEN -- the IEN in 8925 of the file to be automatically signed.
196 ;"Note: This function will not succeed unless field 1303 holds "R"
197 ;" and an Author found for note
198 ;"Results: Results passed back in RESULT(0) ARRAY
199 ;" -1 = failure. 1= success
200 ;" Any error message is passed back in RESULT("DIERR")
201 ;"Note: This differs from RPC CALL: TIU SIGN RECORD in that a signiture
202 ;" code is NOT required
203
204 new TMGFDA,TMGMSG
205 new AuthorIEN,AuthorName
206 new CaptureMethod
207
208 set DOCIEN=+$get(DOCIEN)
209 set RESULT=-1 ;"default to failure
210
211 set CaptureMethod=$piece($get(^TIU(8925,DOCIEN,13)),"^",3)
212 if CaptureMethod'="R" do goto ASDone
213 . set RESULT("DIERR")="Unable to auto-sign. Upload-Method was not 'R'."
214 set AuthorIEN=$piece($get(^TIU(8925,DOCIEN,12)),"^",2)
215 if AuthorIEN'>0 do goto ASDone
216 . set RESULT("DIERR")="Unable to find author of document."
217 set AuthorName=$piece($get(^VA(200,AuthorIEN,0)),"^",1)
218
219 set TMGFDA(8925,DOCIEN_",",.05)="COMPLETED" ;"field .05 = STATUS
220 set TMGFDA(8925,DOCIEN_",",1501)="NOW" ;"field 1501 = Signed date
221 set TMGFDA(8925,DOCIEN_",",1502)="`"_AuthorIEN ;"field 1502 = signed by
222 set TMGFDA(8925,DOCIEN_",",1503)=AuthorName ;"field 1503 = Signature block name
223 set TMGFDA(8925,DOCIEN_",",1504)="[Scanned image auto-signed]" ;"field 1504 = Signature block title
224 set TMGFDA(8925,DOCIEN_",",1505)="C" ;C=Chart ;"field 1505 = Signature mode
225 do FILE^DIE("E","TMGFDA","TMGMSG")
226 if $data(TMGMSG("DIERR")) do goto ASDone
227 . merge RESULT("DIERR")=TMGMSG("DIERR")
228
229 set RESULT(0)=1 ;"set success if we got this far.
230ASDone
231 quit
232
233
234DFNINFO(RESULT,DFN)
235 ;"Purpose: To return array with demographcs details about patient
236 ;"Input: RESULT (this is the output array)
237 ;" DFN : The record number in file #2 of the patient to inquire about.
238 ;"Results: Results passed back in RESULT array. Format as follows:
239 ;" The results are in format: KeyName=Value,
240 ;" There is no set order these will appear.
241 ;" Here are the KeyName names that will be provided.
242 ;" If the record has no value, then value will be empty
243 ;" IEN=record#
244 ;" COMBINED_NAME=
245 ;" LNAME=
246 ;" FNAME=
247 ;" MNAME=
248 ;" PREFIX=
249 ;" SUFFIX=
250 ;" DEGREE
251 ;" DOB=
252 ;" SEX=
253 ;" SS_NUM=
254 ;" ADDRESS_LINE_1=
255 ;" ADDRESS_LINE_2=
256 ;" ADDRESS_LINE_3=
257 ;" CITY=
258 ;" STATE=
259 ;" ZIP4=
260 ;" BAD_ADDRESS=
261 ;" TEMP_ADDRESS_LINE_1=
262 ;" TEMP_ADDRESS_LINE_2=
263 ;" TEMP_ADDRESS_LINE_3=
264 ;" TEMP_CITY=
265 ;" TEMP_STATE=
266 ;" TEMP_ZIP4=
267 ;" TEMP_STARTING_DATE=
268 ;" TEMP_ENDING_DATE=
269 ;" TEMP_ADDRESS_ACTIVE=
270 ;" CONF_ADDRESS_LINE_1=
271 ;" CONF_ADDRESS_LINE_2=
272 ;" CONF_ADDRESS_LINE_3=
273 ;" CONF_CITY=
274 ;" CONF_STATE=
275 ;" CONF_ZIP4=
276 ;" CONF_STARTING_DATE=
277 ;" CONF_ENDING_DATE=
278 ;" CONF_ADDRESS_ACTIVE=
279 ;" PHONE_RESIDENCE=
280 ;" PHONE_WORK=
281 ;" PHONE_CELL=
282 ;" PHONE_TEMP=
283
284 ;"Note, for the following, there may be multiple entries. # is record number
285 ;" ALIAS # NAME
286 ;" ALIAS # SSN
287
288 new TMGFDA,TMGMSG,IENS
289 set IENS=""
290 new ptrParts set ptrParts=0
291 set DFN=+$get(DFN)
292 if DFN>0 do
293 . set ptrParts=+$piece($get(^DPT(DFN,"NAME")),"^",1) ;"ptr to file #20, NAME COMPONENTS
294 . set IENS=DFN_","
295 . do GETS^DIQ(2,IENS,"**","N","TMGFDA","TMGMSG")
296
297 new line set line=0
298 set RESULT(line)="IEN="_DFN set line=line+1
299 set RESULT(line)="COMBINED_NAME="_$get(TMGFDA(2,IENS,.01)) set line=line+1
300 new s set s=""
301 if ptrParts>0 set s=$get(^VA(20,ptrParts,1))
302 set RESULT(line)="LNAME="_$piece(s,"^",1) set line=line+1
303 set RESULT(line)="FNAME="_$piece(s,"^",2) set line=line+1
304 set RESULT(line)="MNAME="_$piece(s,"^",3) set line=line+1
305 set RESULT(line)="PREFIX="_$piece(s,"^",4) set line=line+1
306 set RESULT(line)="SUFFIX="_$piece(s,"^",5) set line=line+1
307 set RESULT(line)="DEGREE="_$piece(s,"^",5) set line=line+1
308 set RESULT(line)="DOB="_$get(TMGFDA(2,IENS,.03)) set line=line+1
309 set RESULT(line)="SEX="_$get(TMGFDA(2,IENS,.02)) set line=line+1
310 set RESULT(line)="SS_NUM="_$get(TMGFDA(2,IENS,.09)) set line=line+1
311 set RESULT(line)="EMAIL="_$get(TMGFDA(2,IENS,.133)) set line=line+1
312 set RESULT(line)="ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.111)) set line=line+1
313 set RESULT(line)="ADDRESS_LINE_2="_$get(TMGFDA(2,IENS,.112)) set line=line+1
314 set RESULT(line)="ADDRESS_LINE_3="_$get(TMGFDA(2,IENS,.113)) set line=line+1
315 set RESULT(line)="CITY="_$get(TMGFDA(2,IENS,.114)) set line=line+1
316 set RESULT(line)="STATE="_$get(TMGFDA(2,IENS,.115)) set line=line+1
317 if $get(TMGFDA(2,IENS,.1122))'="" do
318 . set RESULT(line)="ZIP4="_$get(TMGFDA(2,IENS,.1122)) set line=line+1
319 else if $get(TMGFDA(2,IENS,.1116))'="" do
320 . set RESULT(line)="ZIP4="_$get(TMGFDA(2,IENS,.1116)) set line=line+1
321 set RESULT(line)="BAD_ADDRESS="_$get(TMGFDA(2,IENS,.121)) set line=line+1
322 set RESULT(line)="TEMP_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1211)) set line=line+1
323 set RESULT(line)="TEMP_ADDRESS_LINE_2="_$get(TMGFDA(2,IENS,.1212)) set line=line+1
324 set RESULT(line)="TEMP_ADDRESS_LINE_3="_$get(TMGFDA(2,IENS,.1213)) set line=line+1
325 set RESULT(line)="TEMP_CITY="_$get(TMGFDA(2,IENS,.1214)) set line=line+1
326 set RESULT(line)="TEMP_STATE="_$get(TMGFDA(2,IENS,.1215)) set line=line+1
327 set RESULT(line)="TEMP_ZIP4="_$get(TMGFDA(2,IENS,.1216)) set line=line+1
328 set RESULT(line)="TEMP_STARTING_DATE="_$get(TMGFDA(2,IENS,.1217)) set line=line+1
329 set RESULT(line)="TEMP_ENDING_DATE="_$get(TMGFDA(2,IENS,.1218)) set line=line+1
330 set RESULT(line)="TEMP_ADDRESS_ACTIVE="_$get(TMGFDA(2,IENS,.12105)) set line=line+1
331 set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1411)) set line=line+1
332 set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1412)) set line=line+1
333 set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1413)) set line=line+1
334 set RESULT(line)="CONF_CITY="_$get(TMGFDA(2,IENS,.1414)) set line=line+1
335 set RESULT(line)="CONF_STATE="_$get(TMGFDA(2,IENS,.1415)) set line=line+1
336 set RESULT(line)="CONF_ZIP4="_$get(TMGFDA(2,IENS,.1416)) set line=line+1
337 set RESULT(line)="CONF_STARTING_DATE="_$get(TMGFDA(2,IENS,.1417)) set line=line+1
338 set RESULT(line)="CONF_ENDING_DATE="_$get(TMGFDA(2,IENS,.1418)) set line=line+1
339 set RESULT(line)="CONF_ADDRESS_ACTIVE="_$get(TMGFDA(2,IENS,.14105)) set line=line+1
340 set RESULT(line)="PHONE_RESIDENCE="_$get(TMGFDA(2,IENS,.131)) set line=line+1
341 set RESULT(line)="PHONE_WORK="_$get(TMGFDA(2,IENS,.132)) set line=line+1
342 set RESULT(line)="PHONE_CELL="_$get(TMGFDA(2,IENS,.134)) set line=line+1
343 set RESULT(line)="PHONE_TEMP="_$get(TMGFDA(2,IENS,.1219)) set line=line+1
344
345 ;"the GETS doesn't return ALIAS entries, so will do manually:
346 new Itr,IEN
347 set IEN=$$ItrInit^TMGITR(2.01,.Itr,DFN_",")
348 if IEN'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN)'>0)
349 . new s set s=$get(^DPT(DFN,.01,IEN,0))
350 . if s="" quit
351 . set RESULT(line)="ALIAS "_IEN_" NAME="_$piece(s,"^",1) set line=line+1
352 . set RESULT(line)="ALIAS "_IEN_" SSN="_$piece(s,"^",2) set line=line+1
353 . ;"maybe later do something with NAME COMPONENTS in Alias.
354
355 quit
356
357
358STPTINFO(RESULT,DFN,INFO) ;" SET PATIENT INFO
359 ;"Purpose: To set demographcs details about patient
360 ;"Input: RESULT (this is the output array)
361 ;" DFN : The record number in file #2 of the patient to inquire about.
362 ;" INFO: Format as follows:
363 ;" The results are in format: INFO("KeyName")=Value,
364 ;" There is no set order these will appear.
365 ;" Here are the KeyName names that will be provided.
366 ;" If the record has no value, then value will be empty
367 ;" If a record should be deleted, its value will be @
368 ;" INFO("COMBINED_NAME")=
369 ;" INFO("PREFIX")=
370 ;" INFO("SUFFIX")=
371 ;" INFO("DEGREE")=
372 ;" INFO("DOB")=
373 ;" INFO("SEX")=
374 ;" INFO("SS_NUM")=
375 ;" INFO("ADDRESS_LINE_1")=
376 ;" INFO("ADDRESS_LINE_2")=
377 ;" INFO("ADDRESS_LINE_3")=
378 ;" INFO("CITY")=
379 ;" INFO("STATE")=
380 ;" INFO("ZIP4")=
381 ;" INFO("BAD_ADDRESS")=
382 ;" INFO("TEMP_ADDRESS_LINE_1")=
383 ;" INFO("TEMP_ADDRESS_LINE_2")=
384 ;" INFO("TEMP_ADDRESS_LINE_3")=
385 ;" INFO("TEMP_CITY")=
386 ;" INFO("TEMP_STATE")=
387 ;" INFO("TEMP_ZIP4")=
388 ;" INFO("TEMP_STARTING_DATE")=
389 ;" INFO("TEMP_ENDING_DATE")=
390 ;" INFO("TEMP_ADDRESS_ACTIVE")=
391 ;" INFO("CONF_ADDRESS_LINE_1")=
392 ;" INFO("CONF_ADDRESS_LINE_2")=
393 ;" INFO("CONF_ADDRESS_LINE_3")=
394 ;" INFO("CONF_CITY")=
395 ;" INFO("CONF_STATE")=
396 ;" INFO("CONF_ZIP4")=
397 ;" INFO("CONF_STARTING_DATE")=
398 ;" INFO("CONF_ENDING_DATE")=
399 ;" INFO("CONF_ADDRESS_ACTIVE")=
400 ;" INFO("PHONE_RESIDENCE")=
401 ;" INFO("PHONE_WORK")=
402 ;" INFO("PHONE_CELL")=
403 ;" INFO("PHONE_TEMP")=
404 ;"Note, for the following, there may be multiple entries. # is record number
405 ;" If a record should be added, it will be marked +1, +2 etc.
406 ;" INFO("ALIAS # NAME")=
407 ;" INFO("ALIAS # SSN")=
408 ;"
409 ;"Results: Results passed back in RESULT string:
410 ;" 1 = success
411 ;" -1^Message = failure
412
413 set RESULT=1 ;"default to success
414
415 ;"kill ^TMG("TMP","RPC")
416 ;"merge ^TMG("TMP","RPC")=INFO ;"temp... remove later
417
418 new TMGFDA,TMGMSG,IENS
419 set IENS=DFN_","
420 new key set key=""
421 for set key=$order(INFO(key)) quit:(key="") do
422 . if key="COMBINED_NAME" set TMGFDA(2,IENS,.01)=INFO("COMBINED_NAME")
423 . else if +key=key set TMGFDA(2,IENS,key)=INFO(key)
424 . else if key="DOB" set TMGFDA(2,IENS,.03)=INFO("DOB")
425 . else if key="SEX" set TMGFDA(2,IENS,.02)=INFO("SEX")
426 . else if key="SS_NUM" set TMGFDA(2,IENS,.09)=INFO("SS_NUM")
427 . else if key="ADDRESS_LINE_1" set TMGFDA(2,IENS,.111)=INFO("ADDRESS_LINE_1")
428 . else if key="ADDRESS_LINE_2" set TMGFDA(2,IENS,.112)=INFO("ADDRESS_LINE_2")
429 . else if key="ADDRESS_LINE_3" set TMGFDA(2,IENS,.113)=INFO("ADDRESS_LINE_3")
430 . else if key="CITY" set TMGFDA(2,IENS,.114)=INFO("CITY")
431 . else if key="STATE" set TMGFDA(2,IENS,.115)=INFO("STATE")
432 . else if key="ZIP4" set TMGFDA(2,IENS,.1112)=INFO("ZIP4")
433 . else if key="BAD_ADDRESS" set TMGFDA(2,IENS,.121)=INFO("BAD_ADDRESS")
434 . else if key="TEMP_ADDRESS_LINE_1" set TMGFDA(2,IENS,.1211)=INFO("TEMP_ADDRESS_LINE_1")
435 . else if key="TEMP_ADDRESS_LINE_2" set TMGFDA(2,IENS,.1212)=INFO("TEMP_ADDRESS_LINE_2")
436 . else if key="TEMP_ADDRESS_LINE_3" set TMGFDA(2,IENS,.1213)=INFO("TEMP_ADDRESS_LINE_3")
437 . else if key="TEMP_CITY" set TMGFDA(2,IENS,.1214)=INFO("TEMP_CITY")
438 . else if key="TEMP_STATE" set TMGFDA(2,IENS,.1215)=INFO("TEMP_STATE")
439 . else if key="TEMP_ZIP4" set TMGFDA(2,IENS,.12112)=INFO("TEMP_ZIP4")
440 . else if key="TEMP_STARTING_DATE" set TMGFDA(2,IENS,.1217)=INFO("TEMP_STARTING_DATE")
441 . else if key="TEMP_ENDING_DATE" set TMGFDA(2,IENS,.1218)=INFO("TEMP_ENDING_DATE")
442 . else if key="TEMP_ADDRESS_ACTIVE" set TMGFDA(2,IENS,.12105)=INFO("TEMP_ADDRESS_ACTIVE")
443 . else if key="CONF_ADDRESS_LINE_1" set TMGFDA(2,IENS,.1411)=INFO("CONF_ADDRESS_LINE_1")
444 . else if key="CONF_ADDRESS_LINE_2" set TMGFDA(2,IENS,.1412)=INFO("CONF_ADDRESS_LINE_2")
445 . else if key="CONF_ADDRESS_LINE_3" set TMGFDA(2,IENS,.1413)=INFO("CONF_ADDRESS_LINE_3")
446 . else if key="CONF_CITY" set TMGFDA(2,IENS,.1414)=INFO("CONF_CITY")
447 . else if key="CONF_STATE" set TMGFDA(2,IENS,.1415)=INFO("CONF_STATE")
448 . else if key="CONF_ZIP" set TMGFDA(2,IENS,.1416)=INFO("CONF_ZIP")
449 . else if key="CONF_STARTING_DATE" set TMGFDA(2,IENS,.1417)=INFO("CONF_STARTING_DATE")
450 . else if key="CONF_ENDING_DATE" set TMGFDA(2,IENS,.1418)=INFO("CONF_ENDING_DATE")
451 . else if key="CONF_ADDRESS_ACTIVE" set TMGFDA(2,IENS,.14105)=INFO("CONF_ADDRESS_ACTIVE")
452 . else if key="PHONE_RESIDENCE" set TMGFDA(2,IENS,.131)=INFO("PHONE_RESIDENCE")
453 . else if key="PHONE_WORK" set TMGFDA(2,IENS,.132)=INFO("PHONE_WORK")
454 . else if key="PHONE_CELL" set TMGFDA(2,IENS,.134)=INFO("PHONE_CELL")
455 . else if key="PHONE_TEMP" set TMGFDA(2,IENS,.1219)=INFO("PHONE_TEMP")
456 . else if key="EMAIL" set TMGFDA(2,IENS,.133)=INFO("EMAIL")
457
458 if $data(TMGFDA) do
459 . do FILE^DIE("EKST","TMGFDA","TMGMSG")
460 . if $data(TMGMSG("DIERR")) do
461 . . set RESULT="-1^Filing Error Occured: "_$get(TMGMSG("DIERR",1,"TEXT",1))
462 . . ;"merge ^TMG("TMP","RPC","DIERR")=TMGMSG("DIERR")
463 . . ;"merge ^TMG("TMP","RPC","FDA")=TMGFDA
464
465 ;"now file Alias info separately
466 if RESULT=1 do
467 . new tempArray,index,key2
468 . new key set key=""
469 . for set key=$order(INFO(key)) quit:(key="") do
470 . . if key["ALIAS" do
471 . . . set index=$piece(key," ",2) quit:(index="")
472 . . . set key2=$piece(key," ",3)
473 . . . set tempArray(index,key2)=INFO(key)
474 . set index=0 for set index=$order(tempArray(index)) quit:(index="")!(RESULT'=1) do
475 . . new TMGFDA,TMGMSG,TMGIEN,newRec
476 . . set newRec=0
477 . . set key="" for set key=$order(tempArray(index,key)) quit:(key="")!(RESULT'=1) do
478 . . . if key="NAME" set TMGFDA(2.01,index_","_DFN_",",.01)=$get(tempArray(index,"NAME"))
479 . . . if key="SSN" set TMGFDA(2.01,index_","_DFN_",",1)=$get(tempArray(index,"SSN"))
480 . . . if index["+" set newRec=1
481 . . if $data(TMGFDA) do
482 . . . if newRec=0 do FILE^DIE("EKST","TMGFDA","TMGMSG")
483 . . . else do UPDATE^DIE("ES","TMGFDA","TMGIEN","TMGMSG")
484 . . if $data(TMGMSG("DIERR")) do
485 . . . set RESULT="-1^Filing Error Occured: "_$get(TMGMSG("DIERR",1,"TEXT",1))
486 . . . ;"merge ^TMG("TMP","RPC","DIERR")=TMGMSG("DIERR")
487 . . . ;"merge ^TMG("TMP","RPC","FDA")=TMGFDA
488
489 quit
490
491PTADD(RESULT,INFO) ;" ADD PATIENT
492 ;"Purpose: To add a patient
493 ;"Input: RESULT (this is the output array)
494 ;"
495 ;" INFO: Format as follows:
496 ;" The results are in format: INFO("KeyName")=Value,
497 ;" There is no set order these will appear.
498 ;" Here are the KeyName names that will be provided.
499 ;" If the record has no value, then value will be empty
500 ;" If a record should be deleted, its value will be @
501 ;" INFO("COMBINED_NAME")=
502 ;" INFO("DOB")=
503 ;" INFO("SEX")=
504 ;" INFO("SS_NUM")=
505 ;" INFO("Veteran")=
506 ;" INFO("PtType")=
507 ;"Results: Results passed back in RESULT string:
508 ;" DFN = success
509 ;" -1^Message = failure
510 ;" 0^DFN = already exists
511
512 set RESULT=1 ;"default to success
513
514 kill ^TMG("TMP","RPC")
515 merge ^TMG("TMP","RPC")=INFO ;"temp... remove later
516
517 new TMGFDA,TMGMSG,IENS,PATIENT,DFN,TMGFREG
518 ;" set IENS=DFN_","
519 new key set key=""
520 for set key=$order(INFO(key)) quit:(key="") do
521 . if key="COMBINED_NAME" set PATIENT("NAME")=INFO("COMBINED_NAME")
522 . else if key="DOB" set PATIENT("DOB")=INFO("DOB")
523 . else if key="SEX" set PATIENT("SEX")=INFO("SEX")
524 . else if key="SS_NUM" set PATIENT("SSNUM")=INFO("SS_NUM")
525 . else if key="Veteran" set PATIENT("VETERAN")=INFO("Veteran")
526 . else if key="PtType" set PATIENT("PT_TYPE")=INFO("PtType")
527 set DFN=$$GetDFN^TMGGDFN(.PATIENT)
528 if DFN=-1 do
529 . new Entry,result,ErrMsg
530 . do Pat2Entry^TMGGDFN(.PATIENT,.Entry)
531 . set DFN=$$AddNewPt^TMGGDFN(.Entry,.ErrMsg)
532 . ;"set DFN=$$GetDFN^TMGGDFN(.PATIENT)
533 . if DFN'>0 do
534 . . set RESULT="-1^ERROR ADDING" ;"should use ErrMsg from above. Fix later
535 . . set RESULT=RESULT_". "_$$GetErrStr^TMGDEBUG(.ErrMsg)
536 . else do
537 .. set RESULT=DFN
538 else do
539 . set RESULT="0^"_DFN
540
541 quit
542
543
544GETBARCD(GREF,MESSAGE,OPTION)
545 ;"SCOPE: Public
546 ;"RPC that calls this: TMG BARCODE ENCODE
547 ;"Purpose: To provide an entry point for a RPC call from a client.
548 ;" A 2D DataMatrix Bar Code will be create and passed to client.
549 ;" It will not be stored on server
550 ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE)
551 ;" MESSAGE-- The text to use to create the barcode
552 ;" OPTION -- Array that may hold optional settings, as follows:
553 ;" OPTION("IMAGE TYPE")="jpg" <-- if not specified, then default is "png"
554 ;"Output: results are passed out in @GREF
555 ;" @GREF@(0)=success; 1=success, 0=failure
556 ;" @GREF@(1..xxx) = actual data
557
558 ;"NOTE: dmtxread must be installed on linux host.
559 ;" I found source code here:
560 ;" http://sourceforge.net/projects/libdmtx/
561 ;" After installing (./configure --> make --> make install), I
562 ;" copied dmtxread and dmtxwrite, which were found in the
563 ;" (installdir)/util/dmtxread/.libs and (installdir)/util/dmtxwrite/.libs
564 ;" folders, into a folder on the system path. I chose /usr/bin/
565 ;" Also, to achieve compile of above, I had to install required libs.
566 ;" See notes included with dmtx source code.
567
568 new FileSpec
569 new file
570 new FName,FPath
571
572 set GREF="^TMP(""GETBARCD^TMGRPC1"","_$J_")"
573 kill @GREF
574 set @GREF@(0)="" ;"default to failure
575 set MESSAGE=$get(MESSAGE)
576 if MESSAGE="" goto GBCDone
577
578 ;"Create the barcode and get file name and path
579 set file=$$MAKEBC^TMGBARC(MESSAGE,.OPTION)
580 do SplitFNamePath^TMGIOUTL(file,.FPath,.FName,"/")
581
582 ;"Load binary image into global array
583 set @GREF@(0)=$$BFTG^TMGBINF(.FPath,.FName,$name(@GREF@(1)),3)
584
585 ;"convert binary data to ascii encoded data
586 do ENCODE($name(@GREF@(1)),3)
587
588 ;"delete temp image file
589 do SplitFNamePath^TMGIOUTL(file,.FPath,.FName,"/")
590 set FileSpec(FName)=""
591 new temp set temp=$$DEL^%ZISH(FPath,"FileSpec")
592
593GBCDone
594 quit
595
596
597DECODEBC(RESULT,ARRAY,IMGTYPE)
598 ;"SCOPE: Public
599 ;"RPC that calls this: TMG BARCODE DECODE
600 ;"Purpose: To provide an entry point for a RPC call from a client. The client
601 ;" will upload an image file (.png format only) of a barcode (Datamatrix
602 ;" format) for decoding. Decoded message is passed back.
603 ;"Input: RESULT -- an OUT PARAMETER. See output below.
604 ;" ARRAY -- the array that will hold the image file, in BASE64 ascii encoding
605 ;" IMGTYPE -- Image type, e.g. "jpg" (Note: don't include any '.')
606 ;"Output: results are passed out in RESULT: 1^Decoded Message or 0^FailureMessage
607
608 ;"NOTE: dmtxread must be installed on linux host.
609 ;" I found source code here:
610 ;" http://sourceforge.net/projects/libdmtx/
611 ;" After installing (./configure --> make --> make install), I
612 ;" copied dmtxread and dmtxwrite, which were found in the
613 ;" (installdir)/util/dmtxread/.libs and (installdir)/util/dmtxwrite/.libs
614 ;" folders, into a folder on the system path. I chose /usr/bin/
615 ;" Also, to achieve compile of above, I had to install required libs.
616 ;" See notes included with dmtx source code.
617 ;"NOTE: if image types other than .png will be uploaded, then the linux host
618 ;" must have ImageMagick utility 'convert' installed for conversion
619 ;" between image types.
620
621 kill ^TMG("TMP","BARCODE")
622 ;"set ^TMG("TMP","BARCODE","LOG")=1 ;"temp
623
624 ;"new Stack do GetStackInfo^TMGIDE2(.Stack)
625 ;"merge ^TMG("TMP","BARCODE","STACK")=Stack
626
627 new resultMsg
628 if $data(ARRAY)=0 set resultMsg="0^No image data received to decode" goto DBCDone
629
630 new imageType set imageType=$$LOW^XLFSTR($get(IMGTYPE))
631 if imageType="" set resultMsg="0^Image type not specified" goto DBCDone
632
633 new imageFName set imageFName="/tmp/barcode."_imageType
634 set imageFName=$$UNIQUE^%ZISUTL(imageFName)
635 new FName,FPath,FileSpec
636 do SplitFNamePath^TMGIOUTL(imageFName,.FPath,.FName,"/")
637 set FileSpec(FName)=""
638
639 ;"temp...
640 ;"merge ^TMG("TMP","BARCODE","DATA")=ARRAY
641 ;"merge ^TMG("TMP","BARCODE","IMGTYPE")=IMGTYPE
642
643 ;"set ^TMG("TMP","BARCODE","LOG")=2 ;"temp
644 ;"Remove BASE64 ascii encoding
645 do DECODE("ARRAY(0)",1)
646
647 ;"set ^TMG("TMP","BARCODE","LOG")=3 ;"temp
648 ;"set ^TMG("TMP","BARCODE","LOG","Orig file: "_FPath_FName)=""
649
650 ;"Save to host file system
651 if $$GTBF^TMGBINF("ARRAY(0)",1,FPath,FName)=0 do goto DBCDone
652 . set resultMsg="0^Error while saving file to HFS"
653
654 ;"set ^TMG("TMP","BARCODE","LOG")=4 ;"temp
655
656 ;"convert image file to .png format, if needed
657 if imageType'="png" do
658 . set imageFName=$$Convert^TMGKERNL(imageFName,"png")
659 . if imageFName="" do quit
660 . . set resultMsg="0^Error while converting image from ."_imageType_" to .png format."
661 . do SplitFNamePath^TMGIOUTL(imageFName,.FPath,.FName,"/")
662 . set FileSpec(FName)=""
663 if imageFName="" goto DBCDone
664
665 ;"set ^TMG("TMP","BARCODE","LOG")=5 ;"temp
666
667 ;"Decode the barcode.png image
668 new result set result=$$READBC^TMGBARC(imageFName)
669 if result'="" set resultMsg="1^"_result
670 else set resultMsg="0^Unable to Decode Image"
671
672 ;"delete temp image file
673 ;"temp REMOVE COMMENTS LATER TO DELETE FILE. !!!!!
674 ;"set result=$$DEL^%ZISH(FPath,"FileSpec")
675
676DBCDone
677 ;"set ^TMG("TMP","BARCODE","LOG")=6 ;"temp
678
679 set RESULT=resultMsg
680 quit
681
682 ;"--------------------
683GETURLS(RESULT)
684 ;"SCOPE: Public
685 ;"RPC that calls this: TMG CPRS GET URL LIST
686 ;"Purpose: To provide an entry point for a RPC call from a client. The client
687 ;" will request URLs to display in custom tabs inside CPRS, in an
688 ;" imbedded web browser
689 ;"Input: RESULT -- an OUT PARAMETER. See output below.
690 ;"Output: results are passed out in RESULT:
691 ;" RESULT(0)="1^Success" or "0^SomeFailureMessage"
692 ;" RESULT(1)="Name1^URL#1" ; shows URL#1 in tab #1, named 'Name1'
693 ;" RESULT(2)="Name2^URL#2" ; etc.
694 ;" RESULT(3)="Name3^URL#3"
695 ;"
696 ;" E.g. RESULT(1)="cnn^www.cnn.com"
697 ;" RESULT(2)="INFO^192.168.0.1/home.html"
698 ;"
699 ;" The number of allowed tabs is determined by code in CPRS
700 ;" Reference to tab numbers > specified in CPRS will be ignored by CPRS
701 ;" If a web tab is NOT specified, then the page previously
702 ;" displayed will be left in place. It will not be cleared.
703 ;" To clear a given page, a url of "about:blank" will cause a
704 ;" blank page to be displayed. e.g.
705 ;" RESULT(3)="^about:blank"
706 ;" To HIDE a tab on CPRS use this:
707 ;" RESULT(3)="^<!HIDE!>" ;triggers tab #3 to be hidden
708 ;" To have the browser remain UNCHANGED use this:
709 ;" RESULT(3)="^<!NOCHANGE!>" ;triggers tab #3 to remain unchanged.
710 ;" Note: the rationale for this is that the web tab may have info
711 ;" that should not be refreshed when the patient info is refreshed
712 ;" i.e. the user may have navigated somewhere, and doesn't want
713 ;" to loose their location.
714 ;" --to be implemented.
715 ;" Note: The other way to do this, acs above, is to simply have NO
716 ;" entry for a given tab. I.e. don't have any value for RESULT(3)
717 ;" --already implemented.
718 ;"Notice to others: Below is where code should be added to return
719 ;" proper URL's to CPRS. This will be called whenever a new patient
720 ;" is opened, or a Refresh Information is requested.
721 ;" FYI, 'DFN' should be defined as a globally-scoped variable that can be used
722 ;" to pass back URLS specific for a given patient.
723
724 set RESULT(0)="1^Success"
725 set RESULT(1)="MerkMedicus^http://www.merckmedicus.com/pp/us/hcp/hcp_home.jsp"
726 set RESULT(2)="Pathgroup^http://pathgroup.com/"
727 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"
728 set RESULT(4)="EMedicine^http://emedicine.medscape.com/"
729
730 ;"kill RESULT
731 ;"merge RESULT=^TMG("TMP","URLS") ;"TEMP!!!
732
733 quit
734
735 ;
Note: See TracBrowser for help on using the repository browser.