source: cprs/trunk/CPRS-Chart/Encounter/fPCEBase.pas@ 1672

Last change on this file since 1672 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

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