//kt -- Modified with SourceScanner on 8/8/2007
unit fOrdersCV;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ORCtrls, ORFn, fAutoSZ, uOrders, rOrders, DKLang;

type
  TfrmChgEvent = class(TfrmAutoSz)
    pnlTop: TPanel;
    lblPtInfo: TLabel;
    pnlBottom: TPanel;
    cboSpecialty: TORComboBox;
    btnCancel: TButton;
    btnAction: TButton;
    DKLanguageController1: TDKLanguageController;
    DKLanguageController2: TDKLanguageController;
    procedure FormCreate(Sender: TObject);
    procedure cboSpecialtyChange(Sender: TObject);
    procedure btnActionClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure cboSpecialtyDblClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    FDefaultEvntIFN:   Integer;
    FDefaultPtEvntIFN: Integer;
    FCurrSpecialty    : string;
    FDefaultIndex: String;
    FOKPress: boolean;
    FLastIndex: Integer;

    procedure updateChanges(Const AnOrderIDList: TStringList; Const AnEventName: String);

  public
    { Public declarations }
    procedure LoadSpecialtyList;
    procedure Highlight(APtEvtID: string);
    procedure FilterOutEmptyPtEvt;
    property CurrSpecialty: string      read FCurrSpecialty     write FCurrSpecialty;
    property DefaultIndex:   string    read FDefaultIndex      write FDefaultIndex;
    property OKPress:        boolean    read FOKPress           write FOKPress;

  end;

function ExecuteChangeEvt(SelectedList: TList; var DoesDestEvtOccur: boolean;
  var DestPtEvtID: integer; var DestPtEvtName: string): boolean;


implementation

{$R *.DFM}

uses uCore, uConst, forders, fODChangeEvtDisp, rMisc;

function ExecuteChangeEvt(SelectedList: TList; var DoesDestEvtOccur: boolean;
  var DestPtEvtID: integer; var DestPtEvtName: string): boolean;

//const
//CHANGE_CAP = 'The release event for the following orders will be changed to: ';  <-- original line.  //kt 8/8/2007
//REMOVE_CAP = 'The release event will be deleted for the following orders: ';  <-- original line.  //kt 8/8/2007

  var
    CHANGE_CAP  : string;  //kt
    REMOVE_CAP  : string;  //kt

var
  i: integer;
  frmChgEvent : TfrmChgEvent;
  AnOrder: TOrder;
  AnOrderIDList: TStringList;
  EvtInfo,AnEvtDlg: string;
  AnEvent: TOrderDelayEvent;
  ThePtEvtID, TheDefaultPtEvtID, TheDefaultEvtInfo, SpeCap: string;
  IsNewEvent: boolean;
  ExistedPtEvtId: integer;

  function DisplayEvntDialog(AEvtDlg: String; AnEvent: TOrderDelayEvent): boolean;
  var
    DlgData: string;
  begin
    DlgData := GetDlgData(AEvtDlg);
    frmOrders.NeedShowModal := True;
    frmOrders.IsDefaultDlg := True;
    Result := frmOrders.PlaceOrderForDefaultDialog(DlgData, True, AnEvent);
    frmOrders.IsDefaultDlg := False;
    frmOrders.NeedShowModal := False;
  end;

  function FindMatchedPtEvtID(EventName: string): integer;
  var
    cnt: integer;
    viewName: string;
  begin
    Result := 0;
    for cnt := 0 to frmOrders.lstSheets.Items.Count - 1 do
    begin
      viewName := Piece(frmOrders.lstSheets.Items[cnt],'^',2);
      if AnsiCompareText(EventName,viewName)=0 then
      begin
        Result := StrToIntDef(Piece(frmOrders.lstSheets.Items[cnt],'^',1),0);
        break;
      end;
    end;

  end;
begin
  CHANGE_CAP := DKLangConstW('fOrdersCV_The_release_event_for_the_following_orders_will_be_changed_tox');
  REMOVE_CAP := DKLangConstW('fOrdersCV_The_release_event_will_be_deleted_for_the_following_ordersx');
  Result := False;
  IsNewEvent := False;
  AnEvent.EventType := #0;
  AnEvent.EventIFN  := 0;
  AnEvent.EventName := '';
  AnEvent.Specialty := 0;
  AnEvent.Effective := 0;
  AnEvent.PtEventIFN := 0;
  AnEvent.TheParent := TParentEvent.Create;
  AnEvent.IsNewEvent := False;

  if SelectedList.Count = 0 then Exit;
  frmChgEvent := TfrmChgEvent.Create(Application);
  SetFormPosition(frmChgEvent);
  frmChgEvent.CurrSpecialty := Piece(GetCurrentSpec(Patient.DFN),'^',1);
  if Length(frmChgEvent.CurrSpecialty)>0 then
