source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Orders/fOrdersPrint.pas@ 1679

Last change on this file since 1679 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27
File size: 11.2 KB
Line 
1unit fOrdersPrint;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ORCtrls, ORfn, ExtCtrls, rOrders, fFrame, fBase508Form,
8 VA508AccessibilityManager;
9
10type
11 TfrmOrdersPrint = class(TfrmBase508Form)
12 ckChartCopy: TCheckBox;
13 ckLabels: TCheckBox;
14 ckRequisitions: TCheckBox;
15 ckWorkCopy: TCheckBox;
16 lstChartDevice: TORListBox;
17 lstLabelDevice: TORListBox;
18 lstReqDevice: TORListBox;
19 lstWorkDevice: TORListBox;
20 cmdChart: TORAlignButton;
21 cmdLabels: TORAlignButton;
22 cmdReqs: TORAlignButton;
23 cmdWork: TORAlignButton;
24 cmdOK: TORAlignButton;
25 cmdCancel: TORAlignButton;
26 pnlBase: TORAutoPanel;
27 lblDevice: TLabel;
28 lblPartOne: TMemo;
29 lblPart2: TMemo;
30 procedure SetupControls(PrintParams: TPrintParams);
31 procedure cmdChartClick(Sender: TObject);
32 procedure cmdLabelsClick(Sender: TObject);
33 procedure cmdReqsClick(Sender: TObject);
34 procedure cmdWorkClick(Sender: TObject);
35 procedure cmdOKClick(Sender: TObject);
36 procedure cmdCancelClick(Sender: TObject);
37 procedure ckChartCopyClick(Sender: TObject);
38 procedure ckLabelsClick(Sender: TObject);
39 procedure ckRequisitionsClick(Sender: TObject);
40 procedure ckWorkCopyClick(Sender: TObject);
41 procedure DeviceListClick(Sender: TObject);
42 procedure FormKeyUp(Sender: TObject; var Key: Word;
43 Shift: TShiftState);
44 private
45 FPrintIt: boolean;
46 FSelectAll: boolean;
47 FDevices: string;
48 FNature: char;
49 procedure SetupPrompting(CheckBox: TCheckBox; DeviceList: TORListBox; ChangeButton: TORAlignButton;
50 PromptParam: char; DeviceParam: string);
51 end;
52
53var
54 frmOrdersPrint: TfrmOrdersPrint;
55 PrintParams: TPrintParams;
56 AnyPrompts: boolean;
57 ResultList: TStringList;
58
59const
60 NO_WIN_PRINT = False;
61
62procedure SetupOrdersPrint(OrderList: TStringList; var DeviceInfo: string; Nature: Char; SelectAll: Boolean; var PrintIt: Boolean;
63 PrintTitle: string = ''; PrintLoc: Integer = 0);
64
65implementation
66
67{$R *.DFM}
68
69uses
70 fDeviceSelect, uCore, ORNet, fOrders;
71
72procedure SetupOrdersPrint(OrderList: TStringList; var DeviceInfo: string; Nature: Char; SelectAll: Boolean; var PrintIt: Boolean;
73 PrintTitle: string = ''; PrintLoc: Integer = 0);
74{displays device and copy selection form for printing orders, and returns a record of the selections}
75var
76 frmOrdersPrint: TfrmOrdersPrint;
77begin
78 frmOrdersPrint := TfrmOrdersPrint.Create(Application);
79 if PrintTitle <> '' then frmOrdersPrint.Caption := 'Print Orders for ' + PrintTitle;
80 try
81 frmFrame.CCOWBusy := True;
82 ResizeFormToFont(TForm(frmOrdersPrint));
83 with frmOrdersPrint do
84 begin
85 FSelectAll := SelectAll;
86 FPrintIt := False;
87 FNature := Nature;
88 if Nature = #0 then
89 begin
90 cmdCancel.Caption := 'Cancel Print';
91 lblPart2.Text := 'Greyed out items are not available.';
92 end;
93 OrderPrintDeviceInfo(OrderList, PrintParams, Nature, PrintLoc);
94 SetupControls(PrintParams);
95 if (PrintParams.AnyPrompts) {or FSelectAll} then ShowModal;
96 DeviceInfo := FDevices;
97 PrintIt := FPrintIt;
98 end;
99 finally
100 frmFrame.CCOWBusy := False;
101 frmOrdersPrint.Release;
102 end;
103end;
104
105procedure TfrmOrdersPrint.SetupControls(PrintParams: TPrintParams);
106begin
107 with PrintParams do
108 begin
109 SetupPrompting(ckChartCopy , lstChartDevice, cmdChart , PromptForChartCopy , ChartCopyDevice);
110 SetupPrompting(ckLabels , lstLabelDevice, cmdLabels, PromptForLabels , LabelDevice);
111 SetupPrompting(ckRequisitions, lstReqDevice, cmdReqs , PromptForRequisitions, RequisitionDevice);
112 SetupPrompting(ckWorkCopy , lstWorkDevice, cmdWork , PromptForWorkCopy , WorkCopyDevice);
113 FDevices := lstChartDevice.ItemID + U +
114 lstLabelDevice.ItemID + U +
115 lstReqDevice.ItemID + U +
116 lstWorkDevice.ItemID;
117 FPrintIt := not (FDevices = '^^^');
118 end;
119end;
120
121procedure TfrmOrdersPrint.SetupPrompting(CheckBox: TCheckBox; DeviceList: TORListBox; ChangeButton: TORAlignButton;
122 PromptParam: char; DeviceParam: string);
123{ 0 - no prompts - copy is automatically generated.
124 checkbox checked and disabled, device defaulted and button disabled
125 1 - prompt for copy and ask which printer should be used.
126 checkbox unchecked and enabled, device defaulted and button enabled
127 2 - prompt for copy and automatically print to the
128 printer defined in the XXXXX COPY PRINT DEVICE field.
129 checkbox unchecked and enabled, device defaulted and button disabled
130 * - don't print.
131 checkbox unchecked and disabled, device empty and button disabled
132}
133begin
134 case PromptParam of
135 '0', #0: begin
136 CheckBox.Checked := DeviceParam <> '';
137 CheckBox.Enabled := False;
138 DeviceList.Clear;
139 if DeviceParam <> '' then
140 begin
141 DeviceList.Items.Add(DeviceParam);
142 DeviceList.Font.Color := clGrayText;
143 DeviceList.ItemIndex := 0;
144 CheckBox.Font.Style := CheckBox.Font.Style + [fsBold];
145 CheckBox.Font.Color := clInfoText;
146 CheckBox.Color := clInfoBk;
147 end
148 else
149 begin
150 CheckBox.State := cbUnchecked;
151 CheckBox.Enabled := False;
152 end;
153 ChangeButton.Enabled := False;
154 end;
155 '1': begin
156 CheckBox.State := cbUnchecked;
157 CheckBox.Enabled := True;
158 DeviceList.Clear;
159 if DeviceParam <> '' then DeviceList.Items.Add(DeviceParam);
160 ChangeButton.Enabled := False;
161 end;
162 '2': begin
163 CheckBox.State := cbUnchecked;
164 CheckBox.Enabled := True;
165 DeviceList.Clear;
166 if DeviceParam <> '' then
167 DeviceList.Items.Add(DeviceParam)
168 else
169 begin
170 CheckBox.State := cbUnchecked;
171 CheckBox.Enabled := False;
172 end;
173 ChangeButton.Enabled := False;
174 end;
175 '*': begin
176 CheckBox.State := cbUnchecked;
177 CheckBox.Enabled := False;
178 DeviceList.Clear;
179 ChangeButton.Enabled := False;
180 end;
181 end;
182end;
183
184procedure TfrmOrdersPrint.cmdChartClick(Sender: TObject);
185var
186 x: string;
187begin
188 x := SelectDevice(Self, Encounter.Location, NO_WIN_PRINT,'');
189 if x <> '' then with lstChartDevice do
190 begin
191 Clear;
192 Items.Add(x);
193 end;
194end;
195
196procedure TfrmOrdersPrint.cmdLabelsClick(Sender: TObject);
197var
198 x: string;
199begin
200 x := SelectDevice(Self, Encounter.Location, NO_WIN_PRINT,'');
201 if x <> '' then with lstLabelDevice do
202 begin
203 Clear;
204 Items.Add(x);
205 end;
206end;
207
208procedure TfrmOrdersPrint.cmdReqsClick(Sender: TObject);
209var
210 x: string;
211begin
212 x := SelectDevice(Self, Encounter.Location, NO_WIN_PRINT,'');
213 if x <> '' then with lstReqDevice do
214 begin
215 Clear;
216 Items.Add(x);
217 end;
218end;
219
220procedure TfrmOrdersPrint.cmdWorkClick(Sender: TObject);
221var
222 x: string;
223begin
224 x := SelectDevice(Self, Encounter.Location, NO_WIN_PRINT,'');
225 if x <> '' then with lstWorkDevice do
226 begin
227 Clear;
228 Items.Add(x);
229 end;
230end;
231
232procedure TfrmOrdersPrint.cmdOKClick(Sender: TObject);
233const
234 TX_NO_SELECTION = 'No copies were selected for printing. Check a copy type, or Cancel.';
235 TX_NO_SELECTION_CAP = 'Nothing Selected!';
236begin
237 if not ckChartCopy.Checked then lstChartDevice.ItemIndex := -1 else lstChartDevice.ItemIndex := 0;
238 if not ckLabels.Checked then lstLabelDevice.ItemIndex := -1 else lstLabelDevice.ItemIndex := 0;
239 if not ckRequisitions.Checked then lstReqDevice.ItemIndex := -1 else lstReqDevice.ItemIndex := 0;
240 if not ckWorkCopy.Checked then lstWorkDevice.ItemIndex := -1 else lstWorkDevice.ItemIndex := 0;
241 FDevices := Piece(lstChartDevice.ItemID, ';', 1) + U +
242 Piece(lstLabelDevice.ItemID, ';', 1) + U +
243 Piece(lstReqDevice.ItemID, ';', 1) + U +
244 Piece(lstWorkDevice.ItemID, ';', 1);
245 if FDevices = '^^^' then
246 begin
247 FPrintIt := False;
248 InfoBox(TX_NO_SELECTION, TX_NO_SELECTION_CAP, MB_OK)
249 end
250 else
251 begin
252 FPrintIt := True;
253 Close;
254 end;
255end;
256
257procedure TfrmOrdersPrint.cmdCancelClick(Sender: TObject);
258// Force autoprint of 'don't prompt' items, regardless of continue/cancel selection.
259begin
260 if FNature = #0 then FDevices := '^^^'
261 else with PrintParams do
262 begin
263 if (PromptForChartCopy = '0') or (PromptForChartCopy = #0) then
264 begin
265 if not ckChartCopy.Checked then lstChartDevice.ItemIndex := -1
266 else lstChartDevice.ItemIndex := 0;
267 end
268 else lstChartDevice.ItemIndex := -1;
269
270 if (PromptForLabels = '0') or (PromptForLabels = #0) then
271 begin
272 if not ckLabels.Checked then lstLabelDevice.ItemIndex := -1
273 else lstLabelDevice.ItemIndex := 0;
274 end
275 else lstLabelDevice.ItemIndex := -1;
276
277 if (PromptForRequisitions = '0') or (PromptForRequisitions = #0) then
278 begin
279 if not ckRequisitions.Checked then lstReqDevice.ItemIndex := -1
280 else lstReqDevice.ItemIndex := 0;
281 end
282 else lstReqDevice.ItemIndex := -1;
283
284 if (PromptForWorkCopy = '0') or (PromptForWorkCopy = #0) then
285 begin
286 if not ckWorkCopy.Checked then lstWorkDevice.ItemIndex := -1
287 else lstWorkDevice.ItemIndex := 0;
288 end
289 else lstWorkDevice.ItemIndex := -1;
290
291 FDevices := Piece(lstChartDevice.ItemID, ';', 1) + U +
292 Piece(lstLabelDevice.ItemID, ';', 1) + U +
293 Piece(lstReqDevice.ItemID, ';', 1) + U +
294 Piece(lstWorkDevice.ItemID, ';', 1);
295 end;
296
297 FPrintIt := (FDevices <> '^^^');
298 Close;
299end;
300
301procedure TfrmOrdersPrint.ckChartCopyClick(Sender: TObject);
302begin
303 cmdChart.Enabled := (ckChartCopy.Checked) and (PrintParams.PromptForChartCopy <> '2');
304end;
305
306procedure TfrmOrdersPrint.ckLabelsClick(Sender: TObject);
307begin
308 cmdLabels.Enabled := (ckLabels.Checked) and (PrintParams.PromptForLabels <> '2');
309end;
310
311procedure TfrmOrdersPrint.ckRequisitionsClick(Sender: TObject);
312begin
313 cmdReqs.Enabled := (ckRequisitions.Checked) and (PrintParams.PromptForRequisitions <> '2');
314end;
315
316procedure TfrmOrdersPrint.ckWorkCopyClick(Sender: TObject);
317begin
318 cmdWork.Enabled := (ckWorkCopy.Checked) and (PrintParams.PromptForWorkCopy <> '2');
319end;
320
321procedure TfrmOrdersPrint.DeviceListClick(Sender: TObject);
322begin
323 TORListBox(Sender).ItemIndex := -1;
324end;
325
326procedure TfrmOrdersPrint.FormKeyUp(Sender: TObject; var Key: Word;
327 Shift: TShiftState);
328begin
329 if Key = VK_ESCAPE then
330 begin
331 Key := 0;
332 Close;
333 end;
334end;
335
336end.
337
Note: See TracBrowser for help on using the repository browser.