VistA-cprs/CPRS-Chart/fActivateDeactivate.pas

172 lines
5.2 KiB
Plaintext

unit fActivateDeactivate;
interface
uses
Windows, Messages, SysUtils, StrUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, fAutoSz, StdCtrls, ExtCtrls, ORCtrls,ORFn, rCore, uCore, oRNet, Math, fOrders, ORClasses, rOrders,
fMeds, rMeds, VA508AccessibilityManager;
type
TfrmActivateDeactive = class(TfrmAutoSz)
TActivate: TButton;
TDeactive: TButton;
Memo1: TMemo;
TCancel: TButton;
procedure TActivateClick(Sender: TObject);
procedure TDeactiveClick(Sender: TObject);
procedure TCancelClick(Sender: TObject);
private
{ Private declarations }
procedure GetOriginalOrders(OrderID: TStringList; var OriginalOrder: TORStringList);
procedure DCOriginalOrder(OrderID: string);
procedure BuildForm(Str1: String);
function PromptForm(Text: String): String;
public
{ Public declarations }
procedure fActivateDeactive(OrderID: TStringList); overload;
procedure fActivateDeactive(OrderID: TStringList; AList: TListBox); overload;
end;
var
frmActivateDeactive: TfrmActivateDeactive;
Act: Boolean;
Deact: Boolean;
CancelProcess: Boolean;
implementation
{$R *.dfm}
{ TfrmActivateDeactive }
procedure TfrmActivateDeactive.BuildForm(Str1: String);
var
str: string;
begin
with frmActivateDeactive do
begin
str := 'This order is in a pending status. If this pending order is discontinued, the original order will still be active.';
str := str + CRLF + CRLF + str1;
str := str + CRLF + CRLF + 'Click:';
str := str + CRLF + ' "DC BOTH" to discontinue both orders ';
str := str + CRLF + ' "DC Pending Order" to discontinue only the pending order and return the original order back to an active status ';
str := str + CRLF + ' "Cancel - No Action Taken" to stop the discontinue process ';
Memo1.ReadOnly := False;
Memo1.Text := str;
Memo1.ReadOnly := True;
end;
ResizeAnchoredFormToFont(frmActivateDeactive);
frmActivateDeactive.ShowModal;
frmActivateDeactive.Release;
end;
procedure TfrmActivateDeactive.fActivateDeactive(OrderID: TStringList);
var
i,Pos: integer;
tmpArr: TORStringList;
ActDeact: string;
AnOrder: TOrder;
begin
//called from order tab
tmpArr := TORStringList.Create;
GetOriginalOrders(OrderID,tmpArr);
with forders.frmOrders.lstOrders do for i := 0 to items.Count-1 do if Selected[i] then
begin
AnOrder := TOrder(Items.Objects[i]);
Pos := tmpArr.IndexOfPiece(AnOrder.ID,U,1);
if Pos > -1 then
begin
ActDeact := PromptForm(AnOrder.Text);
if ActDeact = 'D' then AnOrder.DCOriginalOrder := True;
if ActDeact = 'A' then AnOrder.DCOriginalOrder := False;
if ActDeact = 'C' then Selected[i] := False;
end;
end;
end;
procedure TfrmActivateDeactive.fActivateDeactive(OrderID: TStringList; AList: TListBox);
var
i,Pos: integer;
tmpArr: TORStringList;
ActDeact: String;
AMed: TMedListRec;
AnOrder: TOrder;
begin
//called from Med tab
tmpArr := TORStringList.Create;
GetOriginalOrders(OrderID,tmpArr);
AnOrder := TOrder.Create;
with AList do for i := 0 to items.Count-1 do if Selected[i] then
begin
AMed := TMedListRec(Items.Objects[i]);
if AMed = nil then Continue;
Pos := tmpArr.IndexOfPiece(AMed.OrderID,U,1);
if Pos > -1 then
begin
ActDeact := PromptForm(Alist.Items.Strings[i]);
if ActDeact = 'D' then
begin
AnOrder := GetOrderByIFN(Piece(tmpArr.Strings[Pos],U,1));
DCOriginalOrder(AnOrder.ID);
//AnOrder.DCOriginalOrder := True;
end;
if ActDeact = 'A' then AnOrder.DCOriginalOrder := False;
if ActDeact = 'C' then Selected[i] := False;
end;
end;
end;
procedure TfrmActivateDeactive.GetOriginalOrders(OrderID: TStringList; var OriginalOrder: TORStringList);
var
i: integer;
begin
CallV('ORWDX1 DCREN', [OrderID]);
for i := 0 to RPCBrokerV.Results.Count-1 do
OriginalOrder.Add(RPCBrokerV.Results.Strings[i]);
end;
function TfrmActivateDeactive.PromptForm(Text: String): String;
begin
frmActivateDeactive := TfrmActivateDeactive.create(Application);
BuildForm(Text);
if Deact = True then Result := 'D';
if Act = True then Result := 'A';
if CancelProcess = True then Result := 'C';
end;
procedure TfrmActivateDeactive.TActivateClick(Sender: TObject);
begin
inherited;
Act := True;
Deact := False;
CancelProcess := False;
frmActivateDeactive.Close;
end;
procedure TfrmActivateDeactive.TDeactiveClick(Sender: TObject);
begin
inherited;
Act := False;
Deact := True;
CancelProcess := False;
frmActivateDeactive.Close;
end;
procedure TfrmActivateDeactive.TCancelClick(Sender: TObject);
begin
inherited;
Act := False;
Deact := False;
CancelProcess := True;
frmActivateDeactive.Close;
end;
procedure TfrmActivateDeactive.DCOriginalOrder(OrderID: string);
begin
CallV('ORWDX1 DCORIG', [OrderID]);
end;
end.