unit fMainFrame;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, ToolWin, StdCtrls, Menus, uCore, fPage, uConst,
  uPCE, ShellAPI, fAbout, uInit, ORSystem;

const
  TX_IN_USE  = 'Group Notes in use by: ';

type
  TfrmMainFrame = class(TForm)
    pnlPage: TPanel;
    mnuGNMain: TMainMenu;
    Help1: TMenuItem;
    LastBroker1: TMenuItem;
    Font1: TMenuItem;
    N8pt1: TMenuItem;
    N10pt1: TMenuItem;
    N12pt1: TMenuItem;
    N14pt1: TMenuItem;
    N18pt1: TMenuItem;
    N24pt1: TMenuItem;
    Bevel1: TBevel;
    Contents1: TMenuItem;
    N1: TMenuItem;
    OpenDialog1: TOpenDialog;
    About1: TMenuItem;
    File1: TMenuItem;
    Exit1: TMenuItem;
    ICD10Comments1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure LastBroker1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    //procedure Button4Click(Sender: TObject);
    procedure mnuFontSizeClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure UMShowPage(var Message: TMessage);   message UM_SHOWPAGE;
    procedure WMSetFocus(var Message: TMessage);   message WM_SETFOCUS;
    procedure FormDestroy(Sender: TObject);
    procedure Contents1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
  private
    FLastPage:    TfrmPage;
    FontSzInUse:  Integer;
    procedure ChangeFont(NewFontSize: Integer);
    procedure CreatePage(APageID: integer);
    procedure LoadUserPreferences;
    procedure LoadSizesForUser;
    procedure timeOutAction;
    function  timeOutCondition: boolean;
  public
    procedure SwitchTo(NewForm: TfrmPage; NewFormID: integer);
    procedure CloseApp(Sender: TObject);
  end;

var
  frmMainFrame: TfrmMainFrame;
  uPageList: TStringList;
  CloseFromMain: boolean = False;
  bICD10Debug: Boolean = False; // ICD10 Remediation debug flag

implementation

{$R *.dfm}

uses ORNet, ORFn, fGNPtSel, fGNEncounter, fxBroker, rMisc, rGroupNote
  , VAUtils  // ICD-10 Remediation
  , uUtils
//  , WinHelpViewer // 2FA - .hlp support
  , HtmlHelpViewer // 2FA - .chm support
  ;

procedure TfrmMainFrame.FormCreate(Sender: TObject);
(*
const
  TX_VER1       = 'This is version ';
  TX_VER2       = ' of GroupNotes.exe.';
  TX_VER3       = CRLF + 'The running server version is ';
  TX_VER_REQ    = ' version server is required.';
  TX_VER_OLD    = CRLF + 'It is strongly recommended that you upgrade.';
  TX_VER_OLD2   = CRLF + 'The program cannot be run until the client is upgraded.';
  TX_VER_NEW    = CRLF + 'The program cannot be run until the server is upgraded.';
  TC_VER        = 'Server/Client Incompatibility';
  TC_CLIERR     = 'Client Specifications Mismatch';

  TX_CLIENT_MISMATCH = 'Client "version" does not match client "required" server.';
*)
//var
//  sLog,
//  ClientVer, ServerVer, ServerReq: string;
begin
  if not ConnectToServer('OR CPRS GUI CHART') then
    Application.Terminate;
