| [459] | 1 | unit fPage;
 | 
|---|
 | 2 | 
 | 
|---|
 | 3 | {$OPTIMIZATION OFF}                              // REMOVE AFTER UNIT IS DEBUGGED
 | 
|---|
 | 4 | 
 | 
|---|
 | 5 | interface
 | 
|---|
 | 6 | 
 | 
|---|
 | 7 | uses
 | 
|---|
 | 8 |   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, uConst,
 | 
|---|
 | 9 |   rOrders;
 | 
|---|
 | 10 | 
 | 
|---|
 | 11 | type
 | 
|---|
 | 12 |   TfrmPage = class(TForm)
 | 
|---|
 | 13 |     shpPageBottom: TShape;
 | 
|---|
 | 14 |     procedure FormCreate(Sender: TObject);
 | 
|---|
 | 15 |     procedure FormClose(Sender: TObject; var Action: TCloseAction);
 | 
|---|
 | 16 |   private
 | 
|---|
 | 17 |     FDisplayCount: Integer;                      // number of times page displayed
 | 
|---|
 | 18 |     FPatientCount: Integer;                      // number of times page displayed for given pt
 | 
|---|
 | 19 |     FCallingContext: Integer;
 | 
|---|
 | 20 |     FOldEnter: TNotifyEvent;
 | 
|---|
 | 21 |     FPageID: integer;
 | 
|---|
 | 22 |     function GetInitPage: Boolean;
 | 
|---|
 | 23 |     function GetInitPatient: Boolean;
 | 
|---|
 | 24 |     function GetPatientViewed: Boolean;
 | 
|---|
 | 25 |   protected
 | 
|---|
 | 26 |     procedure Loaded; override;
 | 
|---|
 | 27 |     procedure frmPageEnter(Sender: TObject);
 | 
|---|
 | 28 |   public
 | 
|---|
 | 29 |     function AllowContextChange(var WhyNot: string): Boolean; virtual;
 | 
|---|
 | 30 |     procedure ClearPtData; virtual;
 | 
|---|
 | 31 |     procedure DisplayPage; virtual;
 | 
|---|
 | 32 |     procedure NotifyOrder(OrderAction: Integer; AnOrder: TOrder); virtual;
 | 
|---|
 | 33 |     procedure RequestPrint; virtual;
 | 
|---|
 | 34 |     procedure SetFontSize(NewFontSize: Integer); virtual;
 | 
|---|
 | 35 |     procedure FocusFirstControl;
 | 
|---|
 | 36 |     property CallingContext: Integer read FCallingContext;
 | 
|---|
 | 37 |     property InitPage: Boolean read GetInitPage;
 | 
|---|
 | 38 |     property InitPatient: Boolean read GetInitPatient;
 | 
|---|
 | 39 |     property PatientViewed: Boolean read GetPatientViewed;
 | 
|---|
 | 40 |     property PageID: integer read FPageID write FPageID default CT_UNKNOWN;
 | 
|---|
 | 41 |   end;
 | 
|---|
 | 42 | 
 | 
|---|
 | 43 | var
 | 
|---|
 | 44 |   frmPage: TfrmPage;
 | 
|---|
 | 45 | 
 | 
|---|
 | 46 | implementation
 | 
|---|
 | 47 | 
 | 
|---|
| [460] | 48 | uses ORFn, fFrame, uInit;
 | 
|---|
| [459] | 49 | 
 | 
|---|
 | 50 | {$R *.DFM}
 | 
|---|
 | 51 | 
 | 
|---|
 | 52 | procedure TfrmPage.FormCreate(Sender: TObject);
 | 
|---|
 | 53 | { set counters to 0 }
 | 
|---|
 | 54 | begin
 | 
|---|
 | 55 |   HelpFile := Application.HelpFile + '>' + HelpFile;
 | 
|---|
 | 56 |   FDisplayCount := 0;
 | 
|---|
 | 57 |   FPatientCount := 0;
 | 
|---|
 | 58 |   FOldEnter := OnEnter;
 | 
|---|
 | 59 |   OnEnter := frmPageEnter;
 | 
|---|
 | 60 | end;
 | 
|---|
 | 61 | 
 | 
|---|
 | 62 | procedure TfrmPage.Loaded;
 | 
|---|
 | 63 | { make the form borderless to allow it to be a child window }
 | 
|---|
 | 64 | begin
 | 
|---|
 | 65 |   inherited Loaded;
 | 
|---|
 | 66 |   Visible := False;
 | 
|---|
 | 67 |   Position := poDefault;
 | 
|---|
 | 68 |   BorderIcons := [];
 | 
|---|
 | 69 |   BorderStyle := bsNone;
 | 
|---|
 | 70 |   HandleNeeded;
 | 
|---|
 | 71 |   SetBounds(0, 0, Width, Height);
 | 
|---|
 | 72 | end;
 | 
|---|
 | 73 | 
 | 
|---|
 | 74 | function TfrmPage.AllowContextChange(var WhyNot: string): Boolean;
 | 
|---|
 | 75 | begin
 | 
|---|
 | 76 |   Result := True;
 | 
|---|
 | 77 | end;
 | 
|---|
 | 78 | 
 | 
|---|
 | 79 | procedure TfrmPage.ClearPtData;
 | 
