source: cprs/trunk/CPRS-Chart/fNotePrt.pas@ 873

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

Upgrading to version 27

File size: 6.5 KB
RevLine 
[456]1unit fNotePrt;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
[830]7 fAutoSz, ORCtrls, StdCtrls, Mask, ORNet, ORFn, ComCtrls,
8 VA508AccessibilityManager;
[456]9
10type
11 TfrmNotePrint = 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 lblNoteTitle: 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);
34 private
35 { Private declarations }
36 FNote: Integer;
37 FReportText: TRichEdit;
38 procedure DisplaySelectDevice;
39 public
40 { Public declarations }
41 end;
42
43procedure PrintNote(ANote: Longint; const ANoteTitle: string; MultiNotes: boolean = False);
44
45implementation
46
47{$R *.DFM}
48
[830]49uses rCore, rTIU, rReports, uCore, Printers, uReports;
[456]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 PrintNote(ANote: Longint; const ANoteTitle: string; MultiNotes: boolean = False);
58{ displays a form that prompts for a device and then prints the progress note }
59var
60 frmNotePrint: TfrmNotePrint;
61 DefPrt: string;
62begin
63 frmNotePrint := TfrmNotePrint.Create(Application);
64 try
65 ResizeFormToFont(TForm(frmNotePrint));
66 with frmNotePrint do
67 begin
68 { check to see of Chart Print allowed outside of MAS }
69 if AllowChartPrintForNote(ANote) then
70 begin
71 {This next code begs the question: Why are we even bothering to check
72 radWorkCopy if we immediately check the other button?
73 Short answer: it seems to wokr better
74 Long answer: The checkboxes have to in some way register with the group
75 they are in. If this doesn't happen, both will be initially included
76 the tab order. This means that the first time tabbing through the
77 controls, the work copy button would be tabbed to and selected after the
78 chart copy. Tabbing through controls should not change the group
79 selection.
80 }
81 radWorkCopy.Checked := True;
82 radChartCopy.Checked := True;
83 end
84 else
85 begin
86 radChartCopy.Enabled := False;
87 radWorkCopy.Checked := True;
88 end;
89
90 lblNoteTitle.Text := ANoteTitle;
91 frmNotePrint.Caption := 'Print ' + Piece(Piece(ANoteTitle, #9, 2), ',', 1);
92 FNote := ANote;
93 DefPrt := GetDefaultPrinter(User.Duz, Encounter.Location);
94
95 if User.CurrentPrinter = '' then User.CurrentPrinter := DefPrt;
96
97 with cboDevice do
98 begin
99 if Printer.Printers.Count > 0 then
100 begin
101 Items.Add('WIN;Windows Printer^Windows Printer');
102 Items.Add('^--------------------VistA Printers----------------------');
103 end;
104 if User.CurrentPrinter <> '' then
105 begin
106 InitLongList(Piece(User.CurrentPrinter, ';', 2));
107 SelectByID(User.CurrentPrinter);
108 end
109 else
110 InitLongList('');
111 end;
112
113 if ((DefPrt = 'WIN;Windows Printer') and (User.CurrentPrinter = DefPrt)) then
114 cmdOKClick(frmNotePrint) //CQ6660
115 //Commented out for CQ6660
116 //or
117 //((User.CurrentPrinter <> '') and
118 //(MultiNotes = True)) then
119 //frmNotePrint.cmdOKClick(frmNotePrint)
120 //end CQ6660
121 else
122 frmNotePrint.ShowModal;
123 end;
124 finally
125 frmNotePrint.Release;
126 end;
127end;
128
129procedure TfrmNotePrint.DisplaySelectDevice;
130begin
131 with cboDevice, lblPrintTo do
132 begin
133 if radChartCopy.Checked then Caption := 'Print Chart Copy on: ' + Piece(ItemID, ';', 2);
134 if radWorkCopy.Checked then Caption := 'Print Work Copy on: ' + Piece(ItemID, ';', 2);
135 end;
136end;
137
138procedure TfrmNotePrint.cboDeviceNeedData(Sender: TObject; const StartFrom: string;
139 Direction, InsertAt: Integer);
140begin
141 inherited;
142 cboDevice.ForDataUse(SubsetOfDevices(StartFrom, Direction));
143end;
144
145procedure TfrmNotePrint.cboDeviceChange(Sender: TObject);
146begin
147 inherited;
148 with cboDevice do if ItemIndex > -1 then
149 begin
150 txtRightMargin.Text := Piece(Items[ItemIndex], '^', 4);
151 txtPageLength.Text := Piece(Items[ItemIndex], '^', 5);
152 DisplaySelectDevice;
153 end;
154end;
155
156procedure TfrmNotePrint.radChartCopyClick(Sender: TObject);
157begin
158 inherited;
159 DisplaySelectDevice;
160end;
161
162procedure TfrmNotePrint.radWorkCopyClick(Sender: TObject);
163begin
164 inherited;
165 DisplaySelectDevice;
166end;
167
168procedure TfrmNotePrint.cmdOKClick(Sender: TObject);
169var
170 ADevice, ErrMsg: string;
171 ChartCopy: Boolean;
172 RemoteSiteID: string; //for Remote site printing
173 RemoteQuery: string; //for Remote site printing
174begin
175 inherited;
176 RemoteSiteID := '';
177 RemoteQuery := '';
178
179 if cboDevice.ItemID = '' then
180 begin
181 InfoBox(TX_NODEVICE, TX_NODEVICE_CAP, MB_OK);
182 Exit;
183 end;
184
185 if radChartCopy.Checked then
186 ChartCopy := True
187 else ChartCopy := False;
188
189
190 if Piece(cboDevice.ItemID, ';', 1) = 'WIN' then
191 begin
192 if dlgWinPrinter.Execute then
193 begin
[830]194 FReportText := CreateReportTextComponent(Self);
195 FastAssign(GetFormattedNote(FNote, ChartCopy), FReportText.Lines);
[456]196 PrintWindowsReport(FReportText, PAGE_BREAK, Self.Caption, ErrMsg);
197 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
198 end
199 end
200 else
201 begin
202 ADevice := Piece(cboDevice.ItemID, ';', 2);
203 PrintNoteToDevice(FNote, ADevice, ChartCopy, ErrMsg);
204
205 if Length(ErrMsg) > 0 then
206 InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
207 end;
208
209 if chkDefault.Checked then
210 SaveDefaultPrinter(Piece(cboDevice.ItemID, ';', 1));
[830]211
[456]212 User.CurrentPrinter := cboDevice.ItemID;
213 Close;
214end;
215
216procedure TfrmNotePrint.cmdCancelClick(Sender: TObject);
217begin
218 inherited;
219 Close;
220end;
221
222end.
Note: See TracBrowser for help on using the repository browser.