source: cprs/trunk/CPRS-Chart/fLabPrint.pas@ 730

Last change on this file since 730 was 456, checked in by Kevin Toppenberg, 16 years ago

Initial Upload of Official WV CPRS 1.0.26.76

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