| 1 | TMGUPLD ;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 | ;"=======================================================================
|
|---|
| 22 | MAIN
|
|---|
| 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 |
|
|---|
| 110 | LoadTIUBuf(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 |
|
|---|
| 165 | ERRORS
|
|---|
| 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 |
|
|---|
| 286 | DISPX
|
|---|
| 287 | kill XQX1
|
|---|
| 288 | quit
|
|---|
| 289 |
|
|---|
