📄 main.pas
字号:
{ *************************************************************************** }
{ }
{ 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 + -