source: cprs/trunk/CPRS-Chart/fAllgyBox.pas@ 466

Last change on this file since 466 was 456, checked in by Kevin Toppenberg, 16 years ago

Initial Upload of Official WV CPRS 1.0.26.76

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