unit fOrdersCopy; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ORCtrls, ExtCtrls, mEvntDelay, uCore, fODBase, UConst, fAutoSz; type TfrmCopyOrders = class(TForm) pnlInfo: TPanel; fraEvntDelayList: TfraEvntDelayList; pnlRadio: TPanel; GroupBox1: TGroupBox; radRelease: TRadioButton; radEvtDelay: TRadioButton; Image1: TImage; Label2: TStaticText; Label1: TStaticText; pnlTop: TPanel; lblPtInfo: TStaticText; pnlBtns: TPanel; gbBtns: TGroupBox; cmdOK: TButton; cmdCancel: TButton; procedure cmdOKClick(Sender: TObject); procedure cmdCancelClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure radEvtDelayClick(Sender: TObject); procedure radReleaseClick(Sender: TObject); procedure fraEvntDelayListcboEvntListChange(Sender: TObject); procedure UMStillDelay(var message: TMessage); message UM_STILLDELAY; procedure fraEvntDelayListmlstEventsDblClick(Sender: TObject); procedure fraEvntDelayListmlstEventsChange(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); private OKPressed: Boolean; public end; function SetViewForCopy(var IsNewEvent: boolean; var DoesDestEvtOccur: boolean; var DestPtEvtID: integer; var DestPtEvtName: string): Boolean; var frmCopyOrders: TfrmCopyOrders; implementation {$R *.DFM} uses fOrders, fOrdersTS, ORFn, rOrders; function SetViewForCopy(var IsNewEvent: boolean; var DoesDestEvtOccur: boolean; var DestPtEvtID: integer; var DestPtEvtName: string): Boolean; var EvtInfo,APtEvtID, AnEvtDlg: string; AnEvent: TOrderDelayEvent; SpeCap, CurrTS: string; ExistedPtEvtID: integer; procedure Highlight(APtEvtID: string); var j: integer; begin frmOrders.InitOrderSheetsForEvtDelay; for j := 0 to frmOrders.lstSheets.Items.Count - 1 do begin if Piece(frmOrders.lstSheets.Items[j],'^',1)=APtEvtID then begin frmOrders.lstSheets.ItemIndex := j; break; end; end; end; 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 Result := 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; frmCopyOrders := TfrmCopyOrders.Create(Application); try ResizeFormToFont(TForm(frmCopyOrders)); CurrTS := Piece(GetCurrentSpec(Patient.DFN),'^',1); if Length(CurrTS)>0 then SpeCap := #13 + 'The current treating specialty is ' + CurrTS else SpeCap := #13 + 'No treating specialty is available.'; //ResizeFormToFont(TForm(frmCopyOrders)); if Patient.Inpatient then frmCopyOrders.lblPtInfo.Caption := Patient.Name + ' is currently admitted to ' + Encounter.LocationName + SpeCap else begin if (Encounter.Location > 0) then frmCopyOrders.lblPtInfo.Caption := Patient.Name + ' is currently at ' + Encounter.LocationName + SpeCap else frmCopyOrders.lblPtInfo.Caption := Patient.Name + ' currently is an outpatient.' + SpeCap; end; frmCopyOrders.ShowModal; if (frmCopyOrders.OKPressed) and (frmCopyOrders.radRelease.Checked) then begin frmOrders.lstSheets.ItemIndex := 0; frmOrders.lstSheetsClick(Nil); Result := True; end; if (frmCopyOrders.OKPressed) and (frmCopyOrders.radEvtDelay.Checked) then begin EvtInfo := frmCopyOrders.fraEvntDelayList.mlstEvents.Items[frmCopyOrders.fraEvntDelayList.mlstEvents.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 := frmCopyOrders.fraEvntDelayList.mlstEvents.DisplayText[frmCopyOrders.fraEvntDelayList.mlstEvents.ItemIndex]; AnEvent.Specialty := 0; if frmCopyOrders.fraEvntDelayList.orDateBox.Visible then AnEvent.Effective := frmCopyOrders.fraEvntDelayList.orDateBox.FMDateTime else AnEvent.Effective := 0; ExistedPtEvtID := FindMatchedPtEvtID('Delayed ' + AnEvent.EventName + ' Orders'); if (ExistedPtEvtId>0) and IsCompletedPtEvt(ExistedPtEvtId) then begin DoesDestEvtOccur := True; DestPtEvtId := ExistedPtEvtId; DestPtEvtName := AnEvent.EventName; IsNewEvent := False; Result := True; Exit; end; IsNewEvent := False; 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), APtEvtID) then begin IsNewEvent := True; 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),APtEvtID) then begin Highlight(APtEvtID); AnEvent.IsNewEvent := False; AnEvent.PtEventIFN := StrToIntDef(APtEvtID,0); end; end else begin Highlight(APtEvtID); AnEvent.PtEventIFN := StrToIntDef(APtEvtID,0); AnEvent.IsNewEvent := False; end; DestPtEvtId := AnEvent.PtEventIFN; DestPtEvtName := AnEvent.EventName; if (AnEvent.PtEventIFN >0) and IsCompletedPtEvt(AnEvent.PtEventIFN) then begin DoesDestEvtOccur := True; IsNewEvent := False; Result := True; Exit; end; if frmOrders.lstSheets.ItemIndex > -1 then begin frmOrders.AskForCancel := False; frmOrders.lstSheetsClick(nil); frmOrders.AskForCancel := True; end; Result := True; end; finally frmCopyOrders.fraEvntDelayList.ResetProperty; frmCopyOrders.Release; end; end; procedure TfrmCopyOrders.FormCreate(Sender: TObject); begin inherited; radRelease.Checked := True; OKPressed := False; if not Patient.Inpatient then begin pnlInfo.Visible := False; pnlBtns.Top := pnlRadio.Top; end; if not radEvtDelay.Checked then begin if not pnlInfo.Visible then Height := Height - fraEvntDelayList.Height - pnlInfo.Height else Height := Height - fraEvntDelayList.Height; end; end; procedure TfrmCopyOrders.cmdOKClick(Sender: TObject); begin inherited; if (radEvtDelay.Checked) and (fraEvntDelayList.mlstEvents.ItemIndex < 0 ) then begin InfoBox('A release event must be selected.', 'No Selection Made', MB_OK); Exit; end; if radRelease.Checked then begin ImmdCopyAct := True; frmOrders.lstSheets.ItemIndex := 0; frmOrders.lstSheetsClick(Self); end; OKPressed := True; Close; end; procedure TfrmCopyOrders.cmdCancelClick(Sender: TObject); begin inherited; Close; end; procedure TfrmCopyOrders.radEvtDelayClick(Sender: TObject); begin inherited; if radRelease.Checked then radRelease.Checked := False; radEvtDelay.Checked := True; Height := Height + fraEvntDelayList.Height; fraEvntDelayList.Visible := True; frmCopyOrders.fraEvntDelayList.UserDefaultEvent := StrToIntDef(GetDefaultEvt(IntToStr(User.DUZ)),0); fraEvntDelayList.DisplayEvntDelayList; end; procedure TfrmCopyOrders.radReleaseClick(Sender: TObject); begin inherited; if radEvtDelay.Checked then radEvtDelay.Checked := False; radRelease.Checked := True; fraEvntDelayList.Visible := False; Height := Height - fraEvntDelayList.Height; end; procedure TfrmCopyOrders.fraEvntDelayListcboEvntListChange( Sender: TObject); begin inherited; fraEvntDelayList.IsForCpXfer := True; fraEvntDelayList.mlstEventsChange(Sender); if fraEvntDelayList.MatchedCancel then Close end; procedure TfrmCopyOrders.UMStillDelay(var message: TMessage); begin CmdOKClick(Application); end; procedure TfrmCopyOrders.fraEvntDelayListmlstEventsDblClick( Sender: TObject); begin inherited; if fraEvntDelayList.mlstEvents.ItemID > 0 then cmdOKClick(Self); end; procedure TfrmCopyOrders.fraEvntDelayListmlstEventsChange(Sender: TObject); begin fraEvntDelayList.mlstEventsChange(Sender); if fraEvntDelayList.MatchedCancel then begin OKPressed := False; Close; Exit; end; end; procedure TfrmCopyOrders.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_RETURN then cmdOKClick(Self); end; end.