415 lines
12 KiB
Plaintext
415 lines
12 KiB
Plaintext
|
unit fLabTestGroups;
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses
|
||
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
||
|
|
ExtCtrls, Buttons, ORCtrls, StdCtrls;
|
||
|
|
|
||
|
|
type
|
||
|
|
TfrmLabTestGroups = class(TForm)
|
||
|
|
pnlLabTestGroups: TORAutoPanel;
|
||
|
|
cmdOK: TButton;
|
||
|
|
cmdCancel: TButton;
|
||
|
|
cmdClear: TButton;
|
||
|
|
cmdRemove: TButton;
|
||
|
|
lstList: TORListBox;
|
||
|
|
cboTests: TORComboBox;
|
||
|
|
cmdUp: TSpeedButton;
|
||
|
|
pnlUpButton: TKeyClickPanel;
|
||
|
|
cmdDown: TSpeedButton;
|
||
|
|
pnlDownButton: TKeyClickPanel;
|
||
|
|
bvlTestGroups: TBevel;
|
||
|
|
cboUsers: TORComboBox;
|
||
|
|
lstTestGroups: TORListBox;
|
||
|
|
cmdReplace: TButton;
|
||
|
|
lblTests: TLabel;
|
||
|
|
lblList: TLabel;
|
||
|
|
cboSpecimen: TORComboBox;
|
||
|
|
lblSpecimen: TLabel;
|
||
|
|
lblTestGroups: TLabel;
|
||
|
|
lblUsers: TLabel;
|
||
|
|
lblOrder: TLabel;
|
||
|
|
cmdDelete: TButton;
|
||
|
|
cmdAdd: TButton;
|
||
|
|
cmdAddTest: TButton;
|
||
|
|
lblDefine: TLabel;
|
||
|
|
lblTestGroup: TLabel;
|
||
|
|
procedure FormCreate(Sender: TObject);
|
||
|
|
procedure cboTestsNeedData(Sender: TObject; const StartFrom: string;
|
||
|
|
Direction, InsertAt: Integer);
|
||
|
|
procedure cmdOKClick(Sender: TObject);
|
||
|
|
procedure cmdClearClick(Sender: TObject);
|
||
|
|
procedure cmdRemoveClick(Sender: TObject);
|
||
|
|
procedure cmdUpClick(Sender: TObject);
|
||
|
|
procedure cmdDownClick(Sender: TObject);
|
||
|
|
procedure lstListClick(Sender: TObject);
|
||
|
|
procedure cboUsersNeedData(Sender: TObject; const StartFrom: string;
|
||
|
|
Direction, InsertAt: Integer);
|
||
|
|
procedure cboSpecimenNeedData(Sender: TObject; const StartFrom: string;
|
||
|
|
Direction, InsertAt: Integer);
|
||
|
|
procedure cboUsersClick(Sender: TObject);
|
||
|
|
procedure lstTestGroupsClick(Sender: TObject);
|
||
|
|
procedure cmdReplaceClick(Sender: TObject);
|
||
|
|
procedure cmdAddClick(Sender: TObject);
|
||
|
|
procedure cmdDeleteClick(Sender: TObject);
|
||
|
|
procedure cboTestsChange(Sender: TObject);
|
||
|
|
procedure cboTestsEnter(Sender: TObject);
|
||
|
|
procedure cboTestsExit(Sender: TObject);
|
||
|
|
procedure cmdAddTestClick(Sender: TObject);
|
||
|
|
procedure pnlUpButtonEnter(Sender: TObject);
|
||
|
|
procedure pnlUpButtonExit(Sender: TObject);
|
||
|
|
procedure pnlDownButtonEnter(Sender: TObject);
|
||
|
|
procedure pnlDownButtonExit(Sender: TObject);
|
||
|
|
procedure pnlUpButtonResize(Sender: TObject);
|
||
|
|
procedure pnlDownButtonResize(Sender: TObject);
|
||
|
|
private
|
||
|
|
{ Private declarations }
|
||
|
|
procedure AddTests(tests: TStrings);
|
||
|
|
procedure TestGroupEnable;
|
||
|
|
public
|
||
|
|
{ Public declarations }
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure SelectTestGroups(FontSize: Integer);
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
uses fLabs, ORFn, rLabs, uCore;
|
||
|
|
|
||
|
|
{$R *.DFM}
|
||
|
|
|
||
|
|
procedure SelectTestGroups(FontSize: Integer);
|
||
|
|
var
|
||
|
|
frmLabTestGroups: TfrmLabTestGroups;
|
||
|
|
W, H: integer;
|
||
|
|
begin
|
||
|
|
frmLabTestGroups := TfrmLabTestGroups.Create(Application);
|
||
|
|
try
|
||
|
|
with frmLabTestGroups do
|
||
|
|
begin
|
||
|
|
Font.Size := FontSize;
|
||
|
|
W := ClientWidth;
|
||
|
|
H := ClientHeight;
|
||
|
|
ResizeToFont(FontSize, W, H);
|
||
|
|
ClientWidth := W; pnlLabTestGroups.Width := W;
|
||
|
|
ClientHeight := H; pnlLabTestGroups.Height := H;
|
||
|
|
with lblTestGroup do begin
|
||
|
|
AutoSize := False;
|
||
|
|
Height := lstList.Height div 3;
|
||
|
|
Width := cmdAddTest.Width * 4 div 3;
|
||
|
|
AutoSize := True;
|
||
|
|
end;
|
||
|
|
with lblOrder do begin
|
||
|
|
AutoSize := False;
|
||
|
|
Height := lstList.Height div 3;
|
||
|
|
Width := cmdAddTest.Width div 2 + 10;
|
||
|
|
AutoSize := True;
|
||
|
|
end;
|
||
|
|
lstList.Items.Assign(frmLabs.lstTests.Items);
|
||
|
|
if lstList.Items.Count > 0 then lstList.ItemIndex := 0;
|
||
|
|
lstListClick(frmLabTestGroups);
|
||
|
|
ShowModal;
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
frmLabTestGroups.Release;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.FormCreate(Sender: TObject);
|
||
|
|
var
|
||
|
|
i: integer;
|
||
|
|
blood, urine, serum, plasma: string;
|
||
|
|
begin
|
||
|
|
RedrawSuspend(cboTests.Handle);
|
||
|
|
cboTests.InitLongList('');
|
||
|
|
RedrawActivate(cboTests.Handle);
|
||
|
|
RedrawSuspend(cboSpecimen.Handle);
|
||
|
|
cboSpecimen.InitLongList('');
|
||
|
|
SpecimenDefaults(blood, urine, serum, plasma);
|
||
|
|
cboSpecimen.Items.Add('0^Any');
|
||
|
|
cboSpecimen.Items.Add(serum + '^Serum');
|
||
|
|
cboSpecimen.Items.Add(blood + '^Blood');
|
||
|
|
cboSpecimen.Items.Add(plasma + '^Plasma');
|
||
|
|
cboSpecimen.Items.Add(urine + '^Urine');
|
||
|
|
cboSpecimen.Items.Add(LLS_LINE);
|
||
|
|
cboSpecimen.Items.Add(LLS_SPACE);
|
||
|
|
cboSpecimen.ItemIndex := 0;
|
||
|
|
RedrawActivate(cboSpecimen.Handle);
|
||
|
|
RedrawSuspend(cboTests.Handle);
|
||
|
|
cboUsers.InitLongList(User.Name);
|
||
|
|
for i := 0 to cboUsers.Items.Count - 1 do
|
||
|
|
if StrToInt64Def(Piece(cboUsers.Items[i], '^', 1), 0) = User.DUZ then
|
||
|
|
begin
|
||
|
|
cboUsers.ItemIndex := i;
|
||
|
|
break;
|
||
|
|
end;
|
||
|
|
if cboUsers.ItemIndex > -1 then cboUsersClick(self);
|
||
|
|
RedrawActivate(cboTests.Handle);
|
||
|
|
cmdUp.Enabled := false;
|
||
|
|
pnlUpButton.TabStop := false;
|
||
|
|
cmdDown.Enabled := false;
|
||
|
|
pnlDownButton.TabStop := false;
|
||
|
|
lstList.Clear;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.cboTestsNeedData(Sender: TObject;
|
||
|
|
const StartFrom: string; Direction, InsertAt: Integer);
|
||
|
|
begin
|
||
|
|
cboTests.ForDataUse(ChemTest(StartFrom, Direction));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.cmdOKClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
if lstList.Items.Count = 0 then
|
||
|
|
ShowMessage('No tests were selected.')
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
frmLabs.lstTests.Items.Assign(lstList.Items);
|
||
|
|
frmLabs.lblSpecimen.Caption := cboSpecimen.Items[cboSpecimen.ItemIndex];
|
||
|
|
Close;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.cmdClearClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
lstList.Clear;
|
||
|
|
lstListClick(self);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.cmdRemoveClick(Sender: TObject);
|
||
|
|
var
|
||
|
|
newindex: integer;
|
||
|
|
begin
|
||
|
|
if lstList.Items.Count > 0 then
|
||
|
|
begin
|
||
|
|
if lstList.ItemIndex = (lstList.Items.Count -1 ) then
|
||
|
|
newindex := lstList.ItemIndex - 1
|
||
|
|
else
|
||
|
|
newindex := lstList.ItemIndex;
|
||
|
|
lstList.Items.Delete(lstList.ItemIndex);
|
||
|
|
if lstList.Items.Count > 0 then lstList.ItemIndex := newindex;
|
||
|
|
end;
|
||
|
|
lstListClick(self);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.cmdUpClick(Sender: TObject);
|
||
|
|
var
|
||
|
|
newindex: integer;
|
||
|
|
templine: string;
|
||
|
|
begin
|
||
|
|
if cmdUp.Enabled then begin
|
||
|
|
newindex := lstList.ItemIndex - 1;
|
||
|
|
templine := lstList.Items[lstList.ItemIndex - 1];
|
||
|
|
lstList.Items[lstList.ItemIndex - 1] := lstList.Items[lstList.ItemIndex];
|
||
|
|
lstList.Items[lstList.ItemIndex] := templine;
|
||
|
|
lstList.ItemIndex := newindex;
|
||
|
|
lstListClick(self);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.cmdDownClick(Sender: TObject);
|
||
|
|
var
|
||
|
|
newindex: integer;
|
||
|
|
templine: string;
|
||
|
|
begin
|
||
|
|
if cmdDown.Enabled then begin
|
||
|
|
newindex := lstList.ItemIndex + 1;
|
||
|
|
templine := lstList.Items[lstList.ItemIndex + 1];
|
||
|
|
lstList.Items[lstList.ItemIndex + 1] := lstList.Items[lstList.ItemIndex];
|
||
|
|
lstList.Items[lstList.ItemIndex] := templine;
|
||
|
|
lstList.ItemIndex := newindex;
|
||
|
|
lstListClick(self);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.lstListClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
cmdUp.Enabled := not (lstList.ItemIndex = 0);
|
||
|
|
pnlUpButton.TabStop := not (lstList.ItemIndex = 0);
|
||
|
|
cmdDown.Enabled := not (lstList.ItemIndex = lstList.Items.Count - 1);
|
||
|
|
pnlDownButton.TabStop := not (lstList.ItemIndex = lstList.Items.Count - 1);
|
||
|
|
if lstList.Items.Count = 0 then
|
||
|
|
begin
|
||
|
|
cmdUp.Enabled := false;
|
||
|
|
pnlUpButton.TabStop := false;
|
||
|
|
cmdDown.Enabled := false;
|
||
|
|
pnlDownButton.TabStop := false;
|
||
|
|
cmdClear.Enabled := false;
|
||
|
|
cmdRemove.Enabled := false;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
cmdClear.Enabled := true;
|
||
|
|
cmdRemove.Enabled := true;
|
||
|
|
end;
|
||
|
|
TestGroupEnable;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.cboUsersNeedData(Sender: TObject;
|
||
|
|
const StartFrom: string; Direction, InsertAt: Integer);
|
||
|
|
begin
|
||
|
|
cboUsers.ForDataUse(Users(StartFrom, Direction));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.cboSpecimenNeedData(Sender: TObject;
|
||
|
|
const StartFrom: string; Direction, InsertAt: Integer);
|
||
|
|
begin
|
||
|
|
cboSpecimen.ForDataUse(Specimens(StartFrom, Direction));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.cboUsersClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
lstTestGroups.Items.Assign(TestGroups(cboUsers.ItemIEN));
|
||
|
|
TestGroupEnable;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.AddTests(tests: TStrings);
|
||
|
|
var
|
||
|
|
i, j, textindex: integer;
|
||
|
|
ok: boolean;
|
||
|
|
begin
|
||
|
|
textindex := lstList.Items.Count;
|
||
|
|
for i := 0 to tests.Count - 1 do
|
||
|
|
begin
|
||
|
|
ok := true;
|
||
|
|
for j := 0 to lstList.Items.Count - 1 do
|
||
|
|
if lstList.Items[j] = tests[i] then
|
||
|
|
begin
|
||
|
|
ok := false;
|
||
|
|
textindex := j;
|
||
|
|
end;
|
||
|
|
if ok then
|
||
|
|
begin
|
||
|
|
lstList.Items.Add(tests[i]);
|
||
|
|
textindex := lstList.Items.Count - 1;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
lstList.ItemIndex := textindex;
|
||
|
|
lstListClick(self);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.lstTestGroupsClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
AddTests(ATestGroup(lstTestGroups.ItemIEN, cboUsers.ItemIEN));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.TestGroupEnable;
|
||
|
|
begin
|
||
|
|
cmdAdd.Enabled := (lstList.Items.Count > 0) and (lstList.Items.Count < 8);
|
||
|
|
cmdDelete.Enabled := (cboUsers.ItemIEN = User.DUZ) and (lstTestGroups.ItemIndex > -1);
|
||
|
|
cmdReplace.Enabled := cmdAdd.Enabled and cmdDelete.Enabled;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.cmdReplaceClick(Sender: TObject);
|
||
|
|
var
|
||
|
|
text: string;
|
||
|
|
i: integer;
|
||
|
|
begin
|
||
|
|
text := 'Do you want to REPLACE your test group -' + #13 + ' ';
|
||
|
|
text := text + lstTestGroups.DisplayText[lstTestGroups.ItemIndex] + #13;
|
||
|
|
text := text + ' with:' + #13 + ' ';
|
||
|
|
for i := 0 to lstList.Items.Count -1 do
|
||
|
|
text := text + lstList.DisplayText[i] + #13 + ' ';
|
||
|
|
if InfoBox(text,'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
|
||
|
|
UTGReplace(lstList.Items, lstTestGroups.ItemIEN); //ShowMessage('Replace'); //Replace
|
||
|
|
cboUsersClick(self);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.cmdAddClick(Sender: TObject);
|
||
|
|
var
|
||
|
|
text: string;
|
||
|
|
i: integer;
|
||
|
|
begin
|
||
|
|
text := 'Do you wish to create a NEW test group with these tests: ' + #13 + ' ';
|
||
|
|
for i := 0 to lstList.Items.Count -1 do
|
||
|
|
text := text + lstList.DisplayText[i] + #13 + ' ';
|
||
|
|
if InfoBox(text,'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
|
||
|
|
begin
|
||
|
|
UTGAdd(lstList.Items);
|
||
|
|
cboUsers.InitLongList(User.Name);
|
||
|
|
for i := 0 to cboUsers.Items.Count - 1 do
|
||
|
|
if StrToInt64Def(Piece(cboUsers.Items[i], '^', 1), 0) = User.DUZ then
|
||
|
|
begin
|
||
|
|
cboUsers.ItemIndex := i;
|
||
|
|
break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
if cboUsers.ItemIndex > -1 then cboUsersClick(self);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.cmdDeleteClick(Sender: TObject);
|
||
|
|
var
|
||
|
|
text: string;
|
||
|
|
i: integer;
|
||
|
|
begin
|
||
|
|
text := 'Do you wish to DELETE your test group:' + #13 + ' ';
|
||
|
|
text := text + lstTestGroups.DisplayText[lstTestGroups.ItemIndex] + #13 + ' ';
|
||
|
|
if InfoBox(text,'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
|
||
|
|
begin
|
||
|
|
UTGDelete(lstTestGroups.ItemIEN);
|
||
|
|
cboUsers.Text := '';
|
||
|
|
lstTestGroups.Clear;
|
||
|
|
cboUsers.InitLongList(User.Name);
|
||
|
|
for i := 0 to cboUsers.Items.Count - 1 do
|
||
|
|
if StrToInt64Def(Piece(cboUsers.Items[i], '^', 1), 0) = User.DUZ then
|
||
|
|
begin
|
||
|
|
cboUsers.ItemIndex := i;
|
||
|
|
break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
if cboUsers.ItemIndex > -1 then cboUsersClick(self);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.cboTestsChange(Sender: TObject);
|
||
|
|
begin
|
||
|
|
cmdAddTest.Enabled := cboTests.ItemIndex > -1;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.cboTestsEnter(Sender: TObject);
|
||
|
|
begin
|
||
|
|
cmdAddTest.Default := true;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.cboTestsExit(Sender: TObject);
|
||
|
|
begin
|
||
|
|
cmdAddTest.Default := false;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.cmdAddTestClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
AddTests(ATest(cboTests.ItemIEN));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.pnlUpButtonEnter(Sender: TObject);
|
||
|
|
begin
|
||
|
|
pnlUpButton.BevelOuter := bvRaised;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.pnlUpButtonExit(Sender: TObject);
|
||
|
|
begin
|
||
|
|
pnlUpButton.BevelOuter := bvNone;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.pnlDownButtonEnter(Sender: TObject);
|
||
|
|
begin
|
||
|
|
pnlDownButton.BevelOuter := bvRaised;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.pnlDownButtonExit(Sender: TObject);
|
||
|
|
begin
|
||
|
|
pnlDownButton.BevelOuter := bvNone;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.pnlUpButtonResize(Sender: TObject);
|
||
|
|
begin
|
||
|
|
cmdUp.Width := pnlUpButton.Width;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrmLabTestGroups.pnlDownButtonResize(Sender: TObject);
|
||
|
|
begin
|
||
|
|
cmdDown.Width := pnlDownButton.Width;
|
||
|
|
end;
|
||
|
|
|
||
|
|
end.
|