Module

fPCEBase

Path

C:\CPRS\CPRS30\Encounter\fPCEBase.pas

Last Modified

7/15/2014 3:26:36 PM

Comments

//Name: fPCEBase.pas, fPCEBase.dfm
//Created: Jan 1999
//By: Robert Bott
//Location: ISL
//Description: Parent form for all PCE tabs.  This form will hold methods that are
// universal for a PCE tabs.  These forms will be child forms to fEncounterFrame.
////////////////////////////////////////////////////////////////////////////////

 REMOVE AFTER UNIT IS DEBUGGED

Initialization Code

initialization
  SpecifyFormIsNotADialog(TfrmPCEBase);


end.

Units Used in Interface

Name Comments
fAutoSz -
fBase508Form -
uConst -
uPCE -

Units Used in Implementation

Name Comments
fEncounterFrame -

Classes

Name Comments
TfrmPCEBase -

Procedures

Name Owner Declaration Scope Comments
AllowTabChange TfrmPCEBase procedure AllowTabChange(var AllowChange: boolean); virtual; Public
//Name: procedure TfrmPCEBase.CheckListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
//  State: TOwnerDrawState);
//Created: Jan 1999
//By: Robert Bott
//Location: ISL
//Description: Populate the checklist
///////////////////////////////////////////////////////////////////////////////
btnCancelClick TfrmPCEBase procedure btnCancelClick(Sender: TObject); Public/Published
//Name: procedure TfrmPCEBase.btnCancelClick(Sender: TObject);
//Created: Jan 1999
//By: Robert Bott
//Location: ISL
//Description: Indicate to the frame that cancel was pressed, and close the frame.
///////////////////////////////////////////////////////////////////////////////
btnOKClick TfrmPCEBase procedure btnOKClick(Sender: TObject); virtual; Public/Published
//Name: procedure TfrmPCEBase.btnCancelClick(Sender: TObject);
//Created: Jan 1999
//By: Robert Bott
//Location: ISL
//Description: Indicate to the frame that it should close and save data.
///////////////////////////////////////////////////////////////////////////////
DisplayPage TfrmPCEBase procedure DisplayPage; virtual; Public
Function AllowContextChange: Boolean; virtual;
    procedure ClearPtData; virtual;
//Name: function TfrmPCEBase.AllowContextChange: Boolean;
//Created: Jan 1999
//By: Robert Bott
//Location: ISL
//Description:
///////////////////////////////////////////////////////////////////////////////
function TfrmPCEBase.AllowContextChange: Boolean;
begin
  Result := True;
end;

