//kt -- Modified with SourceScanner on 8/7/2007
unit UploadImages;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, pngimage, ExtDlgs, OleCtrls,
uCore,
SHDocVw, DKLang;
type
TImageInfo = class
private
public
TIUIEN : int64; //IEN in file# 8925
DFN : AnsiString; //IEN in Patient File (#2)
UploadDUZ : int64; //IEN in NEW PERSON file
ThumbFPathName : AnsiString; // local file path name
ImageFPathName : AnsiString; // local file path name
ServerPath : AnsiString;
ServerFName : AnsiString;
ServerThumbFName: AnsiString;
ShortDesc : String[60];
Extension : String[16];
ImageDateTime : AnsiString;
UploadDateTime: AnsiString;
ObjectType : int64; //pointer to file 2005.02
ProcName : String[10]; //server limit is 10 chars.
pLongDesc : TStrings; //Won't be owned by this list
procedure Assign(Source : TImageInfo);
procedure Clear;
end;
TAutoUploadNote = class
private
public
TIUIEN : int64; //IEN in file# 8925
ErrMsg : AnsiString;
NoteTitle : AnsiString; //Title of note to be associated with image
Patient : TPatient;
ImageInfo : TImageInfo;
Location : AnsiString; //Location that image if from
DOS : AnsiString; //Date of service
Provider : AnsiString;
CurNoteImages: TStringList;
UploadError : Boolean;
procedure SetDFN(var ChartNum,Location,FName,LName,MName,DOB,Sex : string);
Procedure SetInfo(var DOS,Provider,Location,Title : string);
function SameAs(OtherNote: TAutoUploadNote): boolean;
procedure MakeNewBlankNote(DFN,DOS,Provider,Location,Title : string);
procedure InitFrom(OtherNote: TAutoUploadNote);
function IsValid : boolean;
procedure Clear;
constructor Create();
destructor Destroy; override;
end;
type
TUploadForm = class(TForm)
OpenFileDialog: TOpenDialog;
Image1: TImage;
PickImagesButton: TBitBtn;
Label1: TLabel;
CancelButton: TBitBtn;
UploadButton: TBitBtn;
Label2: TLabel;
Label4: TLabel;
ShortDescEdit: TEdit;
LongDescMemo: TMemo;
Label3: TLabel;
Label5: TLabel;
DateTimeEdit: TEdit;
ClearImagesButton: TBitBtn;
OpenDialog: TOpenPictureDialog;
FilesToUploadList: TListBox;
NoteEdit: TEdit;
PickOtherButton: TBitBtn;
pnlIEHolder: TPanel;
WebBrowser: TWebBrowser;
Label6: TLabel;
MoveCheckBox: TCheckBox;
PolTimer: TTimer;
DKLanguageController1: TDKLanguageController;
procedure UploadButtonClick(Sender: TObject);
procedure PickImagesButtonClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ShortDescEditChange(Sender: TObject);
procedure ClearImagesButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FilesToUploadListClick(Sender: TObject);
procedure PickOtherButtonClick(Sender: TObject);
procedure FormRefresh(Sender: TObject);
procedure PolTimerTimer(Sender: TObject);
private
{ Private declarations }
Bitmap : TBitmap;
Picture : TPicture;
function MakeThumbNail(Info: TImageInfo): boolean;
procedure LoadNotesEdit();
//procedure LoadNotesList();
function UploadFile(Info: TImageInfo; DelOrig : boolean): boolean;
procedure UploadChosenFiles();
function ProcessOneLine(Line : string) : string;
function ProcessOneFile(FileName : string) : boolean;
procedure ScanAndHandleImgTxt;
procedure ScanAndHandleImages;
procedure DecodeImgTxt(Line : string; out ChartNum, Location,
FName, LName, MName, Sex, DOB, DOS, Provider,
Title : string; FilePaths : TStrings);
function EncodeImgTxt(ChartNum, Location, FName, LName, MName, Sex, DOB,
DOS, Provider, Title : string; FilePaths : TStrings) : AnsiString;
procedure FinishDocument(UploadNote : TAutoUploadNote);
public
{ Public declarations }
FScanDir : String;
PolInterval : integer;
procedure SetScanDir(NewDir : string);
published
property ScanDir : String read FScanDir write SetScanDir;
end;
var
UploadForm: TUploadForm;
implementation
{$R *.dfm}
uses fNotes,
StrUtils, //for MidStr etc.
ORFn, //for PIECE etc.
Trpcb, //for .PType enum
fImages, //for upload/download files etc.
//Targa, //for TGA graphic save
ORNet, //for RPCBrokerV
rTIU,
uTMGOptions
;
// const
// DefShortDesc = '(Short Image Description)'; <-- original line. //kt 8/7/2007
type
TFileInfo = class
private
public
SrcRec : TSearchRec;
STimeStamp : String;
SBarCode : String;
FPath : String;
MetaFileName : String;
MetaFileExists : boolean;
BatchCount : integer;
procedure Assign(Source: TFileInfo);
procedure Clear;
end;
var
DefShortDesc : string; //kt
AutoUploadNote : TAutoUploadNote;
procedure SetupVars;
begin
DefShortDesc := DKLangConstW('UploadImages_xShort_Image_Descriptionx'); //kt added 8/7/2007
end;
//-------------------------------------------------------------------------
//-------------------------------------------------------------------------
function NumPieces(const s: string; ADelim : Char) : integer;
var List : TStringList;
begin
List := TStringList.Create;
PiecesToList(S, ADelim, List);
Result := List.Count;
end;
//-------------------------------------------------------------------------
//-------------------------------------------------------------------------
procedure TFileInfo.Assign(Source: TFileInfo);
begin
SrcRec := Source.SrcRec;
STimeStamp := Source.STimeStamp;
SBarCode := Source.SBarCode;
FPath := Source.FPath;
BatchCount := Source.BatchCount;
MetaFileName := Source.MetaFileName;
MetaFileExists := Source.MetaFileExists;
end;
procedure TFileInfo.Clear;
begin
//SrcRec := ... //Note sure how to clear this. Will leave as is...
STimeStamp := '';
SBarCode := '';
FPath := '';
BatchCount := 0;
MetaFileName := '';
MetaFileExists := false;
end;
//-------------------------------------------------------------------------
//-------------------------------------------------------------------------
procedure TImageInfo.Assign(Source : TImageInfo);
begin
TIUIEN := Source.TIUIEN;
DFN := Source.DFN;
UploadDUZ := Source.UploadDUZ;
ThumbFPathName := Source.ThumbFPathName;
ImageFPathName := Source.ImageFPathName;
ServerPath := Source.ServerPath;
ServerFName := Source.ServerFName;
ServerThumbFName := Source.ServerThumbFName;
ShortDesc := Source.ShortDesc;
Extension := Source.Extension;
ImageDateTime := Source.ImageDateTime;
UploadDateTime := Source.UploadDateTime;
ObjectType := Source.ObjectType;
ProcName := Source.ProcName;
pLongDesc := Source.pLongDesc; //this is only a pointer to object owned elsewhere
end;
procedure TImageInfo.Clear;
begin
TIUIEN := 0;
DFN := '';
UploadDUZ := 0;
ThumbFPathName := '';
ImageFPathName := '';
ServerPath := '';
ServerFName := '';
ServerThumbFName := '';
ShortDesc := '';
Extension := '';
ImageDateTime := '';
UploadDateTime:= '';
ObjectType :=0;
ProcName := '';
pLongDesc := nil
end;
//-------------------------------------------------------------------------
//-------------------------------------------------------------------------
procedure TAutoUploadNote.SetDFN(var ChartNum,Location,FName,LName,MName,DOB,Sex : string);
var RPCResult : AnsiString;
PMS : AnsiString;
begin
//Notice: ChartNum, and PMS are optional. If PMS is 1,2,or 3, then ChartNum
// is used to look up patient. Otherwise a lookup is based on just
// Name, DOB, Sex.
// To NOT use ChartNum, just set the values to ''
//
//Note: If LName is in form: `12345, then LName is used for DFN, and call
// to server for lookup is bypassed, and the values for FName,DOB etc
// are ignored
if MidStr(LName,1,1)='`' then begin
Self.Patient.DFN := MidStr(LName,2,999);
end else begin
//**NOTE**: site-specific code
if Location ='Laughlin_Office' then PMS :='2'
else if Location ='Peds_Office' then PMS :='3'
else PMS := ''; //default
RPCBrokerV.ClearParameters := true;
RPCBrokerV.remoteprocedure := 'TMG GET DFN';
RPCBrokerV.param[0].value := ChartNum; RPCBrokerV.param[0].ptype := literal;
RPCBrokerV.param[1].value := PMS; RPCBrokerV.Param[1].ptype := literal;
RPCBrokerV.param[2].value := FName; RPCBrokerV.Param[2].ptype := literal;
RPCBrokerV.param[3].value := LName; RPCBrokerV.Param[3].ptype := literal;
RPCBrokerV.param[4].value := MName; RPCBrokerV.Param[4].ptype := literal;
RPCBrokerV.param[5].value := DOB; RPCBrokerV.Param[5].ptype := literal;
RPCBrokerV.param[6].value := Sex; RPCBrokerV.Param[6].ptype := literal;
RPCBrokerV.Call;
RPCResult := RPCBrokerV.Results[0]; //returns: success: DFN; or error: -1^ErrMsg
if piece(RPCResult,'^',1) <> '-1' then begin
self.Patient.DFN := RPCResult;
end else begin
self.Patient.DFN := '';
end;
end;
end;
Procedure TAutoUploadNote.SetInfo(var DOS,Provider,Location,Title : string);
//Just loads values into structure. No validation done.
begin
Self.DOS := DOS;
Self.Provider := Provider;
Self.Location := Location;
Self.NoteTitle := Title;
end;
procedure TAutoUploadNote.InitFrom(OtherNote: TAutoUploadNote);
//Will create a blank note for itself.
begin
Patient.Assign(OtherNote.Patient);
ImageInfo.Assign(OtherNote.ImageInfo);
Location := OtherNote.Location;
DOS := OtherNote.DOS;
Provider := OtherNote.Provider;
NoteTitle := OtherNote.NoteTitle;
CurNoteImages.Assign(OtherNote.CurNoteImages);
MakeNewBlankNote(Patient.DFN,DOS,Provider,Location,NoteTitle);
end;
procedure TAutoUploadNote.MakeNewBlankNote(DFN,DOS,Provider,Location,Title : string);
var RPCResult : string;
begin
RPCResult := '';
Self.ErrMsg := ''; //default to no error messages
RPCBrokerV.ClearParameters := true;
RPCBrokerV.remoteprocedure := 'TMG GET BLANK TIU DOCUMENT';
RPCBrokerV.param[0].value := DFN; RPCBrokerV.param[0].ptype := literal;
RPCBrokerV.param[1].value := Provider; RPCBrokerV.Param[1].ptype := literal;
RPCBrokerV.param[2].value := Location; RPCBrokerV.Param[2].ptype := literal;
RPCBrokerV.param[3].value := DOS; RPCBrokerV.Param[3].ptype := literal;
RPCBrokerV.param[4].value := Title; RPCBrokerV.Param[4].ptype := literal;
RPCBrokerV.Call;
RPCResult := RPCBrokerV.Results[0];
try
TIUIEN := StrToInt64(Piece(RPCResult,'^',1)); //returns: success: TIU IEN; or error: -1
except
on E: EConvertError do begin
Self.ErrMsg := 'WHILE CREATING BLANK NOTE FOR UPLOAD, ' +
'ERROR CONVERTING: ' + RPCBrokerV.Results[0] + ' to document record #.';
TIUIEN := -1;
end
end;
If TIUIEN <> -1 then begin
Self.Patient.DFN := DFN;
Self.Provider := Provider;
Self.Location := Location;
Self.DOS := DOS;
end else begin
Self.ErrMsg := 'FAILED TO CREATE A BLANK NOTE FOR UPLOAD' +
' ' + Piece(RPCResult,'^',2);
Self.UploadError := true;
end;
end;
function TAutoUploadNote.IsValid : boolean;
begin
Result := true; //default to success.
if (Patient.DFN='') {or (TIUIEN < 1)} or (ErrMsg <> '') or (NoteTitle = '')
or (Location = '') or (DOS = '') or (Provider = '') then begin
Result := false
end;
end;
procedure TAutoUploadNote.Clear;
begin
TIUIEN := 0;
if Patient <> nil then Patient.Clear;
if ImageInfo <> nil then ImageInfo.Clear;
Location := '';
DOS := '';
Provider := '';
NoteTitle := '';
UploadError := False;
if CurNoteImages <> nil then CurNoteImages.Clear;
end;
function TAutoUploadNote.SameAs(OtherNote: TAutoUploadNote): boolean;
begin
Result := true;
if (OtherNote = nil) or (OtherNote.Patient = nil)
or (Patient.DFN <> OtherNote.Patient.DFN)
or (DOS <> OtherNote.DOS)
or (Provider <> OtherNote.Provider)
or (Location <> OtherNote.Location)
or (NoteTitle <> OtherNote.NoteTitle) then begin
Result := false;
end;
end;
constructor TAutoUploadNote.Create;
begin
Self.TIUIEN := 0;
Self.Patient := TPatient.Create;
Self.CurNoteImages := TStringList.Create;
Self.ImageInfo := TImageInfo.Create;
Self.Clear;
end;
destructor TAutoUploadNote.Destroy;
begin
self.patient.free;
Self.CurNoteImages.Free;
Self.ImageInfo.Free;
end;
//-------------------------------------------------------------------------
//-------------------------------------------------------------------------
function TUploadForm.MakeThumbNail(Info: TImageInfo) : boolean;
//This takes Info.ImageFPathName and creates a 64x64 .bmp file with
//this same name, and saves in cache directory.
//saves name of this thumbnail in info.ThumbFPathName
var
Rect : TRect;
ThumbFName : AnsiString;
begin
Rect.Top := 0; Rect.Left:=0; Rect.Right:=63; Rect.Bottom:=63;
result := false; //default of failure
try
Picture.LoadFromFile(Info.ImageFPathName);
Bitmap.Canvas.StretchDraw(Rect,Picture.Graphic);
ThumbFName := frmImages.CacheDir + '\Thumb-' + ExtractFileName(Info.ImageFPathName);
ThumbFName := ChangeFileExt(ThumbFName,'.bmp');
Bitmap.SaveToFile(ThumbFName); //save to local cache (for upload)
Info.ThumbFPathName := ThumbFName; //pass info back out.
Info.ServerThumbFName := ChangeFileExt(Info.ServerFName,'.ABS'); //format is .bmp
result := true
except
on E: Exception do exit;
end;
end;
function TUploadForm.UploadFile(Info: TImageInfo; DelOrig : boolean): boolean;
//result: true if success, false if failure
var
RPCResult,index : AnsiString;
ImageIEN : AnsiString;
MsgNum : AnsiString;
ErrorMsg : AnsiString;
i : integer;
begin
RPCBrokerV.remoteprocedure := 'MAGGADDIMAGE';
RPCBrokerV.Param[0].Value := '.X';
RPCBrokerV.Param[0].PType := list;
RPCBrokerV.Param[0].Mult['"NETLOCABS"'] := 'ABS^STUFFONLY';
RPCBrokerV.Param[0].Mult['"magDFN"'] := '5^' + Info.DFN; {patient dfn}
RPCBrokerV.Param[0].Mult['"DATETIME"'] := '7^NOW'; {date/time image collected}
RPCBrokerV.Param[0].Mult['"DATETIMEPROC"'] := '15^' + Info.ImageDateTime; {Date/Time of Procedure}
if Info.ProcName <> '' then
RPCBrokerV.Param[0].Mult['"PROC"'] := '6^' + Info.ProcName; {procedure}
RPCBrokerV.Param[0].Mult['"DESC"'] := '10^(Hard coded Short Description)'; {image description}
if Info.ShortDesc <> '' then
RPCBrokerV.Param[0].Mult['"DESC"'] := '10^' + Info.ShortDesc; {image description}
RPCBrokerV.Param[0].Mult['"DUZ"'] := '8^' + IntToStr(Info.UploadDUZ); {Duz}
//The field (#14) below is used for images that are part of a group,
//for example a CT exam might contain 30 images. This field
//contains a pointer back to the Image file (2005), to the
//object whose type is "GROUP" that points to this object as
//a member of its group. A pointer to this object will be
//found in the Object Group multiple of the parent GROUP
//object.
//RPCBrokerV.Param[0].Mult['"GROUP"'] := '14^' + group;
RPCBrokerV.Param[0].Mult['"OBJTYPE"'] := '3^' + IntToStr(Info.ObjectType);
RPCBrokerV.Param[0].Mult['"FileExt"'] := 'EXT^' + Info.Extension;
for i := 0 to Info.pLongDesc.Count - 1 do begin
index := IntToStr(i);
while length(index) < 3 do index := '0' + index;
index :='"LongDescr' + index + '"';
RPCBrokerV.Param[0].Mult[index] := '11^' + Info.pLongDesc.Strings[i];
end;
RPCResult := RPCBrokerV.STRcall; { returns ImageIEN^directory/filename }
ImageIEN := Piece(RPCResult,'^',1);
result := ((ImageIEN <> '0') and (ImageIEN <> '')); // function result.
if result=false then begin
// ErrorMsg :='Server Error -- Couldn''t store image information'; <-- original line. //kt 8/7/2007
ErrorMsg :=DKLangConstW('UploadImages_Server_Error_xx_Couldnxxt_store_image_information'); //kt added 8/7/2007
MessageDlg(ErrorMsg,mtWarning,[mbOK],0);
end;
if result then begin
Info.ServerPath := Piece(RPCResult,'^',2);
Info.ServerFName := Piece(RPCResult,'^',3);
result := frmImages.UploadFile(Info.ImageFPathName,Info.ServerPath,Info.ServerFName,1,1);
if result=false then begin
// ErrorMsg :='Error uploading image to server'; <-- original line. //kt 8/7/2007
ErrorMsg :=DKLangConstW('UploadImages_Error_uploading_image_to_server'); //kt added 8/7/2007
//Application.MessageBox(@ErrorMsg,'Error Uploading Image');
MessageDlg(ErrorMsg,mtWarning,[mbCancel],0);
end;
//Later, put code that also copies the file into the cache directory,
//so that we don't have to turn around and download it again.
if result then begin
RPCBrokerV.remoteprocedure := 'MAG3 TIU IMAGE';
RPCBrokerV.param[0].ptype := literal;
RPCBrokerV.param[0].value := ImageIEN;
RPCBrokerV.Param[1].ptype := literal;
RPCBrokerV.param[1].value := IntToStr(Info.TIUIEN);
RPCBrokerV.Call;
RPCResult := RPCBrokerV.Results[0];
//returns: success: 1^message; or error: 0^error message
MsgNum := Piece(RPCResult,'^',1);
result := (MsgNum = '1');
if result=false then begin
// ErrorMsg :='Error associating image with note:' + #13 + Piece(RPCResult,'^',2); <-- original line. //kt 8/7/2007
ErrorMsg :=DKLangConstW('UploadImages_Error_associating_image_with_notex') + #13 + Piece(RPCResult,'^',2); //kt added 8/7/2007
MessageDlg(ErrorMsg,mtWarning,[mbCancel],0);
end;
end;
if (result=true) and (MoveCheckBox.Checked) then begin
DeleteFile(Info.ImageFPathName);
end;
if result then begin
if MakeThumbNail(Info) then begin;
result := frmImages.UploadFile(Info.ThumbFPathName,Info.ServerPath,Info.ServerThumbFName,1,1);
if result=false then begin
// ErrorMsg :='Error sending thumbnail image to server.'; <-- original line. //kt 8/7/2007
ErrorMsg :=DKLangConstW('UploadImages_Error_sending_thumbnail_image_to_serverx'); //kt added 8/7/2007
MessageDlg(ErrorMsg,mtWarning,[mbOK],0);
end;
end;
if DelOrig=true then begin
DeleteFile(Info.ImageFPathName);
end;
end;
end;
//returns: result
end;
procedure TUploadForm.UploadChosenFiles();
var i : integer;
Info: TImageInfo;
begin
SetupVars;
Info := TImageInfo.Create();
Info.pLongDesc := nil;
//Load up info class/record
Info.ShortDesc := MidStr(ShortDescEdit.Text,1,60);
if Info.ShortDesc = DefShortDesc then Info.ShortDesc := ' ';
Info.UploadDUZ := User.DUZ;
if LongDescMemo.Lines.Count>0 then begin
Info.pLongDesc := LongDescMemo.Lines;
end;
Info.ObjectType := 1; //type 1 is Still Image (jpg). OK to use with .bmp??
Info.ProcName := 'Picture'; //max length is 10 characters
Info.ImageDateTime := DateTimeEdit.Text;
Info.TIUIEN := frmNotes.lstNotes.ItemID;
Info.UploadDateTime := 'NOW';
Info.DFN := Patient.DFN;
for i:= 0 to FilesToUploadList.Items.Count-1 do begin
Info.ImageFPathName := FilesToUploadList.Items.Strings[i];
Info.Extension := ExtractFileExt(Info.ImageFPathName); //includes '.'
Info.Extension := MidStr(Info.Extension,2,17); //remove '.'
if not UploadFile(Info,MoveCheckBox.Checked) then begin //Upload function passes back filename info in Info class
//Application.MessageBox('Error uploading image file!','Error');
end;
end;
Info.Free;
end;
procedure TUploadForm.LoadNotesEdit();
begin
NoteEdit.Text := frmNotes.tvNotes.Selected.Text;
end;
{
procedure TUploadForm.LoadNotesList();
var
NoteInfo,s,dateS : AnsiString;
i : integer;
const
U='^';
begin
NoteComboBox.Items.Clear;
for i := 0 to frmNotes.lstNotes.Count-1 do with frmNotes.lstNotes do begin
NoteInfo := Items[i];
(* example NoteInfo:
piece# 1: 14321^ //TIU IEN
piece# 2: PRESCRIPTION CALL IN^ //Document Title
piece# 3: 3050713.0947^ //Date/Time
piece# 4: TEST, KILLME D (T0101)^ //Patient
piece# 5: 133;JANE A DOE;DOE,JANE A^ //Author
piece# 6: Main_Office^ //Location of Visit
piece# 7: completed^ //Status of Document
piece# 8: Visit: 07/13/05;3050713.094721^ //Date/Time
piece# 9...: ;^^1^^^1^' //?
*)
dateS := Piece(Piece(NoteInfo, U, 8), ';', 2);
s := FormatFMDateTime('mmm dd,yy@hh:nn', MakeFMDateTime(dateS)) + ' -- ';
// s := Piece(Piece(NoteInfo, U, 8), ';', 1) + ' -- ';
s := s + Piece(NoteInfo, U, 2) + '; ';
s := s + 'Author: ' + Piece(Piece(NoteInfo, U, 5), ';', 2) + ', ';
s := s + Piece(NoteInfo, U, 6);
NoteComboBox.Items.Add(s);
end;
NoteComboBox.ItemIndex := frmNotes.lstNotes.ItemIndex;
end;
}
//Delphi events etc.------------------------------------------------
procedure TUploadForm.UploadButtonClick(Sender: TObject);
begin
try
WebBrowser.Navigate(frmImages.NullImageName);
except
on E: Exception do exit;
end;
UploadChosenFiles();
end;
procedure TUploadForm.PickImagesButtonClick(Sender: TObject);
var i : integer;
begin
If OpenDialog.Execute then begin
for i := 0 to OpenDialog.Files.Count-1 do begin
FilesToUploadList.Items.Add(OpenDialog.Files.Strings[i]);
end;
end;
end;
procedure TUploadForm.PickOtherButtonClick(Sender: TObject);
var i : integer;
begin
If OpenFileDialog.Execute then begin
for i := 0 to OpenFileDialog.Files.Count-1 do begin
FilesToUploadList.Items.Add(OpenFileDialog.Files.Strings[i]);
end;
end;
end;
procedure TUploadForm.FormShow(Sender: TObject);
begin
FormRefresh(self);
FilesToUploadList.Items.Clear;
LoadNotesEdit();
SetupVars;
ShortDescEdit.Text := DefShortDesc;
end;
procedure TUploadForm.ShortDescEditChange(Sender: TObject);
begin
if Length(ShortDescEdit.Text)> 60 then begin
ShortDescEdit.Text := MidStr(ShortDescEdit.Text,1,60);
end;
end;
procedure TUploadForm.ClearImagesButtonClick(Sender: TObject);
begin
FilesToUploadList.Items.Clear;
FilesToUploadListClick(self);
end;
procedure TUploadForm.FormCreate(Sender: TObject);
begin
Bitmap := TBitmap.Create;
Bitmap.Height := 64;
Bitmap.Width := 64;
Picture := TPicture.Create;
AutoUploadNote := TAutoUploadNote.Create;
FScanDir := uTMGOptions.ReadString('Pol Directory','??');
if FScanDir='??' then begin
FScanDir := ExtractFileDir(Application.ExeName);
uTMGOptions.WriteString('Pol Directory',FScanDir);
end;
PolInterval := uTMGOptions.ReadInteger('Pol Interval (milliseconds)',0);
if PolInterval=0 then begin
PolInterval := 60000;
uTMGOptions.WriteInteger('Pol Interval (milliseconds)',PolInterval);
end;
end;
procedure TUploadForm.SetScanDir(NewDir : string);
begin
if DirectoryExists(NewDir) then begin
FScanDir := NewDir;
uTMGOptions.WriteString('Pol Directory',FScanDir);
end;
end;
procedure TUploadForm.FormDestroy(Sender: TObject);
begin
Bitmap.Free;
Picture.Free;
end;
procedure TUploadForm.FilesToUploadListClick(Sender: TObject);
var
FileName: AnsiString;
SelectedItem: integer;
begin
SelectedItem := FilesToUploadList.ItemIndex;
if SelectedItem > -1 then begin
FileName := FilesToUploadList.Items[SelectedItem];
//Application.MessageBox('Here I would pass to IE','NOte');
end else begin
FileName := frmImages.NullImageName;
end;
try
WebBrowser.Navigate(FileName);
except
on E: Exception do exit;
end;
end;
procedure TUploadForm.FormRefresh(Sender: TObject);
begin
try
WebBrowser.Navigate(frmImages.NullImageName);
except
on E: Exception do exit;
end;
end;
procedure TUploadForm.DecodeImgTxt(Line : string; out ChartNum, Location,
FName, LName, MName, Sex, DOB, DOS, Provider,
Title : string; FilePaths : TStrings);
//format of line is as follows:
//ChartNum^Location^FName^LName^MName^Sex^DOB^DOS^Provider^Title^FilePath(s)
//NOTE: To provide patient IEN instead of FName etc, use this format:
// ^Location^^`1234567^^^^DOS^Provider^Title^FilePath(s)
// i.e. `IEN (note ` is not an appostrophy ('))
// `IEN in place of LName, and leave blank: ChartNum,FName,FName,Sex,DOB
var Files: String;
FileName : String;
num,i : integer;
begin
if Pos('}',Line)>0 then begin
Line := Piece(Line,'}',2); //If error message is present, still allow parse.
end;
ChartNum := Piece(Line,'^',1);
Location := Piece(Line,'^',2);
FName := Piece(Line,'^',3);
LName := Piece(Line,'^',4);
MName := Piece(Line,'^',5);
Sex := Piece(Line,'^',6);
DOB := Piece(Line,'^',7);
DOS := Piece(Line,'^',8);
Provider := Piece(Line,'^',9);
Title := Piece(Line,'^',10);
Files := Piece(Line,'^',11); //may be list of multiple files separated by ;
if Pos(';',Files)>0 then begin
num := NumPieces(Files,';');
for i := 1 to num do begin
FileName := piece(files,';',i);
if FileName <> '' then FilePaths.Add(FileName);
end;
end else begin
FilePaths.Add(Files);
end;
end;
function TUploadForm.EncodeImgTxt(ChartNum, Location, FName, LName, MName, Sex, DOB,
DOS, Provider, Title : string; FilePaths : TStrings) : AnsiString;
//format of line is as follows:
//ChartNum^Location^FName^LName^MName^Sex^DOB^DOS^Provider^Title^FilePath(s)
//NOTE: To provide patient IEN instead of FName etc, use this format:
// ^Location^^`1234567^^^^DOS^Provider^Title^FilePath(s)
// i.e. `IEN (note ` is not an appostrophy ('))
// `IEN in place of LName, and leave blank: ChartNum,FName,FName,Sex,DOB
var i : integer;
begin
Result := ChartNum + '^' + Location + '^' + FName + '^' + LName + '^' +
MName + '^' + Sex + '^' + DOB + '^' + DOS + '@01:00' + '^' + Provider + '^' +
Title + '^'; //added time of 1:00 elh 7/8/08
for i:= 0 to FilePaths.Count-1 do begin
Result := Result + FilePaths.Strings[i];
if i <> FilePaths.Count-1 then Result := Result + ';';
end;
end;
procedure TUploadForm.FinishDocument(UploadNote : TAutoUploadNote);
var Text : TStringList;
ErrMsg : String;
RPCResult : String;
i : integer;
oneImage: string;
//TIUIEN : int64;
begin
if (UploadNote.TIUIEN>0) and (UploadNote.CurNoteImages.Count>0)
and (UploadNote.UploadError = False) then begin
//Add text for note: "See scanned image" --
// or later, some HTML code to show note in CPRS directly....
Text := TStringList.Create;
Text.Add('');
Text.Add('');
Text.Add('');
Text.Add('');
Text.Add('VistA HTML Note');
Text.Add('');
Text.Add('');
Text.Add('');
Text.Add('Note created automatically from imported media.');
Text.Add('
');
for i := 0 to UploadNote.CurNoteImages.Count-1 do begin
// note: $CPRSDIR$ will be replaced at runtime with directory of CPRS
// This will be done as page is passed to TWebBrowser (in rHTMLTools)
oneImage := '$CPRSDIR$\Cache\' + UploadNote.CurNoteImages.Strings[i];
//oneImage := CacheDir + '\' + CurNoteImages.Strings[i];
Text.Add('
');
Text.Add('
');
end;
//Text.Add('');
//Text.Add('If images don''t display, first view them in IMAGES tab.
');
//Text.Add('Then return here, click on note and press [F5] key to refresh.');
//Text.Add('');
//Text.Add('
');
Text.Add('');
Text.Add('');
Text.Add(' ');
rTIU.SetText(ErrMsg,Text,UploadNote.TIUIEN,1); //1=commit data, do actual save.
Text.Free;
//Here I autosign -- later make this optional?
RPCBrokerV.ClearParameters := true;
RPCBrokerV.remoteprocedure := 'TMG AUTOSIGN TIU DOCUMENT';
RPCBrokerV.param[0].value := IntToStr(UploadNote.TIUIEN);
RPCBrokerV.param[0].ptype := literal;
RPCBrokerV.Call;
RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
if RPCResult='-1' then begin
MessageDlg('Unable to set status for scanned document to SIGNED',mtError,[mbOK],0);
end;
UploadNote.TIUIEN := 0;
end;
UploadNote.Clear;
end;
function TUploadForm.ProcessOneLine(Line : string) : string;
//Returns: if success, ''; if failure, returns reason
//format of line is as follows:
//ChartNum^Location^FName^LName^MName^Sex^DOB^DOS^Provider^Title^FilePath(s)
//NOTE: To provide patient IEN instead of FName etc, use this format:
// ^Location^^`1234567^^^^DOS^Provider^Title^FilePath(s)
// i.e. `IEN (note ` is not an appostrophy ('))
// `IEN in place of LName, and leave blank: ChartNum,FName,FName,Sex,DOB
var
ChartNum,FName,LName,MName,Sex,DOB : String;
DOS,Provider,Title : String;
ThisNote : TAutoUploadNote;
FilePaths : TStringList;
i : integer;
Location : string;
begin
Result := ''; //default to success for function
ThisNote := TAutoUploadNote.Create;
FilePaths := TStringList.Create();
DecodeImgTxt(Line, ChartNum, Location, FName, LName, MName, Sex, DOB, DOS, Provider, Title, FilePaths);
ThisNote.SetDFN(ChartNum,Location,FName,LName,MName,DOB,Sex);
ThisNote.SetInfo(DOS,Provider,Location,Title);
if Pos('//Failed',Line)>0 then ThisNote.UploadError := true;
if ThisNote.IsValid then begin //A note can be 'Valid' and still have an 'UploadError'
if ThisNote.SameAs(AutoUploadNote)= false then begin
ThisNote.TIUIEN := AutoUploadNote.TIUIEN;
FinishDocument(AutoUploadNote); // Close and clear any existing note
AutoUploadNote.InitFrom(ThisNote);
Result := AutoUploadNote.ErrMsg; //'' if no error
end;
if ThisNote.UploadError then AutoUploadNote.UploadError := true;
if (AutoUploadNote.UploadError=false) then for i := 0 to FilePaths.Count-1 do begin
AutoUploadNote.ImageInfo.pLongDesc := nil;
//Load up info record with data for upload
AutoUploadNote.ImageInfo.ShortDesc := 'Scanned document';
AutoUploadNote.ImageInfo.UploadDUZ := User.DUZ;
AutoUploadNote.ImageInfo.ObjectType := 1; //type 1 is Still Image (jpg). OK to use with .bmp??
AutoUploadNote.ImageInfo.ProcName := 'Scanned'; //max length is 10 characters
AutoUploadNote.ImageInfo.ImageDateTime := DOS;
AutoUploadNote.ImageInfo.TIUIEN := AutoUploadNote.TIUIEN;
AutoUploadNote.ImageInfo.UploadDateTime := 'NOW';
AutoUploadNote.ImageInfo.DFN := AutoUploadNote.Patient.DFN;
AutoUploadNote.ImageInfo.ImageFPathName := FilePaths.Strings[i];
AutoUploadNote.ImageInfo.Extension := ExtractFileExt(AutoUploadNote.ImageInfo.ImageFPathName); //includes '.'
AutoUploadNote.ImageInfo.Extension := MidStr(AutoUploadNote.ImageInfo.Extension,2,17); //remove '.'
if not UploadFile(AutoUploadNote.ImageInfo,true) then begin //Upload function passes back filename info in Info class
Result := 'ERROR UPLOADING IMAGE FILE';
end;
AutoUploadNote.CurNoteImages.Add(AutoUploadNote.ImageInfo.ServerFName);
end else begin
If Result='' then Result := '(Error found in earlier file entry in batch)';
end;
end else begin
Result := 'NOTE INFO INVALID (Probably: PATIENT NOT FOUND)';
end;
FilePaths.Free;
ThisNote.Free;
end;
function TUploadForm.ProcessOneFile(FileName : string) : boolean;
//This will process image(s) indicated in textfile FileName
//After uploading image to server, textfile and specified images are deleted
//Returns Success
//Note: To upload multiple images into one document, one may add multiple
// lines to the ImgTxt text file. As long as the info is the same
// (i.e. same provider, patient, note type, DOS etc) then they
// will be appended to current note.
// OR, add multiple image file names to one line.
// -- the problem with multiple images on one line is that errors
// can not be reported for just one image. It will be ONE for any/all
// OR, if the next file in process-order is still has the same info as
// the prior file, then it will be appended.
var
Lines : TStringList;
i : integer;
ResultStr : string;
OneLine : string;
begin
Result := true; //default is Success=true
Lines := TStringList.Create;
Lines.LoadFromFile(FileName);
//FinishDocument(AutoUploadNote); //will save and clear any old data.
for i := 0 to Lines.Count-1 do begin
OneLine := Lines.Strings[i];
ResultStr := ProcessOneLine(OneLine); //Even process with //failed markeers (to preserve batches)
if Pos('//Failed',OneLine)> 0 then begin //If we already have //Failed, don't duplicate another Error Msg
Result := false; //prevent deletion of file containing //Failed//
end else begin
if ResultStr <> '' then begin
Lines.Strings[i] := '//Failed: '+ResultStr+'}'+Lines.Strings[i];
Lines.SaveToFile(FileName);
Result := false;
end;
end;
end;
//Temp, for debugging
//Lines.SaveToFile(ChangeFileExt(FileName,'.imgtxt-bak'));
//end temp
Lines.free;
end;
procedure TUploadForm.ScanAndHandleImgTxt;
var
FoundFile : string;
Found : TSearchRec;
FilesList : TStringList;
i : integer;
result : boolean;
begin
//NOTE: Later I may make this spawn a separate thread, so that
// user doesn't encounter sudden unresponsiveness of CPRS
//I can use BeginThread, then EndTread
//Issues: ProcessOneFile would probably have to be a function
// not in a class/object...
FilesList := TStringList.Create;
//scan for new *.ImgTxt file
//FindFirst may not have correct order, so collect all names and then sort.
if FindFirst(FScanDir+'*.imgtxt',faAnyFile,Found)=0 then repeat
FilesList.Add(FScanDir+Found.Name);
until FindNext(Found) <> 0;
FindClose(Found);
FilesList.Sort; //puts filenames in alphanumeric order
//Now process images in correct order.
for i := 0 to FilesList.Count-1 do begin
FoundFile := FilesList.Strings[i];
if ProcessOneFile(FoundFile) = true then begin {process *.imgtxt file}
DeleteFile(FoundFile);
FoundFile := ChangeFileExt(FoundFile,'.barcode.txt');
DeleteFile(FoundFile);
end; //Note: it is OK to continue, to get other non-error notes afterwards.
end;
FinishDocument(AutoUploadNote); // Close and clear any existing note
FilesList.Free
end;
procedure TUploadForm.ScanAndHandleImages;
(* Overview of mechanism of action of automatically uploading images.
=================================================================
-- For an image to be uploaded, it must first be positively identified.
This can occur 1 of two ways:
-- the image contains a datamatrix barcode.
-- the image is part of a batch, and the first image of the batch
contains a barcode for the entire batch.
-- At our site, the scanner program automatically names the files numerically
so that sorting on the name will put them in proper order when working
with batches.
-- The decoding of the barcode requires a special program. I was not
able to find a way to run this on the Windows client. I found the
libdmtx that does this automatically. It currently is on unix only.
It was too complicated for me to compile it for windows. I initially
wanted everything to run through the RPC broker. This involved
uploading the image to the linux server, running the decoder on the
server, then passing the result back. The code for this is still avail
in this CPRS code. However, the process was too slow and I had to
come up with something faster. So the following arrangement was setup
-- scanned images are stored in a folder that was shared by both the
windows network (and thus is available to CPRS), and the linux server.
-- At our site, we used a copier/scanner unit that created only TIFF
files. These are not the needed format for the barcode decoder, so...
-- a cron job runs on the linux server that converts the .tif files
to .png. Here is that script:
---------------------------------
-- Next the .png files must be checked for a barcode. Another cron
task scans a directory for .png files and creates a metafile for
the file giving its barcode reading, or a marker that there is
no barcode available for that image. The file name format is:
*.barcode.txt, with the * coorelating to filename of the image.
-- The decoding process can take some time (up to several minutes
per image.
-- A flag file named barcodeRead.working.txt is created when the
script is run, and deleted when done. So if this file is present
then the decoding process is not complete.
-- if a *.barcode.txt file is present, then no attempts will be made
to decode the image a second time.
-- CPRS still contains code to upload an image to look for a barcode.
At this site, only png's will contain barcodes, so I have commented
out support for automatically uploading other file formats.
-- Here is the unix bash script that decodes the barcodes. It is
launched by cron:
---------------------------------
---------------------------------
-- After the *.png images are available, and no flag files are present
to indicate that the server is working with the files, then the images
are processed, using the barcode metafiles. This is triggered by a
timer in CPRS. It essentially converts imagename + barcode data -->
--> *.imgtxt.
-- For each *.png image, there will be a *.imgtxt metafile created. This
will contain information needed by the server, in a special format for
the RPC calls. When an *.imgtxt file is present, this is a flag that
the image is ready to be uploaded.
-- A timer in CPRS scans for *.imgtxt files. When found, it uploads the
image to the server and creates a container progress note for displaying
it in CPRS.
*)
procedure ScanOneImageType(ImageType : string);
//Scan directory for all instances of images of type ImageType
//For each one, create a metadata file (if not already present)
//Note: Batch mode only works for a batch of file ALL OF THE SAME TYPE.
//I.e. There can't be a batch of .jpg, then .gif, then .bmp. This is
//because a scanner, if it is scanning a stack of documents for a given
//patient will produce all files in the same ImageType
function DeltaMins(CurrentTime,PriorTime : TDateTime) : integer;
//Return ABSOLUTE difference in minutes between Current <--> Prior.
//NOTE: if value is > 1440, then 1440 is returned
var DeltaDays,FracDays : double;
begin
DeltaDays := abs(CurrentTime-PriorTime);
FracDays := DeltaDays - Round(DeltaDays);
if DeltaDays>1 then FracDays := 1;
Result := Round((60*24)*FracDays);
end;
var
FoundFile : string;
MetaFilename : string;
Found : TSearchRec;
BarCodeData : AnsiString;
DFN,DOS,AuthIEN,LocIEN,NoteTypeIEN : string;
OneLine : string;
FilePaths : TStringList;
AllFiles : TStringList;
OutFileLines : TStringList;
BatchS : string;
tempCount : integer;
BatchFInfo : TFileInfo;
LastFileTimeStamp,CurFileTimeStamp : TDateTime;
DeltaMinutes : integer;
pFInfo : TFileInfo;
i : integer;
Label AbortPoint;
const
ALLOWED_TIME_GAP = 2; //time in minutes
begin
FilePaths := TStringList.Create;
OutFileLines := TStringList.Create;
AllFiles := TStringList.Create;
BatchFInfo := TFileInfo.Create;
//NOTE: Later I may make this spawn a separate thread, so that
// user doesn't encounter sudden unresponsiveness of CPRS
//I can use BeginThread, then EndTread
//Issues: ProcessOneFile would probably have to be a function
// not in a class/object...
//scan for all instances *.ImageType Image file
//Store info for processesing after loop
//Do this as a separate step, so files can be processed in proper order
if FindFirst(FScanDir+'*.'+ImageType,faAnyFile,Found)=0 then repeat
FoundFile := FScanDir+Found.Name;
if FileExists(ChangeFileExt(FoundFile,'.imgtxt')) then continue;
MetaFilename := ChangeFileExt(FoundFile,'.barcode.txt');
pFInfo := TFileInfo.Create; //will be owned by AllFiles
pFInfo.MetaFileName := MetaFilename;
pFInfo.FPath := FoundFile;
pFInfo.SrcRec := Found;
pFInfo.STimeStamp := FloatToStr(FileDateToDateTime(Found.Time));
pFInfo.MetaFileExists := FileExists(MetaFilename);
pFInfo.SBarCode := ''; //default to empty.
pFInfo.BatchCount := 0;
if pFInfo.MetaFileExists = false then begin
//Call server via RPC to decode Barcode
//This is too slow and buggy. Will remove for now...
//BarCodeData := frmImages.DecodeBarcode(FoundFile,ImageType);
//pFInfo.SBarCode := BarCodeData;
pFInfo.SBarCode := '';
//Here I could optionally create a Metafile for processing below.
end;
if pFInfo.MetaFileExists then begin //Retest in case RPC changed status.
if FileExists(FScanDir+'barcodeRead.working.txt') then goto AbortPoint;
OutFileLines.LoadFromFile(pFInfo.MetaFileName);
if OutFileLines.Count>0 then begin
pFInfo.SBarCode := OutFileLines.Strings[0];
//convert 'No Barcode message into an empty string, to match existing code.
if Pos('//',pFInfo.SBarCode)=1 then pFInfo.SBarCode := '';
if NumPieces(pFInfo.SBarCode,'-') <> 8 then pFInfo.SBarCode := '';
end else begin
pFInfo.MetaFileExists := false; //set empty file to Non-existence status
end;
end;
AllFiles.AddObject(pFInfo.FPath,pFInfo); //Store filename, to allow sorting on this.
until FindNext(Found) <> 0;
AllFiles.Sort; // Sort on timestamp --> put in ascending alpha filename order
//-------- Now, process files in name order ------------
LastFileTimeStamp := 0;
BatchFInfo.BatchCount := 0;
for i := 0 to AllFiles.Count-1 do begin
pFInfo := TFileInfo(AllFiles.Objects[i]);
if pFInfo.MetaFileExists = false then continue;
CurFileTimeStamp := FileDateToDateTime(pFInfo.SrcRec.Time);
DeltaMinutes := DeltaMins(CurFileTimeStamp,LastFileTimeStamp);
// *.barcode.txt file exists at this point
if pFInfo.SBarCode <> '' then begin //Found a new barcode
LastFileTimeStamp := CurFileTimeStamp;
//Note: The expected format of barcode must be same as that
// created by TfrmPtLabelPrint.PrintButtonClick:
// 70685-12-31-2008-73-6-1302-0
// PtIEN-DateOfService-AuthorIEN-LocIEN-NoteTypeIEN-BatchFlag
// THUS there should be 8 pieces in the string.
DFN := piece(pFInfo.SBarCode,'-',1);
DOS := pieces(pFInfo.SBarCode,'-',2,4);
AuthIEN := piece(pFInfo.SBarCode,'-',5);
LocIEN := piece(pFInfo.SBarCode,'-',6);
NoteTypeIEN := piece(pFInfo.SBarCode,'-',7);
BatchS := piece(pFInfo.SBarCode,'-',8);
if BatchS = '*' then begin
pFInfo.BatchCount := 9999
end else begin
try
pFInfo.BatchCount := StrToInt(BatchS);
except
on E:EConvertError do begin
pFInfo.BatchCount := 1;
end;
end;
end;
//BatchFInfo.SBarCode := pFInfo.SBarCode;
end else if (BatchFInfo.BatchCount > 0) then begin
if (DeltaMinutes > ALLOWED_TIME_GAP) then begin
pFInfo.Clear;
BatchFInfo.Clear;
end else begin
//Apply barcode from last image onto this one (from same batch)
pFInfo.SBarCode := BatchFInfo.SBarCode;
end;
end;
if pFInfo.SBarCode <> '' then begin
//Success --> write out ImgTxt file...
FilePaths.Add(pFInfo.FPath);
OneLine := EncodeImgTxt('', '`'+LocIEN,'', '`'+DFN, '', '', '',
DOS,'`'+AuthIEN, '`'+NoteTypeIEN, FilePaths);
if pFInfo.BatchCount>0 then begin
//A BATCH marker has been found on current barcode. This means that
//Batchmode should be turned on. This will apply current barcode
//data to any subsequent images, providing there is not a gap in
//time > ALLOWED_TIME_GAP
BatchFInfo.Assign(pFInfo); //reset Batch info to current
end;
//Decrease use count of Batch Info
Dec(BatchFInfo.BatchCount);
end else begin
OneLine := '';
end;
OutFileLines.Clear;
if OneLine <> '' then begin
OutFileLines.Add(OneLine);
OutFileLines.SaveToFile(ChangeFileExt(pFInfo.FPath,'.imgtxt'));
end;
FilePaths.Clear;
OutFileLines.Clear;
LastFileTimeStamp := CurFileTimeStamp;
end;
AbortPoint:
FindClose(Found);
BatchFInfo.Free;
FilePaths.Free;
for i := 0 to AllFiles.Count-1 do begin //free owned objects
pFInfo := TFileInfo(AllFiles.Objects[i]);
pFInfo.Free;
end;
AllFiles.Free;
OutFileLines.Free;
end;
var flag1Filename,flag2Filename : string;
begin
flag1Filename := FScanDir+'barcodeRead.working.txt';
flag2Filename := FScanDir+'convertTif2Png.working.txt';
//if linux server is in middle of a conversion or barcode decode, then skip.
if (FileExists(flag1Filename)=false) and (FileExists(flag2Filename)=false) then begin
(* Remove {}'s to be able to have jpg's etc that contain barcodes
In our site, only png's will have barcodes, and thus these are the
only images that can be uploaded automatically. Uploading jpg's, bmp's
etc to look for (nonexistent) barcodes will just waste time and bandwidth. *)
{
ScanOneImageType('jpg');
ScanOneImageType('jpeg');
ScanOneImageType('gif');
ScanOneImageType('bmp');
}
//ScanOneImageType('tif'); {Tiff was not showing up in IE for some reason}
//ScanOneImageType('tiff'); {Tiff was not showing up in IE for some reason}
ScanOneImageType('png');
end;
end;
procedure TUploadForm.PolTimerTimer(Sender: TObject);
begin
PolTimer.Enabled := false;
try
if Assigned(frmImages) and frmImages.AutoScanUpload.Checked then begin
ScanAndHandleImages; //create metadata for images (if not done already)
ScanAndHandleImgTxt; //process upload file, based on metadata
end;
finally
PolTimer.Enabled := true;
PolTimer.Interval := PolInterval;
end;
end;
end.