source: cprs/branches/tmg-cprs/CPRS-Chart/Encounter/fPCEBase.pas@ 770

Last change on this file since 770 was 729, checked in by Kevin Toppenberg, 15 years ago

Added functions to Templates, and Images tab

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