(*
  if not IsAuthUser then
  begin
    ShowMessage('You are not authorized to use Group Notes.');
    Application.Terminate;
    Exit;
  end;
  ClientVer := ClientVersion(Application.ExeName);
  ServerVer := ServerVersion('OR GN SET LOCATIONS', ClientVer);
  if (ServerVer = '0.0.0.0') then
  begin
    InfoBox('Unable to determine current version of server, please make sure you installed latest patch OR*3*222.', 'Group Notes', MB_OK);
    Application.Terminate;
    Exit;
  end;
  ServerReq := Piece(FileVersionValue(Application.ExeName, FILE_VER_INTERNALNAME), ' ', 1);

//  if (ClientVer <> ServerReq) then
  if (CompareVersion(ServerVer, ClientVer) > 0) then // Server newer than Client
  begin
    AddLogLine(TX_CLIENT_MISMATCH, TC_CLIERR); //
    InfoBox(TX_CLIENT_MISMATCH, TC_CLIERR, MB_OK);
    if not bICD10Debug then
      begin
        Application.Terminate;
        Exit;
      end;
  end;

  if (CompareVersion(ServerVer, ServerReq) <> 0) then
  begin
    if (CompareVersion(ServerVer, ServerReq) > 0) then // Server newer than Required
    begin
//      if (true) then // "True" statement guarantees "required" current version client.
      if (CompareVersion(ServerVer, ClientVer) > 0) then  //  Server newer than Client
      begin
        InfoBox(TX_VER1 + ClientVer + TX_VER2 + CRLF + ServerReq + TX_VER_REQ + TX_VER3 + ServerVer + '.' + TX_VER_OLD2, TC_VER, MB_OK);
        if not bICD10Debug then
          begin
            Application.Terminate;
            Exit;
          end
        else
          AddLogLine(TX_VER1 + ClientVer + TX_VER2 + CRLF + ServerReq + TX_VER_REQ + TX_VER3 + ServerVer + '.' + TX_VER_OLD2,TC_VER);
      end
//      else InfoBox(TX_VER1 + ClientVer + TX_VER2 + CRLF + ServerReq + TX_VER_REQ + TX_VER3 + ServerVer + '.' + TX_VER_OLD, TC_VER, MB_OK)
      ;
    end;
    if (CompareVersion(ServerVer, ServerReq) < 0) then // Server older then Required
    begin
      AddLogLine(TX_VER1 + ClientVer + TX_VER2 + CRLF + ServerReq + TX_VER_REQ + TX_VER3 + ServerVer + '.' + TX_VER_NEW, TC_VER);
      InfoBox(TX_VER1 + ClientVer + TX_VER2 + CRLF + ServerReq + TX_VER_REQ + TX_VER3 + ServerVer + '.' + TX_VER_NEW, TC_VER, MB_OK);
      if not bICD10Debug then
        begin
          Application.Terminate;
          Exit;
        end;
    end;
  end;
*)
{$IFDEF DEBUG}
  if not IsCorrectVersion(TRUE) then
{$ELSE}
  if not IsCorrectVersion(FALSE) then
{$ENDIF}
    begin
      Application.Terminate;
      Exit;
    end;

  FontSzInUse := 0;
  User := TUser.Create;
  Encounter := TEncounter.Create;
  Changes := TChanges.Create;
  if User.IsProvider then
  begin
    Encounter.Provider := User.DUZ;
    Encounter.ProviderName := User.Name;
  end;
  uPageList := TStringList.Create;
  Caption := TX_IN_USE + MixedCase(User.Name) + '  (' + RPCBrokerV.Server + ')';
{$IFDEF ICD10DEBUG}
  AddLogLine(Encounter.ToString,'Encounter');
  if bICD10Debug then
    Caption := Caption + ' ' + FileVersionValue(Application.ExeName, 'DEBUG');
{$ENDIF}
  CreatePage(PG_GNPTSEL);
  //CreatePage(PG_GNECTER);  JD

  Application.ShowHint := True;  // rpk 1/21/2012                         ICD-10

  LoadUserPreferences;
  SwitchTo(frmGNPtSel, PG_GNPTSEL);

  GImplementationDate := GetImplementationDate();  // rpk 2/14/2012       ICD-10

  InitTimeOut(TimeOutCondition, TimeOutAction);
  UpdateTimeOutInterval(User.DTIME * 1000);  // DTIME * 1000 mSec
{$IFDEF RPCLOG}
  if bICD10Debug then
    ShowBroker;
{$ENDIF}
end;

procedure TfrmMainFrame.SwitchTo(NewForm: TfrmPage; NewFormID: integer);
begin
  if not Assigned(NewForm) then
  begin
    case NewFormID of
      PG_GNPTSEL:
      begin
        frmGNPtSel := TfrmGNPtSel.Create(self);
        frmGNPtSel.Parent := pnlPage;
        if FontSzInUse > 0 then
          frmGNPtSel.SetFontSize(FontSzInUse);
        NewForm := frmGNPtSel;
      end;
      PG_GNECTER:
      begin
        frmGNEncounter := TfrmGNEncounter.Create(self);
        frmGNEncounter.Parent := pnlPage;
        if FontSzInUse > 0 then
          frmGNEncounter.SetFontSize(FontSzInUse);
        NewForm := frmGNEncounter;
      end;
      else
        Exit;
    end;
  end;
  if FLastPage = NewForm then
    begin
      PostMessage(Handle, UM_SHOWPAGE, 0, 0);
      Exit;
    end;
  if (FLastPage <> nil) then
  begin
    if Assigned(FLastPage.Menu) then
      mnuGNMain.Unmerge(FLastPage.Menu);
    FLastPage.Hide;
  end;
  if Assigned(NewForm) then
  begin
    if Assigned(NewForm.Menu) then
      mnuGNMain.Merge(NewForm.Menu);
    NewForm.Show;
  end;
  FLastPage := NewForm;
  if NewForm <> nil then
  begin
    NewForm.Parent := pnlPage;
    NewForm.Align := alClient;
    NewForm.BringToFront;
    NewForm.FocusFirstControl;
    Application.ProcessMessages;
    PostMessage(Handle, UM_SHOWPAGE, 0, 0);
  end;
