VistA-cprs/CPRS-Chart/Orders/fOrdersOnChart.pas

unit fOrdersOnChart;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls;

type
  TfrmOnChartOrders = class(TfrmAutoSz)
    Panel2: TPanel;
    Label1: TLabel;
    lstOrders: TCaptionListBox;
    Panel1: TPanel;
    cmdOK: TButton;
    cmdCancel: TButton;
    procedure FormCreate(Sender: TObject);
    procedure cmdOKClick(Sender: TObject);
    procedure cmdCancelClick(Sender: TObject);
    procedure lstOrdersMeasureItem(Control: TWinControl; Index: Integer;
      var AHeight: Integer);
    procedure lstOrdersDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure Panel2Resize(Sender: TObject);
  private
    OKPressed: Boolean;
  end;

function ExecuteOnChartOrders(SelectedList: TList): Boolean;

implementation

{$R *.DFM}

uses rCore, rOrders, uConst, fOrdersPrint, uOrders, fFrame, UCore,
  fClinicWardMeds;

const
  TX_SAVERR1 = 'The error, ';
  TX_SAVERR2 = ', occurred while trying to save:' + CRLF + CRLF;
  TC_SAVERR  = 'Error Saving Order';

function ExecuteOnChartOrders(SelectedList: TList): Boolean;
var
  frmOnChartOrders: TfrmOnChartOrders;
  i, PrintLoc: Integer;
  SignList: TStringList;
  OrderText: string;

  function FindOrderText(const AnID: string): string;
  var
    i: Integer;
  begin
    Result := '';
    with SelectedList do for i := 0 to Count - 1 do
      with TOrder(Items[i]) do if ID = AnID then
      begin
        Result := Text;
        Break;
      end;
  end;

begin
  Result := False;
  PrintLoc := 0;
  if SelectedList.Count = 0 then Exit;
  frmOnChartOrders := TfrmOnChartOrders.Create(Application);
  try
    ResizeFormToFont(TForm(frmOnChartOrders));
    with SelectedList do for i := 0 to Count - 1 do
      frmOnChartOrders.lstOrders.Items.Add(TOrder(Items[i]).Text);
    frmOnChartOrders.ShowModal;
    if frmOnChartOrders.OKPressed then
    begin
      Result := True;
      SignList := TStringList.Create;
      try
        with SelectedList do for i := 0 to Count - 1 do with TOrder(Items[i]) do
          SignList.Add(ID + U + SS_ONCHART + U + RS_RELEASE + U + NO_WRITTEN);
        StatusText('Sending Orders to Service(s)...');
        if SignList.Count > 0 then SendOrders(SignList, '');

         if (not frmFrame.TimedOut) then
          begin
             if IsValidIMOLoc(uCore.TempEncounterLoc,Patient.DFN) then
                frmClinicWardMeds.ClinicOrWardLocation(SignList, uCore.TempEncounterLoc,uCore.TempEncounterLocName, PrintLoc)
             else
                if (IsValidIMOLoc(Encounter.Location,Patient.DFN)) and ((frmClinicWardMeds.rpcIsPatientOnWard(patient.DFN)) and (Patient.Inpatient = false)) then
                   frmClinicWardMeds.ClinicOrWardLocation(SignList, Encounter.Location,Encounter.LocationName, PrintLoc);
          end;
          uCore.TempEncounterLoc := 0;
          uCore.TempEncounterLocName := '';

        with SignList do if Count > 0 then for i := 0 to Count - 1 do
          begin
            if Pos('E', Piece(SignList[i], U, 2)) > 0 then
              begin
                OrderText := FindOrderText(Piece(SignList[i], U, 1));
                InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
                        TC_SAVERR, MB_OK);
              end;
          end;
        StatusText('');
        PrintOrdersOnSignRelease(SignList, NO_WRITTEN, PrintLoc);
//        SetupOrdersPrint(SignList, DeviceInfo, NO_WRITTEN, False, PrintIt);  //*KCM*
//        if PrintIt then PrintOrdersOnReview(SignList, DeviceInfo);           //*KCM*
      finally
        SignList.Free;
      end;
    end; {if frmOnChartOrders.OKPressed}
  finally
    frmOnChartOrders.Release;
    with SelectedList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
  end;
end;

procedure TfrmOnChartOrders.FormCreate(Sender: TObject);
begin
  inherited;
  OKPressed := False;
end;

procedure TfrmOnChartOrders.cmdOKClick(Sender: TObject);
begin
  inherited;
  OKPressed := True;
  Close;
end;

procedure TfrmOnChartOrders.cmdCancelClick(Sender: TObject);
begin
  inherited;
  Close;
end;

procedure TfrmOnChartOrders.lstOrdersMeasureItem(Control: TWinControl;
  Index: Integer; var AHeight: Integer);
var
  x: string;
  ARect: TRect;
begin
  inherited;
  with lstOrders do if Index < Items.Count then
  begin
    ARect := ItemRect(Index);
    Canvas.FillRect(ARect);
    x := FilteredString(Items[Index]);
    AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect);
    //if AHeight > 255 then AHeight := 255;
    if AHeight <  13 then AHeight := 15;
  end;
end;

procedure TfrmOnChartOrders.lstOrdersDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  x: string;
  ARect: TRect;
  SaveColor: TColor;
begin
  inherited;
  with lstOrders do
  begin
    ARect := Rect;
    ARect.Left := ARect.Left + 2;
    Canvas.FillRect(ARect);
    Canvas.Pen.Color := clSilver;
    SaveColor := Canvas.Brush.Color;
    Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
    Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
    if Index < Items.Count then
    begin
      x := FilteredString(Items[Index]);
      DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
      Canvas.Brush.Color := SaveColor;
      ARect.Right := ARect.Right + 4;
    end;
  end;
end;

procedure TfrmOnChartOrders.Panel2Resize(Sender: TObject);
begin
  inherited;
  lstOrders.Invalidate;
end;

end.