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;

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 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 ' + str1 +' is currently in a pending status. ';
        str := str + CRLF + 'If this order is discontinued, the original order status will be changed to active, unless it is discontinued.';
        str := str + CRLF + CRLF + 'Click:';
        str := str + CRLF + '     "Yes" to discontinue the original order';
        str := str + CRLF + '     "No" to change the status to active';
        str := str + CRLF + '     "Cancel" to stop the discontinue process for this order';
        Memo1.ReadOnly := False;
        Memo1.Text := str;
        Memo1.ReadOnly := True;
     end;
    ResizeAnchoredFormToFont(frmActivateDeactive);
    frmActivateDeactive.ShowModal;
    frmActivateDeactive.Release;
end;

procedure TfrmActivateDeactive.fActivateDeactive(OrderID: TStringList);
var
i,j,Pos: integer;
tmpArr: TORStringList;
ActDeact: string;
AnOrder,AnOrder1: 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
                begin
                  for j := 0 to forders.frmOrders.lstOrders.Items.Count-1 do
                    begin
                      AnOrder1 := TOrder(forders.frmOrders.lstOrders.Items.Objects[j]);
                      if AnOrder1.ID = Piece(tmpArr.Strings[Pos],U,2) then
                        forders.frmOrders.lstOrders.Selected[j] := True;
                    end;
                end;
              if ActDeact = 'C' then Selected[i] := False;
            end;
        end;
end;

procedure TfrmActivateDeactive.fActivateDeactive(OrderID: TStringList; AList: TListBox);
var
i,j,Pos: integer;
tmpArr: TORStringList;
ActDeact: String;
AMed,AMed1: TMedListRec;
begin
  //called from Med tab
  tmpArr := TORStringList.Create;
  GetOriginalOrders(OrderID,tmpArr);
      with AList do for i := 0 to items.Count-1 do if Selected[i] then
        begin
          AMed := TMedListRec(Items.Objects[i]);
          Pos := tmpArr.IndexOfPiece(AMed.OrderID,U,1);
          if Pos > -1 then
            begin
              ActDeact := PromptForm(Alist.Items.Strings[i]);
              if ActDeact = 'D' then
                begin
                  for j := 0 to Alist.Items.Count-1 do
                    begin
                      AMed1 := TMedListRec(Alist.Items.Objects[j]);
                      if AMed1.OrderID = Piece(tmpArr.Strings[Pos],U,2) then
                        begin
                          Alist.Selected[j] := True;
                          break;
                        end;
                      //some med orders may not have an action defined tends to be renew order of orders that were renew from another
                      //order and outpatient orders
                      if (AMed1.OrderID = Piece(Piece(tmpArr.Strings[Pos],U,2),';',1)) then
                        begin
                          Alist.Selected[j] := True;
                          break;
                        end;

                    end;
                end;
              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;

end.