VistA-cprs/CPRS-Chart/fActivateDeactivate.pas

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.