TMGUPLD ;TMG/kst/CUSTOM VERSION OF TIUUPLD (PARTIAL) ;03/25/06 ;;1.0;TMG-LIB;**1**;09/01/05 ;"CUSTOM VERSION OF TIUUPLD (PARTIAL) ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"9-1-2005 ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"MAIN ;" upload a batch of *.vista files that contain transcribed notes ;"LoadTIUBuf(DA,FPName,DestDir) ;"ask for filename, and load into a TIU buffer ;"ERRORS ;"replacement function for DISPLAY^TIUEVNT ;"======================================================================= ;"PRIVATE API FUNCTIONS ;"======================================================================= ;"======================================================================= MAIN ;"Purpose: To upload a batch of *.vista files that contain transcribed notes ;"Input: None ;"Results: None new EOM,TIUDA,TIUERR,TIUHDR,TIULN,TIUSRC,X if '$data(TIUPRM0)!'$data(TIUPRM1) do SETPARM^TIULE set TIUSRC=$piece($get(TIUPRM0),U,9) set EOM=$piece($get(TIUPRM0),U,11) if EOM']"",($piece(TIUPRM0,U,17)'="k") do quit . write !,$C(7),$C(7),$C(7),"No End of Message Signal Defined - Contact IRM.",! set:TIUSRC']"" TIUSRC="R" set TIUHDR=$piece(TIUPRM0,U,10) if TIUHDR']"" do quit . write $C(7),$C(7),$C(7),"No Record Header Signal Defined - Contact IRM.",! new done set done=1 new FPName set FPName="" new DoAll new TMGMask,TMGFiles new JustFile,JustPath set JustFile="",JustPath="" new NoDestDir set NoDestDir=" " new DestDir set DestDir=NoDestDir new SrcDir set SrcDir="" new defPath set defPath="/var/local/OpenVistA_UserData/transcription" new s set s="Enter name of directory containing transcription"_$char(10)_$char(13) set FPName=$$GetFName^TMGIOUTL(s,defPath,"","",.SrcDir,,"Enter Directory Name (? for Help): ") new mask set mask="*.vista" new result set TMGMask(mask)="" set result=$$LIST^%ZISH(SrcDir,"TMGMask","TMGFiles") new tempFName set tempFName=$order(TMGFiles("")) if tempFName'="" for do quit:(tempFName="") . if $$IsDir^TMGIOUTL(tempFName) kill TMGFiles(tempFName) . set tempFName=$order(TMGFiles(tempFName)) set s="Enter DESTINATION directory to move file(s) into after upload."_$char(10)_$char(13) new Discard set Discard=$$GetFName^TMGIOUTL(s,defPath_"/uploaded","","",.DestDir,,"Enter Directory Name (? for Help): ") write ! if DestDir=JustPath set DestDir=NoDestDir set JustFile=$order(TMGFiles("")) ;"array holds only file names, not path ;"--------- loop here -------------- for do quit:(JustFile="") . set TIUDA=$$MAKEBUF^TIUUPLD . if +TIUDA'>0 do quit . . write $C(7),$C(7),$C(7),"Unable to create a Buffer File Record - Contact IRM.",! . . set FPName="" . ;" . if TIUSRC="R" D REMOTE^TIUUPLD(TIUDA) . set FPName=SrcDir_JustFile . if TIUSRC="H" D LoadTIUBuf(TIUDA,.FPName,.DestDir) . if +$get(TIUERR) do quit . . write $C(7),$C(7),$C(7),!,"File Transfer Error: ",$get(TIUERR),!!,"Please re-transmit the file...",! . . set FPName="" . ;" . ;" Set $ZB to MAIN+14^TIUUPLD:2 . if +$order(^TIU(8925.2,TIUDA,"TEXT",0))>0,'+$get(TIUERR) do . . do FILE^TIUUPLD(TIUDA) . ;" . if +$order(^TIU(8925.2,TIUDA,"TEXT",0))'>0!+$get(TIUERR) do . . do BUFPURGE^TIUPUTC(TIUDA) . ;" . write !! . if '($get(DestDir)="")&'(DestDir=" ") do . . new Dest set Dest=DestDir_JustFile . . if $$Move^TMGIOUTL(FPName,Dest)=0 do . . . write "Moved ",JustFile,!," to: ",Dest,! . . else do . . . write "Unable to Move ",JustFile,!," to: ",Dest,! . ;" . write "Done processing: ",JustFile,! . new KeyCont read "Press Any Key to Continue (^ to Abort)",KeyCont:$get(DTIME,3600),! . set JustFile=$order(TMGFiles(JustFile)) . if KeyCont="^" set JustFile="" quit LoadTIUBuf(DA,FPName,DestDir) ;"Purpose: to ask user for filename, and then load this into a ;" TIU buffer (that already has been created) ;"Input: DA : the IEN (record number) in file ^TIU(8925.2), i.e. ;" in file TIU UPLOAD BUFFER, that the file is ;" to be loaded into. ;" FPName: OPTIONAL -- a FilePathName. If supplied then user will not be ;" prompted to chose a file name to load ;" If passed by reference, then chosen file ;" will be passed back out. ;" DestDir: OPTIONAL -- a directory to move file into after upload ;" if not provided, or if value=" ", then don't move file ;" Will not move file if upload was unsucessful ;"Results: none ;"***NOTICE !!!!!!! ;" This file is called from TIUUPLD. If this function is broken, then ;" the upload process will be broken. So, caution! if '$data(TIUPRM0)!'$data(TIUPRM1) do SETPARM^TIULE write @IOF,! do JUSTIFY^TIUU($$TITLE^TIUU("ASCII UPLOAD"),"C") write ! new defPath new result set result=0 if $get(FPName)="" do . set defPath="/var/local/OpenVistA_UserData/transcription" . set FPName=$$GetFName^TMGIOUTL("Enter name of file containing transcription",defPath) if FPName'="" do . if $$Dos2Unix^TMGIOUTL(FPName)>0 quit ;"error on conversion prob means file doesn't exist. . new name,path,BuffP . do SplitFNamePath^TMGIOUTL(FPName,.path,.name) . if ($get(path)="")!($get(name)="") quit . set BuffP="^TIU(8925.2,"_DA_",""TEXT"",1,0)" . if $$FTG^%ZISH(path,name,BuffP,4) do . . set result=1 . . new MaxLine set MaxLine=$order(^TIU(8925.2,DA,"TEXT",""),-1) . . set ^TIU(8925.2,DA,"TEXT",0)="^^"_+MaxLine_"^"_+MaxLine_"^"_DT_"^^^^" . . new index set index=$order(^TIU(8925.2,DA,"TEXT",0)) . . for do quit:index="" . . . if index="" quit . . . new s set s=$$STRIP^TIUUPLD(^TIU(8925.2,DA,"TEXT",index,0)) . . . set ^TIU(8925.2,DA,"TEXT",index,0)=s . . . set index=$order(^TIU(8925.2,DA,"TEXT",index)) if result=0 do . write "Unsuccessful upload.",! quit ERRORS ;"Purpose: This is replacement function of for DISPLAY^TIUEVNT ;" This function is used in processing Alerts created from failed document ;" uploads. This function is wedged into DISPLAY^TIUEVNT to allow ;" customization. ;"Input: none. ;" global scope variables are used: ;" XQX1 ;" TIUPRM0,TIUPRM1 ;" DIRUT ;" XQADATA , e.g.: 349;FILING ERROR: NOTE Record could not be found or created.;30853;1302 ;" 349 --> TIUBUF ;" 30853 --> TIUEVNT and EVNTDA ;" 1302 --> TIUTYPE new DIC,INQUIRE,RETRY,DWPK,EVNTDA,TIU K XQAKILL,RESCODE,TIUTYPE new TIUDONE ;"<-- this is changed elsewhere... where? new TIUEVNT,TIUSKIP,TIUBUF write !,"TMG Custom Upload Error Handler.",! write "---------------------------------------",!! if '$data(TIUPRM0)!'$data(TIUPRM1) do SETPARM^TIULE ;" Set EVNTDA for backward compatibility, TIUEVNT for PN resolve code set (EVNTDA,TIUEVNT)=+$piece(XQADATA,";",3) ;" Set TIUBUF for similarity w TIURE. DON'T set BUFDA since ;" old code interprets that as set by TIURE only: set TIUBUF=+XQADATA set TIUTYPE=+$piece(XQADATA,";",4) set TIUSKIP=($data(DIRUT)>0) if TIUTYPE>0 set RESCODE=$$FIXCODE^TIULC1(TIUTYPE) new defInput set defInput="1" new input for do quit:(+input<1)!(+input>5) . do WRITEHDR^TIUPEVNT(TIUEVNT) . write !,$piece(XQADATA,";",2),! . write "OPTIONS:",! . write "1. Inquire to patient record.",! . write "2. Create/edit patient record.",! . write "3. Mark note for automatic patient registration.",! . ;"write "4. Show note header again.",! . write "5. Edit erroneous note.",! . write "6. Retry filing buffer (and quit)",! . write "7. Abort",! . write ! . write "Select option (1-7,?,^): ",defInput,"// " . read input:$get(DTIME,3600),! . if input="" set input=defInput . if input["?" do quit . . write "--Regarding option 1:" . . do INQRHELP^TIUPEVNT write !! . . write "--Regarding option 2:",! . . write "To directly edit the patient name, DOB etc, select this.",! . . write "(Caution: only change patient entry if you are SURE information is incorrect.)",!! . . write "--Regarding option 3",! . . write "This will cause the the information in the note to be used to automatically",! . . write "register the patient. Caution! Be careful to not cause a duplicate entry",! . . write "in the database. Only use this option if you are SURE the patient is NOT",! . . write "already registered. Don't use if patient is in database, but with incorrect",! . . write "information.",!! . . ;"write "--Regarding option 4:",! . . ;"write "This will display the header the filer found initially.",!! . . write "--Regarding option 5:",! . . write "Select this option to launch a text editor to correct note",!! . . write "--Regarding option 6:" . . write "--Regarding option 7:",! . . write "This will abort process. Error and Alert will remain unchanged.",!! . . write ! . . set input=1 ;"just to allow loop to continue . . new temp read "Press [ENTER] to continue.",temp:$get(DTIME,3600),! . if +input=1 do quit ;"1. Inquire to patient record." . . if $get(RESCODE)="" do quit . . . write !!,"Filing error resolution code could not be found for this document type.",! . . . write "Please edit the buffered data directly and refile.",! . . . new temp read "Press [ENTER] to continue.",temp:$get(DTIME,3600),! . . . set defInput=5 . . do WRITEHDR^TIUPEVNT(TIUEVNT) . . xecute RESCODE . else if +input=2 do quit ;"2. Create/edit patient record." . . do WRITEHDR^TIUPEVNT(TIUEVNT) . . write "Hint: if entering a patient's name brings up the wrong patient, then",! . . write " enter name in quotes (e.g. ""DOE,JOHN"") to force addition of a new",! . . write " patient with a same name as one alread registered." . . do EDITPT^TMGMISC(1) . . set defInput=6 . else if +input=3 do quit ;"3. Mark note for automatic patient registration." . . ;"TMGSEX is a variable with global scope used by filer. . . for do quit:(TMGSEX'="") . . . read "Is patient MALE or FEMALE? (M/F) // ",TMGSEX:$get(DTIME,3600),! . . . set TMGSEX=$$UP^XLFSTR(TMGSEX) . . . if (TMGSEX="MALE")!(TMGSEX="M") set TMGSEX="MALE" . . . else if (TMGSEX="FEMALE")!(TMGSEX="F") set TMGSEX="FEMALE" . . . else if TMGSEX="^" quit . . . else set TMGSEX="" write "?? Please enter MALE or FEMALE (or ^ to abort)",! . . if TMGSEX="^" set TMGSEX="" quit . . set TMGFREG=1 ;"this is a signal for TMGGDFN to register patient if not otherwise found. . . write "Patient is marked for AUTOMATIC REGISTRATION.",! . . new temp read "Press [ENTER] to continue.",temp:$get(DTIME,3600),! . . set defInput=6 . ;"else if +input=4 do quit ;"4. Show note header again." . ;". do WRITEHDR^TIUPEVNT(TIUEVNT) . else if +input=5 do quit ;"5. Edit buffer." . . set DIC="^TIU(8925.2,"_TIUBUF_",""TEXT""," . . set DWPK=1 . . do EN^DIWE . . set defInput=6 . else if +input=6 do quit ;"6. Retry filing buffer (and quit)" . . do ALERTDEL^TIUPEVNT(TIUBUF) . . do RESOLVE^TIUPEVNT(TIUEVNT,1) . . do FILE^TIUUPLD(TIUBUF) . else do quit ;" Redundant if all RESCODEs do RESOLVE: if +$get(TIUDONE),+$get(TIUEVNT) do RESOLVE^TIUPEVNT(+$get(TIUEVNT)) kill TMGFREG DISPX kill XQX1 quit