279 lines
8.1 KiB
Plaintext
279 lines
8.1 KiB
Plaintext
unit fOrderSaveQuick;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
fAutoSz, Buttons, ExtCtrls, StdCtrls, ORCtrls, ORFn, fODBase, uOrders;
|
|
|
|
type
|
|
TfrmSaveQuickOrder = class(TfrmAutoSz)
|
|
Panel1: TPanel;
|
|
memOrder: TMemo;
|
|
lblDisplayName: TLabel;
|
|
txtDisplayName: TCaptionEdit;
|
|
Panel2: TPanel;
|
|
lblQuickList: TLabel;
|
|
lstQuickList: TORListBox;
|
|
pnlUpButton: TKeyClickPanel;
|
|
cmdUp: TSpeedButton;
|
|
pnlDownButton: TKeyClickPanel;
|
|
cmdRename: TButton;
|
|
cmdDelete: TButton;
|
|
cmdDown: TSpeedButton;
|
|
Panel3: TPanel;
|
|
cmdOK: TButton;
|
|
cmdCancel: TButton;
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure cmdOKClick(Sender: TObject);
|
|
procedure cmdCancelClick(Sender: TObject);
|
|
procedure txtDisplayNameChange(Sender: TObject);
|
|
procedure cmdUpClick(Sender: TObject);
|
|
procedure cmdDownClick(Sender: TObject);
|
|
procedure cmdRenameClick(Sender: TObject);
|
|
procedure cmdDeleteClick(Sender: TObject);
|
|
procedure pnlUpButtonEnter(Sender: TObject);
|
|
procedure pnlUpButtonExit(Sender: TObject);
|
|
private
|
|
OKPressed: Boolean;
|
|
end;
|
|
|
|
function EditCommonList(ADisplayGroup: Integer): Boolean;
|
|
function SaveAsQuickOrder(ResponseSet: TResponses): Boolean;
|
|
|
|
implementation
|
|
|
|
{$R *.DFM}
|
|
|
|
uses rODBase, rOrders, fRename;
|
|
|
|
const
|
|
TX_DNAME_REQ = 'A name for the quick order must be entered in order to save it.';
|
|
TC_DNAME_REQ = 'Display Name Missing';
|
|
TX_DEL_CONFIRM = 'Remove the following quick order from your list?' + CRLF + CRLF;
|
|
TC_DEL_CONFIRM = 'Remove Quick Order';
|
|
TX_QO_RENAME = 'Rename Quick Order';
|
|
TX_NO_DEL_NEW = 'A new quick order cannot be deleted. Press <Cancel> instead.';
|
|
TC_NO_DEL_NEW = 'Remove Quick Order';
|
|
TX_NO_TEXT = 'No fields have been entered - cannot save as quick order.';
|
|
TC_NO_TEXT = 'Save as Quick Order';
|
|
|
|
function EditCommonList(ADisplayGroup: Integer): Boolean;
|
|
var
|
|
frmSaveQuickOrder: TfrmSaveQuickOrder;
|
|
DGroupName: string;
|
|
begin
|
|
Result := False;
|
|
frmSaveQuickOrder := TfrmSaveQuickOrder.Create(Application);
|
|
try
|
|
ResizeFormToFont(TForm(frmSaveQuickOrder));
|
|
with frmSaveQuickOrder do
|
|
begin
|
|
if ADisplayGroup = ClinDisp then
|
|
ADisplayGroup := InptDisp;
|
|
DGroupName := NameOfDGroup(ADisplayGroup);
|
|
Caption := 'Edit Common Order List (' + DGroupName + ')';
|
|
lblQuickList.Caption := 'Common List for ' + DGroupName;
|
|
lstQuickList.Caption := lblQuickList.Caption;
|
|
lblDisplayName.Font.Color := clGrayText;
|
|
txtDisplayName.Enabled := False;
|
|
txtDisplayName.Color := clBtnFace;
|
|
with lstQuickList do
|
|
begin
|
|
LoadQuickListForOD(Items, ADisplayGroup);
|
|
ItemIndex := 0;
|
|
end;
|
|
ShowModal;
|
|
if OKPressed then
|
|
begin
|
|
Result := True;
|
|
// replace the user's quick list with this new quick list
|
|
SaveQuickListForOD(lstQuickList.Items, ADisplayGroup);
|
|
end; {if OKPressed}
|
|
end; {with frmSaveQuickOrder}
|
|
finally
|
|
frmSaveQuickOrder.Release;
|
|
end;
|
|
end;
|
|
|
|
function SaveAsQuickOrder(ResponseSet: TResponses): Boolean;
|
|
const
|
|
EMPTY_CRC = 'FFFFFFFF';
|
|
var
|
|
frmSaveQuickOrder: TfrmSaveQuickOrder;
|
|
DGroupName, QuickName, CRC: string;
|
|
NewIEN, AnIndex, i: Integer;
|
|
IsClinicOrder: boolean;
|
|
begin
|
|
Result := False;
|
|
CRC := ResponseSet.OrderCRC;
|
|
IsClinicOrder := False;
|
|
if CRC = EMPTY_CRC then
|
|
begin
|
|
InfoBox(TX_NO_TEXT, TC_NO_TEXT, MB_OK);
|
|
Exit;
|
|
end;
|
|
frmSaveQuickOrder := TfrmSaveQuickOrder.Create(Application);
|
|
try
|
|
ResizeFormToFont(TForm(frmSaveQuickOrder));
|
|
with frmSaveQuickOrder do
|
|
begin
|
|
if (ResponseSet.DisplayGroup = ClinDisp) and (ResponseSet.Dialog = 'PSJI OR PAT FLUID OE') then
|
|
begin
|
|
ResponseSet.DisplayGroup := IVDisp;
|
|
IsClinicOrder := True;
|
|
end;
|
|
if ResponseSet.DisplayGroup = ClinDisp then
|
|
DGroupName := NameOfDGroup(InptDisp)
|
|
else
|
|
DGroupName := NameOfDGroup(ResponseSet.DisplayGroup);
|
|
Caption := 'Add Quick Order (' + DGroupName + ')';
|
|
lblQuickList.Caption := 'Common List for ' + DGroupName;
|
|
lstQuickList.Caption := lblQuickList.Caption;
|
|
QuickName := GetQuickName(CRC);
|
|
memOrder.Text := ResponseSet.OrderText;
|
|
txtDisplayName.Text := QuickName;
|
|
with lstQuickList do
|
|
begin
|
|
if ResponseSet.DisplayGroup = ClinDisp then
|
|
LoadQuickListForOD(Items, InptDisp)
|
|
else
|
|
LoadQuickListForOD(Items, ResponseSet.DisplayGroup);
|
|
if Length(QuickName) > 0
|
|
then Items.Insert(0, '-1^' + QuickName)
|
|
else Items.Insert(0, '-1^<New Quick Order>');
|
|
ItemIndex := 0;
|
|
end;
|
|
ShowModal;
|
|
if OKPressed then
|
|
begin
|
|
Result := True;
|
|
// save reponses as quick order
|
|
ResponseSet.SaveQuickOrder(NewIEN, txtDisplayName.Text);
|
|
// find the new quick order and set the new IEN
|
|
AnIndex := -1;
|
|
with lstQuickList do for i := 0 to Items.Count - 1 do
|
|
if GetIEN(i) = -1 then AnIndex := i;
|
|
if AnIndex > -1 then lstQuickList.Items[AnIndex] := IntToStr(NewIEN) + U +
|
|
txtDisplayName.Text;
|
|
// replace the user's quick list with this new quick list
|
|
if ResponseSet.DisplayGroup = ClinDisp then
|
|
SaveQuickListForOD(lstQuickList.Items, InptDisp)
|
|
else
|
|
SaveQuickListForOD(lstQuickList.Items, ResponseSet.DisplayGroup);
|
|
end; {if OKPressed}
|
|
if IsClinicOrder = True then ResponseSet.DisplayGroup := ClinDisp;
|
|
end; {with frmSaveQuickOrder}
|
|
finally
|
|
frmSaveQuickOrder.Release;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmSaveQuickOrder.txtDisplayNameChange(Sender: TObject);
|
|
var
|
|
AnIndex, i: Integer;
|
|
begin
|
|
inherited;
|
|
if txtDisplayName.Text = '' then Exit;
|
|
AnIndex := -1;
|
|
with lstQuickList do for i := 0 to Items.Count - 1 do
|
|
if GetIEN(i) = -1 then AnIndex := i;
|
|
if AnIndex > -1 then lstQuickList.Items[AnIndex] := '-1^' + txtDisplayName.Text;
|
|
end;
|
|
|
|
procedure TfrmSaveQuickOrder.cmdUpClick(Sender: TObject);
|
|
var
|
|
NewIndex: Integer;
|
|
begin
|
|
inherited;
|
|
with lstQuickList do
|
|
begin
|
|
if ItemIndex < 1 then Exit;
|
|
NewIndex := ItemIndex - 1;
|
|
Items.Move(ItemIndex, NewIndex);
|
|
ItemIndex := NewIndex;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmSaveQuickOrder.cmdDownClick(Sender: TObject);
|
|
var
|
|
NewIndex: Integer;
|
|
begin
|
|
inherited;
|
|
with lstQuickList do
|
|
begin
|
|
if ItemIndex > Items.Count - 2 then Exit;
|
|
NewIndex := ItemIndex + 1;
|
|
Items.Move(ItemIndex, NewIndex);
|
|
ItemIndex := NewIndex;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmSaveQuickOrder.cmdRenameClick(Sender: TObject);
|
|
var
|
|
AName: string;
|
|
begin
|
|
inherited;
|
|
with lstQuickList do
|
|
begin
|
|
if ItemIndex < 0 then Exit;
|
|
AName := Piece(Items[ItemIndex], U, 2);
|
|
if ExecuteRename(AName, TX_QO_RENAME)
|
|
then Items[ItemIndex] := Piece(Items[ItemIndex], U, 1) + U + AName;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmSaveQuickOrder.cmdDeleteClick(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
with lstQuickList do
|
|
begin
|
|
if ItemIndex < 0 then Exit;
|
|
if ItemIEN = -1 then
|
|
begin
|
|
InfoBox(TX_NO_DEL_NEW, TC_NO_DEL_NEW, MB_OK);
|
|
Exit;
|
|
end;
|
|
if InfoBox(TX_DEL_CONFIRM + DisplayText[ItemIndex], TC_DEL_CONFIRM,
|
|
MB_YESNO or MB_ICONQUESTION) = IDYES then Items.Delete(ItemIndex);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmSaveQuickOrder.FormCreate(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
OKPressed := False;
|
|
end;
|
|
|
|
procedure TfrmSaveQuickOrder.cmdOKClick(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
if txtDisplayName.Enabled and (txtDisplayName.Text = '') then
|
|
begin
|
|
InfoBox(TX_DNAME_REQ, TC_DNAME_REQ, MB_OK);
|
|
Exit;
|
|
end;
|
|
OKPressed := True;
|
|
Close;
|
|
end;
|
|
|
|
procedure TfrmSaveQuickOrder.cmdCancelClick(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
Close;
|
|
end;
|
|
|
|
procedure TfrmSaveQuickOrder.pnlUpButtonEnter(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
TPanel(Sender).BevelOuter := bvRaised;
|
|
end;
|
|
|
|
procedure TfrmSaveQuickOrder.pnlUpButtonExit(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
TPanel(Sender).BevelOuter := bvNone;
|
|
end;
|
|
|
|
end.
|