{///////////////////////////////////////////////////////////////////////////////
//Name: procedure TfrmPCEBase.ClearPtData;
//Created: Jan 1999
//By: Robert Bott
//Location: ISL
//Description: clear all patient related data on a page
///////////////////////////////////////////////////////////////////////////////}
procedure TfrmPCEBase.ClearPtData;
begin
  FPatientCount := 0;
end;


//Name: procedure TfrmPCEBase.DisplayPage;
//Created: Jan 1999
//By: Robert Bott
//Location: ISL
//Description: cause the page to be displayed and update the display counters
///////////////////////////////////////////////////////////////////////////////
DoEnter TfrmPCEBase procedure DoEnter; override; Protected -
FocusFirstControl TfrmPCEBase procedure FocusFirstControl; Public
Property InitPage: Boolean read GetInitPage;
    property InitPatient: Boolean read GetInitPatient;
    property PatientViewed: Boolean read GetPatientViewed;
FormClose TfrmPCEBase procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published
//Name: procedure TfrmPCEBase.FormClose(Sender: TObject; var Action: TCloseAction);
//Created: Jan 1999
//By: Robert Bott
//Location: ISL
//Description: Free the memory held by the form.
///////////////////////////////////////////////////////////////////////////////
FormCreate TfrmPCEBase procedure FormCreate(Sender: TObject); Public/Published
//Name: procedure TfrmPCEBase.FormCreate(Sender: TObject);
//Created: Jan 1999
//By: Robert Bott
//Location: ISL
//Description: Initialize counters to zero
///////////////////////////////////////////////////////////////////////////////
Loaded TfrmPCEBase procedure Loaded; override; Public
//Name: procedure TfrmPCEBase.CreateParams(var Params: TCreateParams);
//Created: Jan 1999
//By: Robert Bott
//Location: ISL
//Description: turn the form into a child window
///////////////////////////////////////////////////////////////////////////////
procedure TfrmPCEBase.CreateParams(var Params: TCreateParams);
{turn the form into a child window }
begin
  inherited CreateParams(Params);
  with Params do
  begin
    if Owner is TPanel
      then WndParent := TPanel(Owner).Handle
    else if owner is TForm then
      WndParent := (Owner as TForm).Handle;
    Style := WS_CHILD or WS_CLIPSIBLINGS;
    X := 0; Y := 0;
  end;
end;
 

//Name: procedure TfrmPCEBase.Loaded;
//Created: Jan 1999
//By: Robert Bott
//Location: ISL
//Description: make the form borderless to allow it to be a child window
///////////////////////////////////////////////////////////////////////////////
SetFontSize TfrmPCEBase procedure SetFontSize(NewFontSize: Integer); virtual; Public
Procedure NotifyOrder(OrderAction: Integer; AnOrder: TOrder); virtual;  //*no ordering will be done*//
    procedure RequestPrint; virtual;
//Name: procedure TfrmPCEBase.SetFontSize(NewFontSize: Integer);
//Created: Jan 1999
//By: Robert Bott
//Location: ISL
//Description: Assign the new font size.
///////////////////////////////////////////////////////////////////////////////
UMResizePage TfrmPCEBase procedure UMResizePage(var Message: TMessage); message UM_RESIZEPAGE; Private
Function GetInitPage: Boolean;
    function GetInitPatient: Boolean;
    function GetPatientViewed: Boolean;
//Name: procedure TfrmPCEBase.UMResizePage(var Message: TMessage);
//Created: Jan 1999
//By: Robert Bott
//Location: ISL
//Description: Redraw the controls on the form when it is resized.
///////////////////////////////////////////////////////////////////////////////

Functions

Name Owner Declaration Scope Comments
ActiveCtrl TfrmPCEBase function ActiveCtrl: TWinControl; Protected Procedure CreateParams(var Params: TCreateParams); override;
SectionString TfrmPCEBase function SectionString: string; Protected -

Global Variables

Name Type Declaration Comments
frmPCEBase TfrmPCEBase frmPCEBase: TfrmPCEBase; -


Module Source

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     
10    unit fPCEBase;
11    
12    {$OPTIMIZATION OFF}                              // REMOVE AFTER UNIT IS DEBUGGED
13    
14    interface
15    
16    uses
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    
21    type
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    
64    var
65      frmPCEBase: TfrmPCEBase;
66    
67    implementation
68    
69    {$R *.DFM}
70    
71    uses
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    ///////////////////////////////////////////////////////////////////////////////}
82    procedure TfrmPCEBase.FormCreate(Sender: TObject);
83    begin
84      FDisplayCount := 0;
85      FPatientCount := 0;
86    end;
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 }
97    begin
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;
108   end;
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   ///////////////////////////////////////////////////////////////////////////////}
117   procedure TfrmPCEBase.Loaded;
118   begin
119     inherited Loaded;
120     Visible := False;
121     Position := poDefault;
122     BorderIcons := [];
123     BorderStyle := bsNone;
124     HandleNeeded;
125     SetBounds(0, 0, Width, Height);
126   end;
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;
136   begin
137     Result := True;
138   end;
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   ///////////////////////////////////////////////////////////////////////////////}
147   procedure TfrmPCEBase.ClearPtData;
148   begin
149     FPatientCount := 0;
150   end;
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   ///////////////////////////////////////////////////////////////////////////////}
159   procedure TfrmPCEBase.DisplayPage;
160   begin
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;
169   end;
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   ///////////////////////////////////////////////////////////////////////////////}
178   procedure TfrmPCEBase.RequestPrint;
179   begin
180     //
181   end;
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   ///////////////////////////////////////////////////////////////////////////////}
191   procedure TfrmPCEBase.SetFontSize(NewFontSize: Integer);
192   begin
193     Font.Size := NewFontSize;
194   end;
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   ///////////////////////////////////////////////////////////////////////////////}
203   function TfrmPCEBase.GetInitPage: Boolean;
204   begin
205     Result := FDisplayCount = 1;
206   end;
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   ///////////////////////////////////////////////////////////////////////////////}
216   function TfrmPCEBase.GetInitPatient: Boolean;
217   begin
218     Result := FPatientCount = 1;
219   end;
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   ///////////////////////////////////////////////////////////////////////////////}
228   function TfrmPCEBase.GetPatientViewed: Boolean;
229   begin
230     Result := FPatientCount > 0;
231   end;
232   *)
233   (*
234   procedure RepaintControl(AControl: TControl);
235   var
236     i: Integer;
237   begin
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]);
242   end;
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   ///////////////////////////////////////////////////////////////////////////////}
252   procedure TfrmPCEBase.UMResizePage(var Message: TMessage);
253   var
254     i: Integer;
255   begin
256     for i := 0 to ComponentCount - 1 do
257       if Components[i] is TControl then with TControl(Components[i]) do Invalidate;
258     Update;
259   end;
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   ///////////////////////////////////////////////////////////////////////////////}
268   procedure TfrmPCEBase.btnCancelClick(Sender: TObject);
269   begin
270     inherited;
271     frmencounterframe.Abort := FALSE;
272     frmEncounterFrame.Cancel := true;
273     frmencounterframe.Close;
274   end;
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   ///////////////////////////////////////////////////////////////////////////////}
283   procedure TfrmPCEBase.btnOKClick(Sender: TObject);
284   begin
285     frmencounterframe.Abort := FALSE;
286     frmencounterframe.Close;
287   end;
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   ///////////////////////////////////////////////////////////////////////////////}
297   procedure TfrmPCEBase.FormClose(Sender: TObject; var Action: TCloseAction);
298   begin
299     inherited;
300     action := caFree;    //destroy the forms when closed
301     FClosing := TRUE;
302   end;
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   ///////////////////////////////////////////////////////////////////////////////}
312   procedure TfrmPCEBase.AllowTabChange(var AllowChange: boolean);
313   begin
314   end;
315   
316   constructor TfrmPCEBase.CreateLinked(AParent: TWinControl);
317   begin
318     inherited Create(GetParentForm(AParent));
319     Parent := AParent;
320     Align := alClient;
321     Show;
322   end;
323   
324   function TfrmPCEBase.ActiveCtrl: TWinControl;
325   begin
326     Result := GetParentForm(Self).ActiveControl;
327     if(Result is TORComboEdit) then
328       Result := TWinControl(Result.Owner);
329   end;
330   
331   function TfrmPCEBase.SectionString: string;
332   var
333     v, i: integer;
334   
335   begin
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;
355   end;
356   
357   procedure TfrmPCEBase.DoEnter;
358   begin
359     inherited;
360     frmEncounterFrame.SelectTab(FTabName);
361   end;
362   
363   procedure TfrmPCEBase.FocusFirstControl;
364   begin
365   //  SetFocus;
366     FindNextControl(self, True, True, False).SetFocus;
367   end;
368   
369   initialization
370     SpecifyFormIsNotADialog(TfrmPCEBase);
371   
372   
373   end.

