VistA-cprs/CPRS-Chart/Options/fOptionsLists.pas

564 lines
17 KiB
Plaintext
Raw Normal View History

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.