source: cprs/branches/foia-cprs/CPRS-Chart/Encounter/fPCEBase.pas@ 1806

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

Adding foia-cprs branch

File size: 11.9 KB
Line 
1{///////////////////////////////////////////////////////////////////////////////
2//Name: fPCEBase.pas, fPCEBase.dfm
3//Created: Jan 1999
4//By: Robert Bott
5//Location: ISL
6//Description: Parent form for all PCE tabs. This form will hold methods that are
7// universal for a PCE tabs. These forms will be child forms to fEncounterFrame.
8////////////////////////////////////////////////////////////////////////////////}
9
10unit fPCEBase;
11
12{$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED
13
14interface
15
16uses
17 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, uConst,
18 StdCtrls, fAutoSz, Buttons, ORCtrls, ORFn, uPCE, ORDtTm, Checklst,
19 ComCtrls;
20
21type
22 TfrmPCEBase = class(TfrmAutoSz)
23 btnOK: TBitBtn;
24 btnCancel: TBitBtn;
25 procedure FormCreate(Sender: TObject);
26 procedure btnCancelClick(Sender: TObject);
27 procedure btnOKClick(Sender: TObject); virtual;
28 procedure FormClose(Sender: TObject; var Action: TCloseAction);
29 procedure FormShow(Sender: TObject);
30 private
31 FDisplayCount: Integer; // number of times page displayed
32 FPatientCount: Integer; // number of times page displayed for given pt
33 FCallingContext: Integer;
34// function GetInitPage: Boolean;
35// function GetInitPatient: Boolean;
36// function GetPatientViewed: Boolean;
37 procedure UMResizePage(var Message: TMessage); message UM_RESIZEPAGE;
38 protected
39 FClosing: boolean;
40 FSectionTabs: array[0..2] of Integer;
41 FSectionTabCount: integer;
42 FTabName: string;
43// procedure CreateParams(var Params: TCreateParams); override;
44 function ActiveCtrl: TWinControl;
45 function SectionString: string;
46 procedure DoEnter; override;
47 public
48 constructor CreateLinked(AParent: TWinControl);
49 procedure Loaded; override;
50// function AllowContextChange: Boolean; virtual;
51// procedure ClearPtData; virtual;
52 procedure DisplayPage; virtual;
53// procedure NotifyOrder(OrderAction: Integer; AnOrder: TOrder); virtual; //*no ordering will be done*//
54// procedure RequestPrint; virtual;
55 procedure SetFontSize(NewFontSize: Integer); virtual;
56 procedure AllowTabChange(var AllowChange: boolean); virtual;
57
58 property CallingContext: Integer read FCallingContext;
59// property InitPage: Boolean read GetInitPage;
60// property InitPatient: Boolean read GetInitPatient;
61// property PatientViewed: Boolean read GetPatientViewed;
62 procedure FocusFirstControl;
63 end;
64
65var
66 frmPCEBase: TfrmPCEBase;
67
68implementation
69
70{$R *.DFM}
71
72uses
73 fEncounterFrame;
74
75
76{///////////////////////////////////////////////////////////////////////////////
77//Name: procedure TfrmPCEBase.FormCreate(Sender: TObject);
78//Created: Jan 1999
79//By: Robert Bott
80//Location: ISL
81//Description: Initialize counters to zero
82///////////////////////////////////////////////////////////////////////////////}
83procedure TfrmPCEBase.FormCreate(Sender: TObject);
84begin
85 FDisplayCount := 0;
86 FPatientCount := 0;
87end;
88
89{///////////////////////////////////////////////////////////////////////////////
90//Name: procedure TfrmPCEBase.CreateParams(var Params: TCreateParams);
91//Created: Jan 1999
92//By: Robert Bott
93//Location: ISL
94//Description: turn the form into a child window
95///////////////////////////////////////////////////////////////////////////////}
96(*procedure TfrmPCEBase.CreateParams(var Params: TCreateParams);
97{ turn the form into a child window }
98begin
99 inherited CreateParams(Params);
100 with Params do
101 begin
102 if Owner is TPanel
103 then WndParent := TPanel(Owner).Handle
104 else if owner is TForm then
105 WndParent := (Owner as TForm).Handle;
106 Style := WS_CHILD or WS_CLIPSIBLINGS;
107 X := 0; Y := 0;
108 end;
109end;
110 *)
111{///////////////////////////////////////////////////////////////////////////////
112//Name: procedure TfrmPCEBase.Loaded;
113//Created: Jan 1999
114//By: Robert Bott
115//Location: ISL
116//Description: make the form borderless to allow it to be a child window
117///////////////////////////////////////////////////////////////////////////////}
118procedure TfrmPCEBase.Loaded;
119begin
120 inherited Loaded;
121 Visible := False;
122 Position := poDefault;
123 BorderIcons := [];
124 BorderStyle := bsNone;
125 HandleNeeded;
126 SetBounds(0, 0, Width, Height);
127end;
128
129{///////////////////////////////////////////////////////////////////////////////
130//Name: function TfrmPCEBase.AllowContextChange: Boolean;
131//Created: Jan 1999
132//By: Robert Bott
133//Location: ISL
134//Description:
135///////////////////////////////////////////////////////////////////////////////}
136(*function TfrmPCEBase.AllowContextChange: Boolean;
137begin
138 Result := True;
139end;
140
141{///////////////////////////////////////////////////////////////////////////////
142//Name: procedure TfrmPCEBase.ClearPtData;
143//Created: Jan 1999
144//By: Robert Bott
145//Location: ISL
146//Description: clear all patient related data on a page
147///////////////////////////////////////////////////////////////////////////////}
148procedure TfrmPCEBase.ClearPtData;
149begin
150 FPatientCount := 0;
151end;
152*)
153{///////////////////////////////////////////////////////////////////////////////
154//Name: procedure TfrmPCEBase.DisplayPage;
155//Created: Jan 1999
156//By: Robert Bott
157//Location: ISL
158//Description: cause the page to be displayed and update the display counters
159///////////////////////////////////////////////////////////////////////////////}
160procedure TfrmPCEBase.DisplayPage;
161begin
162 BringToFront;
163// FocusControl(ActiveCtrl);
164 //SetFocus;
165 Inc(FDisplayCount);
166 Inc(FPatientCount);
167 FCallingContext := frmEncounterFrame.ChangeSource;
168 if (FCallingContext = CC_CLICK) and (FPatientCount = 1)
169 then FCallingContext := CC_INIT_PATIENT;
170end;
171(*
172{///////////////////////////////////////////////////////////////////////////////
173//Name: procedure TfrmPCEBase.RequestPrint;
174//Created: Jan 1999
175//By: Robert Bott
176//Location: ISL
177//Description: For posible future use when printing is supported.
178///////////////////////////////////////////////////////////////////////////////}
179procedure TfrmPCEBase.RequestPrint;
180begin
181 //
182end;
183*)
184
185{///////////////////////////////////////////////////////////////////////////////
186//Name: procedure TfrmPCEBase.SetFontSize(NewFontSize: Integer);
187//Created: Jan 1999
188//By: Robert Bott
189//Location: ISL
190//Description: Assign the new font size.
191///////////////////////////////////////////////////////////////////////////////}
192procedure TfrmPCEBase.SetFontSize(NewFontSize: Integer);
193begin
194 Font.Size := NewFontSize;
195end;
196(*
197{///////////////////////////////////////////////////////////////////////////////
198//Name: function TfrmPCEBase.GetInitPage: Boolean;
199//Created: Jan 1999
200//By: Robert Bott
201//Location: ISL
202//Description: if the count is one, this is the first time the page is being displayed.
203///////////////////////////////////////////////////////////////////////////////}
204function TfrmPCEBase.GetInitPage: Boolean;
205begin
206 Result := FDisplayCount = 1;
207end;
208
209{///////////////////////////////////////////////////////////////////////////////
210//Name: function TfrmPCEBase.GetInitPatient: Boolean;
211//Created: Jan 1999
212//By: Robert Bott
213//Location: ISL
214//Description: if the count is one, this is the first time the page is being
215// displayed for a given patient
216///////////////////////////////////////////////////////////////////////////////}
217function TfrmPCEBase.GetInitPatient: Boolean;
218begin
219 Result := FPatientCount = 1;
220end;
221
222{///////////////////////////////////////////////////////////////////////////////
223//Name: function TfrmPCEBase.GetPatientViewed: Boolean;
224//Created: Jan 1999
225//By: Robert Bott
226//Location: ISL
227//Description: returns false if the tab has never been clicked for this patient
228///////////////////////////////////////////////////////////////////////////////}
229function TfrmPCEBase.GetPatientViewed: Boolean;
230begin
231 Result := FPatientCount > 0;
232end;
233*)
234(*
235procedure RepaintControl(AControl: TControl);
236var
237 i: Integer;
238begin
239 AControl.Invalidate;
240 AControl.Update;
241 if AControl is TWinControl then with TWinControl(AControl) do
242 for i := 0 to ControlCount - 1 do RepaintControl(Controls[i]);
243end;
244*)
245
246{///////////////////////////////////////////////////////////////////////////////
247//Name: procedure TfrmPCEBase.UMResizePage(var Message: TMessage);
248//Created: Jan 1999
249//By: Robert Bott
250//Location: ISL
251//Description: Redraw the controls on the form when it is resized.
252///////////////////////////////////////////////////////////////////////////////}
253procedure TfrmPCEBase.UMResizePage(var Message: TMessage);
254var
255 i: Integer;
256begin
257 for i := 0 to ComponentCount - 1 do
258 if Components[i] is TControl then with TControl(Components[i]) do Invalidate;
259 Update;
260end;
261
262{///////////////////////////////////////////////////////////////////////////////
263//Name: procedure TfrmPCEBase.btnCancelClick(Sender: TObject);
264//Created: Jan 1999
265//By: Robert Bott
266//Location: ISL
267//Description: Indicate to the frame that cancel was pressed, and close the frame.
268///////////////////////////////////////////////////////////////////////////////}
269procedure TfrmPCEBase.btnCancelClick(Sender: TObject);
270begin
271 inherited;
272 frmencounterframe.Abort := FALSE;
273 frmEncounterFrame.Cancel := true;
274 frmencounterframe.Close;
275end;
276
277{///////////////////////////////////////////////////////////////////////////////
278//Name: procedure TfrmPCEBase.btnCancelClick(Sender: TObject);
279//Created: Jan 1999
280//By: Robert Bott
281//Location: ISL
282//Description: Indicate to the frame that it should close and save data.
283///////////////////////////////////////////////////////////////////////////////}
284procedure TfrmPCEBase.btnOKClick(Sender: TObject);
285begin
286 frmencounterframe.Abort := FALSE;
287 frmencounterframe.Close;
288end;
289
290
291{///////////////////////////////////////////////////////////////////////////////
292//Name: procedure TfrmPCEBase.FormClose(Sender: TObject; var Action: TCloseAction);
293//Created: Jan 1999
294//By: Robert Bott
295//Location: ISL
296//Description: Free the memory held by the form.
297///////////////////////////////////////////////////////////////////////////////}
298procedure TfrmPCEBase.FormClose(Sender: TObject; var Action: TCloseAction);
299begin
300 inherited;
301 action := caFree; //destroy the forms when closed
302 FClosing := TRUE;
303end;
304
305{///////////////////////////////////////////////////////////////////////////////
306//Name: procedure TfrmPCEBase.CheckListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
307// State: TOwnerDrawState);
308//Created: Jan 1999
309//By: Robert Bott
310//Location: ISL
311//Description: Populate the checklist
312///////////////////////////////////////////////////////////////////////////////}
313procedure TfrmPCEBase.AllowTabChange(var AllowChange: boolean);
314begin
315end;
316
317constructor TfrmPCEBase.CreateLinked(AParent: TWinControl);
318begin
319 inherited Create(GetParentForm(AParent));
320 Parent := AParent;
321 Align := alClient;
322 Show;
323end;
324
325function TfrmPCEBase.ActiveCtrl: TWinControl;
326begin
327 Result := GetParentForm(Self).ActiveControl;
328 if(Result is TORComboEdit) then
329 Result := TWinControl(Result.Owner);
330end;
331
332function TfrmPCEBase.SectionString: string;
333var
334 v, i: integer;
335
336begin
337 Result := '';
338 if FSectionTabCount = 0 then exit;
339 v := 0;
340 for i := 0 to FSectionTabCount-1 do
341 begin
342 if(Result <> '') then
343 Result := Result + ',';
344 Result := Result + IntToStr(FSectionTabs[i]);
345 v := FSectionTabs[i];
346 end;
347 for i := 1 to 20 do
348 begin
349 if(v<0) then
350 dec(v,32)
351 else
352 inc(v,32);
353 if Result <> '' then Result := Result + ',';
354 Result := Result + inttostr(v);
355 end;
356end;
357
358procedure TfrmPCEBase.DoEnter;
359begin
360 inherited;
361 frmEncounterFrame.SelectTab(FTabName);
362end;
363
364procedure TfrmPCEBase.FocusFirstControl;
365begin
366// SetFocus;
367 FindNextControl(self, True, True, False).SetFocus;
368end;
369
370procedure TfrmPCEBase.FormShow(Sender: TObject);
371begin
372 inherited;
373 FocusFirstControl;
374end;
375
376end.
Note: See TracBrowser for help on using the repository browser.