1 | //kt -- Modified with SourceScanner on 8/7/2007
|
---|
2 | unit UploadImages;
|
---|
3 |
|
---|
4 | interface
|
---|
5 |
|
---|
6 | uses
|
---|
7 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
---|
8 | Dialogs, StdCtrls, Buttons, ExtCtrls, pngimage, ExtDlgs, OleCtrls,
|
---|
9 | uCore,
|
---|
10 | SHDocVw, DKLang;
|
---|
11 |
|
---|
12 | type
|
---|
13 |
|
---|
14 | TImageInfo = class
|
---|
15 | private
|
---|
16 | public
|
---|
17 | TIUIEN : int64; //IEN in file# 8925
|
---|
18 | DFN : AnsiString; //IEN in Patient File (#2)
|
---|
19 | UploadDUZ : int64; //IEN in NEW PERSON file
|
---|
20 | ThumbFPathName : AnsiString; // local file path name
|
---|
21 | ImageFPathName : AnsiString; // local file path name
|
---|
22 | ServerPath : AnsiString;
|
---|
23 | ServerFName : AnsiString;
|
---|
24 | ServerThumbFName: AnsiString;
|
---|
25 | ShortDesc : String[60];
|
---|
26 | Extension : String[16];
|
---|
27 | ImageDateTime : AnsiString;
|
---|
28 | UploadDateTime: AnsiString;
|
---|
29 | ObjectType : int64; //pointer to file 2005.02
|
---|
30 | ProcName : String[10]; //server limit is 10 chars.
|
---|
31 | pLongDesc : TStrings; //Won't be owned by this list
|
---|
32 | procedure Assign(Source : TImageInfo);
|
---|
33 | procedure Clear;
|
---|
34 | end;
|
---|
35 |
|
---|
36 | TAutoUploadNote = class
|
---|
37 | private
|
---|
38 | public
|
---|
39 | TIUIEN : int64; //IEN in file# 8925
|
---|
40 | ErrMsg : AnsiString;
|
---|
41 | NoteTitle : AnsiString; //Title of note to be associated with image
|
---|
42 | Patient : TPatient;
|
---|
43 | ImageInfo : TImageInfo;
|
---|
44 | Location : AnsiString; //Location that image if from
|
---|
45 | DOS : AnsiString; //Date of service
|
---|
46 | Provider : AnsiString;
|
---|
47 | CurNoteImages: TStringList;
|
---|
48 | UploadError : Boolean;
|
---|
49 | procedure SetDFN(var ChartNum,Location,FName,LName,MName,DOB,Sex : string);
|
---|
50 | Procedure SetInfo(var DOS,Provider,Location,Title : string);
|
---|
51 | function SameAs(OtherNote: TAutoUploadNote): boolean;
|
---|
52 | procedure MakeNewBlankNote(DFN,DOS,Provider,Location,Title : string);
|
---|
53 | procedure InitFrom(OtherNote: TAutoUploadNote);
|
---|
54 | function IsValid : boolean;
|
---|
55 | procedure Clear;
|
---|
56 | constructor Create();
|
---|
57 | destructor Destroy; override;
|
---|
58 | end;
|
---|
59 |
|
---|
60 | type
|
---|
61 | TUploadForm = class(TForm)
|
---|
62 | OpenFileDialog: TOpenDialog;
|
---|
63 | Image1: TImage;
|
---|
64 | PickImagesButton: TBitBtn;
|
---|
65 | Label1: TLabel;
|
---|
66 | CancelButton: TBitBtn;
|
---|
67 | UploadButton: TBitBtn;
|
---|
68 | Label2: TLabel;
|
---|
69 | Label4: TLabel;
|
---|
70 | ShortDescEdit: TEdit;
|
---|
71 | LongDescMemo: TMemo;
|
---|
72 | Label3: TLabel;
|
---|
73 | Label5: TLabel;
|
---|
74 | DateTimeEdit: TEdit;
|
---|
75 | ClearImagesButton: TBitBtn;
|
---|
76 | OpenDialog: TOpenPictureDialog;
|
---|
77 | FilesToUploadList: TListBox;
|
---|
78 | NoteEdit: TEdit;
|
---|
79 | PickOtherButton: TBitBtn;
|
---|
80 | pnlIEHolder: TPanel;
|
---|
81 | WebBrowser: TWebBrowser;
|
---|
82 | Label6: TLabel;
|
---|
83 | MoveCheckBox: TCheckBox;
|
---|
84 | PolTimer: TTimer;
|
---|
85 | DKLanguageController1: TDKLanguageController;
|
---|
86 | btnPickPDF: TBitBtn;
|
---|
87 | procedure UploadButtonClick(Sender: TObject);
|
---|
88 | procedure PickImagesButtonClick(Sender: TObject);
|
---|
89 | procedure FormShow(Sender: TObject);
|
---|
90 | procedure ShortDescEditChange(Sender: TObject);
|
---|
91 | procedure ClearImagesButtonClick(Sender: TObject);
|
---|
92 | procedure FormCreate(Sender: TObject);
|
---|
93 | procedure FormDestroy(Sender: TObject);
|
---|
94 | procedure FilesToUploadListClick(Sender: TObject);
|
---|
95 | procedure PickOtherButtonClick(Sender: TObject);
|
---|
96 | procedure FormRefresh(Sender: TObject);
|
---|
97 | procedure PolTimerTimer(Sender: TObject);
|
---|
98 | procedure btnPickPDFClick(Sender: TObject);
|
---|
99 | procedure FormHide(Sender: TObject);
|
---|
100 | private
|
---|
101 | { Private declarations }
|
---|
102 | Bitmap : TBitmap;
|
---|
103 | Picture : TPicture;
|
---|
104 | FAllowNonImages : boolean;
|
---|
105 | FUploadedImagesList : TStringList; //List of strings of images succesfully uploaded.
|
---|
106 | function MakeThumbNail(Info: TImageInfo): boolean;
|
---|
107 |
|
---|
108 | procedure LoadNotesEdit();
|
---|
109 | //procedure LoadNotesList();
|
---|
110 | function UploadFile(Info: TImageInfo; DelOrig : boolean): boolean;
|
---|
111 | function CopyFileToTemp(FNamePath : string) : string;
|
---|
112 | procedure UploadChosenFiles();
|
---|
113 | function ProcessOneLine(Line : string) : string;
|
---|
114 | function ProcessOneFile(FileName : string) : boolean;
|
---|
115 | procedure ScanAndHandleImgTxt;
|
---|
116 | procedure ScanAndHandleImages;
|
---|
117 | procedure DecodeImgTxt(Line : string; out ChartNum, Location,
|
---|
118 | FName, LName, MName, Sex, DOB, DOS, Provider,
|
---|
119 | Title : string; FilePaths : TStrings);
|
---|
120 | function EncodeImgTxt(ChartNum, Location, FName, LName, MName, Sex, DOB,
|
---|
121 | DOS, Provider, Title : string; FilePaths : TStrings) : AnsiString;
|
---|
122 | procedure FinishDocument(UploadNote : TAutoUploadNote);
|
---|
123 | procedure SetAllowNonImages(Value : boolean);
|
---|
124 | public
|
---|
125 | { Public declarations }
|
---|
126 | FScanDir : String;
|
---|
127 | PolInterval : integer;
|
---|
128 | procedure SetScanDir(NewDir : string);
|
---|
129 | published
|
---|
130 | property ScanDir : String read FScanDir write SetScanDir;
|
---|
131 | property UploadedImages : TStringList read FUploadedImagesList;
|
---|
132 | property AllowNonImages : boolean read FAllowNonImages write SetAllowNonImages;
|
---|
133 | end;
|
---|
134 |
|
---|
135 | var
|
---|
136 | UploadForm: TUploadForm;
|
---|
137 |
|
---|
138 | implementation
|
---|
139 |
|
---|
140 | {$R *.dfm}
|
---|
141 |
|
---|
142 | uses fNotes,
|
---|
143 | StrUtils, //for MidStr etc.
|
---|
144 | ORFn, //for PIECE etc.
|
---|
145 | Trpcb, //for .PType enum
|
---|
146 | fImages, //for upload/download files etc.
|
---|
147 | //Targa, //for TGA graphic save
|
---|
148 | ORNet, //for RPCBrokerV
|
---|
149 | rTIU,
|
---|
150 | rHTMLTools,
|
---|
151 | fImagePickPDF, //for PDF picker dialog
|
---|
152 | uTMGOptions
|
---|
153 | ;
|
---|
154 |
|
---|
155 | // const
|
---|
156 | // DefShortDesc = '(Short Image Description)'; <-- original line. //kt 8/7/2007
|
---|
157 |
|
---|
158 | type
|
---|
159 | TFileInfo = class
|
---|
160 | private
|
---|
161 | public
|
---|
162 | SrcRec : TSearchRec;
|
---|
163 | STimeStamp : String;
|
---|
164 | SBarCode : String;
|
---|
165 | FPath : String;
|
---|
166 | MetaFileName : String;
|
---|
167 | MetaFileExists : boolean;
|
---|
168 | BatchCount : integer;
|
---|
169 | procedure Assign(Source: TFileInfo);
|
---|
170 | procedure Clear;
|
---|
171 | end;
|
---|
172 |
|
---|
173 | var
|
---|
174 | DefShortDesc : string; //kt
|
---|
175 | AutoUploadNote : TAutoUploadNote;
|
---|
176 |
|
---|
177 |
|
---|
178 | procedure SetupVars;
|
---|
179 | begin
|
---|
180 | DefShortDesc := DKLangConstW('UploadImages_xShort_Image_Descriptionx'); //kt added 8/7/2007
|
---|
181 | end;
|
---|
182 |
|
---|
183 | //-------------------------------------------------------------------------
|
---|
184 | //-------------------------------------------------------------------------
|
---|
185 |
|
---|
186 | function NumPieces(const s: string; ADelim : Char) : integer;
|
---|
187 | var List : TStringList;
|
---|
188 | begin
|
---|
189 | List := TStringList.Create;
|
---|
190 | PiecesToList(S, ADelim, List);
|
---|
191 | Result := List.Count;
|
---|
192 | end;
|
---|
193 |
|
---|
194 | //-------------------------------------------------------------------------
|
---|
195 | //-------------------------------------------------------------------------
|
---|
196 | procedure TFileInfo.Assign(Source: TFileInfo);
|
---|
197 | begin
|
---|
198 | SrcRec := Source.SrcRec;
|
---|
199 | STimeStamp := Source.STimeStamp;
|
---|
200 | SBarCode := Source.SBarCode;
|
---|
201 | FPath := Source.FPath;
|
---|
202 | BatchCount := Source.BatchCount;
|
---|
203 | MetaFileName := Source.MetaFileName;
|
---|
204 | MetaFileExists := Source.MetaFileExists;
|
---|
205 | end;
|
---|
206 |
|
---|
207 | procedure TFileInfo.Clear;
|
---|
208 | begin
|
---|
209 | //SrcRec := ... //Note sure how to clear this. Will leave as is...
|
---|
210 | STimeStamp := '';
|
---|
211 | SBarCode := '';
|
---|
212 | FPath := '';
|
---|
213 | BatchCount := 0;
|
---|
214 | MetaFileName := '';
|
---|
215 | MetaFileExists := false;
|
---|
216 | end;
|
---|
217 |
|
---|
218 | //-------------------------------------------------------------------------
|
---|
219 | //-------------------------------------------------------------------------
|
---|
220 | procedure TImageInfo.Assign(Source : TImageInfo);
|
---|
221 | begin
|
---|
222 | TIUIEN := Source.TIUIEN;
|
---|
223 | DFN := Source.DFN;
|
---|
224 | UploadDUZ := Source.UploadDUZ;
|
---|
225 | ThumbFPathName := Source.ThumbFPathName;
|
---|
226 | ImageFPathName := Source.ImageFPathName;
|
---|
227 | ServerPath := Source.ServerPath;
|
---|
228 | ServerFName := Source.ServerFName;
|
---|
229 | ServerThumbFName := Source.ServerThumbFName;
|
---|
230 | ShortDesc := Source.ShortDesc;
|
---|
231 | Extension := Source.Extension;
|
---|
232 | ImageDateTime := Source.ImageDateTime;
|
---|
233 | UploadDateTime := Source.UploadDateTime;
|
---|
234 | ObjectType := Source.ObjectType;
|
---|
235 | ProcName := Source.ProcName;
|
---|
236 | pLongDesc := Source.pLongDesc; //this is only a pointer to object owned elsewhere
|
---|
237 | end;
|
---|
238 |
|
---|
239 | procedure TImageInfo.Clear;
|
---|
240 | begin
|
---|
241 | TIUIEN := 0;
|
---|
242 | DFN := '';
|
---|
243 | UploadDUZ := 0;
|
---|
244 | ThumbFPathName := '';
|
---|
245 | ImageFPathName := '';
|
---|
246 | ServerPath := '';
|
---|
247 | ServerFName := '';
|
---|
248 | ServerThumbFName := '';
|
---|
249 | ShortDesc := '';
|
---|
250 | Extension := '';
|
---|
251 | ImageDateTime := '';
|
---|
252 | UploadDateTime:= '';
|
---|
253 | ObjectType :=0;
|
---|
254 | ProcName := '';
|
---|
255 | pLongDesc := nil
|
---|
256 | end;
|
---|
257 |
|
---|
258 | //-------------------------------------------------------------------------
|
---|
259 | //-------------------------------------------------------------------------
|
---|
260 | procedure TAutoUploadNote.SetDFN(var ChartNum,Location,FName,LName,MName,DOB,Sex : string);
|
---|
261 | var RPCResult : AnsiString;
|
---|
262 | PMS : AnsiString;
|
---|
263 | begin
|
---|
264 | //Notice: ChartNum, and PMS are optional. If PMS is 1,2,or 3, then ChartNum
|
---|
265 | // is used to look up patient. Otherwise a lookup is based on just
|
---|
266 | // Name, DOB, Sex.
|
---|
267 | // To NOT use ChartNum, just set the values to ''
|
---|
268 | //
|
---|
269 | //Note: If LName is in form: `12345, then LName is used for DFN, and call
|
---|
270 | // to server for lookup is bypassed, and the values for FName,DOB etc
|
---|
271 | // are ignored
|
---|
272 |
|
---|
273 | if MidStr(LName,1,1)='`' then begin
|
---|
274 | Self.Patient.DFN := MidStr(LName,2,999);
|
---|
275 | end else begin
|
---|
276 | //**NOTE**: site-specific code
|
---|
277 | if Location ='Laughlin_Office' then PMS :='2'
|
---|
278 | else if Location ='Peds_Office' then PMS :='3'
|
---|
279 | else PMS := ''; //default
|
---|
280 |
|
---|
281 | RPCBrokerV.ClearParameters := true;
|
---|
282 | RPCBrokerV.remoteprocedure := 'TMG GET DFN';
|
---|
283 | RPCBrokerV.param[0].value := ChartNum; RPCBrokerV.param[0].ptype := literal;
|
---|
284 | RPCBrokerV.param[1].value := PMS; RPCBrokerV.Param[1].ptype := literal;
|
---|
285 | RPCBrokerV.param[2].value := FName; RPCBrokerV.Param[2].ptype := literal;
|
---|
286 | RPCBrokerV.param[3].value := LName; RPCBrokerV.Param[3].ptype := literal;
|
---|
287 | RPCBrokerV.param[4].value := MName; RPCBrokerV.Param[4].ptype := literal;
|
---|
288 | RPCBrokerV.param[5].value := DOB; RPCBrokerV.Param[5].ptype := literal;
|
---|
289 | RPCBrokerV.param[6].value := Sex; RPCBrokerV.Param[6].ptype := literal;
|
---|
290 | //RPCBrokerV.Call;
|
---|
291 | CallBroker;
|
---|
292 | RPCResult := RPCBrokerV.Results[0]; //returns: success: DFN; or error: -1^ErrMsg
|
---|
293 | if piece(RPCResult,'^',1) <> '-1' then begin
|
---|
294 | self.Patient.DFN := RPCResult;
|
---|
295 | end else begin
|
---|
296 | self.Patient.DFN := '';
|
---|
297 | end;
|
---|
298 | end;
|
---|
299 | end;
|
---|
300 |
|
---|
301 | Procedure TAutoUploadNote.SetInfo(var DOS,Provider,Location,Title : string);
|
---|
302 | //Just loads values into structure. No validation done.
|
---|
303 | begin
|
---|
304 | Self.DOS := DOS;
|
---|
305 | Self.Provider := Provider;
|
---|
306 | Self.Location := Location;
|
---|
307 | Self.NoteTitle := Title;
|
---|
308 | end;
|
---|
309 |
|
---|
310 | procedure TAutoUploadNote.InitFrom(OtherNote: TAutoUploadNote);
|
---|
311 | //Will create a blank note for itself.
|
---|
312 | begin
|
---|
313 | Patient.Assign(OtherNote.Patient);
|
---|
314 | ImageInfo.Assign(OtherNote.ImageInfo);
|
---|
315 | Location := OtherNote.Location;
|
---|
316 | DOS := OtherNote.DOS;
|
---|
317 | Provider := OtherNote.Provider;
|
---|
318 | NoteTitle := OtherNote.NoteTitle;
|
---|
319 | CurNoteImages.Assign(OtherNote.CurNoteImages);
|
---|
320 | MakeNewBlankNote(Patient.DFN,DOS,Provider,Location,NoteTitle);
|
---|
321 | end;
|
---|
322 |
|
---|
323 | procedure TAutoUploadNote.MakeNewBlankNote(DFN,DOS,Provider,Location,Title : string);
|
---|
324 | var RPCResult : string;
|
---|
325 | begin
|
---|
326 | RPCResult := '';
|
---|
327 | Self.ErrMsg := ''; //default to no error messages
|
---|
328 |
|
---|
329 | RPCBrokerV.ClearParameters := true;
|
---|
330 | RPCBrokerV.remoteprocedure := 'TMG GET BLANK TIU DOCUMENT';
|
---|
331 | RPCBrokerV.param[0].value := '`'+DFN; RPCBrokerV.param[0].ptype := literal;
|
---|
332 | RPCBrokerV.param[1].value := Provider; RPCBrokerV.Param[1].ptype := literal;
|
---|
333 | RPCBrokerV.param[2].value := Location; RPCBrokerV.Param[2].ptype := literal;
|
---|
334 | RPCBrokerV.param[3].value := DOS; RPCBrokerV.Param[3].ptype := literal;
|
---|
335 | RPCBrokerV.param[4].value := Title; RPCBrokerV.Param[4].ptype := literal;
|
---|
336 | //RPCBrokerV.Call;
|
---|
337 | CallBroker;
|
---|
338 | RPCResult := RPCBrokerV.Results[0];
|
---|
339 | try
|
---|
340 | TIUIEN := StrToInt64(Piece(RPCResult,'^',1)); //returns: success: TIU IEN; or error: -1
|
---|
341 | except
|
---|
342 | on E: EConvertError do begin
|
---|
343 | Self.ErrMsg := 'WHILE CREATING BLANK NOTE FOR UPLOAD, ' +
|
---|
344 | 'ERROR CONVERTING: ' + RPCBrokerV.Results[0] + ' to document record #.';
|
---|
345 | TIUIEN := -1;
|
---|
346 | end
|
---|
347 | end;
|
---|
348 | If TIUIEN <> -1 then begin
|
---|
349 | Self.Patient.DFN := DFN;
|
---|
350 | Self.Provider := Provider;
|
---|
351 | Self.Location := Location;
|
---|
352 | Self.DOS := DOS;
|
---|
353 | end else begin
|
---|
354 | Self.ErrMsg := 'FAILED TO CREATE A BLANK NOTE FOR UPLOAD' +
|
---|
355 | ' ' + Piece(RPCResult,'^',2);
|
---|
356 | Self.UploadError := true;
|
---|
357 | end;
|
---|
358 | end;
|
---|
359 |
|
---|
360 | function TAutoUploadNote.IsValid : boolean;
|
---|
361 | begin
|
---|
362 | Result := true; //default to success.
|
---|
363 | if (Patient.DFN='') {or (TIUIEN < 1)} or (ErrMsg <> '') or (NoteTitle = '')
|
---|
364 | or (Location = '') or (DOS = '') or (Provider = '') then begin
|
---|
365 | Result := false
|
---|
366 | end;
|
---|
367 | end;
|
---|
368 |
|
---|
369 | procedure TAutoUploadNote.Clear;
|
---|
370 | begin
|
---|
371 | TIUIEN := 0;
|
---|
372 | if Patient <> nil then Patient.Clear;
|
---|
373 | if ImageInfo <> nil then ImageInfo.Clear;
|
---|
374 | Location := '';
|
---|
375 | DOS := '';
|
---|
376 | Provider := '';
|
---|
377 | NoteTitle := '';
|
---|
378 | UploadError := False;
|
---|
379 | if CurNoteImages <> nil then CurNoteImages.Clear;
|
---|
380 | end;
|
---|
381 |
|
---|
382 | function TAutoUploadNote.SameAs(OtherNote: TAutoUploadNote): boolean;
|
---|
383 | begin
|
---|
384 | Result := true;
|
---|
385 | if (OtherNote = nil) or (OtherNote.Patient = nil)
|
---|
386 | or (Patient.DFN <> OtherNote.Patient.DFN)
|
---|
387 | or (DOS <> OtherNote.DOS)
|
---|
388 | or (Provider <> OtherNote.Provider)
|
---|
389 | or (Location <> OtherNote.Location)
|
---|
390 | or (NoteTitle <> OtherNote.NoteTitle) then begin
|
---|
391 | Result := false;
|
---|
392 | end;
|
---|
393 | end;
|
---|
394 |
|
---|
395 | constructor TAutoUploadNote.Create;
|
---|
396 | begin
|
---|
397 | Self.TIUIEN := 0;
|
---|
398 | Self.Patient := TPatient.Create;
|
---|
399 | Self.CurNoteImages := TStringList.Create;
|
---|
400 | Self.ImageInfo := TImageInfo.Create;
|
---|
401 | Self.Clear;
|
---|
402 | end;
|
---|
403 |
|
---|
404 | destructor TAutoUploadNote.Destroy;
|
---|
405 | begin
|
---|
406 | self.patient.free;
|
---|
407 | Self.CurNoteImages.Free;
|
---|
408 | Self.ImageInfo.Free;
|
---|
409 | end;
|
---|
410 |
|
---|
411 | //-------------------------------------------------------------------------
|
---|
412 | //-------------------------------------------------------------------------
|
---|
413 | function TUploadForm.MakeThumbNail(Info: TImageInfo) : boolean;
|
---|
414 | //This takes Info.ImageFPathName and creates a 64x64 .bmp file with
|
---|
415 | //this same name, and saves in cache directory.
|
---|
416 | //saves name of this thumbnail in info.ThumbFPathName
|
---|
417 |
|
---|
418 | var
|
---|
419 | Rect : TRect;
|
---|
420 | ThumbFName : AnsiString;
|
---|
421 | begin
|
---|
422 | Rect.Top := 0; Rect.Left:=0; Rect.Right:=63; Rect.Bottom:=63;
|
---|
423 | result := false; //default of failure
|
---|
424 | try
|
---|
425 | Picture.LoadFromFile(Info.ImageFPathName);
|
---|
426 | Bitmap.Canvas.StretchDraw(Rect,Picture.Graphic);
|
---|
427 | ThumbFName := frmImages.CacheDir + '\Thumb-' + ExtractFileName(Info.ImageFPathName);
|
---|
428 | ThumbFName := ChangeFileExt(ThumbFName,'.bmp');
|
---|
429 | Bitmap.SaveToFile(ThumbFName); //save to local cache (for upload)
|
---|
430 | Info.ThumbFPathName := ThumbFName; //pass info back out.
|
---|
431 | Info.ServerThumbFName := ChangeFileExt(Info.ServerFName,'.ABS'); //format is .bmp
|
---|
432 | result := true
|
---|
433 | except
|
---|
434 | on E: Exception do exit;
|
---|
435 | end;
|
---|
436 | end;
|
---|
437 |
|
---|
438 |
|
---|
439 | function TUploadForm.UploadFile(Info: TImageInfo; DelOrig : boolean): boolean;
|
---|
440 | //result: true if success, false if failure
|
---|
441 | var
|
---|
442 | RPCResult,index : AnsiString;
|
---|
443 | ImageIEN : AnsiString;
|
---|
444 | MsgNum : AnsiString;
|
---|
445 | ErrorMsg : AnsiString;
|
---|
446 | i : integer;
|
---|
447 | CacheFPathName, tempFName : string;
|
---|
448 |
|
---|
449 | begin
|
---|
450 | RPCBrokerV.remoteprocedure := 'MAGGADDIMAGE';
|
---|
451 | RPCBrokerV.Param[0].Value := '.X';
|
---|
452 | RPCBrokerV.Param[0].PType := list;
|
---|
453 | RPCBrokerV.Param[0].Mult['"NETLOCABS"'] := 'ABS^STUFFONLY';
|
---|
454 | RPCBrokerV.Param[0].Mult['"magDFN"'] := '5^' + Info.DFN; {patient dfn}
|
---|
455 | RPCBrokerV.Param[0].Mult['"DATETIME"'] := '7^NOW'; {date/time image collected}
|
---|
456 | RPCBrokerV.Param[0].Mult['"DATETIMEPROC"'] := '15^' + Info.ImageDateTime; {Date/Time of Procedure}
|
---|
457 | if Info.ProcName <> '' then
|
---|
458 | RPCBrokerV.Param[0].Mult['"PROC"'] := '6^' + Info.ProcName; {procedure}
|
---|
459 | RPCBrokerV.Param[0].Mult['"DESC"'] := '10^(Hard coded Short Description)'; {image description}
|
---|
460 | if Info.ShortDesc <> '' then
|
---|
461 | RPCBrokerV.Param[0].Mult['"DESC"'] := '10^' + Info.ShortDesc; {image description}
|
---|
462 | RPCBrokerV.Param[0].Mult['"DUZ"'] := '8^' + IntToStr(Info.UploadDUZ); {Duz}
|
---|
463 |
|
---|
464 | //The field (#14) below is used for images that are part of a group,
|
---|
465 | //for example a CT exam might contain 30 images. This field
|
---|
466 | //contains a pointer back to the Image file (2005), to the
|
---|
467 | //object whose type is "GROUP" that points to this object as
|
---|
468 | //a member of its group. A pointer to this object will be
|
---|
469 | //found in the Object Group multiple of the parent GROUP
|
---|
470 | //object.
|
---|
471 | //RPCBrokerV.Param[0].Mult['"GROUP"'] := '14^' + group;
|
---|
472 |
|
---|
473 | RPCBrokerV.Param[0].Mult['"OBJTYPE"'] := '3^' + IntToStr(Info.ObjectType);
|
---|
474 | RPCBrokerV.Param[0].Mult['"FileExt"'] := 'EXT^' + Info.Extension;
|
---|
475 |
|
---|
476 | if assigned(Info.pLongDesc) then begin
|
---|
477 | for i := 0 to Info.pLongDesc.Count - 1 do begin
|
---|
478 | index := IntToStr(i);
|
---|
479 | while length(index) < 3 do index := '0' + index;
|
---|
480 | index :='"LongDescr' + index + '"';
|
---|
481 | RPCBrokerV.Param[0].Mult[index] := '11^' + Info.pLongDesc.Strings[i];
|
---|
482 | end;
|
---|
483 | end;
|
---|
484 |
|
---|
485 | //RPCResult := RPCBrokerV.STRcall; { returns ImageIEN^directory/filename }
|
---|
486 | CallBroker;
|
---|
487 | if RPCBrokerV.Results.Count>0 then RPCResult := RPCBrokerV.Results.Strings[0];
|
---|
488 |
|
---|
489 | ImageIEN := Piece(RPCResult,'^',1);
|
---|
490 | result := ((ImageIEN <> '0') and (ImageIEN <> '')); // function result.
|
---|
491 | if result=false then begin
|
---|
492 | ErrorMsg :=DKLangConstW('UploadImages_Server_Error_xx_Couldnxxt_store_image_information'); //kt added 8/7/2007
|
---|
493 | MessageDlg(ErrorMsg,mtWarning,[mbOK],0);
|
---|
494 | end;
|
---|
495 | if result then begin
|
---|
496 | Info.ServerPath := Piece(RPCResult,'^',2);
|
---|
497 | Info.ServerFName := Piece(RPCResult,'^',3);
|
---|
498 | result := frmImages.UploadFile(Info.ImageFPathName,Info.ServerPath,Info.ServerFName,1,1);
|
---|
499 | if result=false then begin
|
---|
500 | ErrorMsg :=DKLangConstW('UploadImages_Error_uploading_image_to_server'); //kt added 8/7/2007
|
---|
501 | MessageDlg(ErrorMsg,mtWarning,[mbCancel],0);
|
---|
502 | end;
|
---|
503 | if result then begin
|
---|
504 | RPCBrokerV.remoteprocedure := 'MAG3 TIU IMAGE';
|
---|
505 | RPCBrokerV.param[0].ptype := literal;
|
---|
506 | RPCBrokerV.param[0].value := ImageIEN;
|
---|
507 | RPCBrokerV.Param[1].ptype := literal;
|
---|
508 | RPCBrokerV.param[1].value := IntToStr(Info.TIUIEN);
|
---|
509 | //RPCBrokerV.Call;
|
---|
510 | CallBroker;
|
---|
511 | RPCResult := RPCBrokerV.Results[0];
|
---|
512 | //returns: success: 1^message; or error: 0^error message
|
---|
513 | MsgNum := Piece(RPCResult,'^',1);
|
---|
514 | result := (MsgNum = '1');
|
---|
515 | if result=false then begin
|
---|
516 | ErrorMsg :=DKLangConstW('UploadImages_Error_associating_image_with_notex') + #13 + Piece(RPCResult,'^',2); //kt added 8/7/2007
|
---|
517 | MessageDlg(ErrorMsg,mtWarning,[mbCancel],0);
|
---|
518 | end;
|
---|
519 | end;
|
---|
520 | if (result=false) then exit;
|
---|
521 | //Copy the file into the cache directory, so that we don't have to turn around and download it again.
|
---|
522 | CacheFPathName := rHTMLTools.CPRSDir + '\cache\' + ExtractFileName (Info.ServerFName);
|
---|
523 | if not FileExists(CacheFPathName) then begin
|
---|
524 | tempFName := Info.ImageFPathName;
|
---|
525 | CopyFile(PChar(tempFName),PChar(CacheFPathName),FALSE);
|
---|
526 | end;
|
---|
527 | if (MoveCheckBox.Checked) then begin
|
---|
528 | DeleteFile(Info.ImageFPathName);
|
---|
529 | end;
|
---|
530 | if MakeThumbNail(Info) then begin;
|
---|
531 | result := frmImages.UploadFile(Info.ThumbFPathName,Info.ServerPath,Info.ServerThumbFName,1,1);
|
---|
532 | if result=false then begin
|
---|
533 | ErrorMsg :=DKLangConstW('UploadImages_Error_sending_thumbnail_image_to_serverx'); //kt added 8/7/2007
|
---|
534 | MessageDlg(ErrorMsg,mtWarning,[mbOK],0);
|
---|
535 | end;
|
---|
536 | CacheFPathName := rHTMLTools.CPRSDir + '\cache\' + ExtractFileName (Info.ServerFName);
|
---|
537 | if not FileExists(CacheFPathName) then begin
|
---|
538 | CopyFile(PChar(Info.ImageFPathName),PChar(CacheFPathName),FALSE);
|
---|
539 | end;
|
---|
540 | if DelOrig=true then begin
|
---|
541 | DeleteFile(Info.ImageFPathName);
|
---|
542 | end;
|
---|
543 | end;
|
---|
544 | end;
|
---|
545 | //returns: result
|
---|
546 | end;
|
---|
547 |
|
---|
548 |
|
---|
549 |
|
---|
550 | procedure TUploadForm.UploadChosenFiles();
|
---|
551 | var i : integer;
|
---|
552 | Info: TImageInfo;
|
---|
553 |
|
---|
554 | begin
|
---|
555 | SetupVars;
|
---|
556 | Info := TImageInfo.Create();
|
---|
557 | Info.pLongDesc := nil;
|
---|
558 |
|
---|
559 | //Load up info class/record
|
---|
560 | Info.ShortDesc := MidStr(ShortDescEdit.Text,1,60);
|
---|
561 | if Info.ShortDesc = DefShortDesc then Info.ShortDesc := ' ';
|
---|
562 | Info.UploadDUZ := User.DUZ;
|
---|
563 | if LongDescMemo.Lines.Count>0 then begin
|
---|
564 | Info.pLongDesc := LongDescMemo.Lines;
|
---|
565 | end;
|
---|
566 | Info.ObjectType := 1; //type 1 is Still Image (jpg). OK to use with .bmp??
|
---|
567 | Info.ProcName := 'Picture'; //max length is 10 characters
|
---|
568 | Info.ImageDateTime := DateTimeEdit.Text;
|
---|
569 | Info.TIUIEN := frmNotes.lstNotes.ItemID;
|
---|
570 | Info.UploadDateTime := 'NOW';
|
---|
571 | Info.DFN := Patient.DFN;
|
---|
572 |
|
---|
573 | for i:= 0 to FilesToUploadList.Items.Count-1 do begin
|
---|
574 | Info.ImageFPathName := FilesToUploadList.Items.Strings[i];
|
---|
575 | Info.Extension := ExtractFileExt(Info.ImageFPathName); //includes '.'
|
---|
576 | Info.Extension := MidStr(Info.Extension,2,17); //remove '.'
|
---|
577 |
|
---|
578 | if UploadFile(Info,MoveCheckBox.Checked) then begin //Upload function passes back filename info in Info class
|
---|
579 | FUploadedImagesList.Add(Info.ServerFName);
|
---|
580 | end else begin
|
---|
581 | //Application.MessageBox('Error uploading image file!','Error');
|
---|
582 | end;
|
---|
583 | end;
|
---|
584 | Info.Free;
|
---|
585 | end;
|
---|
586 |
|
---|
587 | procedure TUploadForm.LoadNotesEdit();
|
---|
588 | begin
|
---|
589 | NoteEdit.Text := frmNotes.tvNotes.Selected.Text;
|
---|
590 | end;
|
---|
591 |
|
---|
592 | {
|
---|
593 | procedure TUploadForm.LoadNotesList();
|
---|
594 | var
|
---|
595 | NoteInfo,s,dateS : AnsiString;
|
---|
596 | i : integer;
|
---|
597 | const
|
---|
598 | U='^';
|
---|
599 | begin
|
---|
600 | NoteComboBox.Items.Clear;
|
---|
601 |
|
---|
602 | for i := 0 to frmNotes.lstNotes.Count-1 do with frmNotes.lstNotes do begin
|
---|
603 | NoteInfo := Items[i];
|
---|
604 | (* example NoteInfo:
|
---|
605 | piece# 1: 14321^ //TIU IEN
|
---|
606 | piece# 2: PRESCRIPTION CALL IN^ //Document Title
|
---|
607 | piece# 3: 3050713.0947^ //Date/Time
|
---|
608 | piece# 4: TEST, KILLME D (T0101)^ //Patient
|
---|
609 | piece# 5: 133;JANE A DOE;DOE,JANE A^ //Author
|
---|
610 | piece# 6: Main_Office^ //Location of Visit
|
---|
611 | piece# 7: completed^ //Status of Document
|
---|
612 | piece# 8: Visit: 07/13/05;3050713.094721^ //Date/Time
|
---|
613 | piece# 9...: ;^^1^^^1^' //?
|
---|
614 | *)
|
---|
615 | dateS := Piece(Piece(NoteInfo, U, 8), ';', 2);
|
---|
616 | s := FormatFMDateTime('mmm dd,yy@hh:nn', MakeFMDateTime(dateS)) + ' -- ';
|
---|
617 | // s := Piece(Piece(NoteInfo, U, 8), ';', 1) + ' -- ';
|
---|
618 | s := s + Piece(NoteInfo, U, 2) + '; ';
|
---|
619 | s := s + 'Author: ' + Piece(Piece(NoteInfo, U, 5), ';', 2) + ', ';
|
---|
620 | s := s + Piece(NoteInfo, U, 6);
|
---|
621 | NoteComboBox.Items.Add(s);
|
---|
622 | end;
|
---|
623 | NoteComboBox.ItemIndex := frmNotes.lstNotes.ItemIndex;
|
---|
624 | end;
|
---|
625 | }
|
---|
626 | //Delphi events etc.------------------------------------------------
|
---|
627 |
|
---|
628 | procedure TUploadForm.UploadButtonClick(Sender: TObject);
|
---|
629 | begin
|
---|
630 | try
|
---|
631 | WebBrowser.Navigate(frmImages.NullImageName);
|
---|
632 | sleep(500); //Give Webbrowser time to release any browsed document.
|
---|
633 | except
|
---|
634 | on E: Exception do exit;
|
---|
635 | end;
|
---|
636 | UploadChosenFiles();
|
---|
637 | //note This UploadButton has .ModalResult = mrOK, so form is closed after this.
|
---|
638 | end;
|
---|
639 |
|
---|
640 | procedure TUploadForm.PickImagesButtonClick(Sender: TObject);
|
---|
641 | var i : integer;
|
---|
642 | begin
|
---|
643 | If OpenDialog.Execute then begin
|
---|
644 | for i := 0 to OpenDialog.Files.Count-1 do begin
|
---|
645 | FilesToUploadList.Items.Add(OpenDialog.Files.Strings[i]);
|
---|
646 | end;
|
---|
647 | end;
|
---|
648 | end;
|
---|
649 |
|
---|
650 | procedure TUploadForm.PickOtherButtonClick(Sender: TObject);
|
---|
651 | var i : integer;
|
---|
652 | begin
|
---|
653 | If OpenFileDialog.Execute then begin
|
---|
654 | for i := 0 to OpenFileDialog.Files.Count-1 do begin
|
---|
655 | FilesToUploadList.Items.Add(OpenFileDialog.Files.Strings[i]);
|
---|
656 | end;
|
---|
657 | end;
|
---|
658 | end;
|
---|
659 |
|
---|
660 | procedure TUploadForm.btnPickPDFClick(Sender: TObject);
|
---|
661 | var i : integer;
|
---|
662 | begin
|
---|
663 | if not Assigned(frmImagePickPDF) then begin
|
---|
664 | frmImagePickPDF := TfrmImagePickPDF.Create(Self); //free'd in OnHide
|
---|
665 | end;
|
---|
666 | if frmImagePickPDF.Execute then begin
|
---|
667 | for i := 0 to frmImagePickPDF.Files.Count-1 do begin
|
---|
668 | FilesToUploadList.Items.Add(frmImagePickPDF.Files.Strings[i]);
|
---|
669 | end;
|
---|
670 | end;
|
---|
671 | end;
|
---|
672 |
|
---|
673 | procedure TUploadForm.FormShow(Sender: TObject);
|
---|
674 | begin
|
---|
675 | FormRefresh(self);
|
---|
676 | FilesToUploadList.Items.Clear;
|
---|
677 | FUploadedImagesList.Clear;
|
---|
678 | LoadNotesEdit();
|
---|
679 | SetupVars;
|
---|
680 | ShortDescEdit.Text := DefShortDesc;
|
---|
681 | end;
|
---|
682 |
|
---|
683 | procedure TUploadForm.ShortDescEditChange(Sender: TObject);
|
---|
684 | begin
|
---|
685 | if Length(ShortDescEdit.Text)> 60 then begin
|
---|
686 | ShortDescEdit.Text := MidStr(ShortDescEdit.Text,1,60);
|
---|
687 | end;
|
---|
688 | end;
|
---|
689 |
|
---|
690 | procedure TUploadForm.ClearImagesButtonClick(Sender: TObject);
|
---|
691 | begin
|
---|
692 | FilesToUploadList.Items.Clear;
|
---|
693 | FilesToUploadListClick(self);
|
---|
694 | end;
|
---|
695 |
|
---|
696 | procedure TUploadForm.FormCreate(Sender: TObject);
|
---|
697 | begin
|
---|
698 | Bitmap := TBitmap.Create;
|
---|
699 | Bitmap.Height := 64;
|
---|
700 | Bitmap.Width := 64;
|
---|
701 | Picture := TPicture.Create;
|
---|
702 | FAllowNonImages := true;
|
---|
703 | FUploadedImagesList := TStringList.Create;
|
---|
704 |
|
---|
705 | AutoUploadNote := TAutoUploadNote.Create;
|
---|
706 | FScanDir := uTMGOptions.ReadString('Pol Directory','??');
|
---|
707 | if FScanDir='??' then begin
|
---|
708 | FScanDir := ExtractFileDir(Application.ExeName);
|
---|
709 | uTMGOptions.WriteString('Pol Directory',FScanDir);
|
---|
710 | end;
|
---|
711 | PolInterval := uTMGOptions.ReadInteger('Pol Interval (milliseconds)',0);
|
---|
712 | if PolInterval=0 then begin
|
---|
713 | PolInterval := 60000;
|
---|
714 | uTMGOptions.WriteInteger('Pol Interval (milliseconds)',PolInterval);
|
---|
715 | end;
|
---|
716 | end;
|
---|
717 |
|
---|
718 | procedure TUploadForm.SetScanDir(NewDir : string);
|
---|
719 | begin
|
---|
720 | if DirectoryExists(NewDir) then begin
|
---|
721 | FScanDir := NewDir;
|
---|
722 | uTMGOptions.WriteString('Pol Directory',FScanDir);
|
---|
723 | end;
|
---|
724 | end;
|
---|
725 |
|
---|
726 | procedure TUploadForm.FormDestroy(Sender: TObject);
|
---|
727 | begin
|
---|
728 | Bitmap.Free;
|
---|
729 | Picture.Free;
|
---|
730 | FUploadedImagesList.Free;
|
---|
731 | end;
|
---|
732 |
|
---|
733 | procedure TUploadForm.FilesToUploadListClick(Sender: TObject);
|
---|
734 | var
|
---|
735 | FileName: AnsiString;
|
---|
736 | SelectedItem: integer;
|
---|
737 | begin
|
---|
738 | SelectedItem := FilesToUploadList.ItemIndex;
|
---|
739 | if SelectedItem > -1 then begin
|
---|
740 | FileName := FilesToUploadList.Items[SelectedItem];
|
---|
741 | if UpperCase(ExtractFileExt(FileName))='.PDF' then begin
|
---|
742 | FileName := CopyFileToTemp(FileName); //returns '' if copy fails
|
---|
743 | if FileName = '' then FileName := frmImages.NullImageName;
|
---|
744 | end;
|
---|
745 | end else begin
|
---|
746 | FileName := frmImages.NullImageName;
|
---|
747 | end;
|
---|
748 | try
|
---|
749 | WebBrowser.Navigate(FileName);
|
---|
750 | except
|
---|
751 | on E: Exception do exit;
|
---|
752 | end;
|
---|
753 | end;
|
---|
754 |
|
---|
755 | function TUploadForm.CopyFileToTemp(FNamePath : string) : string;
|
---|
756 | var DestFile : string;
|
---|
757 | lpDestFile : PAnsiChar;
|
---|
758 | lpSourceFile : PAnsiChar;
|
---|
759 | begin
|
---|
760 | DestFile := frmImages.CacheDir + '\tempbrowseable' + ExtractFileExt(FNamePath);
|
---|
761 | lpDestFile := PAnsiChar(DestFile);
|
---|
762 | lpSourceFile := PAnsiChar(FNamePath);
|
---|
763 | if CopyFile(lpSourcefile,lpDestFile,LongBool(FALSE)) = TRUE then begin //0=success
|
---|
764 | Result := DestFile;
|
---|
765 | end else begin
|
---|
766 | Result := '';
|
---|
767 | end;
|
---|
768 | end;
|
---|
769 |
|
---|
770 | procedure TUploadForm.FormRefresh(Sender: TObject);
|
---|
771 | begin
|
---|
772 | try
|
---|
773 | WebBrowser.Navigate(frmImages.NullImageName);
|
---|
774 | except
|
---|
775 | on E: Exception do exit;
|
---|
776 | end;
|
---|
777 | end;
|
---|
778 |
|
---|
779 | procedure TUploadForm.FormHide(Sender: TObject);
|
---|
780 | begin
|
---|
781 | FormRefresh(Sender);
|
---|
782 | frmImagePickPDF.Free;
|
---|
783 | end;
|
---|
784 |
|
---|
785 | procedure TUploadForm.DecodeImgTxt(Line : string; out ChartNum, Location,
|
---|
786 | FName, LName, MName, Sex, DOB, DOS, Provider,
|
---|
787 | Title : string; FilePaths : TStrings);
|
---|
788 | //format of line is as follows:
|
---|
789 | //ChartNum^Location^FName^LName^MName^Sex^DOB^DOS^Provider^Title^FilePath(s)
|
---|
790 | //NOTE: To provide patient IEN instead of FName etc, use this format:
|
---|
791 | // ^Location^^`1234567^^^^DOS^Provider^Title^FilePath(s)
|
---|
792 | // i.e. `IEN (note ` is not an appostrophy ('))
|
---|
793 | // `IEN in place of LName, and leave blank: ChartNum,FName,FName,Sex,DOB
|
---|
794 |
|
---|
795 | var Files: String;
|
---|
796 | FileName : String;
|
---|
797 | num,i : integer;
|
---|
798 | begin
|
---|
799 | if Pos('}',Line)>0 then begin
|
---|
800 | Line := Piece(Line,'}',2); //If error message is present, still allow parse.
|
---|
801 | end;
|
---|
802 | ChartNum := Piece(Line,'^',1);
|
---|
803 | Location := Piece(Line,'^',2);
|
---|
804 | FName := Piece(Line,'^',3);
|
---|
805 | LName := Piece(Line,'^',4);
|
---|
806 | MName := Piece(Line,'^',5);
|
---|
807 | Sex := Piece(Line,'^',6);
|
---|
808 | DOB := Piece(Line,'^',7);
|
---|
809 | DOS := Piece(Line,'^',8);
|
---|
810 | Provider := Piece(Line,'^',9);
|
---|
811 | Title := Piece(Line,'^',10);
|
---|
812 | Files := Piece(Line,'^',11); //may be list of multiple files separated by ;
|
---|
813 | if Pos(';',Files)>0 then begin
|
---|
814 | num := NumPieces(Files,';');
|
---|
815 | for i := 1 to num do begin
|
---|
816 | FileName := piece(files,';',i);
|
---|
817 | if FileName <> '' then FilePaths.Add(FileName);
|
---|
818 | end;
|
---|
819 | end else begin
|
---|
820 | FilePaths.Add(Files);
|
---|
821 | end;
|
---|
822 |
|
---|
823 | end;
|
---|
824 |
|
---|
825 | function TUploadForm.EncodeImgTxt(ChartNum, Location, FName, LName, MName, Sex, DOB,
|
---|
826 | DOS, Provider, Title : string; FilePaths : TStrings) : AnsiString;
|
---|
827 | //format of line is as follows:
|
---|
828 | //ChartNum^Location^FName^LName^MName^Sex^DOB^DOS^Provider^Title^FilePath(s)
|
---|
829 | //NOTE: To provide patient IEN instead of FName etc, use this format:
|
---|
830 | // ^Location^^`1234567^^^^DOS^Provider^Title^FilePath(s)
|
---|
831 | // i.e. `IEN (note ` is not an appostrophy ('))
|
---|
832 | // `IEN in place of LName, and leave blank: ChartNum,FName,FName,Sex,DOB
|
---|
833 | var i : integer;
|
---|
834 | begin
|
---|
835 | Result := ChartNum + '^' + Location + '^' + FName + '^' + LName + '^' +
|
---|
836 | MName + '^' + Sex + '^' + DOB + '^' + DOS + '@01:00' + '^' + Provider + '^' +
|
---|
837 | Title + '^'; //added time of 1:00 elh 7/8/08
|
---|
838 | for i:= 0 to FilePaths.Count-1 do begin
|
---|
839 | Result := Result + FilePaths.Strings[i];
|
---|
840 | if i <> FilePaths.Count-1 then Result := Result + ';';
|
---|
841 | end;
|
---|
842 | end;
|
---|
843 |
|
---|
844 |
|
---|
845 | procedure TUploadForm.FinishDocument(UploadNote : TAutoUploadNote);
|
---|
846 | var Text : TStringList;
|
---|
847 | ErrMsg : String;
|
---|
848 | RPCResult : String;
|
---|
849 | i : integer;
|
---|
850 | oneImage: string;
|
---|
851 | //TIUIEN : int64;
|
---|
852 |
|
---|
853 | begin
|
---|
854 | if (UploadNote.TIUIEN>0) and (UploadNote.CurNoteImages.Count>0)
|
---|
855 | and (UploadNote.UploadError = False) then begin
|
---|
856 | //Add text for note: "See scanned image" --
|
---|
857 | // or later, some HTML code to show note in CPRS directly....
|
---|
858 | Text := TStringList.Create;
|
---|
859 | Text.Add('<!DOCTYPE HTML PUBLIC>');
|
---|
860 | Text.Add('<html>');
|
---|
861 | Text.Add('<head>');
|
---|
862 | Text.Add('<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">');
|
---|
863 | Text.Add('<title>VistA HTML Note</title>');
|
---|
864 | Text.Add('</head>');
|
---|
865 | Text.Add('<body>');
|
---|
866 | Text.Add('<p>');
|
---|
867 | Text.Add('Note created automatically from imported media.');
|
---|
868 | Text.Add('<p>');
|
---|
869 | for i := 0 to UploadNote.CurNoteImages.Count-1 do begin
|
---|
870 | // note: $CPRSDIR$ will be replaced at runtime with directory of CPRS
|
---|
871 | // This will be done as page is passed to TWebBrowser (in rHTMLTools)
|
---|
872 | oneImage := '$CPRSDIR$\Cache\' + UploadNote.CurNoteImages.Strings[i];
|
---|
873 | //oneImage := CacheDir + '\' + CurNoteImages.Strings[i];
|
---|
874 | Text.Add('<img WIDTH=640 src="'+oneImage+'">');
|
---|
875 | Text.Add('<p>');
|
---|
876 | end;
|
---|
877 | //Text.Add('<small>');
|
---|
878 | //Text.Add('If images don''t display, first view them in IMAGES tab.<br>');
|
---|
879 | //Text.Add('Then return here, click on note and press [F5] key to refresh.');
|
---|
880 | //Text.Add('</small>');
|
---|
881 | //Text.Add('<p>');
|
---|
882 | Text.Add('</body>');
|
---|
883 | Text.Add('</html>');
|
---|
884 | Text.Add(' ');
|
---|
885 | rTIU.SetText(ErrMsg,Text,UploadNote.TIUIEN,0); //elh changed from 1 to 0 //1=commit data, do actual save.
|
---|
886 | Text.Free;
|
---|
887 | //Here I autosign -- later make this optional?
|
---|
888 | RPCBrokerV.ClearParameters := true;
|
---|
889 | RPCBrokerV.remoteprocedure := 'TMG AUTOSIGN TIU DOCUMENT';
|
---|
890 | RPCBrokerV.param[0].value := IntToStr(UploadNote.TIUIEN);
|
---|
891 | RPCBrokerV.param[0].ptype := literal;
|
---|
892 | //RPCBrokerV.Call;
|
---|
893 | CallBroker;
|
---|
894 | if RPCBrokerV.Results.Count > 0 then begin
|
---|
895 | RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
|
---|
896 | end else begin
|
---|
897 | RPCResult := '-1';
|
---|
898 | end;
|
---|
899 | if RPCResult='-1' then begin
|
---|
900 | MessageDlg('Unable to set status for scanned document to SIGNED',mtError,[mbOK],0);
|
---|
901 | end;
|
---|
902 | UploadNote.TIUIEN := 0;
|
---|
903 | end;
|
---|
904 | UploadNote.Clear;
|
---|
905 | end;
|
---|
906 |
|
---|
907 |
|
---|
908 | function TUploadForm.ProcessOneLine(Line : string) : string;
|
---|
909 | //Returns: if success, ''; if failure, returns reason
|
---|
910 |
|
---|
911 | //format of line is as follows:
|
---|
912 | //ChartNum^Location^FName^LName^MName^Sex^DOB^DOS^Provider^Title^FilePath(s)
|
---|
913 | //NOTE: To provide patient IEN instead of FName etc, use this format:
|
---|
914 | // ^Location^^`1234567^^^^DOS^Provider^Title^FilePath(s)
|
---|
915 | // i.e. `IEN (note ` is not an appostrophy ('))
|
---|
916 | // `IEN in place of LName, and leave blank: ChartNum,FName,FName,Sex,DOB
|
---|
917 |
|
---|
918 | var
|
---|
919 | ChartNum,FName,LName,MName,Sex,DOB : String;
|
---|
920 | DOS,Provider,Title : String;
|
---|
921 | ThisNote : TAutoUploadNote;
|
---|
922 | FilePaths : TStringList;
|
---|
923 | i : integer;
|
---|
924 | Location : string;
|
---|
925 |
|
---|
926 | begin
|
---|
927 | Result := ''; //default to success for function
|
---|
928 | ThisNote := TAutoUploadNote.Create;
|
---|
929 | FilePaths := TStringList.Create();
|
---|
930 | DecodeImgTxt(Line, ChartNum, Location, FName, LName, MName, Sex, DOB, DOS, Provider, Title, FilePaths);
|
---|
931 |
|
---|
932 | ThisNote.SetDFN(ChartNum,Location,FName,LName,MName,DOB,Sex);
|
---|
933 | ThisNote.SetInfo(DOS,Provider,Location,Title);
|
---|
934 | if Pos('//Failed',Line)>0 then ThisNote.UploadError := true;
|
---|
935 | if ThisNote.IsValid then begin //A note can be 'Valid' and still have an 'UploadError'
|
---|
936 | if ThisNote.SameAs(AutoUploadNote)= false then begin
|
---|
937 | ThisNote.TIUIEN := AutoUploadNote.TIUIEN;
|
---|
938 | FinishDocument(AutoUploadNote); // Close and clear any existing note
|
---|
939 | AutoUploadNote.InitFrom(ThisNote);
|
---|
940 | Result := AutoUploadNote.ErrMsg; //'' if no error
|
---|
941 | end;
|
---|
942 | if ThisNote.UploadError then AutoUploadNote.UploadError := true;
|
---|
943 | if (AutoUploadNote.UploadError=false) then for i := 0 to FilePaths.Count-1 do begin
|
---|
944 | AutoUploadNote.ImageInfo.pLongDesc := nil;
|
---|
945 | //Load up info record with data for upload
|
---|
946 | AutoUploadNote.ImageInfo.ShortDesc := 'Scanned document';
|
---|
947 | AutoUploadNote.ImageInfo.UploadDUZ := User.DUZ;
|
---|
948 | AutoUploadNote.ImageInfo.ObjectType := 1; //type 1 is Still Image (jpg). OK to use with .bmp??
|
---|
949 | AutoUploadNote.ImageInfo.ProcName := 'Scanned'; //max length is 10 characters
|
---|
950 | AutoUploadNote.ImageInfo.ImageDateTime := DOS;
|
---|
951 | AutoUploadNote.ImageInfo.TIUIEN := AutoUploadNote.TIUIEN;
|
---|
952 | AutoUploadNote.ImageInfo.UploadDateTime := 'NOW';
|
---|
953 | AutoUploadNote.ImageInfo.DFN := AutoUploadNote.Patient.DFN;
|
---|
954 | AutoUploadNote.ImageInfo.ImageFPathName := FilePaths.Strings[i];
|
---|
955 | AutoUploadNote.ImageInfo.Extension := ExtractFileExt(AutoUploadNote.ImageInfo.ImageFPathName); //includes '.'
|
---|
956 | AutoUploadNote.ImageInfo.Extension := MidStr(AutoUploadNote.ImageInfo.Extension,2,17); //remove '.'
|
---|
957 | if not UploadFile(AutoUploadNote.ImageInfo,true) then begin //Upload function passes back filename info in Info class
|
---|
958 | Result := 'ERROR UPLOADING IMAGE FILE';
|
---|
959 | end;
|
---|
960 | AutoUploadNote.CurNoteImages.Add(AutoUploadNote.ImageInfo.ServerFName);
|
---|
961 | end else begin
|
---|
962 | If Result='' then Result := '(Error found in earlier file entry in batch)';
|
---|
963 | end;
|
---|
964 | end else begin
|
---|
965 | Result := 'NOTE INFO INVALID (Probably: PATIENT NOT FOUND)';
|
---|
966 | end;
|
---|
967 | FilePaths.Free;
|
---|
968 | ThisNote.Free;
|
---|
969 | end;
|
---|
970 |
|
---|
971 |
|
---|
972 | function TUploadForm.ProcessOneFile(FileName : string) : boolean;
|
---|
973 | //This will process image(s) indicated in textfile FileName
|
---|
974 | //After uploading image to server, textfile and specified images are deleted
|
---|
975 | //Returns Success
|
---|
976 | //Note: To upload multiple images into one document, one may add multiple
|
---|
977 | // lines to the ImgTxt text file. As long as the info is the same
|
---|
978 | // (i.e. same provider, patient, note type, DOS etc) then they
|
---|
979 | // will be appended to current note.
|
---|
980 | // OR, add multiple image file names to one line.
|
---|
981 | // -- the problem with multiple images on one line is that errors
|
---|
982 | // can not be reported for just one image. It will be ONE for any/all
|
---|
983 | // OR, if the next file in process-order is still has the same info as
|
---|
984 | // the prior file, then it will be appended.
|
---|
985 | var
|
---|
986 | Lines : TStringList;
|
---|
987 | i : integer;
|
---|
988 | ResultStr : string;
|
---|
989 | OneLine : string;
|
---|
990 | begin
|
---|
991 | Result := true; //default is Success=true
|
---|
992 | Lines := TStringList.Create;
|
---|
993 | Lines.LoadFromFile(FileName);
|
---|
994 | //FinishDocument(AutoUploadNote); //will save and clear any old data.
|
---|
995 | for i := 0 to Lines.Count-1 do begin
|
---|
996 | OneLine := Lines.Strings[i];
|
---|
997 | ResultStr := ProcessOneLine(OneLine); //Even process with //failed markeers (to preserve batches)
|
---|
998 | if Pos('//Failed',OneLine)> 0 then begin //If we already have //Failed, don't duplicate another Error Msg
|
---|
999 | Result := false; //prevent deletion of file containing //Failed//
|
---|
1000 | end else begin
|
---|
1001 | if ResultStr <> '' then begin
|
---|
1002 | Lines.Strings[i] := '//Failed: '+ResultStr+'}'+Lines.Strings[i];
|
---|
1003 | Lines.SaveToFile(FileName);
|
---|
1004 | Result := false;
|
---|
1005 | end;
|
---|
1006 | end;
|
---|
1007 | end;
|
---|
1008 | //Temp, for debugging
|
---|
1009 | //Lines.SaveToFile(ChangeFileExt(FileName,'.imgtxt-bak'));
|
---|
1010 | //end temp
|
---|
1011 | Lines.free;
|
---|
1012 | end;
|
---|
1013 |
|
---|
1014 |
|
---|
1015 | procedure TUploadForm.ScanAndHandleImgTxt;
|
---|
1016 | var
|
---|
1017 | FoundFile : string;
|
---|
1018 | Found : TSearchRec;
|
---|
1019 | FilesList : TStringList;
|
---|
1020 | i : integer;
|
---|
1021 | result : boolean;
|
---|
1022 | begin
|
---|
1023 | //NOTE: Later I may make this spawn a separate thread, so that
|
---|
1024 | // user doesn't encounter sudden unresponsiveness of CPRS
|
---|
1025 | //I can use BeginThread, then EndTread
|
---|
1026 | //Issues: ProcessOneFile would probably have to be a function
|
---|
1027 | // not in a class/object...
|
---|
1028 |
|
---|
1029 | FilesList := TStringList.Create;
|
---|
1030 |
|
---|
1031 | //scan for new *.ImgTxt file
|
---|
1032 | //FindFirst may not have correct order, so collect all names and then sort.
|
---|
1033 | if FindFirst(FScanDir+'*.imgtxt',faAnyFile,Found)=0 then repeat
|
---|
1034 | FilesList.Add(FScanDir+Found.Name);
|
---|
1035 | until FindNext(Found) <> 0;
|
---|
1036 | FindClose(Found);
|
---|
1037 | FilesList.Sort; //puts filenames in alphanumeric order
|
---|
1038 |
|
---|
1039 | //Now process images in correct order.
|
---|
1040 | for i := 0 to FilesList.Count-1 do begin
|
---|
1041 | FoundFile := FilesList.Strings[i];
|
---|
1042 | if ProcessOneFile(FoundFile) = true then begin {process *.imgtxt file}
|
---|
1043 | DeleteFile(FoundFile);
|
---|
1044 | FoundFile := ChangeFileExt(FoundFile,'.barcode.txt');
|
---|
1045 | DeleteFile(FoundFile);
|
---|
1046 | end; //Note: it is OK to continue, to get other non-error notes afterwards.
|
---|
1047 | end;
|
---|
1048 | FinishDocument(AutoUploadNote); // Close and clear any existing note
|
---|
1049 | FilesList.Free
|
---|
1050 | end;
|
---|
1051 |
|
---|
1052 |
|
---|
1053 | procedure TUploadForm.ScanAndHandleImages;
|
---|
1054 | (* Overview of mechanism of action of automatically uploading images.
|
---|
1055 | =================================================================
|
---|
1056 | -- For an image to be uploaded, it must first be positively identified.
|
---|
1057 | This can occur 1 of two ways:
|
---|
1058 | -- the image contains a datamatrix barcode.
|
---|
1059 | -- the image is part of a batch, and the first image of the batch
|
---|
1060 | contains a barcode for the entire batch.
|
---|
1061 | -- At our site, the scanner program automatically names the files numerically
|
---|
1062 | so that sorting on the name will put them in proper order when working
|
---|
1063 | with batches.
|
---|
1064 | -- The decoding of the barcode requires a special program. I was not
|
---|
1065 | able to find a way to run this on the Windows client. I found the
|
---|
1066 | libdmtx that does this automatically. It currently is on unix only.
|
---|
1067 | It was too complicated for me to compile it for windows. I initially
|
---|
1068 | wanted everything to run through the RPC broker. This involved
|
---|
1069 | uploading the image to the linux server, running the decoder on the
|
---|
1070 | server, then passing the result back. The code for this is still avail
|
---|
1071 | in this CPRS code. However, the process was too slow and I had to
|
---|
1072 | come up with something faster. So the following arrangement was setup
|
---|
1073 | -- scanned images are stored in a folder that was shared by both the
|
---|
1074 | windows network (and thus is available to CPRS), and the linux server.
|
---|
1075 | -- At our site, we used a copier/scanner unit that created only TIFF
|
---|
1076 | files. These are not the needed format for the barcode decoder, so...
|
---|
1077 | -- a cron job runs on the linux server that converts the .tif files
|
---|
1078 | to .png. Here is that script:
|
---|
1079 | <removed due to frequent changes...>
|
---|
1080 | ---------------------------------
|
---|
1081 | -- Next the .png files must be checked for a barcode. Another cron
|
---|
1082 | task scans a directory for .png files and creates a metafile for
|
---|
1083 | the file giving its barcode reading, or a marker that there is
|
---|
1084 | no barcode available for that image. The file name format is:
|
---|
1085 | *.barcode.txt, with the * coorelating to filename of the image.
|
---|
1086 | -- The decoding process can take some time (up to several minutes
|
---|
1087 | per image.
|
---|
1088 | -- A flag file named barcodeRead.working.txt is created when the
|
---|
1089 | script is run, and deleted when done. So if this file is present
|
---|
1090 | then the decoding process is not complete.
|
---|
1091 | -- if a *.barcode.txt file is present, then no attempts will be made
|
---|
1092 | to decode the image a second time.
|
---|
1093 | -- CPRS still contains code to upload an image to look for a barcode.
|
---|
1094 | At this site, only png's will contain barcodes, so I have commented
|
---|
1095 | out support for automatically uploading other file formats.
|
---|
1096 | -- Here is the unix bash script that decodes the barcodes. It is
|
---|
1097 | launched by cron:
|
---|
1098 | ---------------------------------
|
---|
1099 | <removed due to frequent changes...>
|
---|
1100 | ---------------------------------
|
---|
1101 | -- After the *.png images are available, and no flag files are present
|
---|
1102 | to indicate that the server is working with the files, then the images
|
---|
1103 | are processed, using the barcode metafiles. This is triggered by a
|
---|
1104 | timer in CPRS. It essentially converts imagename + barcode data -->
|
---|
1105 | --> *.imgtxt.
|
---|
1106 | -- For each *.png image, there will be a *.imgtxt metafile created. This
|
---|
1107 | will contain information needed by the server, in a special format for
|
---|
1108 | the RPC calls. When an *.imgtxt file is present, this is a flag that
|
---|
1109 | the image is ready to be uploaded.
|
---|
1110 | -- A timer in CPRS scans for *.imgtxt files. When found, it uploads the
|
---|
1111 | image to the server and creates a container progress note for displaying
|
---|
1112 | it in CPRS.
|
---|
1113 | *)
|
---|
1114 |
|
---|
1115 | procedure ScanOneImageType(ImageType : string);
|
---|
1116 | //Scan directory for all instances of images of type ImageType
|
---|
1117 | //For each one, create a metadata file (if not already present)
|
---|
1118 |
|
---|
1119 | //Note: Batch mode only works for a batch of file ALL OF THE SAME TYPE.
|
---|
1120 | //I.e. There can't be a batch of .jpg, then .gif, then .bmp. This is
|
---|
1121 | //because a scanner, if it is scanning a stack of documents for a given
|
---|
1122 | //patient will produce all files in the same ImageType
|
---|
1123 |
|
---|
1124 | function DeltaMins(CurrentTime,PriorTime : TDateTime) : integer;
|
---|
1125 | //Return ABSOLUTE difference in minutes between Current <--> Prior.
|
---|
1126 | //NOTE: if value is > 1440, then 1440 is returned
|
---|
1127 | var DeltaDays,FracDays : double;
|
---|
1128 | begin
|
---|
1129 | DeltaDays := abs(CurrentTime-PriorTime);
|
---|
1130 | FracDays := DeltaDays - Round(DeltaDays);
|
---|
1131 | if DeltaDays>1 then FracDays := 1;
|
---|
1132 | Result := Round((60*24)*FracDays);
|
---|
1133 | end;
|
---|
1134 |
|
---|
1135 | var
|
---|
1136 | FoundFile : string;
|
---|
1137 | MetaFilename : string;
|
---|
1138 | Found : TSearchRec;
|
---|
1139 | BarCodeData : AnsiString;
|
---|
1140 | DFN,DOS,AuthIEN,LocIEN,NoteTypeIEN : string;
|
---|
1141 | OneLine : string;
|
---|
1142 | FilePaths : TStringList;
|
---|
1143 | AllFiles : TStringList;
|
---|
1144 | OutFileLines : TStringList;
|
---|
1145 | BatchS : string;
|
---|
1146 | tempCount : integer;
|
---|
1147 | BatchFInfo : TFileInfo;
|
---|
1148 | LastFileTimeStamp,CurFileTimeStamp : TDateTime;
|
---|
1149 | DeltaMinutes : integer;
|
---|
1150 | pFInfo : TFileInfo;
|
---|
1151 | i : integer;
|
---|
1152 | Label AbortPoint;
|
---|
1153 |
|
---|
1154 | const
|
---|
1155 | ALLOWED_TIME_GAP = 2; //time in minutes
|
---|
1156 |
|
---|
1157 | begin
|
---|
1158 | FilePaths := TStringList.Create;
|
---|
1159 | OutFileLines := TStringList.Create;
|
---|
1160 | AllFiles := TStringList.Create;
|
---|
1161 | BatchFInfo := TFileInfo.Create;
|
---|
1162 |
|
---|
1163 | //NOTE: Later I may make this spawn a separate thread, so that
|
---|
1164 | // user doesn't encounter sudden unresponsiveness of CPRS
|
---|
1165 | //I can use BeginThread, then EndTread
|
---|
1166 | //Issues: ProcessOneFile would probably have to be a function
|
---|
1167 | // not in a class/object...
|
---|
1168 |
|
---|
1169 | //scan for all instances *.ImageType Image file
|
---|
1170 | //Store info for processesing after loop
|
---|
1171 | //Do this as a separate step, so files can be processed in proper order
|
---|
1172 | if FindFirst(FScanDir+'*.'+ImageType,faAnyFile,Found)=0 then repeat
|
---|
1173 | FoundFile := FScanDir+Found.Name;
|
---|
1174 | if FileExists(ChangeFileExt(FoundFile,'.imgtxt')) then continue;
|
---|
1175 | MetaFilename := ChangeFileExt(FoundFile,'.barcode.txt');
|
---|
1176 | pFInfo := TFileInfo.Create; //will be owned by AllFiles
|
---|
1177 | pFInfo.MetaFileName := MetaFilename;
|
---|
1178 | pFInfo.FPath := FoundFile;
|
---|
1179 | pFInfo.SrcRec := Found;
|
---|
1180 | pFInfo.STimeStamp := FloatToStr(FileDateToDateTime(Found.Time));
|
---|
1181 | pFInfo.MetaFileExists := FileExists(MetaFilename);
|
---|
1182 | pFInfo.SBarCode := ''; //default to empty.
|
---|
1183 | pFInfo.BatchCount := 0;
|
---|
1184 | if pFInfo.MetaFileExists = false then begin
|
---|
1185 | //Call server via RPC to decode Barcode
|
---|
1186 | //This is too slow and buggy. Will remove for now...
|
---|
1187 | //BarCodeData := frmImages.DecodeBarcode(FoundFile,ImageType);
|
---|
1188 | //pFInfo.SBarCode := BarCodeData;
|
---|
1189 | pFInfo.SBarCode := '';
|
---|
1190 | //Here I could optionally create a Metafile for processing below.
|
---|
1191 | end;
|
---|
1192 | if pFInfo.MetaFileExists then begin //Retest in case RPC changed status.
|
---|
1193 | if FileExists(FScanDir+'barcodeRead.working.txt') then goto AbortPoint;
|
---|
1194 | OutFileLines.LoadFromFile(pFInfo.MetaFileName);
|
---|
1195 | if OutFileLines.Count>0 then begin
|
---|
1196 | pFInfo.SBarCode := OutFileLines.Strings[0];
|
---|
1197 | //convert 'No Barcode message into an empty string, to match existing code.
|
---|
1198 | if Pos('//',pFInfo.SBarCode)=1 then pFInfo.SBarCode := '';
|
---|
1199 | if NumPieces(pFInfo.SBarCode,'-') <> 8 then pFInfo.SBarCode := '';
|
---|
1200 | end else begin
|
---|
1201 | pFInfo.MetaFileExists := false; //set empty file to Non-existence status
|
---|
1202 | end;
|
---|
1203 | end;
|
---|
1204 | AllFiles.AddObject(pFInfo.FPath,pFInfo); //Store filename, to allow sorting on this.
|
---|
1205 | until FindNext(Found) <> 0;
|
---|
1206 | AllFiles.Sort; // Sort on timestamp --> put in ascending alpha filename order
|
---|
1207 |
|
---|
1208 | //-------- Now, process files in name order ------------
|
---|
1209 | LastFileTimeStamp := 0;
|
---|
1210 | BatchFInfo.BatchCount := 0;
|
---|
1211 | for i := 0 to AllFiles.Count-1 do begin
|
---|
1212 | pFInfo := TFileInfo(AllFiles.Objects[i]);
|
---|
1213 | if pFInfo.MetaFileExists = false then continue;
|
---|
1214 | CurFileTimeStamp := FileDateToDateTime(pFInfo.SrcRec.Time);
|
---|
1215 | DeltaMinutes := DeltaMins(CurFileTimeStamp,LastFileTimeStamp);
|
---|
1216 | // *.barcode.txt file exists at this point
|
---|
1217 | if pFInfo.SBarCode <> '' then begin //Found a new barcode
|
---|
1218 | LastFileTimeStamp := CurFileTimeStamp;
|
---|
1219 | //Note: The expected format of barcode must be same as that
|
---|
1220 | // created by TfrmPtLabelPrint.PrintButtonClick:
|
---|
1221 | // 70685-12-31-2008-73-6-1302-0
|
---|
1222 | // PtIEN-DateOfService-AuthorIEN-LocIEN-NoteTypeIEN-BatchFlag
|
---|
1223 | // THUS there should be 8 pieces in the string.
|
---|
1224 | DFN := piece(pFInfo.SBarCode,'-',1);
|
---|
1225 | DOS := pieces(pFInfo.SBarCode,'-',2,4);
|
---|
1226 | AuthIEN := piece(pFInfo.SBarCode,'-',5);
|
---|
1227 | LocIEN := piece(pFInfo.SBarCode,'-',6);
|
---|
1228 | NoteTypeIEN := piece(pFInfo.SBarCode,'-',7);
|
---|
1229 | BatchS := piece(pFInfo.SBarCode,'-',8);
|
---|
1230 | if BatchS = '*' then begin
|
---|
1231 | pFInfo.BatchCount := 9999
|
---|
1232 | end else begin
|
---|
1233 | try
|
---|
1234 | pFInfo.BatchCount := StrToInt(BatchS);
|
---|
1235 | except
|
---|
1236 | on E:EConvertError do begin
|
---|
1237 | pFInfo.BatchCount := 1;
|
---|
1238 | end;
|
---|
1239 | end;
|
---|
1240 | end;
|
---|
1241 | //BatchFInfo.SBarCode := pFInfo.SBarCode;
|
---|
1242 | end else if (BatchFInfo.BatchCount > 0) then begin
|
---|
1243 | if (DeltaMinutes > ALLOWED_TIME_GAP) then begin
|
---|
1244 | pFInfo.Clear;
|
---|
1245 | BatchFInfo.Clear;
|
---|
1246 | end else begin
|
---|
1247 | //Apply barcode from last image onto this one (from same batch)
|
---|
1248 | pFInfo.SBarCode := BatchFInfo.SBarCode;
|
---|
1249 | end;
|
---|
1250 | end;
|
---|
1251 | if pFInfo.SBarCode <> '' then begin
|
---|
1252 | //Success --> write out ImgTxt file...
|
---|
1253 | FilePaths.Add(pFInfo.FPath);
|
---|
1254 | OneLine := EncodeImgTxt('', '`'+LocIEN,'', '`'+DFN, '', '', '',
|
---|
1255 | DOS,'`'+AuthIEN, '`'+NoteTypeIEN, FilePaths);
|
---|
1256 | if pFInfo.BatchCount>0 then begin
|
---|
1257 | //A BATCH marker has been found on current barcode. This means that
|
---|
1258 | //Batchmode should be turned on. This will apply current barcode
|
---|
1259 | //data to any subsequent images, providing there is not a gap in
|
---|
1260 | //time > ALLOWED_TIME_GAP
|
---|
1261 | BatchFInfo.Assign(pFInfo); //reset Batch info to current
|
---|
1262 | end;
|
---|
1263 | //Decrease use count of Batch Info
|
---|
1264 | Dec(BatchFInfo.BatchCount);
|
---|
1265 | end else begin
|
---|
1266 | OneLine := '';
|
---|
1267 | end;
|
---|
1268 | OutFileLines.Clear;
|
---|
1269 | if OneLine <> '' then begin
|
---|
1270 | OutFileLines.Add(OneLine);
|
---|
1271 | OutFileLines.SaveToFile(ChangeFileExt(pFInfo.FPath,'.imgtxt'));
|
---|
1272 | end;
|
---|
1273 | FilePaths.Clear;
|
---|
1274 | OutFileLines.Clear;
|
---|
1275 | LastFileTimeStamp := CurFileTimeStamp;
|
---|
1276 | end;
|
---|
1277 | AbortPoint:
|
---|
1278 | FindClose(Found);
|
---|
1279 | BatchFInfo.Free;
|
---|
1280 | FilePaths.Free;
|
---|
1281 | for i := 0 to AllFiles.Count-1 do begin //free owned objects
|
---|
1282 | pFInfo := TFileInfo(AllFiles.Objects[i]);
|
---|
1283 | pFInfo.Free;
|
---|
1284 | end;
|
---|
1285 | AllFiles.Free;
|
---|
1286 | OutFileLines.Free;
|
---|
1287 | end;
|
---|
1288 |
|
---|
1289 | var flag1Filename,flag2Filename : string;
|
---|
1290 | begin
|
---|
1291 | flag1Filename := FScanDir+'barcodeRead.working.txt';
|
---|
1292 | flag2Filename := FScanDir+'convertTif2Png.working.txt';
|
---|
1293 | //if linux server is in middle of a conversion or barcode decode, then skip.
|
---|
1294 | if (FileExists(flag1Filename)=false) and (FileExists(flag2Filename)=false) then begin
|
---|
1295 | (* Remove {}'s to be able to have jpg's etc that contain barcodes
|
---|
1296 | In our site, only png's will have barcodes, and thus these are the
|
---|
1297 | only images that can be uploaded automatically. Uploading jpg's, bmp's
|
---|
1298 | etc to look for (nonexistent) barcodes will just waste time and bandwidth. *)
|
---|
1299 | {
|
---|
1300 | ScanOneImageType('jpg');
|
---|
1301 | ScanOneImageType('jpeg');
|
---|
1302 | ScanOneImageType('gif');
|
---|
1303 | ScanOneImageType('bmp');
|
---|
1304 | }
|
---|
1305 | //ScanOneImageType('tif'); {Tiff was not showing up in IE for some reason}
|
---|
1306 | //ScanOneImageType('tiff'); {Tiff was not showing up in IE for some reason}
|
---|
1307 | ScanOneImageType('png');
|
---|
1308 | end;
|
---|
1309 | end;
|
---|
1310 |
|
---|
1311 | procedure TUploadForm.PolTimerTimer(Sender: TObject);
|
---|
1312 | begin
|
---|
1313 | PolTimer.Enabled := false;
|
---|
1314 | try
|
---|
1315 | if Assigned(frmImages) and frmImages.AutoScanUpload.Checked then begin
|
---|
1316 | ScanAndHandleImages; //create metadata for images (if not done already)
|
---|
1317 | ScanAndHandleImgTxt; //process upload file, based on metadata
|
---|
1318 | end;
|
---|
1319 | finally
|
---|
1320 | PolTimer.Enabled := true;
|
---|
1321 | PolTimer.Interval := PolInterval;
|
---|
1322 | end;
|
---|
1323 | end;
|
---|
1324 |
|
---|
1325 | procedure TUploadForm.SetAllowNonImages(Value : boolean);
|
---|
1326 | begin
|
---|
1327 | FAllowNonImages := Value;
|
---|
1328 | btnPickPDF.Enabled := Value;
|
---|
1329 | PickOtherButton.Enabled := Value;
|
---|
1330 | end;
|
---|
1331 |
|
---|
1332 |
|
---|
1333 |
|
---|
1334 | end.
|
---|