Module

fDeviceSelect

Path

C:\CPRS\CPRS30\fDeviceSelect.pas

Last Modified

7/15/2014 3:26:36 PM

Units Used in Interface

Name Comments
fAutoSz -

Units Used in Implementation

Name Comments
fFrame -
rCore -
rMisc -
rReports -
uCore -

Classes

Name Comments
TfrmDeviceSelect -

Procedures

Name Owner Declaration Scope Comments
cboDeviceChange TfrmDeviceSelect procedure cboDeviceChange(Sender: TObject); Public/Published -
cboDeviceNeedData TfrmDeviceSelect procedure cboDeviceNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
cmdCancelClick TfrmDeviceSelect procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdOKClick TfrmDeviceSelect procedure cmdOKClick(Sender: TObject); Public/Published -
FormClose TfrmDeviceSelect procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmDeviceSelect procedure FormCreate(Sender: TObject); Public/Published -

Functions

Name Owner Declaration Scope Comments
SelectDevice - function SelectDevice(Sender: TObject; ALocation: integer; AllowWindowsPrinter: boolean; ACaption: String): string ; Interfaced Displays a form that prompts for a device

Global Variables

Name Type Declaration Comments
ADevice UnicodeString ADevice: string; -
frmDeviceSelect TfrmDeviceSelect frmDeviceSelect: TfrmDeviceSelect; -

Constants

Name Declaration Scope Comments
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 fDeviceSelect;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, fAutoSz, ORCtrls, ORNet, Mask, ExtCtrls, VA508AccessibilityManager;
8     
9     type
10      TfrmDeviceSelect = class(TfrmAutoSz)
11        grpDevice: TGroupBox;
12        cboDevice: TORComboBox;
13        pnlBottom: TPanel;
14        cmdOK: TButton;
15        cmdCancel: TButton;
16        chkDefault: TCheckBox;
17        pnlGBBottom: TPanel;
18        lblMargin: TLabel;
19        txtRightMargin: TMaskEdit;
20        lblLength: TLabel;
21        txtPageLength: TMaskEdit;
22        procedure cboDeviceChange(Sender: TObject);
23        procedure cmdOKClick(Sender: TObject);
24        procedure cmdCancelClick(Sender: TObject);
25        procedure cboDeviceNeedData(Sender: TObject; const StartFrom: String;
26          Direction, InsertAt: Integer);
27        procedure FormClose(Sender: TObject; var Action: TCloseAction);
28        procedure FormCreate(Sender: TObject);
29      private
30        FWinPrint: Boolean;
31      end;
32    
33    var
34      frmDeviceSelect: TfrmDeviceSelect;
35      ADevice: string;
36    
37    function SelectDevice(Sender: TObject; ALocation: integer; AllowWindowsPrinter: boolean; ACaption: String): string ;
38    
39    implementation
40    
41    {$R *.DFM}
42    
43    uses ORFn, rCore, uCore, rReports, Printers, fFrame, rMisc;
44    
45    const
46      TX_NODEVICE = 'A device must be selected to print, or press ''Cancel'' to not print.';
47      TX_NODEVICE_CAP = 'Device Not Selected';
48      TX_ERR_CAP = 'Print Error';
49    
50    function SelectDevice(Sender: TObject; ALocation: integer; AllowWindowsPrinter: boolean; ACaption: String): string ;
51    { displays a form that prompts for a device}
52    var
53      frmDeviceSelect: TfrmDeviceSelect;
54      DefPrt: string;
55    begin
56      frmDeviceSelect := TfrmDeviceSelect.Create(Application);
57      try
58        with frmDeviceSelect do
59          begin
60            FWinPrint := AllowWindowsPrinter;
61            with cboDevice do
62              begin
63                if (FWinPrint) and (Printer.Printers.Count > 0) then
64                  begin
65                    Items.Add('WIN;Windows Printer^Windows Printer');
66                    Items.Add('^--------------------VistA Printers----------------------');
67                  end;
68              end;
69    
70                DefPrt := User.CurrentPrinter;
71                if DefPrt = '' then DefPrt := GetDefaultPrinter(User.Duz, Encounter.Location);
72                if DefPrt <> '' then
73                  begin
74                    if (not FWinPrint) then
75                      begin
76                        if (DefPrt <> 'WIN;Windows Printer') then
77                          begin
78                            cboDevice.InitLongList(Piece(DefPrt, ';', 2));
79                            cboDevice.SelectByID(DefPrt);
80                          end
81                        else
82                          cboDevice.InitLongList('');
83                      end
84                    else if FWinprint then
85                      begin
86                        cboDevice.InitLongList(Piece(DefPrt, ';', 2));
87                        cboDevice.SelectByID(DefPrt);
88                      end;
89                      end
90                  else
91                  begin
92                    cboDevice.InitLongList('');
93                  end;
94               if ACaption<>'' then frmDeviceSelect.Caption:=ACaption;
95             
96            ShowModal;
97            Result := ADevice;
98            //Result := Piece(ADevice, ';', 1) + U + Piece(ADevice, U, 2);
99          end;
100     finally
101       frmDeviceSelect.Release;
102     end;
103   end;
104   
105   procedure TfrmDeviceSelect.cboDeviceChange(Sender: TObject);
106   begin
107   inherited;
108     with cboDevice do if ItemIndex > -1 then
109     begin
110       txtRightMargin.Text := Piece(Items[ItemIndex], '^', 4);
111       txtPageLength.Text := Piece(Items[ItemIndex], '^', 5);
112     end;
113   end;
114   
115   procedure TfrmDeviceSelect.cmdOKClick(Sender: TObject);
116   begin
117     inherited;
118     if cboDevice.ItemID = '' then
119     begin
120       InfoBox(TX_NODEVICE, TX_NODEVICE_CAP, MB_OK);
121       Exit;
122     end;
123     ADevice := cboDevice.Items[cboDevice.ItemIndex];
124     if chkDefault.Checked then begin
125      SaveDefaultPrinter(Piece(cboDevice.ItemID, ';', 1));
126      User.CurrentPrinter := cboDevice.ItemID;
127     end;
128     Close;
129   end;
130   
131   procedure TfrmDeviceSelect.cmdCancelClick(Sender: TObject);
132   begin
133     inherited;
134     ADevice := User.CurrentPrinter;
135     Close;
136   end;
137   
138   procedure TfrmDeviceSelect.cboDeviceNeedData(Sender: TObject;
139     const StartFrom: String; Direction, InsertAt: Integer);
140   begin
141     inherited;
142     cboDevice.ForDataUse(SubsetOfDevices(StartFrom, Direction));
143   end;
144   
145   procedure TfrmDeviceSelect.FormClose(Sender: TObject;
146     var Action: TCloseAction);
147   begin
148     inherited;
149     SaveUserBounds(Self);
150   end;
151   
152   procedure TfrmDeviceSelect.FormCreate(Sender: TObject);
153   begin
154     inherited;
155     ResizeFormToFont(Self);
156     SetFormPosition(Self);
157   end;
158   
159   end.

