564 lines
17 KiB
Plaintext
564 lines
17 KiB
Plaintext
unit fOptionsLists;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
StdCtrls, ExtCtrls, ORCtrls, OrFn, Menus;
|
|
|
|
type
|
|
TfrmOptionsLists = class(TForm)
|
|
pnlBottom: TPanel;
|
|
btnOK: TButton;
|
|
btnCancel: TButton;
|
|
lblAddby: TLabel;
|
|
lblPatientsAdd: TLabel;
|
|
lblPersonalPatientList: TLabel;
|
|
lblPersonalLists: TLabel;
|
|
lstAddBy: TORComboBox;
|
|
btnPersonalPatientRA: TButton;
|
|
btnPersonalPatientR: TButton;
|
|
lstListPats: TORListBox;
|
|
lstPersonalPatients: TORListBox;
|
|
btnListAddAll: TButton;
|
|
btnNewList: TButton;
|
|
btnDeleteList: TButton;
|
|
lstPersonalLists: TORListBox;
|
|
radAddByType: TRadioGroup;
|
|
btnListSaveChanges: TButton;
|
|
btnListAdd: TButton;
|
|
lblInfo: TMemo;
|
|
bvlBottom: TBevel;
|
|
mnuPopPatient: TPopupMenu;
|
|
mnuPatientID: TMenuItem;
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure btnNewListClick(Sender: TObject);
|
|
procedure radAddByTypeClick(Sender: TObject);
|
|
procedure lstPersonalListsChange(Sender: TObject);
|
|
procedure lstAddByClick(Sender: TObject);
|
|
procedure btnDeleteListClick(Sender: TObject);
|
|
procedure btnListSaveChangesClick(Sender: TObject);
|
|
procedure btnPersonalPatientRAClick(Sender: TObject);
|
|
procedure btnListAddAllClick(Sender: TObject);
|
|
procedure btnPersonalPatientRClick(Sender: TObject);
|
|
procedure lstPersonalPatientsChange(Sender: TObject);
|
|
procedure btnListAddClick(Sender: TObject);
|
|
procedure lstListPatsChange(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure lstAddByNeedData(Sender: TObject; const StartFrom: String;
|
|
Direction, InsertAt: Integer);
|
|
procedure btnOKClick(Sender: TObject);
|
|
procedure mnuPatientIDClick(Sender: TObject);
|
|
procedure lstListPatsMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure lstPersonalPatientsMouseDown(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
procedure lstAddByKeyPress(Sender: TObject; var Key: Char);
|
|
private
|
|
{ Private declarations }
|
|
FLastList: integer;
|
|
procedure AddIfUnique(entry: string; aList: TORListBox);
|
|
public
|
|
{ Public declarations }
|
|
end;
|
|
|
|
var
|
|
frmOptionsLists: TfrmOptionsLists;
|
|
|
|
procedure DialogOptionsLists(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
|
|
|
|
implementation
|
|
|
|
uses fOptionsNewList, rOptions, uOptions, rCore, fPtSelOptns;
|
|
|
|
{$R *.DFM}
|
|
|
|
const
|
|
LIST_ADD = 1;
|
|
LIST_PERSONAL = 2;
|
|
|
|
procedure DialogOptionsLists(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
|
|
// create the form and make it modal, return an action
|
|
var
|
|
frmOptionsLists: TfrmOptionsLists;
|
|
begin
|
|
frmOptionsLists := TfrmOptionsLists.Create(Application);
|
|
actiontype := 0;
|
|
try
|
|
with frmOptionsLists do
|
|
begin
|
|
if (topvalue < 0) or (leftvalue < 0) then
|
|
Position := poScreenCenter
|
|
else
|
|
begin
|
|
Position := poDesigned;
|
|
Top := topvalue;
|
|
Left := leftvalue;
|
|
end;
|
|
ResizeAnchoredFormToFont(frmOptionsLists);
|
|
ShowModal;
|
|
actiontype := btnOK.Tag;
|
|
end;
|
|
finally
|
|
frmOptionsLists.Release;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.FormCreate(Sender: TObject);
|
|
begin
|
|
rpcGetPersonalLists(lstPersonalLists.Items);
|
|
radAddByType.ItemIndex := 0;
|
|
radAddByTypeClick(self);
|
|
FLastList := 0;
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.btnNewListClick(Sender: TObject);
|
|
var
|
|
newlist: string;
|
|
newlistnum: integer;
|
|
begin
|
|
newlist := '';
|
|
DialogOptionsNewList(Font.Size, newlist);
|
|
newlistnum := strtointdef(Piece(newlist, '^', 1), 0);
|
|
if newlistnum > 0 then
|
|
begin
|
|
with lstPersonalLists do
|
|
begin
|
|
Items.Add(newlist);
|
|
SelectByIEN(newlistnum);
|
|
end;
|
|
lstPersonalListsChange(self);
|
|
lstPersonalPatients.Items.Clear;
|
|
lstPersonalPatientsChange(self);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.radAddByTypeClick(Sender: TObject);
|
|
begin
|
|
with lstAddBy do
|
|
begin
|
|
case radAddByType.ItemIndex of
|
|
0: begin
|
|
ListItemsOnly := true;
|
|
LongList := true;
|
|
InitLongList('');
|
|
lblAddby.Caption := 'Patient:';
|
|
end;
|
|
1: begin
|
|
ListItemsOnly := false;
|
|
LongList := false;
|
|
ListWardAll(lstAddBy.Items);
|
|
lblAddby.Caption := 'Ward:';
|
|
end;
|
|
2: begin
|
|
ListItemsOnly := true;
|
|
LongList := true;
|
|
InitLongList('');
|
|
lblAddby.Caption := 'Clinic:';
|
|
end;
|
|
3: begin
|
|
ListItemsOnly := true;
|
|
LongList := true;
|
|
InitLongList('');
|
|
lblAddby.Caption := 'Provider:';
|
|
end;
|
|
4: begin
|
|
ListItemsOnly := false;
|
|
LongList := false;
|
|
ListSpecialtyAll(lstAddBy.Items);
|
|
lblAddby.Caption := 'Specialty:';
|
|
end;
|
|
5: begin
|
|
ListItemsOnly := false;
|
|
LongList := false;
|
|
ListTeamAll(lstAddBy.Items);
|
|
lblAddby.Caption := 'List:';
|
|
end;
|
|
end;
|
|
lstAddby.Caption := lblAddby.Caption;
|
|
ItemIndex := -1;
|
|
Text := '';
|
|
end;
|
|
lstListPats.Items.Clear;
|
|
lstListPatsChange(self);
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.AddIfUnique(entry: string; aList: TORListBox);
|
|
var
|
|
i: integer;
|
|
ien: string;
|
|
inlist: boolean;
|
|
begin
|
|
ien := Piece(entry, '^', 1);
|
|
inlist := false;
|
|
with aList do
|
|
for i := 0 to Items.Count - 1 do
|
|
if ien = Piece(Items[i], '^', 1) then
|
|
begin
|
|
inlist := true;
|
|
break;
|
|
end;
|
|
if not inlist then
|
|
aList.Items.Add(entry);
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.lstPersonalListsChange(Sender: TObject);
|
|
begin
|
|
if btnListSaveChanges.Enabled then
|
|
begin
|
|
if InfoBox('Do you want to save changes to '
|
|
+ Piece(lstPersonalLists.Items[FLastList], '^', 2) + '?',
|
|
'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
|
|
btnListSaveChangesClick(self);
|
|
end;
|
|
if lstPersonalLists.ItemIndex > -1 then FLastList := lstPersonalLists.ItemIndex;
|
|
lstPersonalPatients.Items.Clear;
|
|
btnDeleteList.Enabled := lstPersonalLists.ItemIndex > -1;
|
|
with lstPersonalLists do
|
|
begin
|
|
if (ItemIndex < 0) or (Items.Count <1) then
|
|
begin
|
|
btnListAdd.Enabled := false;
|
|
btnListAddAll.Enabled := false;
|
|
btnPersonalPatientR.Enabled := false;
|
|
btnPersonalPatientRA.Enabled := false;
|
|
btnListSaveChanges.Enabled := false;
|
|
exit;
|
|
end;
|
|
ListPtByTeam(lstPersonalPatients.Items, strtointdef(Piece(Items[ItemIndex], '^', 1), 0));
|
|
btnDeleteList.Enabled := true;
|
|
end;
|
|
if lstPersonalPatients.Items.Count = 1 then // avoid selecting '^No patients found.' msg
|
|
if Piece(lstPersonalPatients.Items[0], '^', 1) = '' then
|
|
begin
|
|
btnPersonalPatientR.Enabled := false;
|
|
btnPersonalPatientRA.Enabled := false;
|
|
exit;
|
|
end;
|
|
btnPersonalPatientR.Enabled := lstPersonalPatients.SelCount > 0;
|
|
btnPersonalPatientRA.Enabled := lstPersonalPatients.Items.Count > 0;
|
|
btnListSaveChanges.Enabled := false;
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.lstAddByClick(Sender: TObject);
|
|
var
|
|
ien: string;
|
|
visitstart, visitstop, i: integer;
|
|
visittoday, visitbegin, visitend: TFMDateTime;
|
|
aList: TStringList;
|
|
PtRec: TPtIDInfo;
|
|
begin
|
|
if lstAddBy.ItemIndex < 0 then exit;
|
|
ien := Piece(lstAddBy.Items[lstAddBy.ItemIndex], '^', 1);
|
|
case radAddByType.ItemIndex of
|
|
0:
|
|
begin
|
|
PtRec := GetPtIDInfo(ien);
|
|
lblAddBy.Caption := 'Patient: SSN: ' + PtRec.SSN;
|
|
lstAddby.Caption := lblAddby.Caption;
|
|
AddIfUnique(lstAddBy.Items[lstAddBy.ItemIndex], lstListPats);
|
|
end;
|
|
1:
|
|
begin
|
|
ListPtByWard(lstListPats.Items, strtointdef(ien,0));
|
|
end;
|
|
2:
|
|
begin
|
|
rpcGetApptUserDays(visitstart, visitstop); // use user's date range for appointments
|
|
visittoday := FMToday;
|
|
visitbegin := FMDateTimeOffsetBy(visittoday, LowerOf(visitstart, visitstop));
|
|
visitend := FMDateTimeOffsetBy(visittoday, HigherOf(visitstart, visitstop));
|
|
aList := TStringList.Create;
|
|
ListPtByClinic(lstListPats.Items, strtointdef(ien, 0), floattostr(visitbegin), floattostr(visitend));
|
|
for i := 0 to aList.Count - 1 do
|
|
AddIfUnique(aList[i], lstListPats);
|
|
aList.Free;
|
|
end;
|
|
3:
|
|
begin
|
|
ListPtByProvider(lstListPats.Items, strtoint64def(ien,0));
|
|
end;
|
|
4:
|
|
begin
|
|
ListPtBySpecialty(lstListPats.Items, strtointdef(ien,0));
|
|
end;
|
|
5:
|
|
begin
|
|
ListPtByTeam(lstListPats.Items, strtointdef(ien,0));
|
|
end;
|
|
end;
|
|
if lstListPats.Items.Count = 1 then // avoid selecting '^No patients found.' msg
|
|
if Piece(lstListPats.Items[0], '^', 1) = '' then
|
|
begin
|
|
btnListAddAll.Enabled := false;
|
|
btnListAdd.Enabled := false;
|
|
exit;
|
|
end;
|
|
btnListAddAll.Enabled := (lstListPats.Items.Count > 0) and (lstPersonalLists.ItemIndex > -1);
|
|
btnListAdd.Enabled := (lstListPats.SelCount > 0) and (lstPersonalLists.ItemIndex > -1);
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.btnDeleteListClick(Sender: TObject);
|
|
var
|
|
oldindex: integer;
|
|
deletemsg: string;
|
|
begin
|
|
with lstPersonalLists do
|
|
deletemsg := 'You have selected "' + DisplayText[ItemIndex]
|
|
+ '" to be deleted.' + CRLF + 'Are you sure you want to delete this list?';
|
|
if InfoBox(deletemsg, 'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
|
|
begin
|
|
btnListSaveChanges.Enabled := false;
|
|
with lstPersonalLists do
|
|
begin
|
|
oldindex := ItemIndex;
|
|
if oldindex > -1 then
|
|
begin
|
|
rpcDeleteList(Piece(Items[oldindex], '^', 1));
|
|
Items.Delete(oldindex);
|
|
btnPersonalPatientRAClick(self);
|
|
btnListSaveChanges.Enabled := false;
|
|
end;
|
|
if Items.Count > 0 then
|
|
begin
|
|
if oldindex = 0 then
|
|
ItemIndex := 0
|
|
else if oldindex > (Items.Count - 1) then
|
|
ItemIndex := Items.Count - 1
|
|
else
|
|
ItemIndex := oldindex;
|
|
btnListSaveChanges.Enabled := false;
|
|
lstPersonalListsChange(self);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.btnListSaveChangesClick(Sender: TObject);
|
|
var
|
|
listien: integer;
|
|
begin
|
|
listien := strtointdef(Piece(lstPersonalLists.Items[FLastList], '^', 1), 0);
|
|
rpcSaveListChanges(lstPersonalPatients.Items, listien);
|
|
btnListSaveChanges.Enabled := false;
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.btnPersonalPatientRAClick(Sender: TObject);
|
|
begin
|
|
lstPersonalPatients.Items.Clear;
|
|
btnPersonalPatientR.Enabled := lstPersonalPatients.SelCount > 0;
|
|
btnPersonalPatientRA.Enabled := lstPersonalPatients.Items.Count > 0;
|
|
btnListSaveChanges.Enabled := true;
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.btnListAddAllClick(Sender: TObject);
|
|
var
|
|
i: integer;
|
|
begin
|
|
with lstPersonalPatients do
|
|
begin
|
|
if Items.Count = 1 then
|
|
if Piece(Items[0], '^', 1) = '' then
|
|
Items.Clear;
|
|
end;
|
|
with lstListPats do
|
|
begin
|
|
for i := 0 to Items.Count - 1 do
|
|
AddIfUnique(Items[i], lstPersonalPatients);
|
|
Items.Clear;
|
|
lstPersonalPatientsChange(self);
|
|
lstAddBy.ItemIndex := -1;
|
|
btnListAddAll.Enabled := false;
|
|
lstPersonalPatientsChange(self);
|
|
end;
|
|
btnListSaveChanges.Enabled := true;
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.btnPersonalPatientRClick(Sender: TObject);
|
|
var
|
|
i: integer;
|
|
begin
|
|
if not btnPersonalPatientR.Enabled then exit;
|
|
with lstPersonalPatients do
|
|
for i := Items.Count - 1 downto 0 do
|
|
if Selected[i] then
|
|
Items.Delete(i);
|
|
btnPersonalPatientR.Enabled := lstPersonalPatients.SelCount > 0;
|
|
btnPersonalPatientRA.Enabled := lstPersonalPatients.Items.Count > 0;
|
|
btnListSaveChanges.Enabled := true;
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.lstPersonalPatientsChange(Sender: TObject);
|
|
begin
|
|
if lstPersonalPatients.SelCount = 1 then // avoid selecting '^No patients found.' msg
|
|
if Piece(lstPersonalPatients.Items[0], '^', 1) = '' then
|
|
begin
|
|
btnPersonalPatientR.Enabled := false;
|
|
btnPersonalPatientRA.Enabled := false;
|
|
exit;
|
|
end;
|
|
btnPersonalPatientR.Enabled := lstPersonalPatients.SelCount > 0;
|
|
btnPersonalPatientRA.Enabled := lstPersonalPatients.Items.Count > 0;
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.btnListAddClick(Sender: TObject);
|
|
var
|
|
i: integer;
|
|
begin
|
|
if not btnListAdd.Enabled then exit;
|
|
with lstPersonalPatients do
|
|
begin
|
|
if Items.Count = 1 then
|
|
if Piece(Items[0], '^', 1) = '' then
|
|
Items.Clear;
|
|
end;
|
|
with lstListPats do
|
|
for i := Items.Count - 1 downto 0 do
|
|
if Selected[i] then
|
|
begin
|
|
AddIfUnique(Items[i], lstPersonalPatients);
|
|
Items.Delete(i);
|
|
end;
|
|
lstListPatsChange(self);
|
|
lstPersonalPatientsChange(self);
|
|
btnListSaveChanges.Enabled := true;
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.lstListPatsChange(Sender: TObject);
|
|
begin
|
|
if lstListPats.SelCount = 1 then // avoid selecting '^No patients found.' msg
|
|
if Piece(lstListPats.Items[0], '^', 1) = '' then
|
|
exit;
|
|
btnListAdd.Enabled := (lstListPats.SelCount > 0) and (lstPersonalLists.ItemIndex > -1);
|
|
btnListAddAll.Enabled := (lstListPats.Items.Count > 0) and (lstPersonalLists.ItemIndex > -1);
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.FormShow(Sender: TObject);
|
|
begin
|
|
with lstPersonalLists do
|
|
if Items.Count < 1 then
|
|
showmessage('You have no personal lists. Use "New List..." to create one.')
|
|
else
|
|
begin
|
|
ItemIndex := 0;
|
|
lstPersonalListsChange(self);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.lstAddByNeedData(Sender: TObject;
|
|
const StartFrom: String; Direction, InsertAt: Integer);
|
|
begin
|
|
with lstAddBy do
|
|
begin
|
|
case radAddByType.ItemIndex of
|
|
0: begin
|
|
Pieces := '2';
|
|
ForDataUse(SubSetOfPatients(StartFrom, Direction));
|
|
end;
|
|
1: begin
|
|
Pieces := '2';
|
|
end;
|
|
2: begin
|
|
Pieces := '2';
|
|
ForDataUse(SubSetOfClinics(StartFrom, Direction));
|
|
end;
|
|
3: begin
|
|
Pieces := '2,3';
|
|
ForDataUse(SubSetOfProviders(StartFrom, Direction));
|
|
end;
|
|
4: begin
|
|
Pieces := '2';
|
|
end;
|
|
5: begin
|
|
Pieces := '2';
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.btnOKClick(Sender: TObject);
|
|
begin
|
|
if btnListSaveChanges.Enabled then
|
|
begin
|
|
if InfoBox('Do you want to save changes to '
|
|
+ Piece(lstPersonalLists.Items[FLastList], '^', 2) + '?',
|
|
'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
|
|
btnListSaveChangesClick(self);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.mnuPatientIDClick(Sender: TObject);
|
|
begin
|
|
case mnuPopPatient.Tag of
|
|
LIST_PERSONAL: DisplayPtInfo(lstPersonalPatients.ItemID);
|
|
LIST_ADD: DisplayPtInfo(lstListPats.ItemID);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.lstListPatsMouseDown(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
mnuPopPatient.AutoPopup := (lstListPats.Items.Count > 0)
|
|
and (lstListPats.ItemIndex > -1)
|
|
and (lstListPats.SelCount = 1)
|
|
and (Button = mbRight)
|
|
and (btnListAdd.Enabled);
|
|
mnuPopPatient.Tag := LIST_ADD;
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.lstPersonalPatientsMouseDown(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
mnuPopPatient.AutoPopup := (lstPersonalPatients.Items.Count > 0)
|
|
and (lstPersonalPatients.ItemIndex > -1)
|
|
and (lstPersonalPatients.SelCount = 1)
|
|
and (Button = mbRight)
|
|
and (btnPersonalPatientR.Enabled);
|
|
mnuPopPatient.Tag := LIST_PERSONAL;
|
|
end;
|
|
|
|
procedure TfrmOptionsLists.lstAddByKeyPress(Sender: TObject;
|
|
var Key: Char);
|
|
|
|
procedure ShowMatchingPatients;
|
|
begin
|
|
with lstAddBy do
|
|
begin
|
|
if ShortCount > 0 then
|
|
begin
|
|
if ShortCount = 1 then
|
|
begin
|
|
ItemIndex := 0;
|
|
end;
|
|
Items.Add(LLS_LINE);
|
|
Items.Add(LLS_SPACE);
|
|
end;
|
|
InitLongList('');
|
|
end;
|
|
Key := #0; //Now that we've selected it, don't process the last keystroke!
|
|
end;
|
|
|
|
var
|
|
FutureText: string;
|
|
begin
|
|
if radAddByType.ItemIndex = 0 {patient} then
|
|
begin
|
|
with lstAddBy do
|
|
begin
|
|
FutureText := Text + Key;
|
|
if frmPtSelOptns.IsLast5(FutureText) then
|
|
begin
|
|
ListPtByLast5(Items, FutureText);
|
|
ShowMatchingPatients;
|
|
end
|
|
else if frmPtSelOptns.IsFullSSN(FutureText) then
|
|
begin
|
|
ListPtByFullSSN(Items, FutureText);
|
|
ShowMatchingPatients;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|