source: cprs/branches/tmg-cprs/CPRS-Chart/fLabPrint.pas@ 761

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

TMG Ver 1.1 Added HTML Support, better demographics editing

File size: 7.7 KB
Line 
1//kt -- Modified with SourceScanner on 7/19/2007
2unit fLabPrint;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 StdCtrls, ORCtrls, ORNet, Mask, ComCtrls, DKLang;
9
10type
11 TfrmLabPrint = class(TForm)
12 lblLabTitle: TMemo;
13 lblPrintTo: TLabel;
14 grpDevice: TGroupBox;
15 lblMargin: TLabel;
16 lblLength: TLabel;
17 txtRightMargin: TMaskEdit;
18 txtPageLength: TMaskEdit;
19 cboDevice: TORComboBox;
20 cmdOK: TButton;
21 cmdCancel: TButton;
22 dlgWinPrinter: TPrintDialog;
23 chkDefault: TCheckBox;
24 DKLanguageController1: TDKLanguageController;
25 procedure FormCreate(Sender: TObject);
26 procedure cboDeviceChange(Sender: TObject);
27 procedure cboDeviceNeedData(Sender: TObject; const StartFrom: String;
28 Direction, InsertAt: Integer);
29 procedure cmdOKClick(Sender: TObject);
30 procedure cmdCancelClick(Sender: TObject);
31 procedure FormDestroy(Sender: TObject);
32 private
33 //kt Begin Mod (change Consts to Vars) 7/19/2007
34 TX_NODEVICE : string; //kt
35 TX_NODEVICE_CAP : string; //kt
36 TX_ERR_CAP : string; //kt
37 PAGE_BREAK : string; //kt
38 //kt End Mod -------------------
39 { Private declarations }
40 FReports: Integer;
41 FDaysBack: Integer;
42 FReportText: TRichEdit;
43 procedure DisplaySelectDevice;
44 procedure SetupVars; //kt
45 public
46 { Public declarations }
47 end;
48
49var
50 frmLabPrint: TfrmLabPrint;
51
52procedure PrintLabs(AReports: Longint; const ALabTitle: string; ADaysBack: Integer);
53
54implementation
55
56{$R *.DFM}
57
58uses ORFn, rCore, uCore, fLabs, rLabs, Printers, rReports;
59
60//const
61//TX_NODEVICE = 'A device must be selected to print, or press ''Cancel'' to not print.'; <-- original line. //kt 7/19/2007
62//TX_NODEVICE_CAP = 'Device Not Selected'; <-- original line. //kt 7/19/2007
63//TX_ERR_CAP = 'Print Error'; <-- original line. //kt 7/19/2007
64//PAGE_BREAK = '**PAGE BREAK**'; <-- original line. //kt 7/19/2007
65
66
67procedure TfrmLabPrint.SetupVars;
68//kt Added entire function to replace constant declarations 7/19/2007
69begin
70 TX_NODEVICE := DKLangConstW('fLabPrint_A_device_must_be_selected_to_printx_or_press_xxCancelxx_to_not_printx');
71 TX_NODEVICE_CAP := DKLangConstW('fLabPrint_Device_Not_Selected');
72 TX_ERR_CAP := DKLangConstW('fLabPrint_Print_Error');
73 PAGE_BREAK := DKLangConstW('fLabPrint_xxPAGE_BREAKxx');
74end;
75
76procedure PrintLabs(AReports: Integer; const ALabTitle: string; ADaysBack: Integer);
77{ displays a form that prompts for a device and then prints the report }
78var
79 frmLabPrint: TfrmLabPrint;
80 DefPrt: string;
81begin
82 frmLabPrint := TfrmLabPrint.Create(Application);
83 try
84 ResizeAnchoredFormToFont(frmLabPrint);
85 with frmLabPrint do
86 begin
87 lblLabTitle.Text := ALabTitle;
88 FReports := AReports;
89 FDaysBack := ADaysBack;
90 DefPrt := GetDefaultPrinter(User.Duz, Encounter.Location);
91 if User.CurrentPrinter = '' then User.CurrentPrinter := DefPrt;
92 with cboDevice do
93 begin
94 if Printer.Printers.Count > 0 then
95 begin
96// Items.Add('WIN;Windows Printer^Windows Printer'); <-- original line. //kt 7/19/2007
97 Items.Add('WIN;'+DKLangConstW('fLabPrint_Windows_Printer')+'^'+DKLangConstW('fLabPrint_Windows_Printer')); //kt added 7/19/2007
98// Items.Add('^--------------------VistA Printers----------------------'); <-- original line. //kt 7/19/2007
99 Items.Add('^'+DKLangConstW('fLabPrint_xxxxxxxxxxxxxxxxxxxxxVistA_Printersxxxxxxxxxxxxxxxxxxxxxx')); //kt added 7/19/2007
100 end;
101 if User.CurrentPrinter <> '' then
102 begin
103 InitLongList(Piece(User.CurrentPrinter, ';', 2));
104 SelectByID(User.CurrentPrinter);
105 end
106 else
107 InitLongList('');
108 end;
109// if (DefPrt = 'WIN;Windows Printer') and <-- original line. //kt 7/19/2007
110 if (DefPrt = DKLangConstW('fLabPrint_WINxWindows_Printer')) and //kt added 7/19/2007
111 (User.CurrentPrinter = DefPrt) then
112 cmdOKClick(frmLabPrint)
113 else
114 ShowModal;
115 end;
116 finally
117 frmLabPrint.Release;
118 end;
119end;
120
121procedure TfrmLabPrint.DisplaySelectDevice;
122begin
123 with cboDevice, lblPrintTo do
124 begin
125// Caption := 'Print Report on: ' + Piece(ItemID, ';', 2); <-- original line. //kt 7/19/2007
126 Caption := DKLangConstW('fLabPrint_Print_Report_onx') + Piece(ItemID, ';', 2); //kt added 7/19/2007
127 end;
128end;
129
130procedure TfrmLabPrint.FormCreate(Sender: TObject);
131begin
132 inherited;
133 FReportText := TRichEdit.Create(Self);
134 with FReportText do
135 begin
136 Parent := Self;
137 Visible := False;
138 Width := 600;
139 end;
140end;
141
142procedure TfrmLabPrint.cboDeviceChange(Sender: TObject);
143begin
144 inherited;
145 with cboDevice do if ItemIndex > -1 then
146 begin
147 txtRightMargin.Text := Piece(Items[ItemIndex], '^', 4);
148 txtPageLength.Text := Piece(Items[ItemIndex], '^', 5);
149 DisplaySelectDevice;
150 end;
151end;
152
153procedure TfrmLabPrint.cboDeviceNeedData(Sender: TObject;
154 const StartFrom: String; Direction, InsertAt: Integer);
155begin
156inherited;
157 cboDevice.ForDataUse(SubsetOfDevices(StartFrom, Direction));
158end;
159
160procedure TfrmLabPrint.cmdOKClick(Sender: TObject);
161var
162 ADevice, ErrMsg: string;
163 daysback: integer;
164 date1, date2: TFMDateTime;
165 today: TDateTime;
166 RemoteSiteID: string; //for Remote site printing
167 RemoteQuery: string; //for Remote site printing
168begin
169 SetupVars; //kt added 7/19/2007 to replace constants with vars.
170 inherited;
171 RemoteSiteID := '';
172 RemoteQuery := '';
173 with frmLabs.TabControl1 do
174 if TabIndex > 0 then
175 begin
176 RemoteSiteID := TRemoteSite(Tabs.Objects[TabIndex]).SiteID;
177 RemoteQuery := TRemoteSite(Tabs.Objects[TabIndex]).CurrentLabQuery;
178 end;
179 if cboDevice.ItemID = '' then
180 begin
181 InfoBox(TX_NODEVICE, TX_NODEVICE_CAP, MB_OK);
182 Exit;
183 end;
184 today := frmLabs.FMToDateTime(floattostr(FMToday));
185 if frmLabs.lstDates.ItemIEN > 0 then
186 begin
187 daysback := frmLabs.lstDates.ItemIEN;
188 date1 := FMToday;
189 If daysback = 1 then
190 date2 := DateTimeToFMDateTime(today)
191 Else
192 date2 := DateTimeToFMDateTime(today - daysback);
193 end
194 else
195 frmLabs.BeginEndDates(date1,date2,daysback);
196 date1 := date1 + 0.2359;
197//if Piece(cboDevice.ItemID, ';', 1) = 'WIN' then <-- original line. //kt 7/19/2007
198 if Piece(cboDevice.ItemID, ';', 1) = DKLangConstW('fLabPrint_WIN') then //kt added 7/19/2007
199 begin
200 if dlgWinPrinter.Execute then with FReportText do
201 begin
202 Lines.Assign(GetFormattedLabReport(FReports, FDaysBack, Patient.DFN,
203 frmLabs.lstTests.Items, date1, date2, RemoteSiteID, RemoteQuery));
204 PrintWindowsReport(FReportText, PAGE_BREAK, Self.Caption, ErrMsg, Application); //kt 8/09 added 'Application'
205 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
206 end;
207 end
208 else
209 begin
210 ADevice := Piece(cboDevice.ItemID, ';', 2);
211 PrintLabsToDevice(FReports, FDaysBack, Patient.DFN, ADevice,
212 frmLabs.lstTests.Items, ErrMsg, date1, date2, RemoteSiteID, RemoteQuery);
213 ErrMsg := Piece(FReportText.Lines[0], U, 2);
214 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
215 end;
216 if chkDefault.Checked then SaveDefaultPrinter(Piece(cboDevice.ItemID, ';', 1));
217 User.CurrentPrinter := cboDevice.ItemID;
218 Close;
219end;
220
221procedure TfrmLabPrint.cmdCancelClick(Sender: TObject);
222begin
223inherited;
224 Close;
225end;
226
227procedure TfrmLabPrint.FormDestroy(Sender: TObject);
228begin
229 FReportText.Free;
230 inherited;
231end;
232
233end.
Note: See TracBrowser for help on using the repository browser.