Health Organizer Code

{

    Health Organizer (http://sourceforge.net/projects/hor/,
                      http://hor.sourceforge.net/)
    Copyright (C) 2014-2015  Andrea Urbani ( matfanjol@users.sf.net,
	                                     matfanjol@mail.com )

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.

}
unit hor_main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, pqconnection, sqldb, FileUtil, Forms, Controls, Graphics,
  Dialogs, defaulttranslator, ComCtrls, Menus, ActnList, XMLPropStorage;

type

  { TfrmMain }

  TfrmMain = class(TForm)
    actDbConnect: TAction;
    actHeAbout: TAction;
    actCountriesAdd: TAction;
    actCountriesList: TAction;
    actDbCheckSystemTables: TAction;
    actPathologiesAdd: TAction;
    actPathologiesList: TAction;
    actMeasurementsAdd: TAction;
    actPersonsAdd: TAction;
    actPersonsList: TAction;
    actQuit: TAction;
    MainActionList: TActionList;
    MainMenu: TMainMenu;
    MenuItem1: TMenuItem;
    miPathologiesList: TMenuItem;
    miPathologiesAdd: TMenuItem;
    miGeneralDataPathologies: TMenuItem;
    miGeneralData: TMenuItem;
    miLaFrancais: TMenuItem;
    miLaPortuguese: TMenuItem;
    miMeasurementsAdd: TMenuItem;
    miPatientsMeasurements: TMenuItem;
    miPatients: TMenuItem;
    miDbCheckST: TMenuItem;
    MenuItem5: TMenuItem;
    miCountriesList: TMenuItem;
    miCountriesAdd: TMenuItem;
    miGdCountries: TMenuItem;
    miGeneralDataGeographical: TMenuItem;
    miPersons: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    miHeAbout: TMenuItem;
    miHelp: TMenuItem;
    miLaItaliano: TMenuItem;
    miLaEnglish: TMenuItem;
    miLanguage: TMenuItem;
    miDbQuit: TMenuItem;
    miDbOpen: TMenuItem;
    miDatabase: TMenuItem;
    pgConnection: TPQConnection;
    pgQuery: TSQLQuery;
    pgTransaction: TSQLTransaction;
    pgScript: TSQLScript;
    StatusBar: TStatusBar;
    XmlPropStor: TXMLPropStorage;
    procedure actCountriesAddExecute(Sender: TObject);
    procedure actCountriesListExecute(Sender: TObject);
    procedure actDbCheckSystemTablesExecute(Sender: TObject);
    procedure actDbConnectExecute(Sender: TObject);
    procedure actHeAboutExecute(Sender: TObject);
    procedure actMeasurementsAddExecute(Sender: TObject);
    procedure actPathologiesAddExecute(Sender: TObject);
    procedure actPathologiesListExecute(Sender: TObject);
    procedure actPersonsAddExecute(Sender: TObject);
    procedure actPersonsListExecute(Sender: TObject);
    procedure actQuitExecute(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure miLaEnglishClick(Sender: TObject);
    procedure pgConnectionAfterConnect(Sender: TObject);
    procedure pgConnectionAfterDisconnect(Sender: TObject);
    procedure pgScriptException(Sender: TObject; Statement: TStrings;
      TheException: Exception; var Continue: boolean);
  protected
    procedure SelectLanguage( MenuItem : TMenuItem );
    procedure BuildTitle;
    procedure EnableDisableDatabaseRelativeFunction( const EnableThem :
      boolean);
  private
    { private declarations }
  public
    var ReadOnlyMode: boolean;

    // It asks to the user to select a patient.
    // If no patient exist, the user can create a new one
    // If only one patient exists, that one is returned
    // Otherwise the selection mask is showed in modal form
    // Returns true if PatientID and PatientName contain valid data.
    function SelectPatient( var PatientID : LongInt; var PatientName : string ):
      boolean;
  end;

var
  frmMain: TfrmMain;
  Traduzioni: string;

const
  constMyLatestKnownDbVersion=1;

  // The default data database is built with the <database name> +
  // constDefaultDataDatabaseSuffix name and will contain default data like the
  // list of countries, cities, drugs, etc..
  // The idea is to store inside the main database just the used data.
  constDefaultDataDatabaseSuffix='_defdata';

implementation

{$R *.lfm}

{ TfrmMain }

Uses hor_dbopen, hor_about, hor_navigation_persons,
  hor_edit_persons, hor_navigation_countries, hor_edit_countries, LCLTranslator,
  hor_messages, hor_database, hor_combobox, hor_edit_mdl_measurements,
  hor_navigation_pathologies, hor_edit_pathologies;

procedure TfrmMain.actQuitExecute(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TfrmMain.FormActivate(Sender: TObject);
begin
  if ( not pgConnection.Connected ) then
    // I automatically start the connection action if no connection is available
    actDbConnect.Execute;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  XmlPropStor.FileName:=GetAppConfigFileUTF8(false,false,true);
  ReadOnlyMode := false;
  BuildTitle;
  // At the beginning, that there is no database connection, all the function
  // relative to the database has to be disabled
  EnableDisableDatabaseRelativeFunction(false);
end;

procedure TfrmMain.actDbConnectExecute(Sender: TObject);
begin
  Application.CreateForm(TfrmDbConnect,frmDbConnect);
  frmDbConnect.ShowModal;
//  if ( frmDbConnect.ShowModal = mrOK ) then
//    DatabaseChanged
  frmDbConnect.Release;
end;

procedure TfrmMain.actCountriesListExecute(Sender: TObject);
begin
  TfrmNavigationCountries.Create(Self).Show();
end;

procedure TfrmMain.actDbCheckSystemTablesExecute(Sender: TObject);
begin
  Screen.Cursor := crSQLWait;
  try
    try
      if ( DB_CheckSystemData() ) then
        MessageDlg( rsMsgDone, rsMsgCheckSuccess, mtInformation, [mbOk], 0 )
      else
        MessageDlg( rsMsgError, rsMsgUnknown, mtError, [mbOk], 0 );
    except
      on E: Exception do
        MessageDlg( rsMsgError, Format( rsMsgErrorCheckingSystemData, [
          e.Message ] ), mtError, [mbOk], 0 );
    end;
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TfrmMain.actCountriesAddExecute(Sender: TObject);
begin
  with TfrmEditCountries.Create(Self) do
  begin
    NewRecord;
    Show;
  end;
end;

procedure TfrmMain.actHeAboutExecute(Sender: TObject);
begin
  Application.CreateForm(TfrmAbout, frmAbout);
  frmAbout.ShowModal;
  frmAbout.Release;
end;

procedure TfrmMain.actMeasurementsAddExecute(Sender: TObject);
var
  vPatientID : LongInt;
  vPatientName : string;
begin
  // First of all I have to request for which patiente
  vPatientID:=0;
  vPatientName:='';
  if ( SelectPatient( vPatientID, vPatientName ) ) then
  begin
    with TfrmEditMdlMeasurements.Create( Application ) do
    begin
      Caption := Format( Caption, [ vPatientName ] );
      lblTitle.Caption := Caption;
      NewRecord;
      qDataID_Patient.Value:=vPatientID;
      Show;
    end;
  end;
end;

procedure TfrmMain.actPathologiesAddExecute(Sender: TObject);
begin
  with TfrmEditPathologies.Create(Self) do
  begin
    NewRecord;
    Show;
  end;
end;

procedure TfrmMain.actPathologiesListExecute(Sender: TObject);
begin
  TfrmNavigationPathologies.Create(Self).Show();
end;

procedure TfrmMain.actPersonsAddExecute(Sender: TObject);
begin
  with TfrmEditPersons.Create(Self) do
  begin
    NewRecord;
    Show;
  end;
end;

procedure TfrmMain.actPersonsListExecute(Sender: TObject);
begin
  TfrmNavigationPersons.Create(Self).Show();
end;

procedure TfrmMain.miLaEnglishClick(Sender: TObject);
begin
  if ( Sender is TMenuItem ) then
    SelectLanguage( Sender as TMenuItem );
end;

procedure TfrmMain.pgConnectionAfterConnect(Sender: TObject);
begin
  EnableDisableDatabaseRelativeFunction(true);
end;

procedure TfrmMain.pgConnectionAfterDisconnect(Sender: TObject);
begin
  EnableDisableDatabaseRelativeFunction(false);
end;

procedure TfrmMain.pgScriptException(Sender: TObject; Statement: TStrings;
  TheException: Exception; var Continue: boolean);
begin
  Continue := false;
  raise Exception.Create( Statement.Text + LineEnding + TheException.Message );
end;

procedure TfrmMain.SelectLanguage(MenuItem: TMenuItem);
var
  I : integer;
begin
  I := miLanguage.Count-1;
  while ( I >= 0 ) do
  begin
    if ( miLanguage.Items[I] = MenuItem ) then
    begin
      miLanguage.Items[I].Checked:=true;
      if ( miLanguage.Items[I] = miLaItaliano ) then
        SetDefaultLang('it')
      else if ( miLanguage.Items[I] = miLaPortuguese ) then
          SetDefaultLang('pt_PT')
      else if ( miLanguage.Items[I] = miLaFrancais ) then
          SetDefaultLang('fr_FR')
      else
        // The default in the case of not already handled language
        SetDefaultLang('en');
      BuildTitle;
    end
    else
      miLanguage.Items[I].Checked:=false;
    Dec(I);
  end;
end;

procedure TfrmMain.BuildTitle;
begin
  Caption := rsAboutTitle + ' - ' + rsAboutBrief;
end;


procedure TfrmMain.EnableDisableDatabaseRelativeFunction(
  const EnableThem: boolean);
begin
  // It enables or disables (according to the EnableThem parameter) all the
  // functions that needs an established database connection to work properly
  actDbCheckSystemTables.Enabled:=EnableThem;
  actPersonsAdd.Enabled:=EnableThem;
  actPersonsList.Enabled:=EnableThem;
  actCountriesAdd.Enabled:=EnableThem;
  actCountriesList.Enabled:=EnableThem;
  actMeasurementsAdd.Enabled:=EnableThem;
end;

function TfrmMain.SelectPatient(var PatientID: LongInt; var PatientName: string
  ): boolean;
begin
  result := false;
  with TfrmComboBox.Create( Application ) do
  begin
    qList.Sql.Clear;
    qList.Sql.Add('select');
    qList.Sql.Add('"ID",');
    qList.Sql.Add('cast(trim(');
    qList.Sql.Add('case');
    qList.Sql.Add('when "tPersons"."Surname" is null then ''''');
    qList.Sql.Add('else "tPersons"."Surname" end || '' '' || "tPersons"."Name"');
    qList.Sql.Add(') as varchar(80)) as "Name"');
    qList.Sql.Add('from "tPatients"');
    qList.Sql.Add('inner join "tPersons"');
    qList.Sql.Add('on ( "tPatients"."ID_Person" = "tPersons"."ID" )');
    qList.Sql.Add('where');
    qList.Sql.Add('"tPersons"."Dead_Day" is null');
    qList.Sql.Add('order by');
    qList.Sql.Add('trim(');
    qList.Sql.Add('case');
    qList.Sql.Add('when "tPersons"."Surname" is null then ''''');
    qList.Sql.Add('else "tPersons"."Surname" end || '' '' || "tPersons"."Name"');
    qList.Sql.Add(')');
    dlCombobox.KeyField := 'ID';
    dlCombobox.ListField:='Name';
    lblTitle.Caption:=rsMsgSelectThePatient;
    Caption := lblTitle.Caption;
    qList.Open;
    if ( qList.IsEmpty ) then
    begin
      if ( MessageDlg( rsMsgNoPatient, rsQMsgNoPatientExistsCreateOne,
        mtConfirmation, [mbYes,mbNo], 0 ) = mrYes ) then
        actPersonsAdd.Execute;
    end
    else if ( qList.RecordCount = 1 ) then
    begin
      PatientID:=qList.FieldByName('ID').AsInteger;
      PatientName := qList.FieldByName('Name').AsString;
      result := true;
    end
    else
    begin
      if ShowModal=mrOK then
      begin
        PatientID:=dlCombobox.KeyValue;
        PatientName := dlCombobox.Text;
        result := true;
      end;
    end;
    Release;
  end;
end;

end.