//  SpeCap := #13 + '  The current treating specialty is ' + frmChgEvent.CurrSpecialty  <-- original line.  //kt 8/8/2007
    SpeCap := #13 + DKLangConstW('fOrdersCV_The_current_treating_specialty_is') + frmChgEvent.CurrSpecialty //kt added 8/8/2007
  else
//  SpeCap := #13 + '  No treating specialty is available.';  <-- original line.  //kt 8/8/2007
    SpeCap := #13 + DKLangConstW('fOrdersCV_No_treating_specialty_is_availablex'); //kt added 8/8/2007
  ResizeFormToFont(TForm(frmChgEvent));
  SetFormPosition(frmChgEvent);
  if Patient.Inpatient then
//  frmChgEvent.lblPtInfo.Caption := '   ' + Patient.Name + ' is currently admitted to ' + Encounter.LocationName + SpeCap  <-- original line.  //kt 8/8/2007
    frmChgEvent.lblPtInfo.Caption := '   ' + Patient.Name + DKLangConstW('fOrdersCV_is_currently_admitted_to') + Encounter.LocationName + SpeCap //kt added 8/8/2007
  else
//  frmChgEvent.lblPtInfo.Caption := '   ' + Patient.Name + ' is currently at ' + Encounter.LocationName + SpeCap;  <-- original line.  //kt 8/8/2007
    frmChgEvent.lblPtInfo.Caption := '   ' + Patient.Name + DKLangConstW('fOrdersCV_is_currently_at') + Encounter.LocationName + SpeCap; //kt added 8/8/2007
  frmChgEvent.cboSpecialty.Caption := frmChgEvent.lblPtInfo.Caption;
  ThePtEvtID := '';
  AnOrder := TOrder(selectedList[0]);
  TheDefaultPtEvtID := GetOrderPtEvtID(AnOrder.ID);
  if Length(TheDefaultPtEvtID)>0 then
  begin
    frmChgEvent.FDefaultPtEvntIFN := StrToIntDef(TheDefaultPtEvtId,0);
    TheDefaultEvtInfo := EventInfo(TheDefaultPtEvtID);
    frmChgEvent.FDefaultEvntIFN := StrToIntDef(Piece(TheDefaultEvtInfo,'^',2),0);
  end;
  frmChgEvent.LoadSpecialtyList;
  frmChgEvent.ShowModal;
  if frmChgEvent.OKPress then
  begin
//  if frmChgEvent.btnAction.Caption = 'Change' then  <-- original line.  //kt 8/8/2007
    if frmChgEvent.btnAction.Caption = DKLangConstW('fOrdersCV_Change') then //kt added 8/8/2007
    begin
      AnOrderIDList := TStringList.Create;
      for i := 0 to selectedList.Count - 1 do
      begin
        AnOrder := TOrder(selectedList[i]);
        AnOrderIDList.Add(AnOrder.ID);
      end;
      EvtInfo := frmChgEvent.cboSpecialty.Items[frmChgEvent.cboSpecialty.ItemIndex];
      AnEvent.EventType := CharAt(Piece(EvtInfo,'^',3),1);
      AnEvent.EventIFN  := StrToInt64Def(Piece(EvtInfo,'^',1),0);
      if StrToInt64Def(Piece(EvtInfo,'^',13),0) > 0 then
      begin
        AnEvent.TheParent.Assign(Piece(EvtInfo,'^',13));
        AnEvent.EventType := AnEvent.TheParent.ParentType;
      end;
      AnEvent.EventName := Piece(EvtInfo,'^',9);
