source: cprs/trunk/CPRS-Chart/fReportsPrint.pas@ 1679

Last change on this file since 1679 was 1679, checked in by healthsevak, 9 years ago

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