source: cprs/branches/tmg-cprs/m_files/TMGUPLD.m@ 1742

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

Initial upload

File size: 12.7 KB
RevLine 
[796]1TMGUPLD ;TMG/kst/CUSTOM VERSION OF TIUUPLD (PARTIAL) ;03/25/06
2 ;;1.0;TMG-LIB;**1**;09/01/05
3
4 ;"CUSTOM VERSION OF TIUUPLD (PARTIAL)
5 ;"Kevin Toppenberg MD
6 ;"GNU General Public License (GPL) applies
7 ;"9-1-2005
8
9 ;"=======================================================================
10 ;" API -- Public Functions.
11 ;"=======================================================================
12 ;"MAIN ;" upload a batch of *.vista files that contain transcribed notes
13 ;"LoadTIUBuf(DA,FPName,DestDir) ;"ask for filename, and load into a TIU buffer
14 ;"ERRORS ;"replacement function for DISPLAY^TIUEVNT
15
16 ;"=======================================================================
17 ;"PRIVATE API FUNCTIONS
18 ;"=======================================================================
19
20
21 ;"=======================================================================
22MAIN
23 ;"Purpose: To upload a batch of *.vista files that contain transcribed notes
24 ;"Input: None
25 ;"Results: None
26
27 new EOM,TIUDA,TIUERR,TIUHDR,TIULN,TIUSRC,X
28
29 if '$data(TIUPRM0)!'$data(TIUPRM1) do SETPARM^TIULE
30 set TIUSRC=$piece($get(TIUPRM0),U,9)
31 set EOM=$piece($get(TIUPRM0),U,11)
32
33 if EOM']"",($piece(TIUPRM0,U,17)'="k") do quit
34 . write !,$C(7),$C(7),$C(7),"No End of Message Signal Defined - Contact IRM.",!
35
36 set:TIUSRC']"" TIUSRC="R"
37 set TIUHDR=$piece(TIUPRM0,U,10)
38 if TIUHDR']"" do quit
39 . write $C(7),$C(7),$C(7),"No Record Header Signal Defined - Contact IRM.",!
40
41 new done set done=1
42 new FPName set FPName=""
43 new DoAll
44 new TMGMask,TMGFiles
45 new JustFile,JustPath
46 set JustFile="",JustPath=""
47 new NoDestDir set NoDestDir=" "
48 new DestDir set DestDir=NoDestDir
49 new SrcDir set SrcDir=""
50 new defPath set defPath="/var/local/OpenVistA_UserData/transcription"
51 new s
52 set s="Enter name of directory containing transcription"_$char(10)_$char(13)
53 set FPName=$$GetFName^TMGIOUTL(s,defPath,"","",.SrcDir,,"Enter Directory Name (? for Help): ")
54
55 new mask set mask="*.vista"
56 new result
57 set TMGMask(mask)=""
58 set result=$$LIST^%ZISH(SrcDir,"TMGMask","TMGFiles")
59 new tempFName set tempFName=$order(TMGFiles(""))
60 if tempFName'="" for do quit:(tempFName="")
61 . if $$IsDir^TMGIOUTL(tempFName) kill TMGFiles(tempFName)
62 . set tempFName=$order(TMGFiles(tempFName))
63
64 set s="Enter DESTINATION directory to move file(s) into after upload."_$char(10)_$char(13)
65 new Discard
66 set Discard=$$GetFName^TMGIOUTL(s,defPath_"/uploaded","","",.DestDir,,"Enter Directory Name (? for Help): ")
67 write !
68 if DestDir=JustPath set DestDir=NoDestDir
69
70 set JustFile=$order(TMGFiles("")) ;"array holds only file names, not path
71
72 ;"--------- loop here --------------
73 for do quit:(JustFile="")
74 . set TIUDA=$$MAKEBUF^TIUUPLD
75 . if +TIUDA'>0 do quit
76 . . write $C(7),$C(7),$C(7),"Unable to create a Buffer File Record - Contact IRM.",!
77 . . set FPName=""
78 . ;"
79 . if TIUSRC="R" D REMOTE^TIUUPLD(TIUDA)
80 . set FPName=SrcDir_JustFile
81 . if TIUSRC="H" D LoadTIUBuf(TIUDA,.FPName,.DestDir)
82 . if +$get(TIUERR) do quit
83 . . write $C(7),$C(7),$C(7),!,"File Transfer Error: ",$get(TIUERR),!!,"Please re-transmit the file...",!
84 . . set FPName=""
85 . ;"
86 . ;" Set $ZB to MAIN+14^TIUUPLD:2
87 . if +$order(^TIU(8925.2,TIUDA,"TEXT",0))>0,'+$get(TIUERR) do
88 . . do FILE^TIUUPLD(TIUDA)
89 . ;"
90 . if +$order(^TIU(8925.2,TIUDA,"TEXT",0))'>0!+$get(TIUERR) do
91 . . do BUFPURGE^TIUPUTC(TIUDA)
92 . ;"
93 . write !!
94 . if '($get(DestDir)="")&'(DestDir=" ") do
95 . . new Dest set Dest=DestDir_JustFile
96 . . if $$Move^TMGIOUTL(FPName,Dest)=0 do
97 . . . write "Moved ",JustFile,!," to: ",Dest,!
98 . . else do
99 . . . write "Unable to Move ",JustFile,!," to: ",Dest,!
100 . ;"
101 . write "Done processing: ",JustFile,!
102 . new KeyCont read "Press Any Key to Continue (^ to Abort)",KeyCont:$get(DTIME,3600),!
103 . set JustFile=$order(TMGFiles(JustFile))
104 . if KeyCont="^" set JustFile=""
105
106 quit
107
108
109
110LoadTIUBuf(DA,FPName,DestDir)
111 ;"Purpose: to ask user for filename, and then load this into a
112 ;" TIU buffer (that already has been created)
113 ;"Input: DA : the IEN (record number) in file ^TIU(8925.2), i.e.
114 ;" in file TIU UPLOAD BUFFER, that the file is
115 ;" to be loaded into.
116 ;" FPName: OPTIONAL -- a FilePathName. If supplied then user will not be
117 ;" prompted to chose a file name to load
118 ;" If passed by reference, then chosen file
119 ;" will be passed back out.
120 ;" DestDir: OPTIONAL -- a directory to move file into after upload
121 ;" if not provided, or if value=" ", then don't move file
122 ;" Will not move file if upload was unsucessful
123 ;"Results: none
124
125 ;"***NOTICE !!!!!!!
126 ;" This file is called from TIUUPLD. If this function is broken, then
127 ;" the upload process will be broken. So, caution!
128
129 if '$data(TIUPRM0)!'$data(TIUPRM1) do SETPARM^TIULE
130 write @IOF,!
131 do JUSTIFY^TIUU($$TITLE^TIUU("ASCII UPLOAD"),"C")
132 write !
133
134 new defPath
135 new result set result=0
136
137 if $get(FPName)="" do
138 . set defPath="/var/local/OpenVistA_UserData/transcription"
139 . set FPName=$$GetFName^TMGIOUTL("Enter name of file containing transcription",defPath)
140
141 if FPName'="" do
142 . if $$Dos2Unix^TMGIOUTL(FPName)>0 quit ;"error on conversion prob means file doesn't exist.
143 . new name,path,BuffP
144 . do SplitFNamePath^TMGIOUTL(FPName,.path,.name)
145 . if ($get(path)="")!($get(name)="") quit
146 . set BuffP="^TIU(8925.2,"_DA_",""TEXT"",1,0)"
147 . if $$FTG^%ZISH(path,name,BuffP,4) do
148 . . set result=1
149 . . new MaxLine set MaxLine=$order(^TIU(8925.2,DA,"TEXT",""),-1)
150 . . set ^TIU(8925.2,DA,"TEXT",0)="^^"_+MaxLine_"^"_+MaxLine_"^"_DT_"^^^^"
151 . . new index set index=$order(^TIU(8925.2,DA,"TEXT",0))
152 . . for do quit:index=""
153 . . . if index="" quit
154 . . . new s set s=$$STRIP^TIUUPLD(^TIU(8925.2,DA,"TEXT",index,0))
155 . . . set ^TIU(8925.2,DA,"TEXT",index,0)=s
156 . . . set index=$order(^TIU(8925.2,DA,"TEXT",index))
157
158 if result=0 do
159 . write "Unsuccessful upload.",!
160
161 quit
162
163
164
165ERRORS
166 ;"Purpose: This is replacement function of for DISPLAY^TIUEVNT
167 ;" This function is used in processing Alerts created from failed document
168 ;" uploads. This function is wedged into DISPLAY^TIUEVNT to allow
169 ;" customization.
170 ;"Input: none.
171 ;" global scope variables are used:
172 ;" XQX1
173 ;" TIUPRM0,TIUPRM1
174 ;" DIRUT
175 ;" XQADATA , e.g.: 349;FILING ERROR: NOTE Record could not be found or created.;30853;1302
176 ;" 349 --> TIUBUF
177 ;" 30853 --> TIUEVNT and EVNTDA
178 ;" 1302 --> TIUTYPE
179
180 new DIC,INQUIRE,RETRY,DWPK,EVNTDA,TIU K XQAKILL,RESCODE,TIUTYPE
181 new TIUDONE ;"<-- this is changed elsewhere... where?
182 new TIUEVNT,TIUSKIP,TIUBUF
183
184 write !,"TMG Custom Upload Error Handler.",!
185 write "---------------------------------------",!!
186
187 if '$data(TIUPRM0)!'$data(TIUPRM1) do SETPARM^TIULE
188
189 ;" Set EVNTDA for backward compatibility, TIUEVNT for PN resolve code
190 set (EVNTDA,TIUEVNT)=+$piece(XQADATA,";",3)
191
192 ;" Set TIUBUF for similarity w TIURE. DON'T set BUFDA since
193 ;" old code interprets that as set by TIURE only:
194 set TIUBUF=+XQADATA
195 set TIUTYPE=+$piece(XQADATA,";",4)
196 set TIUSKIP=($data(DIRUT)>0)
197
198 if TIUTYPE>0 set RESCODE=$$FIXCODE^TIULC1(TIUTYPE)
199
200 new defInput set defInput="1"
201 new input
202 for do quit:(+input<1)!(+input>5)
203 . do WRITEHDR^TIUPEVNT(TIUEVNT)
204 . write !,$piece(XQADATA,";",2),!
205 . write "OPTIONS:",!
206 . write "1. Inquire to patient record.",!
207 . write "2. Create/edit patient record.",!
208 . write "3. Mark note for automatic patient registration.",!
209 . ;"write "4. Show note header again.",!
210 . write "5. Edit erroneous note.",!
211 . write "6. Retry filing buffer (and quit)",!
212 . write "7. Abort",!
213 . write !
214 . write "Select option (1-7,?,^): ",defInput,"// "
215 . read input:$get(DTIME,3600),!
216 . if input="" set input=defInput
217 . if input["?" do quit
218 . . write "--Regarding option 1:"
219 . . do INQRHELP^TIUPEVNT write !!
220 . . write "--Regarding option 2:",!
221 . . write "To directly edit the patient name, DOB etc, select this.",!
222 . . write "(Caution: only change patient entry if you are SURE information is incorrect.)",!!
223 . . write "--Regarding option 3",!
224 . . write "This will cause the the information in the note to be used to automatically",!
225 . . write "register the patient. Caution! Be careful to not cause a duplicate entry",!
226 . . write "in the database. Only use this option if you are SURE the patient is NOT",!
227 . . write "already registered. Don't use if patient is in database, but with incorrect",!
228 . . write "information.",!!
229 . . ;"write "--Regarding option 4:",!
230 . . ;"write "This will display the header the filer found initially.",!!
231 . . write "--Regarding option 5:",!
232 . . write "Select this option to launch a text editor to correct note",!!
233 . . write "--Regarding option 6:"
234 . . write "--Regarding option 7:",!
235 . . write "This will abort process. Error and Alert will remain unchanged.",!!
236 . . write !
237 . . set input=1 ;"just to allow loop to continue
238 . . new temp read "Press [ENTER] to continue.",temp:$get(DTIME,3600),!
239 . if +input=1 do quit ;"1. Inquire to patient record."
240 . . if $get(RESCODE)="" do quit
241 . . . write !!,"Filing error resolution code could not be found for this document type.",!
242 . . . write "Please edit the buffered data directly and refile.",!
243 . . . new temp read "Press [ENTER] to continue.",temp:$get(DTIME,3600),!
244 . . . set defInput=5
245 . . do WRITEHDR^TIUPEVNT(TIUEVNT)
246 . . xecute RESCODE
247 . else if +input=2 do quit ;"2. Create/edit patient record."
248 . . do WRITEHDR^TIUPEVNT(TIUEVNT)
249 . . write "Hint: if entering a patient's name brings up the wrong patient, then",!
250 . . write " enter name in quotes (e.g. ""DOE,JOHN"") to force addition of a new",!
251 . . write " patient with a same name as one alread registered."
252 . . do EDITPT^TMGMISC(1)
253 . . set defInput=6
254 . else if +input=3 do quit ;"3. Mark note for automatic patient registration."
255 . . ;"TMGSEX is a variable with global scope used by filer.
256 . . for do quit:(TMGSEX'="")
257 . . . read "Is patient MALE or FEMALE? (M/F) // ",TMGSEX:$get(DTIME,3600),!
258 . . . set TMGSEX=$$UP^XLFSTR(TMGSEX)
259 . . . if (TMGSEX="MALE")!(TMGSEX="M") set TMGSEX="MALE"
260 . . . else if (TMGSEX="FEMALE")!(TMGSEX="F") set TMGSEX="FEMALE"
261 . . . else if TMGSEX="^" quit
262 . . . else set TMGSEX="" write "?? Please enter MALE or FEMALE (or ^ to abort)",!
263 . . if TMGSEX="^" set TMGSEX="" quit
264 . . set TMGFREG=1 ;"this is a signal for TMGGDFN to register patient if not otherwise found.
265 . . write "Patient is marked for AUTOMATIC REGISTRATION.",!
266 . . new temp read "Press [ENTER] to continue.",temp:$get(DTIME,3600),!
267 . . set defInput=6
268 . ;"else if +input=4 do quit ;"4. Show note header again."
269 . ;". do WRITEHDR^TIUPEVNT(TIUEVNT)
270 . else if +input=5 do quit ;"5. Edit buffer."
271 . . set DIC="^TIU(8925.2,"_TIUBUF_",""TEXT"","
272 . . set DWPK=1
273 . . do EN^DIWE
274 . . set defInput=6
275 . else if +input=6 do quit ;"6. Retry filing buffer (and quit)"
276 . . do ALERTDEL^TIUPEVNT(TIUBUF)
277 . . do RESOLVE^TIUPEVNT(TIUEVNT,1)
278 . . do FILE^TIUUPLD(TIUBUF)
279 . else do quit
280
281 ;" Redundant if all RESCODEs do RESOLVE:
282 if +$get(TIUDONE),+$get(TIUEVNT) do RESOLVE^TIUPEVNT(+$get(TIUEVNT))
283
284 kill TMGFREG
285
286DISPX
287 kill XQX1
288 quit
289
Note: See TracBrowser for help on using the repository browser.