Module

fReportsPrint

Path

C:\CPRS\CPRS30\fReportsPrint.pas

Last Modified

7/15/2014 3:26:38 PM

Units Used in Interface

Name Comments
fAutoSz -
fBase508Form -
rECS -

Units Used in Implementation

Name Comments
fFrame -
fReports -
rCore -
rReports -
uCore -
uReports -

Classes

Name Comments
TfrmReportPrt -

Procedures

Name Owner Declaration Scope Comments
cboDeviceChange TfrmReportPrt procedure cboDeviceChange(Sender: TObject); Public/Published -
cboDeviceNeedData TfrmReportPrt procedure cboDeviceNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
cmdCancelClick TfrmReportPrt procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdOKClick TfrmReportPrt procedure cmdOKClick(Sender: TObject); Public/Published -
DisplaySelectDevice TfrmReportPrt procedure DisplaySelectDevice; Private -
FindVType TfrmReportPrt procedure FindVType; Public/Published -
PrintReports - procedure PrintReports(AReports: string; const AReportsTitle: string); Interfaced Displays a form that prompts for a device and then prints the report

Functions

Name Owner Declaration Scope Comments
DeleteLineBreaks - function DeleteLineBreaks(const S: string): string; Interfaced -
StringPad - function StringPad(aString: string; aStringCount, aPadCount: integer): String; Interfaced -

Global Variables

Name Type Declaration Comments
frmReportPrt TfrmReportPrt frmReportPrt: TfrmReportPrt; -

Constants

Name Declaration Scope Comments
PAGE_BREAK '**PAGE BREAK**' Global -
QT_DATERANGE 2 Global -
QT_HSCOMPONENT 5 Global -
QT_HSTYPE 1 Global -
QT_HSWPCOMPONENT 6 Global -
QT_IMAGING 3 Global -
QT_NUTR 4 Global -
QT_OTHER 0 Global -
QT_PROCEDURES 19 Global -
QT_SURGERY 28 Global -
TX_ERR_CAP 'Print Error' Global -
TX_NODEVICE 'A device must be selected to print, or press ''Cancel'' to not print.' Global -
TX_NODEVICE_CAP 'Device Not Selected' Global -


Module Source

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

Module Calls (2 levels)


fReportsPrint
 ├rECS
 │ ├rCore
 │ └uCore
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├rCore...
 ├uCore...
 ├fReports
 │ ├fHSplit
 │ ├uConst
 │ ├rECS...
 │ ├fBase508Form...
 │ ├rCore...
 │ ├rReports
 │ ├fFrame
 │ ├uCore...
 │ ├uReports
 │ ├fReportsPrint...
 │ ├fReportsAdhocComponent1
 │ ├dShared
 │ ├fGraphs
 │ └fGraphData
 ├rReports...
 ├uReports
 └fFrame...

Module Called-By (2 levels)


               fReportsPrint
                  fReports┤ 
                  fFrame┤ │ 
                  fProbs┤ │ 
        fReportsPrint...┤ │ 
 fReportsAdhocComponent1┤ │ 
                 fGraphs┤ │ 
   fOptionsReportsCustom┤ │ 
  fOptionsReportsDefault┘ │ 
                 fProbs...┤ 
                     fLabs┘ 
               fFrame...┤   
                fLabTest┤   
               fLabTests┤   
          fLabTestGroups┤   
               fLabPrint┤   
fOptionsReportsCustom...┘