Module

fAllgyBox

Path

C:\CPRS\CPRS30\fAllgyBox.pas

Last Modified

7/15/2014 3:26:36 PM

Units Used in Interface

Name Comments
fARTAllgy -
fRptBox -

Units Used in Implementation

Name Comments
fCover -
rCover -
rODAllergy -

Classes

Name Comments
TfrmAllgyBox -

Procedures

Name Owner Declaration Scope Comments
AllergyBox - procedure AllergyBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean; AllergyIEN: integer); Interfaced -
cmdAddClick TfrmAllgyBox procedure cmdAddClick(Sender: TObject); Public/Published -
cmdEditClick TfrmAllgyBox procedure cmdEditClick(Sender: TObject); Public/Published -
cmdInErrorClick TfrmAllgyBox procedure cmdInErrorClick(Sender: TObject); Public/Published -
RefreshText TfrmAllgyBox procedure RefreshText; Private -

Functions

Name Owner Declaration Scope Comments
CreateAllergyBox - function CreateAllergyBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean): TfrmAllgyBox; Global -

Global Variables

Name Type Declaration Comments
frmAllgyBox TfrmAllgyBox frmAllgyBox: TfrmAllgyBox; -

Constants

Name Declaration Scope Comments
ENTERED_IN_ERROR True Global -
NEW_ALLERGY True Global -


Module Source

