source: cprs/branches/tmg-cprs/m_files/TMGMEDIC.m

Last change on this file was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload
File size: 29.5 KB
Line 
1TMGMEDIC ;TMG/kst/Interface from old MEDIC PMS ;03/25/06
2 ;;1.0;TMG-LIB;**1**;11/01/04
3
4 ;"TMG MEDIC INTERFACE FUNCTIONS
5
6 ;"=======================================================================
7 ;" API -- Public Functions.
8 ;"=======================================================================
9 ;"ASKCONVD
10 ;"CONVDICT(FullNamePath)
11
12 ;"=======================================================================
13 ;"PRIVATE API FUNCTIONS
14 ;"=======================================================================
15 ;"ExtractOneNote(Array,OneNote)
16 ;"ConvertOneNote(OneNote,NoteInfo)
17 ;"WriteOneNote(.OneNote,NoteInfo,.ResultFile)
18
19 ;"=======================================================================
20 ;"=======================================================================
21
22FULLDIRCVD
23 ;"Purpose: To convert files created for old Medic system into format ready for
24 ;" upload into VistA
25 ;" This will allow conversion of all files in a directory.
26 ;"Input: None (Filename will be asked)
27 ;"Output: none (A new file will be created at same site as old file, with .vista extension
28 ;"Result: none
29
30 new FullNamePath
31 new JustFile,JustPath
32 new DoAll
33 new TMGMask,TMGFiles
34 new FileName
35 new result set result=1
36 new PriorErrorFound
37 new ErrorFiles
38 new OfficeLoc
39 new abort set abort=0
40 new SkipExisting set SkipExisting=0
41 new noAskSkip set noAskSkip=0
42 new NoDestDir set NoDestDir=" "
43 new DestDir set DestDir=NoDestDir
44
45 write !!
46 write "*************************************",!
47 write "Medic/Autochart Format Converter",!
48 write "*************************************",!,!
49
50 new s set s="Please select Medic transcription file to convert (or directory for all files)"
51 set FullNamePath=$$GetFName^TMGIOUTL(s,"/var/local/OpenVistA_UserData/transcription","","",.JustPath,.JustFile)
52 if FullNamePath="" do goto FDCDone
53 . do ShowError^TMGDEBUG(.PriorErrorFound,"No file selected. Aborting")
54
55 if ($get(JustFile)="")&($data(JustPath)>0) do
56 . set DoAll="Y"
57 else do
58 . read "Convert all files in same directory? YES// ",DoAll:$get(DTIME,3600),!
59 if DoAll="" set DoAll="Y"
60 set DoAll=$$UP^XLFSTR(DoAll)
61 if DoAll["Y" do
62 . new result
63 . set TMGMask("*")=""
64 . set result=$$LIST^%ZISH(JustPath,"TMGMask","TMGFiles")
65 else do
66 . set TMGFiles(JustFile)=""
67 if DoAll="^" goto FDCDone
68
69 for do quit:(DestDir'="")
70 . set s="Enter DESTINATION directory to move originals file(s) into after conversion.\n Leave blank to NOT move."
71 . new Discard
72 . set Discard=$$GetFName^TMGIOUTL(s,JustPath_"originals/","","",.DestDir,,"Enter Directory Name (? for Help): ")
73 . write !
74 . if DestDir=JustPath set DestDir=NoDestDir quit
75
76 set FileName=$order(TMGFiles(""))
77 if FileName'="" for do quit:(FileName="")!(abort=1)
78 . new skipThis set skipThis=SkipExisting
79 . new isDir set isDir=0
80 . set FullNamePath=JustPath_FileName
81 . if $$IsDir^TMGIOUTL(FullNamePath) set skipThis=1,isDir=1
82 . if (skipThis=0)&(noAskSkip=0)&($$FileExists^TMGIOUTL(FullNamePath_".vista")) do quit:(abort)
83 . . new redo
84 . . write "File ",FullNamePath," has already been converted.",!
85 . . read "Convert anyway? (Yes/No/Yes-Always/No-Always) (Y/N/YA/NA/^) YA// ",redo:$get(DTIME,3600),!
86 . . set redo=$$UP^XLFSTR(redo)
87 . . if redo="" set redo="YA"
88 . . if redo="^" set abort=1 quit
89 . . if redo="YA" set noAskSkip=1
90 . . if redo="NA" set SkipExisting=1,skipThis=1
91 . . if "NO"[redo set skipThis=1
92 . if (FullNamePath'[".vista")&(skipThis=0) do
93 . . write !,"Converting file: ",FullNamePath,"...",!
94 . . write "--------------------------------------------------------",!
95 . . set result=$$CONVDICT(FullNamePath,.OfficeLoc)
96 . . if result'>0 do
97 . . . do ShowError^TMGDEBUG(.PriorErrorFound,"Error converting file.")
98 . . . set PriorErrorFound=0 ;"clear errors, to allow reporting of future errors.
99 . . . set ErrorFiles(FullNamePath)=1
100 . . . if result=-1 set abort=1 quit
101 . . else if DestDir'=NoDestDir do
102 . . . new Dest set Dest=DestDir_FileName
103 . . . ;"write "Moving: ",FullNamePath,!
104 . . . ;"write "To: ",Dest,!
105 . . . if $$Move^TMGIOUTL(FullNamePath,Dest)=0 do
106 . . . . write "Moved ",FileName,!," to: ",Dest,!
107 . if (skipThis=1)&(FullNamePath'[".vista")&(isDir=0) do
108 . . write "Skipping over file, as requested: ",FullNamePath,!
109 . set FileName=$order(TMGFiles(FileName))
110
111 if $data(ErrorFiles) do
112 . write !!,"The following files contained notes with errors...",!
113 . set FileName=$order(ErrorFiles(""))
114 . if FileName'="" for do quit:(FileName="")
115 . . write FileName,!
116 . . set FileName=$order(ErrorFiles(FileName))
117
118FDCDone
119 write !,"Goodbye.",!
120 quit
121
122
123ASKCONVD
124 ;"Purpose: To convert files created for old Medic system into format ready for
125 ;" upload into VistA
126 ;"Input: None (Filename will be asked)
127 ;"Output: none (A new file will be created at same site as old file, with .vista extension
128 ;"Result: none
129
130 new FullNamePath
131 new JustFile,JustPath
132 new result
133 new PriorErrorFound
134
135 set FullNamePath=$$GetFName^TMGIOUTL("Please select Medic transcription file to convert","/","","",.JustPath,.JustFile)
136 if FullNamePath="" do goto CDDone
137 . do ShowError^TMGDEBUG(.PriorErrorFound,"No file selected. Aborting")
138
139 set result=$$CONVDICT(FullNamePath)
140
141 write "Goodbye.",!
142
143 quit
144
145
146CONVDICT(FullNamePath,OfficeLoc)
147 ;"Purpose: To convert files created for old Medic system into format ready for
148 ;" upload into VistA
149 ;"Input: FullNamePath -- full path and filename.
150 ;" OfficeLoc -OPTIONAL (if not provided, user may be quered for info)
151 ;" OfficeLoc(DUZ)="Full Name of Location"
152 ;" e.g. OfficeLoc(12)="Main_Office"
153 ;"Output: none (A new file will be created at same site as old file, with .vista extension
154 ;"Result: 1 if success, 0 if failure; -1 abort
155
156 new JustFile,JustPath
157 new TempFile
158 new ResultFile
159 new index
160 new abort set abort=0
161 new result
162 new error set error=0
163 new retry set retry=0
164 new ErrorFound set ErrorFound=0
165
166 do SplitFNamePath^TMGIOUTL(FullNamePath,.JustPath,.JustFile)
167
168 if $$Dos2Unix^TMGIOUTL(FullNamePath)>0 do goto CDDone
169 . do ShowError^TMGDEBUG(.PriorErrorFound,"Error while converting file ('"_FullNamePath_"') to Linux text format. Aborting")
170
171LoadFile
172 if $$FTG^%ZISH(JustPath,JustFile,"TempFile(0)",1)=0 do goto CDDone
173 . do ShowError^TMGDEBUG(.PriorErrorFound,"Error loading file. Aborting")
174
175 for do quit:($data(TempFile)=0)!(abort=1)
176 . new OneNote,NoteInfo
177 . set error=0
178 . do ExtractOneNote(.TempFile,.OneNote)
179 . if $$ConvertOneNote(.OneNote,.NoteInfo,.OfficeLoc)=0 do quit
180 . . set ErrorFound=1
181 . . set PriorErrorFound=0
182 . . do ShowError^TMGDEBUG(.PriorErrorFound,"Error while processing note.")
183 . . set PriorErrorFound=0
184 . . write "Will run through that again, this time in verbose/debug mode",!
185 . . set error=$$ConvertOneNote(.OneNote,.NoteInfo,.OfficeLoc,1)
186 . . write "<Verbose information above>",!
187 . . write "File: ",FullNamePath,!
188 . . if $data(NoteInfo) do
189 . . . write "Here is the Note Info that was successfully gathered:",!
190 . . . zwr NoteInfo(*)
191 . . new temp
192 . . read !,"Show more info? (^ to abort) NO// ",temp:$get(DTIME,3600),!
193 . . if $$UP^XLFSTR(temp)["Y" do
194 . . . write "Here is the note to be processed:",!
195 . . . zwr OneNote(*)
196 . . . if $data(NoteInfo) do
197 . . . . write "Here is the info that was extracted:",!
198 . . . . zwr NoteInfo(*)
199 . . . write !,"That was the info...",!
200 . . . read !,"Press enter to continue (^ to abort)...",temp:$get(DTIME,3600),!
201 . . if temp="^" set abort=1,error=1
202 . . write !,"File: ",FullNamePath,!
203 . . read "Edit file? (^ to abort) NO// ",temp:$get(DTIME,3600),!
204 . . if $$UP^XLFSTR(temp)["Y" do quit
205 . . . do LinuxEdit^TMGEDIT("joe",$$LinuxStr^TMGSTUTL(FullNamePath))
206 . . . set retry=1,abort=1
207 . . if temp="^" set abort=1,error=1
208 . if error=0 do WriteOneNote(.OneNote,.NoteInfo,.ResultFile)
209
210 if retry=1 do goto LoadFile
211 . kill TempFile
212 . set retry=0,abort=0,error=0
213
214 if abort=1 goto CDDone
215 set index=$order(ResultFile(""))
216 new ref set ref="ResultFile("_index_")"
217 if $$GTF^%ZISH(ref,1,JustPath,JustFile_".vista")=0 do goto CDDone
218 . do ShowError^TMGDEBUG(.PriorErrorFound,"Error saving file. Aborting")
219 else do
220 . write !,"File successfully written to: '",JustFile_".vista'",!!
221 . if $$IsDir^TMGIOUTL(JustPath_"orig/") do
222 . . if $$Move^TMGIOUTL(JustPath_JustFile,JustPath_"orig/"_JustFile)=0 do
223 . . . write "Original file moved to: ",JustPath_"orig/",!
224 . . else do
225 . . . write "Unable to move file moved to: ",JustPath_"orig/",!
226
227
228CDDone
229 set result='ErrorFound
230 if abort=1 set result=-1
231 quit result
232
233
234ExtractOneNote(Array,OneNote)
235 ;"Purpose: To extract one note from Array, and return in OneNote
236 ;"Input: Array: PASS BY REFERENCE. This should be array holding entire transcription file
237 ;" extracted note will be removed from Array
238 ;" OneNote: PASS BY REFERENCE. This array will hold the extracted note.
239 ;" Anything in OneNote array will be killed before refilling
240 ;"Note: notes are always divided by a line that looks like this:
241 ;" !PAT(xxxx) !DATE(xxxx) (Note: I will use !DATE as my signal, because if we use this
242 ;" system in the future, !PAT may not be available.
243 ;" This function will assume that Array is at the first line of the new note (i.e. no lead lines)
244 ;" The new note will be copied from the beginning of Array until the next occurance of
245 ;" !PAT/!DATE, or until the end of the Array.
246 ;"Output: one note is copied into OneNote
247 ;"Results: none
248
249 new index
250 new j
251 new NextLine set NextLine=""
252 kill OneNote
253
254 set index=$order(Array(""))
255 set j=0 ;"<-- Start numbering of array at 0 (because 0 header line will be killed later)
256 if index'="" for do quit:(index="")!(NextLine["!DATE")
257 . set OneNote(j)=$get(Array(index))
258 . set j=j+1
259 . kill Array(index)
260 . set index=$order(Array(index))
261 . if index'="" set NextLine=$get(Array(index))
262 . else set NextLine=""
263
264 quit
265
266
267
268ConvertOneNote(OneNote,NoteInfo,OfficeLoc,DebugMode)
269 ;"Purpose: To take a note (in older MEDIC upload format) and extract information needed to make a VistA upload note
270 ;"Input: OneNote -- PASS BY REFERENCE -- a single note to be converted. Format will be like this:
271 ;" OneNote(0)="first line"
272 ;" OneNote(1)="second line"
273 ;" etc.
274 ;" ---Content of note---
275 ;" !PAT(123456) !DATE(05/12/05) <--- always the first line (OneNote(0))
276 ;" <blank line>
277 ;" PATIENT NAME:[TAB]Sarah P. Doe[TAB]DATE: 05/12/2005 <---Date of encounter
278 ;" CHART#: 123456[TAB]DOB: 05/06/1995
279 ;" <blank line>
280 ;" <start of free text of document>
281 ;" ...
282 ;"
283 ;" <Sometimes, if dictation extends to a second page, the following will be inserted>
284 ;" <blank line>
285 ;" PATIENT NAME:[TAB]Sarah P. Doe[TAB]DATE: 05/12/2005
286 ;" CHART#: 123456[TAB]DOB: 05/06/1995
287 ;" Page Two
288 ;" <blank line>
289 ;" ...
290 ;"
291 ;" <blank line> <--- end of note
292 ;" Kevin S. Toppenberg M.D.
293 ;" KST/kle
294 ;" <blank line>
295 ;"
296 ;" NoteInfo -- PASS BY REFERENCE. This is an array to return note into into, as follows:
297 ;" NoteInfo("PATIENT")="Lastname,firstname initial"
298 ;" NoteInfo("DOB")="5/12/05"
299 ;" NoteInfo("AUTHOR")="Toppenberg,Kevin S"
300 ;" NoteInfo("TRANS INITS")="kle"
301 ;" NoteInfo("MEDIC NUMBER")=123456
302 ;" NoteInfo("DATE OF ENCOUNTER")="05/12/05"
303 ;" NoteInfo("LOCATION")="Main_Office"
304 ;" OfficeLoc -- PASS BY REFERENCE -- OPTIONAL
305 ;" an array storing default locations for authors. See format in CONVDICT
306 ;" If not passed, into will be looked for in^TMG(
307 ;" Note: **First looks in file 8926 for def. office
308 ;" DebugMode -- OPTIONAL. If value=1, then verbose info written
309 ;"Output: Results are returned in NoteInfo. OneNote is modified to remove !PAT() and !DATE() line
310 ;"Results: 1 if success, 0 if error
311 ;"Note: accesses a global var: PriorErrorFound (OK if not defined)
312
313 new result set result=1
314 Kill NoteInfo
315 new index set index=0
316 new Line
317 new Debug set Debug=$get(DebugMode,0)
318
319 new HeaderLine set HeaderLine=$get(OneNote(index))
320 ;"kill OneNote(index)
321
322 if Debug do
323 . write !,"========================================================",!
324 . write "Processing the following line: ",!
325 . write "--------------------------------------------------------",!
326 . write HeaderLine,!
327 . write "--------------------------------------------------------",!
328 . write "Expecting line to contain '!PAT [!DATE]",!
329 . write "========================================================",!
330
331 if (HeaderLine="")!((HeaderLine'["!DATE")&(HeaderLine'["!PAT")) do goto CONDone
332 . set result=0
333 . do ShowError^TMGDEBUG(.PriorErrorFound,"Header line not correct.")
334
335 if Debug do
336 . write "Checking header line for '!PAT(xxx)'"
337 if HeaderLine["!PAT(" do
338 . if Debug write "...found.",!
339 . new s,s1,s2
340 . set s=$piece(HeaderLine,"!PAT(",2)
341 . set s1=$$Trim^TMGSTUTL(s)
342 . set s1=$piece(s,")",1)
343 . set s1=$$Trim^TMGSTUTL(s1)
344 . if s1'="" do
345 . . set NoteInfo("MEDIC NUMBER")=s1
346 . . if Debug write "!PAT() --> Patient number found was: ",s1,!
347 . else write "Patient number unexpectedly not found!",!
348
349 if HeaderLine["!DATE(" do
350 . new s,s1,s2
351 . set s=$piece(HeaderLine,"!DATE(",2)
352 . set s1=$piece(s,")",1)
353 . set s1=$$Trim^TMGSTUTL(s1)
354 . if s1'="" do
355 . . set NoteInfo("DATE OF ENCOUNTER")=s1
356 . . if Debug write "!DATE() --> Date of encounter found was: ",s1,!
357 . else write "Date of encounter unexpectedly not found!",!
358
359 set index=index+1
360 if $$Trim^TMGSTUTL($get(OneNote(index)))="" set index=index+1 ;"Skip any blank line
361 ;"e.g. line-- PATIENT NAME:[TAB]Sarah P. Doe[TAB]DATE: 05/12/2005 <---Date of encounter
362 set Line=$get(OneNote(index))
363 set Line=$translate(Line,$char(9)," ") ;"convert tabs to space
364
365 if Debug do
366 . write !,"========================================================",!
367 . write "Processing the following line: ",!
368 . write "--------------------------------------------------------",!
369 . write Line,!
370 . write "--------------------------------------------------------",!
371 . write "Expecting pattern line this: ",!
372 . write "[PATIENT NAME: ]Sarah P. Doe [DATE:05/12/2005] [DOS:5/12/2005] [DOB:1/1/1920]",!
373 . write "========================================================",!
374
375 if (Line["PATIENT NAME:")!(Line["DATE:")!(Line["DOS:")!(Line["DOB:") do
376 . new s,s1,s2
377 . s s=""
378 . if (Line["PATIENT NAME:") set s=$piece(Line,"PATIENT NAME:",2)
379 . else set s=Line
380 . ;"if (Line'["DATE:")&(Line'["DOS:")&(Line'["DOB:") do
381 . ;". set result=0
382 . ;". do ShowError^TMGDEBUG(.PriorErrorFound,"'DATE' or 'DOS' or 'DOB' not found in note header.")
383 . ;". write "-->'",Line,"'",!
384 . set s1=""
385 . new doneloop set doneloop=0
386 . for do quit:(doneloop)
387 . . if (s["DATE:") set s=$piece(s,"DATE:",1) quit
388 . . if (s["DOB:") set s=$piece(s,"DOB:",1) quit
389 . . if (s["DOS:") set s=$piece(s,"DOS:",1) quit
390 . . set s1=$$Trim^TMGSTUTL(s)
391 . . set s1=$$FormatName^TMGMISC(s1)
392 . . set doneloop=1
393 . if s1'="" set NoteInfo("PATIENT")=s1
394 . if Debug write "Patient Name found was: ",s1,!
395 . if (Line["DOB:") do ;"expects date to contain NO spaces... e.g. 1/1/05, not 'Jan 1, 2005'
396 . . if Debug write "Looking at ",Line,!
397 . . set s1=$piece(Line,"DOB:",2)
398 . . set s1=$$Trim^TMGSTUTL(s1)
399 . . set s1=$piece(s1," ",1)
400 . . set NoteInfo("DOB")=s1
401 . . if Debug write "Patient DOB found was: ",s1,!
402 . if (Line["DOS:") do ;"expects date to contain NO spaces... e.g. 1/1/05, not 'Jan 1, 2005'
403 . . if Debug write "Looking at ",Line,!
404 . . set s1=$piece(Line,"DOS:",2)
405 . . set s1=$$Trim^TMGSTUTL(s1)
406 . . set s1=$piece(s1," ",1)
407 . . set NoteInfo("DATE OF ENCOUNTER")=s1
408 . . if Debug write "Date of Encounter: ",s1,!
409 . if (Line["DATE:") do ;"expects date to contain NO spaces... e.g. 1/1/05, not 'Jan 1, 2005'
410 . . if Debug write "Looking at ",Line,!
411 . . set s1=$piece(Line,"DATE:",2)
412 . . set s1=$$Trim^TMGSTUTL(s1)
413 . . set s1=$piece(s1," ",1)
414 . . set NoteInfo("DATE OF ENCOUNTER")=s1
415 . . if Debug write "Date of Encounter: ",s1,!
416 else do goto CONDone
417 . set result=0
418 . do ShowError^TMGDEBUG(.PriorErrorFound,"'PATIENT NAME:' or 'DATE:' or 'DOS:' or 'DOB:' not found.")
419
420 set index=index+1
421 if $$Trim^TMGSTUTL($get(OneNote(index)))="" set index=index+1 ;"Skip any blank line
422 ;"e.g. line -- CHART#: 123456[TAB]DOB: 05/06/1995
423 set Line=$get(OneNote(index))
424 set Line=$translate(Line,$char(9)," ") ;"convert tabs to space
425
426 if Debug do
427 . write !,"========================================================",!
428 . write "Processing the following line: ",!
429 . write "--------------------------------------------------------",!
430 . write Line,!
431 . write "--------------------------------------------------------",!
432 . write "Expecting pattern line this: ",!
433 . write " CHART#: 123456 DOB: 05/06/1995",!
434 . write "(Note: This line is optional)",!
435 . write "========================================================",!
436
437 if $get(NoteInfo("MEDIC NUMBER"))="" do
438 . if Line["CHART#:" do
439 . . new s,s1,s2
440 . . set s=$piece(Line,"CHART#:",2)
441 . . set s1=$piece(s,"DOB:",1)
442 . . set NoteInfo("MEDIC NUMBER")=$$Trim^TMGSTUTL(s1)
443 . else do
444 . . set result=0
445 . . do ShowError^TMGDEBUG(.PriorErrorFound,"'CHART#:' not found in line.")
446 . . write "-->'",Line,"'",!
447
448 if $get(NoteInfo("DOB"))="" do if result=0 goto CONDone
449 . if Line["DOB:" do
450 . . new s,s1,s2
451 . . set s1=$piece(Line,"DOB:",2)
452 . . set s1=$$Trim^TMGSTUTL(s1)
453 . . if s1'="" set NoteInfo("DOB")=s1
454 . else do
455 . . set result=0
456 . . do ShowError^TMGDEBUG(.PriorErrorFound,"'DOB:' not found in line.")
457 . . write "-->'",Line,"'",!
458
459 if $get(NoteInfo("DATE OF ENCOUNTER"))="" do goto CONDone
460 . set result=0
461 . do ShowError^TMGDEBUG(.PriorErrorFound,"Done with header, but no Date of Encounter found.")
462
463 ;"Main header processing now done. Now scan for a header for subsequent pages, and delete.
464 if Debug write !!,"Now scanning for unneeded header info in middle of note.",!
465 set index=index+1
466 for do quit:(index="")
467 . set Line=$get(OneNote(index))
468 . if Debug write "."
469 . ;"if Debug write ">>",Line,!
470 . if (Line["PATIENT NAME:")&(Line["DATE:") do
471 . . if Debug do
472 . . . write !,"Found one...",!
473 . . . write "-->",Line,!
474 . . kill OneNote(index)
475 . . if $$Trim^TMGSTUTL($get(OneNote(index-1)))="" kill OneNote(index-1)
476 . . set index=index+1
477 . . set Line=$get(OneNote(index))
478 . . if (Line["CHART#")&(Line["DOB") kill OneNote(index)
479 . . if Debug write "And-->",Line,!
480 . . set index=index+1
481 . . set Line=$$Trim^TMGSTUTL($$UP^XLFSTR($get(OneNote(index))))
482 . . if ($piece(Line," ",1)="PAGE")&($piece(Line," ",3)="") do
483 . . . if Debug write "And-->",Line,!
484 . . . kill OneNote(index)
485 . set index=$order(OneNote(index))
486
487 ;"Now work backwards from end of note to get transcriptionist name and author name
488 if Debug write !!,"Now trimming blank lines from the end of the note (scanning backwards).",!
489 ;"Trim blank lines from end of note.
490 set index=$order(OneNote(""),-1)
491 for do quit:(Line'="")!(+index<4)
492 . set Line=$get(OneNote(index))
493 . set Line=$translate(Line,$char(9)," ") ;"convert tabs to space
494 . set Line=$$Trim^TMGSTUTL(Line)
495 . ;"if Debug write ">> '",Line,"'",!
496 . if Debug write "."
497 . if Line="" kill OneNote(index)
498 . set index=$order(OneNote(index),-1)
499
500 if Debug write !!,"Now looking for Transcriptionist initials. (scanning backwards)",!
501 new InitsFound set InitsFound=0
502 ;"Get transcriptionist initials
503 set index=$order(OneNote(""),-1)
504 for do quit:(InitsFound)!(index="")!(+index<4)
505 . set Line=$get(OneNote(index))
506 . set Line=$translate(Line,$char(9)," ") ;"convert tabs to space
507 . set Line=$$Trim^TMGSTUTL(Line)
508 . ;"if Debug write ">",Line,!
509 . if Debug write "."
510 . if (Line["/")&($piece(Line," ",2)="") do quit
511 . . set InitsFound=1
512 . . if Debug write "...found a line (#",index,") with '/' -->",Line,!
513 . set index=$order(OneNote(index),-1)
514
515 if Debug do
516 . write !,"========================================================",!
517 . write "Now looking for transcriptionist's name",!
518 . write "Processing the following line: ",!
519 . write "--------------------------------------------------------",!
520 . write Line,!
521 . write "--------------------------------------------------------",!
522 . write "Expecting pattern: 'Author's inits/tran's inits'"
523 . write " (with no other text on line.)",!
524 . write " e.g. KST/abc",!
525 . write "========================================================",!
526 if (Line[" ")&(Debug) do
527 . write "? trim not working?",!
528 . write "OneNote(index)='",OneNote(index),"'",!
529 . write "After trim, resulting Line='",Line,"'",!
530 . write "Will try another trim.",!
531 . set Line=$$Trim^TMGSTUTL(Line)
532 . write "Now Line='",Line,"'",!
533 if (Line["/")&($piece(Line," ",2)="") do
534 . new inits
535 . set inits=$piece(Line,"/",2)
536 . set NoteInfo("TRANS INITS")=inits
537 . if Debug write "...found a line with '/': ",Line,!
538 . ;"now turn initials into full name via database lookup
539 . set DIC=200,DIC(0)="M"
540 . set X=inits
541 . do ^DIC
542 . if Y'>0 do quit
543 . . set result=0
544 . . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to find '"_inits_"' in database.")
545 . set NoteInfo("TRANSCRIPTIONIST")=$piece(Y,"^",2)
546 else do goto CONDone
547 . set result=0,PriorErrorFound=0
548 . do ShowError^TMGDEBUG(.PriorErrorFound,"Transcriptionists initials not found")
549
550 ;"Get author
551 for do quit:(Line'="")
552 . set index=$order(OneNote(index),-1)
553 . set Line=$$Trim^TMGSTUTL($get(OneNote(index)))
554 if Debug do
555 . write !,"========================================================",!
556 . write "Now looking for author's name",!
557 . write "Processing the following line: ",!
558 . write "--------------------------------------------------------",!
559 . write Line,!
560 . write "--------------------------------------------------------",!
561 . write "Expecting pattern: 'Doctor's name'",!
562 . write "========================================================",!
563 if Line'="" do
564 . set Line=$$FormatName^TMGMISC(Line,1)
565 . If Line="TOPPENBERG,M DEE" set Line="TOPPENBERG,MARCIA D"
566 . if Line="SVENDSEN,CLAES V" set Line="SVENDSEN,CLAES U"
567 . set NoteInfo("AUTHOR")=Line
568
569 if $get(NoteInfo("DOB"))="" do goto CONDone
570 . set result=0
571 . do ShowError^TMGDEBUG(.PriorErrorFound,"Patient DOB not found.")
572
573 ;"Ensure provider name is correct
574 if Debug do
575 . write "Looking up Author in VistA database to ensure it's correct.",!
576 set DIC=200
577 set DIC(0)=""
578 set X=$get(NoteInfo("AUTHOR"))
579 do ^DIC
580 if Y'>0 do goto CONDone
581 . set result=0
582 . do ShowError^TMGDEBUG(.PriorErrorFound,"Provider name in note ('"_$get(NoteInfo("AUTHOR"))_"') incorrect. Aborting")
583 ;"Now get office location based on provider
584 if Debug write "Found: ",Y,!
585 new Office set Office=""
586 new AuthDUZ
587 set AuthDUZ=+Y
588 new i set i=$order(^TIU(8926,"B",AuthDUZ,"")) ;"file 8926: def. office
589 if i'="" do
590 . new j set j=$get(TIU(8926,i,0))
591 . if j="" quit
592 . new IENOffice set IENOffice=$piece(j,"^",2)
593 . if IENOffice="" quit
594 . set Office=$piece($get(^SC(IENOffice,0)),"^",1)
595 if Office="" set Office=$get(OfficeLoc(AuthDUZ))
596 if Office="" set Office=$get(^TMG("MEDIC CONV","Office",AuthDUZ))
597 if Office="" do
598 . set DIC=44 ;"HOSPITAL LOCATION
599 . set DIC(0)="AEQ"
600 . set X=""
601 . set DIC("A")="Which office does "_$piece(Y,"^",2)_" work in (Type ? for list)?: "
602 . do ^DIC
603 . write !
604 . if Y>0 do
605 . . set Office=$piece(Y,"^",2)
606 . . set OfficeLoc(AuthDUZ)=Office
607 . . set ^TMG("MEDIC CONV","Office",AuthDUZ)=Office
608 if Office="" do goto CONDone
609 . set result=0
610 . do ShowError^TMGDEBUG(.PriorErrorFound,"Can't determine office location. Aborting")
611 set NoteInfo("LOCATION")=Office
612
613CONDone
614 quit result
615
616
617WriteOneNote(OneNote,NoteInfo,ResultFile)
618 ;"Purpose: To take One note, and append to Result File, with appropriate header, based on NoteInfo
619 ;"Input: OneNote -- PASS BY REFERENCE-- the text array to append to resulting file
620 ;" NoteInfo -- array with note info. See format in ConvertOneNote
621 ;" ResultFile -- PASS BY REFERENCE this is the array built to the cumulative output
622 ;"
623 ;" Here is the needed format for vista upload. (at our site)
624 ;" [NewDict]: NOTE
625 ;" Patient Name: Doe,John A
626 ;" DOB: 08/01/0931
627 ;" Date of Encounter: 06/08/2005
628 ;" Provider: Welby,Marcus
629 ;" Visit Location: Laughlin_Office
630 ;" Transcriptionist: Fingers,Speedy
631 ;" [TEXT]
632 ;" (Here is the text of the note...
633 ;" [END]
634
635 kill OneNote(0) ;"the !PAT() !DATE etc. line
636
637 set OneNote(.1)="[NewDict]: NOTE"
638 set OneNote(.2)="Patient Name: "_$get(NoteInfo("PATIENT"))
639 set OneNote(.3)="DOB: "_$get(NoteInfo("DOB"))
640 set OneNote(.4)="Date of Encounter: "_$get(NoteInfo("DATE OF ENCOUNTER"))
641 set OneNote(.5)="Provider: "_$get(NoteInfo("AUTHOR"))
642 set OneNote(.6)="Visit Location: "_$get(NoteInfo("LOCATION"))
643 set OneNote(.7)="Transcriptionist: "_$get(NoteInfo("TRANSCRIPTIONIST"))
644 set OneNote(.8)="[TEXT]"
645
646 new s
647 set s=$get(NoteInfo("PATIENT"))
648 set s=s_" on "_$get(NoteInfo("DATE OF ENCOUNTER"))_"; "
649 set s=s_$get(NoteInfo("AUTHOR"))
650 set s=s_" at "_$get(NoteInfo("LOCATION"))
651 write "Done: ",s,!
652
653 new index,j
654 set index=$order(OneNote(""),-1)
655 set index=index+1
656 set OneNote(index)="[END]"
657 set OneNote(index+1)=" "
658
659 ;"Now append OneNote to ResultFile
660 set j=$order(ResultFile(""),-1)+1
661 set index=$order(OneNote(""))
662 for do quit:(index="")
663 . set ResultFile(j)=$get(OneNote(index))
664 . set j=j+1
665 . set index=$order(OneNote(index))
666
667 quit
668
669
670TELNET
671 ;"Purpose: to provide ability to telnet to medic server (AIX)
672
673 new HookCmd
674 set HookCmd="telnet medic"
675 zsystem HookCmd
676
677 write !,!,"Done. Returning to VistA",!
678 new temp read "Press Enter to Continue...",temp:$get(DTIME,3600),!
679
680 quit
Note: See TracBrowser for help on using the repository browser.