//    ExistedPtEvtId := FindMatchedPtEvtID('Delayed ' + AnEvent.EventName + ' Orders');  <-- original line.  //kt 8/8/2007
      ExistedPtEvtId := FindMatchedPtEvtID(DKLangConstW('fOrdersCV_Delayed') + AnEvent.EventName + DKLangConstW('fOrdersCV_Orders')); //kt added 8/8/2007
      if (ExistedPtEvtId>0) and IsCompletedPtEvt(ExistedPtEvtId) then
      begin
        DoesDestEvtOccur := True;
        DestPtEvtId := ExistedPtEvtId;
        DestPtEvtName := AnEvent.EventName;
        ChangeEvent(AnOrderIDList, '');
        Result := True;
        Exit;
      end;

      if Length(AnEvent.EventName) < 1 then
        AnEvent.EventName := Piece(EvtInfo,'^',2);
      AnEvent.Specialty := 0;
      if TypeOfExistedEvent(Patient.DFN,AnEvent.EventIFN) = 0 then
      begin
         IsNewEvent := True;
         if AnEvent.TheParent.ParentIFN > 0 then
         begin
           if StrToIntDef(AnEvent.TheParent.ParentDlg,0)>0 then
             AnEvtDlg := AnEvent.TheParent.ParentDlg;
         end
         else
           AnEvtDlg := Piece(EvtInfo,'^',5);
      end;
      if (StrToIntDef(AnEvtDlg,0)>0) and (IsNewEvent) then
         if not DisplayEvntDialog(AnEvtDlg, AnEvent) then
         begin
           frmOrders.lstSheets.ItemIndex := 0;
           frmOrders.lstSheetsClick(nil);
           Result := False;
           Exit;
         end;
      if not isExistedEvent(Patient.DFN, IntToStr(AnEvent.EventIFN), ThePtEvtID) then
      begin
        if (AnEvent.TheParent.ParentIFN > 0) and (TypeOfExistedEvent(Patient.DFN,AnEvent.EventIFN) = 0 )then
          SaveEvtForOrder(Patient.DFN, AnEvent.TheParent.ParentIFN, '');
        SaveEvtForOrder(Patient.DFN,AnEvent.EventIFN,'');
        if isExistedEvent(Patient.DFN, IntToStr(AnEvent.EventIFN),ThePtEvtID) then
        begin
          AnEvent.IsNewEvent := False;
          AnEvent.PtEventIFN := StrToIntDef(ThePtEvtID,0);
        end;
      end;
      ChangeEvent(AnOrderIDList, ThePtEvtID);
//    frmChgEvent.updateChanges(AnOrderIDList,'Delayed ' + AnEvent.EventName);  <-- original line.  //kt 8/8/2007
      frmChgEvent.updateChanges(AnOrderIDList,DKLangConstW('fOrdersCV_Delayed') + AnEvent.EventName); //kt added 8/8/2007
      frmChgEvent.Highlight(ThePtEvtID);
      if frmOrders.lstSheets.ItemIndex >= 0 then
        frmOrders.lstSheetsClick(Nil);
    end else
    begin
      if not DispOrdersForEventChange(SelectedList, REMOVE_CAP) then exit;
      AnOrderIDList := TStringList.Create;
      for i := 0 to selectedList.Count - 1 do
      begin
        AnOrder := TOrder(selectedList[i]);
        AnOrderIDList.Add(AnOrder.ID);
      end;
      ChangeEvent(AnOrderIDList,'');
      frmChgEvent.updateChanges(AnOrderIDList,'');
      frmChgEvent.FilterOutEmptyPtEvt;
      frmOrders.InitOrderSheetsForEvtDelay;
      frmOrders.lstSheets.ItemIndex := 0;
      frmOrders.lstSheetsClick(Nil);
    end;
    Result := True;
  end else
    Result := False;
end;

{ TfrmChgEvent }

procedure TfrmChgEvent.LoadSpecialtyList;
var
  i: integer;
  tempStr: string;
