source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/fPtLabelPrint.pas@ 820

Last change on this file since 820 was 729, checked in by Kevin Toppenberg, 15 years ago

Added functions to Templates, and Images tab
File size: 14.0 KB
Line 
1unit fPtLabelPrint;
2//kt added this entire unit and form 12/2007
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, Spin, StdCtrls, Buttons, jpeg, ExtCtrls, ORCtrls, ORDtTm,
8 Printers, uCore,ORFn;
9
10type
11 TfrmPtLabelPrint = class(TForm)
12 NameLabel: TLabel;
13 AuthorLabel: TLabel;
14 NoteTypeLabel: TLabel;
15 PrinterComboBox: TComboBox;
16 PrinterLabel: TLabel;
17 DateLabel: TLabel;
18 LocationLabel: TLabel;
19 PrintButton: TBitBtn;
20 DoneButton: TBitBtn;
21 Image1: TImage;
22 cboAuthor: TORComboBox;
23 calDOS: TORDateBox;
24 cboLocation: TORComboBox;
25 cboNoteTitle: TORComboBox;
26 cboPatient: TORComboBox;
27 PrinterSetupDialog: TPrinterSetupDialog;
28 SpeedButton1: TSpeedButton;
29 PtNameLabel: TLabel;
30 PtDOBLabel: TLabel;
31 PtSSNLabel: TLabel;
32 PtName: TLabel;
33 PtDOB: TLabel;
34 PtSSN: TLabel;
35 Label1: TLabel;
36 BarcodeLabel: TLabel;
37 BatchNumComboBox: TComboBox;
38 Label2: TLabel;
39 procedure DoneButtonClick(Sender: TObject);
40 procedure PrintButtonClick(Sender: TObject);
41 procedure FormCreate(Sender: TObject);
42 procedure FormShow(Sender: TObject);
43 procedure cboLocationNeedData(Sender: TObject; const StartFrom: String;
44 Direction, InsertAt: Integer);
45 procedure cboAuthorNeedData(Sender: TObject; const StartFrom: String;
46 Direction, InsertAt: Integer);
47 procedure cboNoteTitleNeedData(Sender: TObject; const StartFrom: String;
48 Direction, InsertAt: Integer);
49 procedure FormDestroy(Sender: TObject);
50 procedure cboPatientNeedData(Sender: TObject; const StartFrom: String;
51 Direction, InsertAt: Integer);
52 procedure calDOSChange(Sender: TObject);
53 procedure calDOSExit(Sender: TObject);
54 procedure FormResize(Sender: TObject);
55 procedure SpeedButton1Click(Sender: TObject);
56 procedure cboPatientChange(Sender: TObject);
57 procedure cboAuthorChange(Sender: TObject);
58 procedure cboNoteTitleChange(Sender: TObject);
59 procedure cboLocationChange(Sender: TObject);
60 procedure PrinterComboBoxChange(Sender: TObject);
61 procedure BatchNumComboBoxChange(Sender: TObject);
62 private
63 { Private declarations }
64 FInitPtIEN : int64;
65 FPrinter : TPrinter;
66 initPatientName : string;
67 //FDateTime: TFMDateTime;
68 //FDateTimeText : string;
69 function CompileBarcodeNumber: String;
70 procedure BarcodeChange(Sender: TObject);
71 public
72 { Public declarations }
73 procedure PrepDialog(Patient : TPatient);
74 end;
75
76var
77 frmPtLabelPrint: TfrmPtLabelPrint;
78
79implementation
80
81{$R *.dfm}
82
83uses rCore,rTIU,uConst,
84 IniFiles // for IniFile
85 , fImages;
86
87const
88 ANY_NUM_PAGES = '<ANY>';
89
90procedure TfrmPtLabelPrint.PrepDialog(Patient : TPatient);
91begin
92 initPatientName := Patient.Name;
93 FInitPtIEN := StrToInt(Patient.DFN);
94end;
95
96procedure TfrmPtLabelPrint.DoneButtonClick(Sender: TObject);
97begin
98 ModalResult := mrOK; //to close form.
99end;
100
101
102function TfrmPtLabelPrint.CompileBarcodeNumber: String;
103var
104 DateOfService: string;
105 PtIEN, AuthorIEN, NoteTypeIEN, LocIEN : int64;
106 BCLine,BatchFlag: string;
107 PtIDInfo : TPtIDInfo;
108begin
109 PtIEN := cboPatient.ItemIEN; //check this
110 PtIDInfo := rCore.GetPtIDInfo(IntToStr(PtIEN));
111 DateOfService := FormatFMDateTime('mm"-"dd"-"yyyy', calDOS.FMDateTime);
112 AuthorIEN := cboAuthor.ItemIEN;
113 LocIEN := cboLocation.ItemIEN;
114 NoteTypeIEN := cboNoteTitle.ItemIEN;
115 BatchFlag := BatchNumComboBox.Text;
116 if BatchFlag = ANY_NUM_PAGES then BatchFlag := '*';
117
118 // 70685-12-31-2008-73-6-1302-0
119 //Note: *** If this changes, then change format in UploadImages.ScanAndHandleImages
120 BCLine := IntToStr(PtIEN) + '-' + DateOfService + '-' +
121 IntToStr(AuthorIEN) + '-' +
122 IntToStr(LocIEN) + '-' + IntToStr(NoteTypeIEN) + '-' +
123 BatchFlag;
124
125 Result := BCLine;
126end;
127
128procedure TfrmPtLabelPrint.PrintButtonClick(Sender: TObject);
129var
130 DateOfService: string;
131 PtIEN, AuthorIEN, NoteTypeIEN, LocIEN : int64;
132 BCLine : string;
133 NameLine,DOBLine,ProvLine,LocLine,TitleLine : string;
134 //BatchFlag: string;
135 YPos,XPos : integer;
136 PtIDInfo : TPtIDInfo;
137 FNamePath : AnsiString;
138 pic : TPicture;
139 SrcRec,DestRec :TRect;
140 DestPos : TPoint;
141 barcodeWidth,barcodeHeight : integer;
142
143Const
144 BarCodeSize=310;
145 LMargin = 1;
146 TMargin = 1;
147
148begin
149 PtIEN := cboPatient.ItemIEN; //check this
150 PtIDInfo := rCore.GetPtIDInfo(IntToStr(PtIEN));
151 //DateOfService := FormatFMDateTime('mm"-"dd"-"yyyy', calDOS.FMDateTime);
152
153 //AuthorIEN := cboAuthor.ItemIEN;
154 //LocIEN := cboLocation.ItemIEN;
155 //NoteTypeIEN := cboNoteTitle.ItemIEN;
156 //if BatchCB.Checked = true then begin
157 // BatchFlag := '1';
158 //end else begin
159 // BatchFlag := '0';
160 //end;
161
162 YPos := TMargin+25;
163 XPos := LMargin+BarCodeSize+10;
164 BCLine := CompileBarcodeNumber;
165
166 //TEST,KILLME
167 //DOB: 04-02-1956
168 NameLine := PtIDInfo.Name;
169 DOBLine := 'DOB: ' + PtIDInfo.DOB;
170 //DOBLine := DOBLine + BatchNumComboBox.Text;
171 ProvLine := Trim(piece(cboAuthor.Text,'-',1));
172 LocLine := cboLocation.Text;
173 if Pos('<',cboNoteTitle.Text)>0 then begin
174 TitleLine := piece(cboNoteTitle.Text,'<',2);
175 TitleLine := piece(TitleLine,'>',1)
176 end else begin
177 TitleLine := cboNoteTitle.Text;
178 end;
179
180 FPrinter.PrinterIndex := PrinterComboBox.ItemIndex;
181 FPrinter.Orientation := poLandscape;
182 FPrinter.Title := 'Patient Label -- ' + PtIDInfo.Name;
183 //FPrinter.Copies := StrToInt(QuantitySpinEdit.Text);
184
185 try
186 pic := TPicture.Create;
187 FNamePath := frmImages.CreateBarcode(BCLine,'png');
188 pic.LoadFromFile(FNamePath);
189 //barcodeWidth := pic.Bitmap.Width;
190 //barcodeHeight := pic.Bitmap.Height;
191 SrcRec.Top := 0;
192 SrcRec.Left := 0;
193 SrcRec.Right := 32;
194 SrcRec.Bottom := 32;
195
196 DestPos.X := LMargin;
197 DestPos.Y := TMargin;
198 DestRec.TopLeft := DestPos;
199 DestRec.Right := DestPos.X+BarCodeSize;
200 DestRec.Bottom := DestPos.Y+BarCodeSize;
201
202 FPrinter.BeginDoc; //start print job.
203
204 //copy barcode bitmap to printer canvas.
205 FPrinter.Canvas.CopyMode := cmSrcCopy;
206 FPrinter.Canvas.StretchDraw(DestRec,pic.Graphic);
207
208 FPrinter.Canvas.Font.Name := 'Arial';
209 FPrinter.Canvas.Font.Size := 10; //# point
210
211 //Print out Name line
212 FPrinter.Canvas.TextOut(XPos,YPos,NameLine);
213 YPos := YPos + FPrinter.Canvas.TextHeight(NameLine)+5;
214
215 FPrinter.Canvas.Font.Size := 8; //# point
216 //Print out DOB line
217 FPrinter.Canvas.TextOut(XPos,YPos,DOBLine);
218 YPos := YPos + FPrinter.Canvas.TextHeight(DOBLine)+5;
219
220 //Print out Provider/Author line
221 FPrinter.Canvas.TextOut(XPos,YPos,ProvLine);
222 YPos := YPos + FPrinter.Canvas.TextHeight(ProvLine)+5;
223
224 //Print out Location line
225 FPrinter.Canvas.TextOut(XPos,YPos,LocLine);
226 YPos := YPos + FPrinter.Canvas.TextHeight(LocLine)+5;
227
228 //Print out Note Title line
229 FPrinter.Canvas.TextOut(XPos,YPos,TitleLine);
230 YPos := YPos + FPrinter.Canvas.TextHeight(TitleLine)+5;
231
232 //Print out clear-text of barcode data line
233 FPrinter.Canvas.Font.Size := 8; //x point
234 FPrinter.Canvas.TextOut(XPos,YPos,BCLine);
235 YPos := YPos + FPrinter.Canvas.TextHeight(BCLine)+5;
236
237 finally
238 FPrinter.EndDoc; //close and launch print job
239 pic.Free;
240 DeleteFile(FNamePath);
241 end;
242
243end;
244
245
246procedure TfrmPtLabelPrint.FormCreate(Sender: TObject);
247var IniFile : TIniFile;
248 defPrinter : string;
249
250begin
251 FPrinter := TPrinter.Create;
252end;
253
254
255procedure TfrmPtLabelPrint.FormShow(Sender: TObject);
256var
257 uTIULocationName: string;
258 uTIULocation: integer;
259 //temp : string;
260
261 IniFile : TIniFile;
262 defPrinter : string;
263
264begin
265 cboAuthor.InitLongList(User.Name);
266 cboAuthor.SelectByIEN(User.DUZ);
267
268 uTIULocation := DfltTIULocation;
269 if uTIULocation <> 0 then uTIULocationName := ExternalName(uTIULocation, FN_HOSPITAL_LOCATION);
270
271 cboLocation.InitLongList(uTIULocationName);
272 cboLocation.SelectByIEN(uTIULocation);
273
274 cboNoteTitle.InitLongList('');
275 if cboNoteTitle.Items.Count>0 then cboNoteTitle.ItemIndex := 0;
276
277 // Assign list box TabPosition, Pieces properties according to type of list to be displayed.
278 // (Always use Piece "2" as the first in the list to assure display of patient's name.)
279 cboPatient.pieces := '2,3'; // This line and next: defaults set - exceptions modifield next.
280 cboPatient.tabPositions := '20,28';
281 cboPatient.InitLongList(initPatientName);
282 cboPatient.SelectByIEN(FInitPtIEN);
283 // temp := cboPatient.Text;
284 cboPatientChange(self);
285
286
287 IniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.INI'));
288 try
289 defPrinter := IniFile.ReadString('Label Printing','Default Printer','');
290 finally
291 IniFile.Free;
292 end;
293
294 PrinterComboBox.Items.Clear ;
295 PrinterComboBox.Items.Assign(FPrinter.Printers);
296 if PrinterComboBox.Items.IndexOf(defPrinter) > -1 then begin
297 PrinterComboBox.ItemIndex := PrinterComboBox.Items.IndexOf(defPrinter);
298 end else if PrinterComboBox.Items.Count > 0 then begin
299 PrinterComboBox.ItemIndex := 0;
300 end;
301
302end;
303
304
305
306procedure TfrmPtLabelPrint.cboLocationNeedData(Sender: TObject;
307 const StartFrom: String;
308 Direction, InsertAt: Integer);
309begin
310 inherited;
311 cboLocation.ForDataUse(SubSetOfNewLocs(StartFrom, Direction));
312end;
313
314
315procedure TfrmPtLabelPrint.cboAuthorNeedData(Sender: TObject;
316 const StartFrom: String;
317 Direction, InsertAt: Integer);
318begin
319 (Sender as TORComboBox).ForDataUse(SubSetOfPersons(StartFrom, Direction));
320end;
321
322
323procedure TfrmPtLabelPrint.cboNoteTitleNeedData(Sender: TObject;
324 const StartFrom: String;
325 Direction, InsertAt: Integer);
326var FIDNoteTitlesOnly : boolean;
327begin
328 FIDNoteTitlesOnly := false;
329 cboNoteTitle.ForDataUse(SubSetOfNoteTitles(StartFrom, Direction, FIDNoteTitlesOnly));
330end;
331
332
333procedure TfrmPtLabelPrint.FormDestroy(Sender: TObject);
334begin
335 FPrinter.free;
336end;
337
338procedure TfrmPtLabelPrint.cboPatientNeedData(Sender: TObject;
339 const StartFrom: String;
340 Direction, InsertAt: Integer);
341var
342 i: Integer;
343 NoAlias, Patient: String;
344 PatientList: TStringList;
345const
346 AliasString = ' -- ALIAS';
347
348begin
349 //NOTICE: for now I am taking out restrictions regarding restricted
350 // patient lists. User will be able to *print a label* for
351 // any patient (but not open their chart)
352
353
354 NoAlias := StartFrom;
355 with Sender as TORComboBox do begin
356 if Items.Count > ShortCount then begin
357 NoAlias := Piece(Items[Items.Count-1], U, 1) + U + NoAlias;
358 end;
359 end;
360 if pos(AliasString, NoAlias)> 0 then begin
361 NoAlias := Copy(NoAlias, 1, pos(AliasString, NoAlias)-1);
362 end;
363 PatientList := TStringList.Create;
364 try
365 begin
366 PatientList.Assign(SubSetOfPatients(NoAlias, Direction));
367 for i := 0 to PatientList.Count-1 do begin // Add " - Alias" to alias names:
368 Patient := PatientList[i];
369 // Piece 6 avoids display problems when mixed with "RPL" lists:
370 if (Uppercase(Piece(Patient, U, 2)) <> Uppercase(Piece(Patient, U, 6))) then begin
371 SetPiece(Patient, U, 2, Piece(Patient, U, 2) + AliasString);
372 PatientList[i] := Patient;
373 end;
374 end;
375 cboPatient.ForDataUse(PatientList);
376 end;
377 finally
378 PatientList.Free;
379 end;
380end;
381
382
383
384procedure TfrmPtLabelPrint.calDOSChange(Sender: TObject);
385begin
386 //FDateTime := calDOS.FMDateTime;
387 BarcodeChange(self);
388end;
389
390procedure TfrmPtLabelPrint.calDOSExit(Sender: TObject);
391begin
392// FDateTimeText := FormatFMDateTime('mmm dd,yyyy', FDateTime);
393end;
394
395procedure TfrmPtLabelPrint.FormResize(Sender: TObject);
396begin
397 //if Width < 375 then Width := 375;
398 //if Width > 500 then Width := 500;
399 //if Height <> 345 then Height := 345;
400end;
401
402procedure TfrmPtLabelPrint.SpeedButton1Click(Sender: TObject);
403begin
404 PrinterSetupDialog.Execute;
405end;
406
407procedure TfrmPtLabelPrint.cboPatientChange(Sender: TObject);
408var
409 PtIDInfo : TPtIDInfo;
410 PtIEN : int64;
411begin
412 PtIEN := cboPatient.ItemIEN;
413 PtIDInfo := rCore.GetPtIDInfo(IntToStr(PtIEN));
414 PtName.Caption := PtIDInfo.Name;
415 PtDOB.Caption := PtIDInfo.DOB;
416 PtSSN.Caption := PtIDInfo.SSN;
417 BarcodeChange(self);
418end;
419
420procedure TfrmPtLabelPrint.BarcodeChange(Sender: TObject);
421begin
422 BarcodeLabel.Caption := CompileBarcodeNumber;
423end;
424
425
426procedure TfrmPtLabelPrint.cboAuthorChange(Sender: TObject);
427begin
428 BarcodeChange(self);
429end;
430
431procedure TfrmPtLabelPrint.cboNoteTitleChange(Sender: TObject);
432begin
433 BarcodeChange(self);
434end;
435
436procedure TfrmPtLabelPrint.cboLocationChange(Sender: TObject);
437begin
438 BarcodeChange(self);
439end;
440
441procedure TfrmPtLabelPrint.PrinterComboBoxChange(Sender: TObject);
442var IniFile : TIniFile;
443 defPrinter : string;
444begin
445 FPrinter := TPrinter.Create;
446 IniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.INI'));
447 defPrinter := PrinterComboBox.Items.Strings[PrinterComboBox.ItemIndex];
448 try
449 IniFile.WriteString('Label Printing','Default Printer',defPrinter);
450 finally
451 IniFile.Free;
452 end;
453end;
454
455procedure TfrmPtLabelPrint.BatchNumComboBoxChange(Sender: TObject);
456var temp : integer;
457begin
458 if BatchNumComboBox.Text <> ANY_NUM_PAGES then begin
459 temp := 0;
460 try
461 temp := StrToInt(BatchNumComboBox.Text);
462 except
463 on E:EConvertError do begin
464 temp := 0;
465 end;
466 end;
467 if temp < 1 then begin
468 MessageDlg('Invalid Number.',mtError,[mbOK],0);
469 BatchNumComboBox.Text := '1';
470 end;
471 end;
472 BarcodeChange(self);
473end;
474
475end.
476
477
Note: See TracBrowser for help on using the repository browser.