Module Calls (2 levels)


fPCEBase
 ├uConst
 ├fAutoSz
 │ └fBase508Form
 ├fBase508Form...
 └fEncounterFrame
   ├fPCEBase...
   ├fVisitType
   ├fDiagnoses
   ├fProcedure
   ├fImmunization
   ├fSkinTest
   ├fPatientEd
   ├fHealthFactor
   ├fExam
   ├uPCE
   ├rPCE
   ├fEncVitals
   ├rVitals
   ├fBase508Form...
   ├uCore
   ├fGAF
   ├rCore
   ├fPCEProvider
   └rMisc

Module Called-By (2 levels)


           fPCEBase
  fEncounterFrame┤ 
           uPCE┤ │ 
           rPCE┤ │ 
    fPCEBase...┤ │ 
     fVisitType┤ │ 
     fDiagnoses┤ │ 
   fPCEBaseMain┤ │ 
     fProcedure┤ │ 
      fPCEOther┤ │ 
  fImmunization┤ │ 
      fSkinTest┤ │ 
     fPatientEd┤ │ 
  fHealthFactor┤ │ 
          fExam┤ │ 
     fEncVitals┤ │ 
         fNotes┤ │ 
      fConsults┤ │ 
        fDCSumm┤ │ 
       fSurgery┤ │ 
           fGAF┤ │ 
       fPCEEdit┤ │ 
      fHFSearch┘ │ 
    fVisitType...┤ 
    fDiagnoses...┤ 
     fPCEBaseGrid┤ 
fPCEBaseMain...┤ │ 
  fProcedure...┤ │ 
        fGAF...┘ │ 
    fProcedure...┤ 
 fImmunization...┤ 
     fSkinTest...┤ 
    fPatientEd...┤ 
 fHealthFactor...┤ 
         fExam...┤ 
    fEncVitals...┤ 
          fGAF...┘