begin
  inherited;
  cboSpecialty.Items.Clear;
  if Patient.Inpatient then
  begin
    ListSpecialtiesED(#0,cboSpecialty.Items);
  end
  else  ListSpecialtiesED('A',cboSpecialty.Items);
  if FDefaultEvntIFN > 0 then
  begin
    for i := 0 to cboSpecialty.Items.Count - 1 do
    begin
      if Piece(cboSpecialty.Items[i],'^',1)=IntToStr(FDefaultEvntIFN) then
      begin
        tempStr := cboSpecialty.Items[i];
        cboSpecialty.Items.Insert(0,tempStr);
        cboSpecialty.Items.Insert(1,'^^^^^^^^__________________________________________________________________________________');
        cboSpecialty.ItemIndex := 0;
        FDefaultIndex := Piece(tempStr,'^',1);
        btnAction.Visible := True;
//      btnAction.Caption := 'Remove';  <-- original line.  //kt 8/8/2007
        btnAction.Caption := DKLangConstW('fOrdersCV_Remove'); //kt added 8/8/2007
        break;
      end;
    end;
    if cboSpecialty.ItemIndex < 0 then
      btnAction.Visible := False;
  end;
end;

procedure TfrmChgEvent.FormCreate(Sender: TObject);
begin
  inherited;
  FDefaultEvntIFN   := 0;
  FDefaultPtEvntIFN := 0;
  FCurrSpecialty    := '';
  FDefaultIndex     := '';
  FOKPress          := False;
  FLastIndex        := 0;

end;

procedure TfrmChgEvent.cboSpecialtyChange(Sender: TObject);
//const
//TX_MCHEVT1  = ' is already assigned to ';  <-- original line.  //kt 8/8/2007
//TX_MCHEVT2  = #13 + 'Do you still want to write delayed orders?';  <-- original line.  //kt 8/8/2007
var
  AnEvtID, AnEvtType: string;
  AnEvtName,ATsName: string;
  i: integer;
  NMRec : TNextMoveRec;
  TX_MCHEVT1  : string; //kt
  TX_MCHEVT2  : string; //kt

 begin
  inherited;
  TX_MCHEVT1  := DKLangConstW('fOrdersCV_is_already_assigned_to'); //kt added 8/8/2007
  TX_MCHEVT2  := #13 + DKLangConstW('fOrdersCV_Do_you_still_want_to_write_delayed_ordersx'); //kt added 8/8/2007
  NextMove(NMRec, FLastIndex, cboSpecialty.ItemIndex); //Logic added for 508 1/31/03
  FLastIndex := NMRec.LastIndex ;
  if (cboSpecialty.text = '') or (cboSpecialty.ItemIndex = -1) then
  begin
    btnAction.visible := False;
    btnAction.Caption := '';
  end
  else if (Piece(cboSpecialty.Items[cboSpecialty.ItemIndex],'^',1) <> FDefaultIndex) then
  begin
    btnAction.Visible := True;
//  btnAction.Caption := 'Change';  <-- original line.  //kt 8/8/2007
    btnAction.Caption := DKLangConstW('fOrdersCV_Change'); //kt added 8/8/2007
  end
  else
  begin
    btnAction.Visible := True;
//  btnAction.Caption := 'Remove';  <-- original line.  //kt 8/8/2007
    btnAction.Caption := DKLangConstW('fOrdersCV_Remove'); //kt added 8/8/2007
  end;
  if cboSpecialty.ItemIndex >= 0 then
  begin
    AnEvtID   := Piece(cboSpecialty.Items[cboSpecialty.ItemIndex],'^',1);
    AnEvtType := Piece(cboSpecialty.Items[cboSpecialty.ItemIndex],'^',3);
    AnEvtName := Piece(cboSpecialty.Items[cboSpecialty.ItemIndex],'^',9)
  end else
  begin
    AnEvtID   := '';
    AnEvtType := '';
    AnEvtName := '';
  end;
  ATsName := CurrSpecialty;
  if (StrToIntDef(AnEvtID,0)>0) and (isMatchedEvent(Patient.DFN,AnEvtID,ATsName)) then
  begin
//  if InfoBox(Patient.Name + TX_MCHEVT1 + CurrSpecialty + ' on ' + Encounter.LocationName + TX_MCHEVT2,  <-- original line.  //kt 8/8/2007
    if InfoBox(Patient.Name + TX_MCHEVT1 + CurrSpecialty + DKLangConstW('fOrdersCV_on') + Encounter.LocationName + TX_MCHEVT2, //kt added 8/8/2007
//      'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDOK then  <-- original line.  //kt 8/8/2007
        DKLangConstW('fOrdersCV_Warning'), MB_OKCANCEL or MB_ICONWARNING) = IDOK then //kt added 8/8/2007
      btnActionClick(Self)
   else
   begin
     if Length(FDefaultIndex) > 0 then
     begin
       for i := 0 to cboSpecialty.Items.Count - 1 do
       begin
         if Piece(cboSpecialty.items[i],'^',1)=FDefaultIndex then
         begin
           cboSpecialty.ItemIndex := cboSpecialty.ItemIndex + NMRec.NextStep; //Added this code for 508 compliance GRE 01/30/03
           break;
         end;
       end;
//     btnAction.Caption := 'Remove';  <-- original line.  //kt 8/8/2007
       btnAction.Caption := DKLangConstW('fOrdersCV_Remove'); //kt added 8/8/2007
     end else
     begin
       cboSpecialty.ItemIndex := 0;
//     btnAction.Caption := 'Change';  <-- original line.  //kt 8/8/2007
       btnAction.Caption := DKLangConstW('fOrdersCV_Change'); //kt added 8/8/2007
     end;
   end;
  end;
end;

procedure TfrmChgEvent.btnActionClick(Sender: TObject);
//const
//TX_REASON_REQ = 'A Delayed Event must be selected.';  <-- original line.  //kt 8/8/2007
//TX_REMOVE     = 'Are you sure you want to remove the release event from these orders?';  <-- original line.  //kt 8/8/2007
//TX_CHANGE     = 'Are you sure you want to change the release event for these orders?';  <-- original line.  //kt 8/8/2007

var
TX_REASON_REQ : string; //kt
TX_REMOVE     : string; //kt
TX_CHANGE     : string; //kt

begin
  inherited;
  TX_REASON_REQ := DKLangConstW('fOrdersCV_A_Delayed_Event_must_be_selectedx'); //kt added 8/8/2007
  TX_REMOVE     := DKLangConstW('fOrdersCV_Are_you_sure_you_want_to_remove_the_release_event_from_these_ordersx'); //kt added 8/8/2007
  TX_CHANGE     := DKLangConstW('fOrdersCV_Are_you_sure_you_want_to_change_the_release_event_for_these_ordersx'); //kt added 8/8/2007
  if cboSpecialty.ItemIndex < 0 then
  begin
//  InfoBox(TX_REASON_REQ, 'No Selection made', MB_OK);  <-- original line.  //kt 8/8/2007
    InfoBox(TX_REASON_REQ, DKLangConstW('fOrdersCV_No_Selection_made'), MB_OK); //kt added 8/8/2007
    Exit;
  end;
  OKPress := True;
  Close;
end;

procedure TfrmChgEvent.btnCancelClick(Sender: TObject);
begin
  Close;
end;
procedure TfrmChgEvent.cboSpecialtyDblClick(Sender: TObject);
begin
  inherited;
  if cboSpecialty.ItemIndex > -1 then
    btnActionClick(Self);
end;

procedure TfrmChgEvent.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  inherited;
  SaveUserBounds(Self);
  Action := caFree;
end;

procedure TfrmChgEvent.updateChanges(const AnOrderIDList: TStringList; const AnEventName: String);
var
  jx,TempSigSts: integer;
  theChangeItem: TChangeItem;
  TempText: string;
begin
  for jx := 0 to AnOrderIDList.Count - 1 do
  begin
    theChangeItem := Changes.Locate(CH_ORD,AnOrderIDList[jx]);
    if theChangeItem = nil then
    begin
      TempText := RetrieveOrderText(AnOrderIDList[jx]);
      Changes.Add(CH_ORD,AnOrderIDList[jx],TempText,AnEventName,1);
    end
    else
    begin
      TempText := theChangeItem.Text;
      TempSigSts := theChangeItem.SignState;
      Changes.Remove(CH_ORD,AnOrderIDList[jx]);
      Changes.Add(CH_ORD,AnOrderIDList[jx],TempText, AnEventName, TempSigSts);
    end;
  end;
  if FDefaultPtEvntIFN>0 then
  begin
    if PtEvtEmpty(IntToStr(FDefaultPtEvntIFN)) then
    begin
      DeletePtEvent(IntToStr(FDefaultPtEvntIFN));
      frmOrders.ChangesUpdate(IntToStr(FDefaultPtEvntIFN));
    end;
  end;
end;

procedure TfrmChgEvent.Highlight(APtEvtID: string);
var
  jjj: integer;
begin
  FilterOutEmptyPtEvt;
  frmOrders.InitOrderSheetsForEvtDelay;
  for jjj := 0 to frmOrders.lstSheets.Items.Count - 1 do
  begin
    if Piece(frmOrders.lstSheets.Items[jjj],'^',1)=APtEvtID then
    begin
      frmOrders.lstSheets.ItemIndex := jjj;
      break;
    end;
  end;
end;

procedure TfrmChgEvent.FilterOutEmptyPtEvt;
var
  TmpStr: string;
  hhh: integer;
  AaPtEvtList: TStringList;
begin
  AaPtEvtList := TStringList.Create;
  LoadOrderSheetsED(AaPtEvtList);
  for hhh := 0 to AaPtEvtList.Count - 1 do
  begin
    if StrToIntDef(Piece(AaPtEvtList[hhh],'^',1),0)>0 then
    begin
      if DeleteEmptyEvt(Piece(AaPtEvtList[hhh],'^',1),TmpStr, False) then
        frmOrders.ChangesUpdate(Piece(AaPtEvtList[hhh],'^',1));
    end;
  end;
end;

end.