Module

fConsult513Prt

Path

C:\CPRS\CPRS30\Consults\fConsult513Prt.pas

Last Modified

7/15/2014 3:26:34 PM

Units Used in Interface

Name Comments
fAutoSz -
uReports -

Units Used in Implementation

Name Comments
rConsults -
rCore -
rReports -
uCore -

Classes

Name Comments
Tfrm513Print -

Procedures

Name Owner Declaration Scope Comments
cboDeviceChange Tfrm513Print procedure cboDeviceChange(Sender: TObject); Public/Published -
cboDeviceNeedData Tfrm513Print procedure cboDeviceNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
cmdCancelClick Tfrm513Print procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdOKClick Tfrm513Print procedure cmdOKClick(Sender: TObject); Public/Published -
DisplaySelectDevice Tfrm513Print procedure DisplaySelectDevice; Private -
PrintSF513 - procedure PrintSF513(AConsult: Longint; AConsultTitle: string); Interfaced Displays a form that prompts for a device and then prints the SF513
radChartCopyClick Tfrm513Print procedure radChartCopyClick(Sender: TObject); Public/Published -
radWorkCopyClick Tfrm513Print procedure radWorkCopyClick(Sender: TObject); Public/Published -

Constants

Name Declaration Scope Comments
PAGE_BREAK '**PAGE BREAK**' 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 -
TX_QUEUED_CAP 'Printing Report' Global -


Module Source

1     unit fConsult513Prt;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fAutoSz, ORCtrls, StdCtrls, Mask, ORNet, ORFn, ComCtrls,
8       VA508AccessibilityManager, uReports;
9     
10    type
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);
34    
35      private
36        { Private declarations }
37        FConsult: Integer;
38        FReportText: TRichEdit;
39        procedure DisplaySelectDevice;
40      public
41        { Public declarations }
42      end;
43    
44    procedure PrintSF513(AConsult: Longint; AConsultTitle: string);
45    
46    implementation
47    
48    {$R *.DFM}
49    
50    uses rCore, rConsults, Printers, rReports, uCore;
51    
52    const
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    
59    procedure PrintSF513(AConsult: Longint; AConsultTitle: string);
60    { displays a form that prompts for a device and then prints the SF513 }
61    var
62      frm513Print: Tfrm513Print;
63      DefPrt: string;
64    begin
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;
98    end;
99    
100   procedure Tfrm513Print.DisplaySelectDevice;
101   begin
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;
107   end;
108   
109   procedure Tfrm513Print.cboDeviceNeedData(Sender: TObject; const StartFrom: string;
110     Direction, InsertAt: Integer);
111   begin
112     inherited;
113     cboDevice.ForDataUse(SubsetOfDevices(StartFrom, Direction));
114   end;
115   
116   procedure Tfrm513Print.cboDeviceChange(Sender: TObject);
117   begin
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;
125   end;
126   
127   procedure Tfrm513Print.radChartCopyClick(Sender: TObject);
128   begin
129     inherited;
130     DisplaySelectDevice;
131   end;
132   
133   procedure Tfrm513Print.radWorkCopyClick(Sender: TObject);
134   begin
135     inherited;
136     DisplaySelectDevice;
137   end;
138   
139   procedure Tfrm513Print.cmdOKClick(Sender: TObject);
140   var
141     ADevice, ErrMsg: string;
142     ChartCopy: string;
143     RemoteSiteID: string;    //for Remote site printing
144     RemoteQuery: string;    //for Remote site printing
145   begin
146     inherited;
147     FReportText := CreateReportTextComponent(Self);
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
160             QuickCopy(GetFormattedSF513(FConsult, ChartCopy), FReportText);
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;
174     FReportText.Free;
175     Close;
176   end;
177   
178   procedure Tfrm513Print.cmdCancelClick(Sender: TObject);
179   begin
180     inherited;
181     Close;
182   end;
183   
184   end.

Module Calls (2 levels)


fConsult513Prt
 ├fAutoSz
 │ └fBase508Form
 ├uReports
 ├rCore
 │ └uCore
 ├rConsults
 │ ├rCore...
 │ ├uCore...
 │ ├uConsults
 │ └uTIU
 ├rReports
 │ ├uCore...
 │ ├rCore...
 │ └uReports
 └uCore...

Module Called-By (2 levels)


     fConsult513Prt
        fConsults┘ 
         fFrame┤   
         fNotes┤   
     fPrintList┤   
fReminderDialog┤   
        fReview┤   
       fSurgery┤   
    fConsultAct┤   
      fCsltNote┘