source: cprs/trunk/CPRS-Chart/Consults/fConsult513Prt.pas@ 1655

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

Upgrade to version 27

File size: 5.3 KB
RevLine 
[456]1unit fConsult513Prt;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
[829]7 fAutoSz, ORCtrls, StdCtrls, Mask, ORNet, ORFn, ComCtrls,
8 VA508AccessibilityManager, uReports;
[456]9
10type
11 Tfrm513Print = class(TfrmAutoSz)
12 grpChooseCopy: TGroupBox;
13 radChartCopy: TRadioButton;
14 radWorkCopy: TRadioButton;
15 grpDevice: TGroupBox;
16 lblMargin: TLabel;
17 lblLength: TLabel;
18 txtRightMargin: TMaskEdit;
19 txtPageLength: TMaskEdit;
20 cmdOK: TButton;
21 cmdCancel: TButton;
22 lblConsultTitle: TMemo;
23 cboDevice: TORComboBox;
24 lblPrintTo: TLabel;
25 dlgWinPrinter: TPrintDialog;
26 chkDefault: TCheckBox;
27 procedure cboDeviceNeedData(Sender: TObject; const StartFrom: String;
28 Direction, InsertAt: Integer);
29 procedure cboDeviceChange(Sender: TObject);
30 procedure radChartCopyClick(Sender: TObject);
31 procedure radWorkCopyClick(Sender: TObject);
32 procedure cmdOKClick(Sender: TObject);
33 procedure cmdCancelClick(Sender: TObject);
[829]34
[456]35 private
36 { Private declarations }
37 FConsult: Integer;
38 FReportText: TRichEdit;
39 procedure DisplaySelectDevice;
40 public
41 { Public declarations }
42 end;
43
44procedure PrintSF513(AConsult: Longint; AConsultTitle: string);
45
46implementation
47
48{$R *.DFM}
49
50uses rCore, rConsults, Printers, rReports, uCore;
51
52const
53 TX_NODEVICE = 'A device must be selected to print, or press ''Cancel'' to not print.';
54 TX_NODEVICE_CAP = 'Device Not Selected';
55 TX_ERR_CAP = 'Print Error';
56 TX_QUEUED_CAP = 'Printing Report' ;
57 PAGE_BREAK = '**PAGE BREAK**';
58
59procedure PrintSF513(AConsult: Longint; AConsultTitle: string);
60{ displays a form that prompts for a device and then prints the SF513 }
61var
62 frm513Print: Tfrm513Print;
63 DefPrt: string;
64begin
65 frm513Print := Tfrm513Print.Create(Application);
66 try
67 ResizeFormToFont(TForm(frm513Print));
68 with frm513Print do
69 begin
70 lblConsultTitle.Text := AConsultTitle;
71 FConsult := AConsult;
72 DefPrt := GetDefaultPrinter(User.Duz, Encounter.Location);
73 if User.CurrentPrinter = '' then User.CurrentPrinter := DefPrt;
74 with cboDevice do
75 begin
76 if Printer.Printers.Count > 0 then
77 begin
78 Items.Add('WIN;Windows Printer^Windows Printer');
79 Items.Add('^--------------------VistA Printers----------------------');
80 end;
81 if User.CurrentPrinter <> '' then
82 begin
83 InitLongList(Piece(User.CurrentPrinter, ';', 2));
84 SelectByID(User.CurrentPrinter);
85 end
86 else
87 InitLongList('');
88 end;
89 if (DefPrt = 'WIN;Windows Printer') and
90 (User.CurrentPrinter = DefPrt) then
91 cmdOKClick(frm513Print)
92 else
93 ShowModal;
94 end;
95 finally
96 frm513Print.Release;
97 end;
98end;
99
100procedure Tfrm513Print.DisplaySelectDevice;
101begin
102 with cboDevice, lblPrintTo do
103 begin
104 if radChartCopy.Checked then Caption := 'Print Chart Copy on: ' + Piece(ItemID, ';', 2);
105 if radWorkCopy.Checked then Caption := 'Print Work Copy on: ' + Piece(ItemID, ';', 2);
106 end;
107end;
108
109procedure Tfrm513Print.cboDeviceNeedData(Sender: TObject; const StartFrom: string;
110 Direction, InsertAt: Integer);
111begin
112 inherited;
113 cboDevice.ForDataUse(SubsetOfDevices(StartFrom, Direction));
114end;
115
116procedure Tfrm513Print.cboDeviceChange(Sender: TObject);
117begin
118 inherited;
119 with cboDevice do if ItemIndex > -1 then
120 begin
121 txtRightMargin.Text := Piece(Items[ItemIndex], '^', 4);
122 txtPageLength.Text := Piece(Items[ItemIndex], '^', 5);
123 DisplaySelectDevice;
124 end;
125end;
126
127procedure Tfrm513Print.radChartCopyClick(Sender: TObject);
128begin
129 inherited;
130 DisplaySelectDevice;
131end;
132
133procedure Tfrm513Print.radWorkCopyClick(Sender: TObject);
134begin
135 inherited;
136 DisplaySelectDevice;
137end;
138
139procedure Tfrm513Print.cmdOKClick(Sender: TObject);
140var
141 ADevice, ErrMsg: string;
142 ChartCopy: string;
143 RemoteSiteID: string; //for Remote site printing
144 RemoteQuery: string; //for Remote site printing
145begin
146 inherited;
[829]147 FReportText := CreateReportTextComponent(Self);
[456]148 RemoteSiteID := '';
149 RemoteQuery := '';
150 if cboDevice.ItemID = '' then
151 begin
152 InfoBox(TX_NODEVICE, TX_NODEVICE_CAP, MB_OK);
153 Exit;
154 end;
155 if radChartCopy.Checked then ChartCopy := 'C' else ChartCopy := 'W';
156 if Piece(cboDevice.ItemID, ';', 1) = 'WIN' then
157 begin
158 if dlgWinPrinter.Execute then with FReportText do
159 begin
[829]160 QuickCopy(GetFormattedSF513(FConsult, ChartCopy), FReportText);
[456]161 PrintWindowsReport(FReportText, PAGE_BREAK, Self.Caption, ErrMsg);
162 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
163 end;
164 end
165 else
166 begin
167 ADevice := Piece(cboDevice.ItemID, ';', 2);
168 PrintSF513ToDevice(FConsult, ADevice, ChartCopy, ErrMsg);
169 ErrMsg := Piece(FReportText.Lines[0], U, 2);
170 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
171 end;
172 if chkDefault.Checked then SaveDefaultPrinter(Piece(cboDevice.ItemID, ';', 1));
173 User.CurrentPrinter := cboDevice.ItemID;
[829]174 FReportText.Free;
[456]175 Close;
176end;
177
178procedure Tfrm513Print.cmdCancelClick(Sender: TObject);
179begin
180 inherited;
181 Close;
182end;
183
184end.
Note: See TracBrowser for help on using the repository browser.