1     unit fAllgyBox;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7       Dialogs, fRptBox, StdCtrls, ExtCtrls, ComCtrls, fARTAllgy, ORFn,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmAllgyBox = class(TfrmReportBox)
12        cmdEdit: TButton;
13        cmdAdd: TButton;
14        cmdInError: TButton;
15        procedure cmdAddClick(Sender: TObject);
16        procedure cmdEditClick(Sender: TObject);
17        procedure cmdInErrorClick(Sender: TObject);
18      private
19        { Private declarations }
20        FAllergyIEN: integer;
21        procedure RefreshText;
22      public
23        { Public declarations }
24      end;
25    
26    procedure AllergyBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean; AllergyIEN: integer);
27    
28    var
29      frmAllgyBox: TfrmAllgyBox;
30    
31    implementation
32    
33    {$R *.dfm}
34    
35    uses rCover, fCover, rODAllergy;
36    
37    const
38      NEW_ALLERGY = True;
39      ENTERED_IN_ERROR = True;
40    
41    function CreateAllergyBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean): TfrmAllgyBox;
42    var
43      i, AWidth, MaxWidth, AHeight: Integer;
44      Rect: TRect;
45      // %$@# buttons!
46      BtnArray: array of TButton;
47      BtnRight: array of integer;
48      BtnLeft:  array of integer;
49      j, k: integer;
50      x: string;
51    begin
52      Result := TfrmAllgyBox.Create(Application);
53      try
54        with Result do
55        begin
56          k := 0;
57          with pnlButton do for j := 0 to ControlCount - 1 do
58            if Controls[j] is TButton then
59              begin
60                SetLength(BtnArray, k+1);
61                SetLength(BtnRight, k+1);
62                BtnArray[j] := TButton(Controls[j]);
63                BtnRight[j] := ResizeWidth(Font, MainFont, BtnArray[j].Width - BtnArray[j].Width - BtnArray[j].Left);
64                k := k + 1;
65              end;
66          MaxWidth := 350;
67          for i := 0 to ReportText.Count - 1 do
68          begin
69            AWidth := lblFontTest.Canvas.TextWidth(ReportText[i]);
70            if AWidth > MaxWidth then MaxWidth := AWidth;
71          end;
72          MaxWidth := MaxWidth + GetSystemMetrics(SM_CXVSCROLL);
73          AHeight := (ReportText.Count * (lblFontTest.Height + 2)) + pnlbutton.Height;
74          AHeight := HigherOf(AHeight, 250);
75          if AHeight > (Screen.Height - 80) then AHeight := Screen.Height - 80;
76          if MaxWidth > Screen.Width then MaxWidth := Screen.Width;
77          ClientWidth := MaxWidth;
78          ClientHeight := AHeight;
79          Rect := BoundsRect;
80          ForceInsideWorkArea(Rect);
81          BoundsRect := Rect;
82          ResizeAnchoredFormToFont(Result);
83    
84          //CQ6889 - force Print & Close buttons to bottom right of form regardless of selected font size
85          cmdClose.Left := (pnlButton.Left+pnlButton.Width)-cmdClose.Width;
86          cmdPrint.Left := (cmdClose.Left-cmdPrint.Width) - 1;
87          //end CQ6889
88    
89          Constraints.MinWidth := cmdAdd.Width + cmdEdit.Width + cmdInError.Width + cmdPrint.Width + cmdClose.Width + 20;
90          Constraints.MinHeight := 2*pnlButton.Height + memReport.Height;
91          cmdAdd.Left := 1;
92          cmdEdit.Left := (cmdAdd.Left + cmdAdd.Width) + 1;
93          cmdInError.Left := (cmdEdit.Left + cmdEdit.Width) + 1;
94    
95          SetLength(BtnLeft, k);
96          for j := 0 to k - 1 do
97            BtnLeft[j] := pnlButton.Width - BtnArray[j].Width - BtnRight[j];
98          QuickCopy(ReportText, memReport);
99          for i := 1 to Length(ReportTitle) do if ReportTitle[i] = #9 then ReportTitle[i] := ' ';
100         Caption := ReportTitle;
101         memReport.SelStart := 0;
102         cmdPrint.Visible := AllowPrint;
103         cmdAdd.Enabled := True;  //IsARTClinicalUser(x);   v26.12
104         cmdEdit.Enabled := IsARTClinicalUser(x);  
105         cmdInError.Enabled := IsARTClinicalUser(x);
106       end;
107     except
108       KillObj(@Result);
109       raise;
110     end;
111   end;
112   
113   procedure AllergyBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean; AllergyIEN: integer);
114   begin
115     frmAllgyBox := CreateAllergyBox(ReportText, ReportTitle, AllowPrint);
116     try
117       with frmAllgyBox do
118       begin
119         FAllergyIEN := AllergyIEN;
120         if not ContainsVisibleChar(memReport.Text) then RefreshText;
121         ShowModal;
122       end;
123     finally
124       frmAllgyBox.Release;
125     end;
126   end;
127   
128   procedure TfrmAllgyBox.cmdAddClick(Sender: TObject);
129   begin
130     inherited;
131     Visible := False;
132     EnterEditAllergy(0, NEW_ALLERGY, not ENTERED_IN_ERROR);
133     Close;
134   end;
135   
136   procedure TfrmAllgyBox.cmdEditClick(Sender: TObject);
137   var
138     Changed: boolean;
139   begin
140     inherited;
141     Visible := False;
142     Changed := EnterEditAllergy(FAllergyIEN, not NEW_ALLERGY, not ENTERED_IN_ERROR);
143     if Changed then RefreshText;
144     Visible := True;
145   end;
146   
147   procedure TfrmAllgyBox.cmdInErrorClick(Sender: TObject);
148   begin
149     inherited;
150     Visible := False;
151     MarkEnteredInError(FAllergyIEN);
152     Close;
153   end;
154   
155   procedure TfrmAllgyBox.RefreshText;
156   begin
157     memReport.Clear;
158     QuickCopy(DetailAllergy(FAllergyIEN), memReport);
159   end;
160   
161   end.

Module Calls (2 levels)


fAllgyBox
 ├fRptBox
 │ ├fFrame
 │ ├fBase508Form
 │ ├uReports
 │ └rReports
 ├fARTAllgy
 │ ├uConst
 │ ├fOMAction
 │ ├rODAllergy
 │ ├uOrders
 │ ├uCore
 │ ├rCore
 │ ├rCover
 │ ├fCover
 │ ├fAllgyFind
 │ └fRptBox...
 ├rCover...
 └rODAllergy...

Module Called-By (2 levels)


    fAllgyBox
     fCover┘ 
   fFrame┤   
fARTAllgy┘