Module Calls (2 levels)


fDeviceSelect
 ├fAutoSz
 │ └fBase508Form
 ├rCore
 │ └uCore
 ├uCore...
 ├rReports
 │ ├uCore...
 │ ├rCore...
 │ └uReports
 └rMisc
   └fOrders

Module Called-By (2 levels)


              fDeviceSelect
                   fFrame┤ 
              CPRSChart┤ │ 
                  fPage┤ │ 
                uOrders┤ │ 
                fODBase┤ │ 
                UBACore┤ │ 
                fOrders┤ │ 
                   uPCE┤ │ 
      fBALocalDiagnoses┤ │ 
             fEncVitals┤ │ 
                fVitals┤ │ 
                 fCover┤ │ 
                 rCover┤ │ 
              fPtSelMsg┤ │ 
                 fPtSel┤ │ 
            fOrdersSign┤ │ 
         fPrintLocation┤ │ 
                  fMeds┤ │ 
                fRptBox┤ │ 
                 fNotes┤ │ 
               fReports┤ │ 
                 fEncnt┤ │ 
                 fProbs┤ │ 
          fReportsPrint┤ │ 
                fGraphs┤ │ 
              fConsults┤ │ 
                fDCSumm┤ │ 
        fReminderDialog┤ │ 
                  fLabs┤ │ 
              fLabPrint┤ │ 
                fReview┤ │ 
            fIconLegend┤ │ 
           fOrdersPrint┤ │ 
               fSurgery┤ │ 
uVA508CPRSCompatibility┤ │ 
           fOrdersRenew┤ │ 
             fODConsult┤ │ 
                fODProc┤ │ 
                 fODRad┤ │ 
                 fODLab┤ │ 
                fODMeds┤ │ 
               fODMedIV┤ │ 
              fODVitals┤ │ 
                fODAuto┤ │ 
                 fOMSet┤ │ 
         fOrdersRelease┤ │ 
              fODMedNVA┤ │ 
         fOrdersOnChart┤ │ 
             fOCSession┤ │ 
              fODActive┤ │ 
               fPCEEdit┘ │ 
               uReminders┤ 
              fFrame...┤ │ 
               fDrawers┤ │ 
              fCover...┤ │ 
              rCover...┤ │ 
              fNotes...┤ │ 
           fConsults...┤ │ 
        fTemplateEditor┤ │ 
     fReminderDialog...┤ │ 
          fReminderTree┤ │ 
             rReminders┤ │ 
            fSurgery...┤ │ 
         fRemCoverSheet┘ │ 
          fOrdersPrint...┘