end;

procedure TfrmMainFrame.LastBroker1Click(Sender: TObject);
begin
  ShowBroker;
end;

procedure TfrmMainFrame.ChangeFont(NewFontSize: Integer);
var
  OldFont: TFont;
begin
  OldFont := TFont.Create;
  try
    DisableAlign;
    try
      OldFont.Assign(Font);
      with Self  do Font.Size := NewFontSize;
      FormResize( self );
    finally
      EnableAlign;
    end;
  finally
    OldFont.Free;
  end;
  FontSzInUse := NewFontSize;
  if Assigned(frmGNPtSel) then
    frmGNPtSel.SetFontSize(NewFontSize);
  if Assigned(frmGNEncounter) then
    frmGNEncounter.SetFontSize(NewFontSize);
end;

procedure TfrmMainFrame.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
 CloseFromMain := True;
 if Assigned(frmGNPtSel) then
   frmGNPtSel.Close;
 if Assigned(frmGNEncounter) then
   frmGNEncounter.Close;
 CleanGNPtList;
 SaveUserBounds(self);
end;

procedure TfrmMainFrame.mnuFontSizeClick(Sender: TObject);
begin
  with Sender as TMenuItem do ChangeFont(Tag);
end;

procedure TfrmMainFrame.FormResize(Sender: TObject);
begin
  Self.Repaint;
end;

procedure TfrmMainFrame.CreatePage(APageID: integer);
begin
  case APageID of
    PG_GNPTSEL:
    begin
      frmGNPtSel := TfrmGNPtSel.Create(self);
      frmGNPtSel.Parent := pnlPage;
    end;
    PG_GNECTER:
    begin
        frmGNEncounter := TfrmGNEncounter.Create(self);
        frmGNEncounter.Parent := pnlPage;
    end;
    else
      Exit;
  end;
end;

procedure TfrmMainFrame.LoadUserPreferences;
begin
  LoadSizesForUser;
end;

procedure TfrmMainFrame.LoadSizesForUser;
begin
  ChangeFont(UserFontSize);
  SetUserBounds(TControl(frmMainFrame));
end;

procedure TfrmMainFrame.UMShowPage(var Message: TMessage);
begin
  if FLastPage <> nil then FLastPage.DisplayPage;
end;

procedure TfrmMainFrame.WMSetFocus(var Message: TMessage);
begin
  if (FLastPage <> nil) and
     (not (csDestroying in FLastPage.ComponentState)) and FLastPage.Visible
    then FLastPage.FocusFirstControl;
end;

procedure TfrmMainFrame.FormDestroy(Sender: TObject);
begin
  Encounter.Free;
  User.Free;
  Patient.Free;
end;

procedure TfrmMainFrame.CloseApp(Sender: TObject);
begin
  Close;
end;

procedure TfrmMainFrame.Contents1Click(Sender: TObject);
//var
//  x,AFile,Param: String;
begin
{ 2FA
  x := Contents1.Hint;
  AFile := Piece(x, ' ', 1);
  Param := Copy(x, Length(AFile)+1, Length(x));
  ShellExecute(Handle, 'open', PChar(AFile), PChar(Param), '', SW_NORMAL);
}
  Application.HelpCommand(HELP_INDEX, 1001);
end;

procedure TfrmMainFrame.About1Click(Sender: TObject);
begin
  ShowAbout;
end;

procedure TfrmMainFrame.timeOutAction;
begin
  Close;
end;

function TfrmMainFrame.timeOutCondition: boolean;
begin
  Result := False;
end;

procedure TfrmMainFrame.Exit1Click(Sender: TObject);
begin
  Close;
end;

{$IFDEF ICD10DEBUG}
procedure setParams;
var
  i: integer;
begin
  for i := 0 to ParamCount do
    begin
      if UpperCase(ParamStr(i))='/ICD10DEBUG' then
        bICD10Debug := True;
    end;
end;

initialization

setParams;
{$ENDIF}
end.
