⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 PatientRunner 20 Source
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{ *************************************************************************** }
{                                                                             }
{ PatientRunner                                                               }
{                                                                             }
{ Copyright (c) 2002-2005 IgD Software, LLC                                   }
{                                                                             }
{ This file may be distributed and/or modified under the terms of the GNU     }
{ General Public License (GPL) version 2 as published by the Free Software    }
{ Foundation and appearing at http://www.gnu.org/licenses/gpl.html.           }
{                                                                             }
{ *************************************************************************** }
{                                                                             }
{ V2.0 - In TPatientRecord, replaced TDate and TTime fields with TDateTime    }
{ to maximize compatibility with different DBMS. Consolidated lastseendate    }
{ and lastseentime fields into lastseendatetime field.                        }
{                                                                             }
{ *************************************************************************** }

{ Important lession about TListView:
  Don't use TListView.Selected b/c it can be nil if a user clicks (de-selects)
  outside items on control.  Use TListView.ItemFocused instead which is never
  nil once an item is selected.  For example, the redraw procedures.}


unit Main;

interface

uses
  SysUtils, Forms, Classes, Controls, StdCtrls, ComCtrls,
  Dialogs, ExtCtrls, Menus, DBXpress,
  FMTBcd, SqlExpr, DB, MidasLib, dbExpMYSQL;

const VersionInfo = 'PatientRunner 2.0';

type
  PPatientRecord = ^TPatientRecord;
  TPatientRecord = record
    PatientID: integer;
    Lastname: string;
    Firstname: string;
    SSN: string;
    Birthday: TDateTime;
    Status: string;
    IsMale: boolean;
    Rate: string;
    Rank: string;
    Service: string;
    PayDate: TDateTime;
    Command: string;
    POC: string;
    Allergies: string;
    Inactive: boolean;
    Author: string;
    LastSeenDateTime: TDateTime;
  end;

  TMainForm = class(TForm)
    PatientListPopupMenu: TPopupMenu;
    MainMenu: TMainMenu;
    NewPatient: TMenuItem;
    ExplorePatient: TMenuItem;
    DeletePatient: TMenuItem;
    N1: TMenuItem;
    NewPatientMenuItem: TMenuItem;
    ExplorePatientMenuItem: TMenuItem;
    DeletePatientMenuItem: TMenuItem;
    N2: TMenuItem;
    Refresh: TMenuItem;
    N3: TMenuItem;
    RefreshMenuItem: TMenuItem;
    EditPatientMenuItem: TMenuItem;
    EditPatient: TMenuItem;
    SQLConnection: TSQLConnection;
    SQLQuery: TSQLQuery;
    ools1: TMenuItem;
    TemplateManager: TMenuItem;
    StatusBar: TStatusBar;
    Sort1: TMenuItem;
    byName: TMenuItem;
    byLastSeenDate: TMenuItem;
    EncounterReportGenerator: TMenuItem;
    PatientListView: TListView;
    byProvider: TMenuItem;
    SelectionCriteria1: TMenuItem;
    ShowOnlyMyPatientsCheckBox: TMenuItem;
    ShowOnlyActivePatientsCheckBox: TMenuItem;
    Status1: TMenuItem;
    ActiveDutyStatus: TMenuItem;
    FamilyMemberStatus: TMenuItem;
    RetireesStatus: TMenuItem;
    TDRLStatus: TMenuItem;
    AllStatus: TMenuItem;
    OtherStatus: TMenuItem;
    LastSeenDate1: TMenuItem;
    Time180Days: TMenuItem;
    Time1Year: TMenuItem;
    Time2Years: TMenuItem;
    TimeAll: TMenuItem;
    procedure RadioItemClick(Sender: TObject);
    procedure NewPatientClick(Sender: TObject);
    procedure ExplorePatientClick(Sender: TObject);
    procedure DeletePatientClick(Sender: TObject);
    procedure RefreshPatientsDBClick(Sender: TObject);
    procedure EditPatientClick(Sender: TObject);
    procedure TemplateManagerClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PatientListViewClick(Sender: TObject);
    procedure EncounterReportGeneratorClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PatientListViewColumnClick(Sender: TObject;
      Column: TListColumn);
  private
    procedure CleanUpPatientListView;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

  function AgeinYears(const Date: TDateTime): integer;
  function AgetoStr(Date1, Date2: TDateTime): string;
  function BooltoSexStr(IsMale: boolean): string;

implementation

uses Windows, Registry, StrUtils, PatientEditor, PatientExplorer, TemplateManager,
  EncounterReportGenerator;

{$R *.dfm}

function AgeinYears(const Date: TDateTime): integer;
var iYearA, iMonthA, iDayA: word;
    iYearB, iMonthB, iDayB: word;
begin
  DecodeDate(Date, iYearB, iMonthB, iDayB);
  DecodeDate(Now(), iYearA, iMonthA, iDayA);
  Result:=iYearA-iYearB;
  if iMonthA<iMonthB then
    Dec(Result)
  else
    if (iMonthA=iMonthB) and (iDayA<iDayB) then
    begin
      Dec(Result);
    end;
end;

function AgetoStr(Date1, Date2: TDateTime): string;
var
  year1, month1, day1: word;
  tyear, tmonth, tday: word;
  yyyy, mm, dd: word;
  d: TDateTime;
begin
  if Date1 > Date2 then
  begin
    Result:='Invalid Dates!';
    Exit; //Check for future dates
  end;

  DecodeDate(date1, year1, month1, day1);
  DecodeDate(date2, yyyy, mm, dd);
    
  if dd < day1 then
  begin
    d := EncodeDate(yyyy, mm, 1)-1;    // last day of previous month
    DecodeDate(d, tyear, tmonth, tday); // only want tday
    inc(dd, tday);
    dec(mm);
  end;
  dec(dd, day1);

  if mm < month1 then
  begin
    inc(mm, 12);
    dec(yyyy);
  end;
  dec(mm, month1);

  dec(yyyy, year1);

  Result:='';
  if yyyy>0 then Result:=Result+inttostr(yyyy)+'y ';
  if mm>0 then Result:=Result+inttostr(mm)+'m';
  //Result:=Result+inttostr(dd)+'d';
end;

function BooltoSexStr(IsMale: boolean): string;
begin
  if IsMale then
    Result:='male'
  else
    Result:='female';
end;

procedure TMainForm.RadioItemClick(Sender: TObject);
begin
  TMenuItem(Sender).Checked:=True;
  RefreshPatientsDBClick(Sender);
end;

procedure TMainForm.CleanUpPatientListView;
var i: integer;
begin
  //Delete everything from list
  try
    for i:=PatientListView.Items.Count-1 downto 0 do
    begin
      if Assigned(PatientListView.Items[i].Data) then Dispose(PPatientRecord(PatientListView.Items[i].Data));
      PatientListView.Items.Delete(i);
    end;
  finally
    PatientListView.Clear;
  end;
end;

procedure TMainForm.PatientListViewClick(Sender: TObject);
var PatientListViewnotEmpty: boolean;
begin
  PatientListViewnotEmpty:=Boolean(PatientListView.Items.Count>0);

  //First we need to update (enable/disable) the menu items on the edit menu
  EditPatient.Enabled:=PatientListViewnotEmpty;
  EditPatientMenuItem.Enabled:=PatientListViewnotEmpty;
  ExplorePatient.Enabled:=PatientListViewnotEmpty;
  ExplorePatientMenuItem.Enabled:=PatientListViewnotEmpty;
  DeletePatient.Enabled:=PatientListViewnotEmpty;
  DeletePatientMenuItem.Enabled:=PatientListViewnotEmpty;

  //If no items exist, then reset all controls to default setting and exit
  if not PatientListViewnotEmpty then Exit;

  //At this point, the list is populated with at least one item.  Now we check
  //and see if something is selected.  If not, we select the top item by default.
  if PatientListView.ItemFocused=nil then
  begin
    PatientListView.Selected:=PatientListView.TopItem;
    PatientListView.ItemFocused:=PatientListView.TopItem;
  end;

  //Check to make sure there is a pointer associated with the item, if not exit
  //to avoid nasty access error.
  if not Assigned(PatientListView.ItemFocused.Data) then Exit;

  //Update cosmetics (item in list and statusbar);
  with PPatientRecord(PatientListView.ItemFocused.Data)^ do
  begin
    PatientListView.ItemFocused.Caption:=Lastname+', '+Firstname+' '+SSN;

    //Now for debugging purposed, update status bar with PatientID of selected note
    //StatusBar.Panels[0].Text:='PatientID: '+inttostr(PatientID);
  end;
end;

procedure TMainForm.NewPatientClick(Sender: TObject);
begin
  with PatientEditorForm do
  begin
    NewRecord:=True;
    LastnameEdit.Text:='';
    FirstnameEdit.Text:='';
    SSNEdit.Text:='';
    StatusComboBox.ItemIndex:=0;
    MaleCheckBox.Checked:=True;
    BirthdatePicker.Date:=Now;
    Label4.Caption:='Birthday';
    RateEdit.Text:='';
    RankEdit.Text:='';
    ServiceComboBox.ItemIndex:=0;
    PayDatePicker.Date:=Now;
    Label7.Caption:='Pay Entry Base Date';
    CommandEdit.Text:='';
    POCEdit.Text:='';
    AllergiesEdit.Text:='';
    InactiveCheckBox.Checked:=False;
    ShowModal;
  end;

  //The new patient will be inserted into the db.  Just before the patient
  //editing form closes, the patient refresh DB procedure is called.  The
  //patient refresh DB includes a screen redraw call. 
end;

procedure TMainForm.EditPatientClick(Sender: TObject);
begin
  if PatientListView.Items.Count<=0 then Exit;
  if PatientListView.ItemFocused=nil then Exit;
  if not Assigned(PatientListView.ItemFocused.Data) then Exit;

  with PPatientRecord(PatientListView.ItemFocused.Data)^ do
  begin
    with PatientEditorForm do
    begin
      NewRecord:=False;
      LastnameEdit.Text:=Lastname;
      FirstnameEdit.Text:=Firstname;
      SSNEdit.Text:=SSN;
      if AnsiContainsText(Status, 'active') then StatusComboBox.ItemIndex:=0;
      if AnsiContainsText(Status, 'family') then StatusComboBox.ItemIndex:=1;
      if AnsiContainsText(Status, 'retiree') then StatusComboBox.ItemIndex:=2;
      if AnsiContainsText(Status, 'tdrl') then StatusComboBox.ItemIndex:=3;
      if AnsiContainsText(Status, 'other') then StatusComboBox.ItemIndex:=4;
      MaleCheckBox.Checked:=IsMale;
      BirthdatePicker.Date:=Birthday;
      BirthdatePickerChange(Sender);
      RateEdit.Text:=Rate;
      RankEdit.Text:=Rank;
      if AnsiContainsText(Service, 'N') then ServiceComboBox.ItemIndex:=0;
      if AnsiContainsText(Service, 'USA') then ServiceComboBox.ItemIndex:=1;
      if AnsiContainsText(Service, 'AF') then ServiceComboBox.ItemIndex:=2;
      if AnsiContainsText(Service, 'CG') then ServiceComboBox.ItemIndex:=3;
      if AnsiContainsText(Service, 'MC') then ServiceComboBox.ItemIndex:=4;
      PayDatePicker.Date:=PayDate;
      PayDatePickerChange(Sender);
      CommandEdit.Text:=Command;
      POCEdit.Text:=POC;
      AllergiesEdit.Text:=Allergies;
      InactiveCheckBox.Checked:=Inactive;
      ShowModal;
    end;
  end;

  //screen updating will be handled in patient editor form
end;

procedure TMainForm.ExplorePatientClick(Sender: TObject);
begin
  if PatientListView.Items.Count<=0 then Exit;
  if PatientListView.ItemFocused=nil then Exit;
  if not Assigned(PatientListView.ItemFocused.Data) then Exit;

  with PatientExplorerForm do
  begin
    with PPatientRecord(PatientListView.ItemFocused.Data)^ do
    begin
      Label1.Caption:=Lastname+', '+Firstname+' '+SSN;
      Label2.Caption:=inttostr(AgeInYears(Birthday) )+' y/o '+BooltoSexStr(IsMale)+' '+Status;
      //3 cases:
      //1.  For active duty service members, Rate/Rank/Ser + CAD time displayed.
      //    Command is displayed on next line.
      //2.  For TDRL and retirees, Rate/Rank/Ser displayed only.  Command is left blank.
      //3.  For family members or others, Rate/Rank/Ser and command are left blank.
      if Status='active duty service member' then
      begin
        Label3.Caption:=Rate+'/'+Rank+'/'+Service+' with '+AgetoStr(PayDate, Now() )+' CAD';
        Label4.Caption:='Command: '+Command;
      end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -