source: cprs/branches/tmg-cprs/CPRS-Chart/fReportsPrint.pas@ 611

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

TMG Ver 1.1 Added HTML Support, better demographics editing
File size: 25.2 KB
RevLine 
[453]1//kt -- Modified with SourceScanner on 8/20/2007
2unit fReportsPrint;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 StdCtrls, fAutoSz, ORCtrls, ORNet, Mask, ComCtrls, rECS, DKLang;
9
10type
11 TfrmReportPrt = class(TfrmAutoSz)
12 lblReportsTitle: 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 cmdOKClick(Sender: TObject);
28 procedure cmdCancelClick(Sender: TObject);
29 procedure cboDeviceNeedData(Sender: TObject; const StartFrom: String;
30 Direction, InsertAt: Integer);
31 procedure FormDestroy(Sender: TObject);
32 procedure FindVType;
33
34 private
35 //kt Begin Mod (change Consts to Vars) 8/20/2007
36 TX_NODEVICE : string; //kt
37 TX_NODEVICE_CAP : string; //kt
38 TX_ERR_CAP : string; //kt
39 //kt End Mod -------------------
40 { Private declarations }
41 FReports: string;
42 FReportText: TRichEdit;
43 procedure DisplaySelectDevice;
44 procedure SetupVars; //kt
45 public
46 { Public declarations }
47 end;
48
49var
50 frmReportPrt: TfrmReportPrt;
51
52procedure PrintReports(AReports: string; const AReportsTitle: string);
53function StringPad(aString: string; aStringCount, aPadCount: integer): String;
54
55implementation
56
57{$R *.DFM}
58
59uses ORFn, rCore, uCore, fReports, rReports, uReports, Printers, fFrame;
60
61const
62//TX_NODEVICE = 'A device must be selected to print, or press ''Cancel'' to not print.'; <-- original line. //kt 8/20/2007
63//TX_NODEVICE_CAP = 'Device Not Selected'; <-- original line. //kt 8/20/2007
64//TX_ERR_CAP = 'Print Error'; <-- original line. //kt 8/20/2007
65 PAGE_BREAK = '**PAGE BREAK**';
66 QT_OTHER = 0;
67 QT_HSTYPE = 1;
68 QT_DATERANGE = 2;
69 QT_IMAGING = 3;
70 QT_NUTR = 4;
71 QT_PROCEDURES = 19;
72 QT_SURGERY = 28;
73 QT_HSCOMPONENT = 5;
74 QT_HSWPCOMPONENT = 6;
75
76
77
78procedure PrintReports(AReports: string; const AReportsTitle: string);
79{ displays a form that prompts for a device and then prints the report }
80var
81 frmReportPrt: TfrmReportPrt;
82 DefPrt: string;
83begin
84 frmReportPrt := TfrmReportPrt.Create(Application);
85 try
86 ResizeFormToFont(TForm(frmReportPrt));
87 with frmReportPrt do
88 begin
89 lblReportsTitle.Text := AReportsTitle;
90 FReports := AReports;
91 DefPrt := GetDefaultPrinter(User.Duz, Encounter.Location);
92 if User.CurrentPrinter = '' then User.CurrentPrinter := DefPrt;
93 with cboDevice do
94 begin
95 if Printer.Printers.Count > 0 then
96 begin
97 Items.Add('WIN;Windows Printer^Windows Printer');
98 Items.Add('^--------------------VistA Printers----------------------');
99 end;
100 if User.CurrentPrinter <> '' then
101 begin
102 InitLongList(Piece(User.CurrentPrinter, ';', 2));
103 SelectByID(User.CurrentPrinter);
104 end
105 else
106 InitLongList('');
107 end;
108 if (DefPrt = 'WIN;Windows Printer') and
109 (User.CurrentPrinter = DefPrt) then
110 cmdOKClick(frmReportPrt)
111 else
112 ShowModal;
113 end;
114 finally
115 frmReportPrt.Release;
116 end;
117end;
118
119
120procedure TfrmReportPrt.SetupVars;
121//kt Added entire function to replace constant declarations 8/20/2007
122begin
123 TX_NODEVICE := DKLangConstW('fReportsPrint_A_device_must_be_selected_to_printx_or_press_xxCancelxx_to_not_printx');
124 TX_NODEVICE_CAP := DKLangConstW('fReportsPrint_Device_Not_Selected');
125 TX_ERR_CAP := DKLangConstW('fReportsPrint_Print_Error');
126end;
127
128
129
130procedure TfrmReportPrt.FindVType;
131var
132 i,j,k,L,cnt: integer;
133 aBasket: TStringList;
134 aID, aHead, aData, aCol, x: string;
135 ListItem: TListItem;
136 aWPFlag: Boolean;
137begin
138 aBasket := TStringList.Create;
139 aBasket.Clear;
140 //frmReports.MemText.Clear;
141 aHead := '';
142 cnt := 2;
143 //aWPFlag := false;
144 for i := 0 to uColumns.Count - 1 do
145 begin
146 if (piece(uColumns[i],'^',7) = '1') and (not(piece(uColumns[i],'^',4) = '1')) then
147 begin
148 L := StrToIntDef(piece(uColumns[i],'^',6),15);
149 if length(piece(uColumns[i],'^',8)) > 0 then
150 x := piece(uColumns[i],'^',8)
151 else
152 x := piece(uColumns[i],'^',1);
153 x := StringPad(x, L, L+1);
154 if frmReports.TabControl1.Tabs.Count > 1 then
155 aHead := aHead + x
156 else
157 if i = 0 then
158 continue
159 else
160 aHead := aHead + x;
161 end;
162 end;
163 if length(aHead) > 0 then
164 begin
165 FReportText.Lines.Add(aHead);
166 FReportText.Lines.Add('-------------------------------------------------------------------------------');
167 //frmReports.memText.Lines.Add(aHead);
168 //frmReports.MemText.Lines.Add('-------------------------------------------------------------------------------');
169 end;
170 for i := 0 to frmReports.lvReports.Items.Count - 1 do
171 if frmReports.lvReports.Items[i].Selected then
172 begin
173 aData := '';
174 aWPFlag := false;
175 ListItem := frmReports.lvReports.Items[i];
176 aID := ListItem.SubItems[0];
177 if frmReports.TabControl1.Tabs.Count > 1 then
178 begin
179 L := StrToIntDef(piece(uColumns[0],'^',6),10);
180 x := StringPad(ListItem.Caption, L, L+1);
181 aData := x;
182 end;
183 for j := 0 to RowObjects.ColumnList.Count - 1 do
184 begin
185 aCol := TCellObject(RowObjects.ColumnList[j]).Handle;
186 if piece(aID,':',1) = piece(TCellObject(RowObjects.ColumnList[j]).Handle,':',1) then
187 if ListItem.Caption = (piece(TCellObject(RowObjects.ColumnList[j]).Site,';',1)) then
188 begin
189 if (piece(uColumns[StrToInt(piece(aCol,':',2))],'^',7) = '1') and
190 (not (piece(uColumns[StrToInt(piece(aCol,':',2))],'^',4) = '1')) then
191 begin
192 aBasket.Assign(TCellObject(RowObjects.ColumnList[j]).Data);
193 for k := 0 to aBasket.Count - 1 do
194 begin
195 L := StrToIntDef(piece(uColumns[StrToInt(piece(aCol,':',2))],'^',6),15);
196 x := StringPad(aBasket[k], L, L+1);
197 aData := aData + x;
198 end;
199 end;
200 end;
201 end;
202 //frmReports.memText.Lines.Add(aData);
203 FReportText.Lines.Add(aData);
204 cnt := cnt + 1;
205 if cnt > 40 then
206 begin
207 cnt := 0;
208 //frmReports.memText.Lines.Add('**PAGE BREAK**');
209 FReportText.Lines.Add('**PAGE BREAK**');
210 end;
211 for j := 0 to RowObjects.ColumnList.Count - 1 do
212 begin
213 aCol := TCellObject(RowObjects.ColumnList[j]).Handle;
214 if piece(aID,':',1) = piece(TCellObject(RowObjects.ColumnList[j]).Handle,':',1) then
215 if ListItem.Caption = (piece(TCellObject(RowObjects.ColumnList[j]).Site,';',1)) then
216 begin
217 if (piece(uColumns[StrToInt(piece(aCol,':',2))],'^',7) = '1') and
218 (piece(uColumns[StrToInt(piece(aCol,':',2))],'^',4) = '1') then
219 begin
220 aWPFlag := true;
221 aBasket.Assign(TCellObject(RowObjects.ColumnList[j]).Data);
222 //frmReports.MemText.Lines.Add(TCellObject(RowObjects.ColumnList[j]).Name);
223 FReportText.Lines.Add(TCellObject(RowObjects.ColumnList[j]).Name);
224 cnt := cnt + 1;
225 for k := 0 to aBasket.Count - 1 do
226 begin
227 //frmReports.memText.Lines.Add(' ' + aBasket[k]);
228 FReportText.Lines.Add(' ' + aBasket[k]);
229 cnt := cnt + 1;
230 if cnt > 40 then
231 begin
232 cnt := 0;
233 //frmReports.memText.Lines.Add('**PAGE BREAK**');
234 FReportText.Lines.Add('**PAGE BREAK**');
235 end;
236 end;
237 end;
238 end;
239 end;
240 if aWPFlag = true then
241 begin
242 //frmReports.MemText.Lines.Add('===============================================================================');
243 FReportText.Lines.Add('===============================================================================');
244 end;
245 end;
246 aBasket.Free;
247end;
248
249function StringPad(aString: string; aStringCount, aPadCount: integer): String;
250var
251 s: integer;
252begin
253 if aStringCount >= aPadCount then
254 aStringCount := aPadCount - 1;
255 Result := copy(aString, 1, aStringCount);
256 s := aPadCount - length(Result);
257 if s < 0 then s := 0;
258 Result := Result + StringOfChar(' ', s);
259end;
260
261procedure TfrmReportPrt.DisplaySelectDevice;
262begin
263 with cboDevice, lblPrintTo do
264 begin
265// Caption := 'Print Report on: ' + Piece(ItemID, ';', 2); <-- original line. //kt 8/20/2007
266 Caption := DKLangConstW('fReportsPrint_Print_Report_onx') + Piece(ItemID, ';', 2); //kt added 8/20/2007
267 end;
268end;
269
270procedure TfrmReportPrt.FormCreate(Sender: TObject);
271begin
272 inherited;
273 FReportText := TRichEdit.Create(Self);
274 with FReportText do
275 begin
276 Parent := Self;
277 Visible := False;
278 Width := 600;
279 end;
280end;
281
282procedure TfrmReportPrt.cboDeviceChange(Sender: TObject);
283begin
284 inherited;
285 with cboDevice do if ItemIndex > -1 then
286 begin
287 txtRightMargin.Text := Piece(Items[ItemIndex], '^', 4);
288 txtPageLength.Text := Piece(Items[ItemIndex], '^', 5);
289 DisplaySelectDevice;
290 end;
291end;
292
293procedure TfrmReportPrt.cmdOKClick(Sender: TObject);
294var
295 ADevice, ErrMsg: string;
296 RemoteSiteID: string;
297 RemoteQuery: string;
298 aQualifier: string;
299 aReport: TStringList;
300 aCaption: string;
301 i: integer;
302 ListItem: TListItem;
303 MoreID: String; //Restores MaxOcc value
304begin
305 SetupVars; //kt added 8/20/2007 to replace constants with vars.
306 inherited;
307 RemoteSiteID := '';
308 RemoteQuery := '';
309 MoreID := '';
310 aReport := TStringList.Create;
311 if uQualifier = '' then
312 aQualifier := piece(uRemoteType,'^',5) //Health Summary Type Report
313 else
314 begin
315 MoreID := ';' + Piece(uQualifier,';',3);
316 aQualifier := piece(uRemoteType,'^',5);
317 end;
318 with frmReports.TabControl1 do
319 if TabIndex > 0 then
320 begin
321 RemoteSiteID := TRemoteSite(Tabs.Objects[TabIndex]).SiteID;
322 RemoteQuery := TRemoteSite(Tabs.Objects[TabIndex]).CurrentReportQuery;
323 end;
324 if cboDevice.ItemID = '' then
325 begin
326 InfoBox(TX_NODEVICE, TX_NODEVICE_CAP, MB_OK);
327 Exit;
328 end;
329 if Piece(cboDevice.ItemID, ';', 1) = 'WIN' then
330 begin
331 if dlgWinPrinter.Execute then with FReportText do
332 begin
333 if uReportType = 'V' then
334 begin
335 case uQualifierType of
336 QT_IMAGING:
337 begin
338 for i := 0 to frmReports.lvReports.Items.Count - 1 do
339 if frmReports.lvReports.Items[i].Selected then
340 begin
341 ListItem := frmReports.lvReports.Items[i];
342 aQualifier := ListItem.SubItems[0];
343 ADevice := Piece(cboDevice.ItemID, ';', 2);
344 Lines.Assign(GetFormattedReport(FReports, aQualifier,
345 Patient.DFN, uHSComponents, RemoteSiteID, RemoteQuery, uHState));
346 aCaption := piece(uRemoteType,'^',4);
[541]347 PrintWindowsReport(FReportText, PAGE_BREAK, aCaption, ErrMsg, Application); //kt 8/09, Added ',Application'
[453]348 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
349 end;
350 end;
351 QT_NUTR:
352 begin
353 for i := 0 to frmReports.lvReports.Items.Count - 1 do
354 if frmReports.lvReports.Items[i].Selected then
355 begin
356 ListItem := frmReports.lvReports.Items[i];
357 aQualifier := ListItem.SubItems[0];
358 ADevice := Piece(cboDevice.ItemID, ';', 2);
359 Lines.Assign(GetFormattedReport(FReports, aQualifier + MoreID,
360 Patient.DFN, uHSComponents, RemoteSiteID, RemoteQuery, uHState));
361 aCaption := piece(uRemoteType,'^',4);
[541]362 PrintWindowsReport(FReportText, PAGE_BREAK, aCaption, ErrMsg, Application); //kt 8/09, Added ',Application'
[453]363 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
364 end;
365 end;
366 QT_HSCOMPONENT:
367 begin
368 if (length(piece(uHState,';',2)) > 0) then
369 begin
370 FReportText.Clear;
371 aReport.Clear;
372 CreatePatientHeader(aReport,piece(uRemoteType,'^',4));
373 FReportText.Lines.Assign(aReport);
374 FindVType;
375 aCaption := piece(uRemoteType,'^',4) + ';1';
[541]376 PrintWindowsReport(FReportText, PAGE_BREAK, aCaption, ErrMsg, Application); //kt 8/09, Added ',Application'
[453]377 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
378 end
379 else
380 begin
381 Lines.Assign(GetFormattedReport(FReports, aQualifier + MoreID,
382 Patient.DFN, uHSComponents, RemoteSiteID, RemoteQuery, uHState));
383 aCaption := piece(uRemoteType,'^',4);
[541]384 PrintWindowsReport(FReportText, PAGE_BREAK, aCaption, ErrMsg, Application); //kt 8/09, Added ',Application'
[453]385 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
386 end;
387 end;
388 QT_HSWPCOMPONENT:
389 begin
390 if (length(piece(uHState,';',2)) > 0) then
391 begin
392 FReportText.Clear;
393 aReport.Clear;
394 CreatePatientHeader(aReport,piece(uRemoteType,'^',4));
395 FReportText.Lines.Assign(aReport);
396 FindVType;
397 aCaption := piece(uRemoteType,'^',4) + ';1';
[541]398 PrintWindowsReport(FReportText, PAGE_BREAK, aCaption, ErrMsg, Application); //kt 8/09, Added ',Application'
[453]399 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
400 end
401 else
402 begin
403 Lines.Assign(GetFormattedReport(FReports, aQualifier + MoreID,
404 Patient.DFN, uHSComponents, RemoteSiteID, RemoteQuery, uHState));
405 aCaption := piece(uRemoteType,'^',4);
[541]406 PrintWindowsReport(FReportText, PAGE_BREAK, aCaption, ErrMsg, Application); //kt 8/09, Added ',Application'
[453]407 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
408 end;
409 end;
410 QT_PROCEDURES:
411 begin
412 for i := 0 to frmReports.lvReports.Items.Count - 1 do
413 if frmReports.lvReports.Items[i].Selected then
414 begin
415 ListItem := frmReports.lvReports.Items[i];
416 aQualifier := ListItem.SubItems[0];
417 ADevice := Piece(cboDevice.ItemID, ';', 2);
418 Lines.Assign(GetFormattedReport(FReports, aQualifier,
419 Patient.DFN, uHSComponents, RemoteSiteID, RemoteQuery, uHState));
420 aCaption := piece(uRemoteType,'^',4);
[541]421 PrintWindowsReport(FReportText, PAGE_BREAK, aCaption, ErrMsg, Application); //kt 8/09, Added ',Application'
[453]422 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
423 end;
424 end;
425 QT_SURGERY:
426 begin
427 for i := 0 to frmReports.lvReports.Items.Count - 1 do
428 if frmReports.lvReports.Items[i].Selected then
429 begin
430 ListItem := frmReports.lvReports.Items[i];
431 aQualifier := ListItem.SubItems[0];
432 ADevice := Piece(cboDevice.ItemID, ';', 2);
433 Lines.Assign(GetFormattedReport(FReports, aQualifier,
434 Patient.DFN, uHSComponents, RemoteSiteID, RemoteQuery, uHState));
435 aCaption := piece(uRemoteType,'^',4);
[541]436 PrintWindowsReport(FReportText, PAGE_BREAK, aCaption, ErrMsg, Application); //kt 8/09, Added ',Application'
[453]437 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
438 end;
439 end;
440 end;
441 end
442 else
443 begin
444 if (Pos('OR_ECS1',FReports)>0) or (Pos('OR_ECS2',FReports)>0) then
445 begin
446// ShowMessage('The Event Capture report can only be printed by Vista printer.'); <-- original line. //kt 8/20/2007
447 ShowMessage(DKLangConstW('fReportsPrint_The_Event_Capture_report_can_only_be_printed_by_Vista_printerx')); //kt added 8/20/2007
448 Exit;
449 end;
450 aQualifier := Piece(uRemoteType,'^',5);
451 Lines.Assign(GetFormattedReport(FReports, aQualifier,
452 Patient.DFN, uHSComponents, RemoteSiteID, RemoteQuery, uHState));
453 aCaption := piece(uRemoteType,'^',4);
[541]454 PrintWindowsReport(FReportText, PAGE_BREAK, aCaption, ErrMsg, Application); //kt 8/09, Added ',Application'
[453]455 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
456 end;
457 end;
458 end
459 else // if it's not a Win printer
460 begin
461 if uReportType = 'V' then
462 begin
463 case uQualifierType of
464 QT_IMAGING:
465 begin
466 for i := 0 to frmReports.lvReports.Items.Count - 1 do
467 if frmReports.lvReports.Items[i].Selected then
468 begin
469 ListItem := frmReports.lvReports.Items[i];
470 aQualifier := ListItem.SubItems[0];
471 ADevice := Piece(cboDevice.ItemID, ';', 2);
472 PrintReportsToDevice(piece(FReports,':',1), aQualifier + MoreID,
473 Patient.DFN, ADevice, ErrMsg, uHSComponents, RemoteSiteID, RemoteQuery, uHState);
474 ErrMsg := Piece(FReportText.Lines[0], U, 2);
475 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
476 end;
477 end;
478 QT_NUTR:
479 begin
480 for i := 0 to frmReports.lvReports.Items.Count - 1 do
481 if frmReports.lvReports.Items[i].Selected then
482 begin
483 ListItem := frmReports.lvReports.Items[i];
484 aQualifier := ListItem.SubItems[0];
485 ADevice := Piece(cboDevice.ItemID, ';', 2);
486 PrintReportsToDevice(piece(FReports,':',1), aQualifier + MoreID,
487 Patient.DFN, ADevice, ErrMsg, uHSComponents, RemoteSiteID, RemoteQuery, uHState);
488 ErrMsg := Piece(FReportText.Lines[0], U, 2);
489 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
490 end;
491 end;
492 QT_HSCOMPONENT:
493 begin
494 if (length(piece(uHState,';',2)) > 0) then
495 begin
496 FindVType;
497 aReport.Clear;
498 aReport.Assign(FReportText.Lines);
499 ADevice := Piece(cboDevice.ItemID, ';', 2);
500 PrintVReports(ErrMsg, ADevice, piece(uRemoteType,'^',4),aReport);
501 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
502 end
503 else
504 begin
505 ADevice := Piece(cboDevice.ItemID, ';', 2);
506 PrintReportsToDevice(FReports, aQualifier + MoreID,
507 Patient.DFN, ADevice, ErrMsg, uHSComponents, RemoteSiteID, RemoteQuery, uHState);
508 ErrMsg := Piece(FReportText.Lines[0], U, 2);
509 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
510 end;
511 end;
512 QT_HSWPCOMPONENT:
513 begin
514 if (length(piece(uHState,';',2)) > 0) then
515 begin
516 FindVType;
517 aReport.Clear;
518 aReport.Assign(FReportText.Lines);
519 ADevice := Piece(cboDevice.ItemID, ';', 2);
520 PrintVReports(ErrMsg, ADevice, piece(uRemoteType,'^',4),aReport);
521 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
522 end
523 else
524 begin
525 ADevice := Piece(cboDevice.ItemID, ';', 2);
526 PrintReportsToDevice(FReports, aQualifier + MoreID,
527 Patient.DFN, ADevice, ErrMsg, uHSComponents, RemoteSiteID, RemoteQuery, uHState);
528 ErrMsg := Piece(FReportText.Lines[0], U, 2);
529 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
530 end;
531 end;
532 QT_PROCEDURES:
533 begin
534 for i := 0 to frmReports.lvReports.Items.Count - 1 do
535 if frmReports.lvReports.Items[i].Selected then
536 begin
537 ListItem := frmReports.lvReports.Items[i];
538 aQualifier := ListItem.SubItems[0];
539 ADevice := Piece(cboDevice.ItemID, ';', 2);
540 PrintReportsToDevice(piece(FReports,':',1), aQualifier,
541 Patient.DFN, ADevice, ErrMsg, uHSComponents, RemoteSiteID, RemoteQuery, uHState);
542 ErrMsg := Piece(FReportText.Lines[0], U, 2);
543 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
544 end;
545 end;
546 QT_SURGERY:
547 begin
548 for i := 0 to frmReports.lvReports.Items.Count - 1 do
549 if frmReports.lvReports.Items[i].Selected then
550 begin
551 ListItem := frmReports.lvReports.Items[i];
552 aQualifier := ListItem.SubItems[0];
553 ADevice := Piece(cboDevice.ItemID, ';', 2);
554 PrintReportsToDevice(piece(FReports,':',1), aQualifier + MoreID,
555 Patient.DFN, ADevice, ErrMsg, uHSComponents, RemoteSiteID, RemoteQuery, uHState);
556 ErrMsg := Piece(FReportText.Lines[0], U, 2);
557 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
558 end;
559 end;
560 end;
561 end
562 else
563 begin
564 ADevice := Piece(cboDevice.ItemID, ';', 2);
565 aQualifier := Piece(uRemoteType,'^',5);
566 if (Pos('OR_ECS1',FReports)>0) or (Pos('OR_ECS2',FReports)>0) then
567 begin
568 uECSReport.ReportType := 'P';
569 uECSReport.PrintDEV := Piece(cboDevice.ItemID,';',1);
570 PrintECSReportToDevice(uECSReport);
571 end
572 else
573 begin
574 PrintReportsToDevice(FReports, aQualifier + MoreID,
575 Patient.DFN, ADevice, ErrMsg, uHSComponents, RemoteSiteID, RemoteQuery, uHState);
576 ErrMsg := Piece(FReportText.Lines[0], U, 2);
577 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
578 end;
579 end;
580 end;
581 if chkDefault.Checked then SaveDefaultPrinter(Piece(cboDevice.ItemID, ';', 1));
582 User.CurrentPrinter := cboDevice.ItemID;
583 aReport.Free;
584 Close;
585end;
586
587procedure TfrmReportPrt.cmdCancelClick(Sender: TObject);
588begin
589 SetupVars; //kt added 8/20/2007 to replace constants with vars.
590 SetupVars; //kt added 8/20/2007 to replace constants with vars.
591 inherited;
592 Close;
593end;
594
595procedure TfrmReportPrt.cboDeviceNeedData(Sender: TObject;
596 const StartFrom: String; Direction, InsertAt: Integer);
597begin
598 inherited;
599 cboDevice.ForDataUse(SubsetOfDevices(StartFrom, Direction));
600end;
601
602procedure TfrmReportPrt.FormDestroy(Sender: TObject);
603begin
604 FReportText.Free;
605 inherited;
606end;
607
608end.
609
610
611
Note: See TracBrowser for help on using the repository browser.