|---|
 | 80 | { clear all patient related data on a page }
 | 
|---|
 | 81 | begin
 | 
|---|
 | 82 |   FPatientCount := 0;
 | 
|---|
 | 83 | end;
 | 
|---|
 | 84 | 
 | 
|---|
 | 85 | procedure TfrmPage.DisplayPage;
 | 
|---|
 | 86 | { cause the page to be displayed and update the display counters }
 | 
|---|
 | 87 | begin
 | 
|---|
 | 88 |   BringToFront;
 | 
|---|
 | 89 |   if ActiveControl <> nil then
 | 
|---|
 | 90 |     FocusControl(ActiveControl)
 | 
|---|
 | 91 |   else
 | 
|---|
 | 92 |     FocusFirstControl;
 | 
|---|
 | 93 |   //SetFocus;
 | 
|---|
 | 94 |   Inc(FDisplayCount);
 | 
|---|
 | 95 |   Inc(FPatientCount);
 | 
|---|
 | 96 |   FCallingContext := frmFrame.ChangeSource;
 | 
|---|
 | 97 |   if (FCallingContext = CC_CLICK) and (FPatientCount = 1)
 | 
|---|
 | 98 |     then FCallingContext := CC_INIT_PATIENT;
 | 
|---|
 | 99 | end;
 | 
|---|
 | 100 | 
 | 
|---|
 | 101 | procedure TfrmPage.NotifyOrder(OrderAction: Integer; AnOrder: TOrder);
 | 
|---|
 | 102 | begin
 | 
|---|
 | 103 | end;
 | 
|---|
 | 104 | 
 | 
|---|
 | 105 | procedure TfrmPage.RequestPrint;
 | 
|---|
 | 106 | begin
 | 
|---|
 | 107 | end;
 | 
|---|
 | 108 | 
 | 
|---|
 | 109 | procedure TfrmPage.SetFontSize(NewFontSize: Integer);
 | 
|---|
 | 110 | begin
 | 
|---|
 | 111 |   ResizeAnchoredFormToFont( self );
 | 
|---|
 | 112 |   if Assigned(Parent) then begin
 | 
|---|
 | 113 |     Width := Parent.ClientWidth;
 | 
|---|
 | 114 |     Height := Parent.ClientHeight;
 | 
|---|
 | 115 |   end;
 | 
|---|
 | 116 |   Resize;
 | 
|---|
 | 117 | end;
 | 
|---|
 | 118 | 
 | 
|---|
 | 119 | function TfrmPage.GetInitPage: Boolean;
 | 
|---|
 | 120 | { if the count is one, this is the first time the page is being displayed }
 | 
|---|
 | 121 | begin
 | 
|---|
 | 122 |   Result := FDisplayCount = 1;
 | 
|---|
 | 123 | end;
 | 
|---|
 | 124 | 
 | 
|---|
 | 125 | function TfrmPage.GetInitPatient: Boolean;
 | 
|---|
 | 126 | { if the count is one, this is the first time the page is being displayed for a given patient }
 | 
|---|
 | 127 | begin
 | 
|---|
 | 128 |   Result := FPatientCount = 1;
 | 
|---|
 | 129 | end;
 | 
|---|
 | 130 | 
 | 
|---|
 | 131 | function TfrmPage.GetPatientViewed: Boolean;
 | 
|---|
 | 132 | { returns false if the tab has never been clicked for this patient }
 | 
|---|
 | 133 | begin
 | 
|---|
 | 134 |   Result := FPatientCount > 0;
 | 
|---|
 | 135 | end;
 | 
|---|
 | 136 | 
 | 
|---|
 | 137 | procedure TfrmPage.FormClose(Sender: TObject; var Action: TCloseAction);
 | 
|---|
 | 138 | begin
 | 
|---|
 | 139 |   Action := caFree;
 | 
|---|
 | 140 | end;
 | 
|---|
 | 141 | 
 | 
|---|
 | 142 | procedure TfrmPage.frmPageEnter(Sender: TObject);
 | 
|---|
 | 143 | begin
 | 
|---|
 | 144 |   if Assigned(frmFrame) then
 | 
|---|
 | 145 |     FrmFrame.tabPage.TabIndex := FrmFrame.PageIDToTab(PageID);
 | 
|---|
 | 146 |   if Assigned(FOldEnter) then
 | 
|---|
 | 147 |     FOldEnter(Sender);
 | 
|---|
 | 148 | end;
 | 
|---|
 | 149 | 
 | 
|---|
 | 150 | procedure TfrmPage.FocusFirstControl;
 | 
|---|
 | 151 | var
 | 
|---|
 | 152 |   NextControl: TWinControl;
 | 
|---|
 | 153 | begin
 | 
|---|
| [460] | 154 |   if Assigned(frmFrame) and frmFrame.Enabled and frmFrame.Visible and not uInit.Timedout then begin
 | 
|---|
| [459] | 155 |     NextControl := FindNextControl(nil, True, True, False);
 | 
|---|
 | 156 |     if NextControl <> nil then
 | 
|---|
 | 157 |       NextControl.SetFocus;
 | 
|---|
 | 158 |   end;
 | 
|---|
 | 159 | end;
 | 
|---|
 | 160 | 
 | 
|---|
 | 161 | end.
 | 
|---|