unit fOrdersTS; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fAutoSz, StdCtrls, ORCtrls, ORFn, ExtCtrls, rOrders, ORDtTm, mEvntDelay,uConst; type TfrmOrdersTS = class(TfrmAutoSz) pnlMiddle: TPanel; pnlTop: TPanel; lblPtInfo: TLabel; grpChoice: TGroupBox; radReleaseNow: TRadioButton; radDelayed: TRadioButton; pnldif: TPanel; Image1: TImage; cmdOK: TButton; cmdCancel: TButton; Label1: TLabel; Label2: TLabel; Panel1: TPanel; fraEvntDelayList: TfraEvntDelayList; procedure cmdOKClick(Sender: TObject); procedure cmdCancelClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure radDelayedClick(Sender: TObject); procedure radReleaseNowClick(Sender: TObject); procedure fraEvntDelayListcboEvntListChange(Sender: TObject); procedure UMStillDelay(var message: TMessage); message UM_STILLDELAY; procedure fraEvntDelayListmlstEventsDblClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure fraEvntDelayListmlstEventsChange(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); private OKPressed: Boolean; FResult : Boolean; FImmediatelyRelease: boolean; FCurrSpecialty: string; F1stClick: Boolean; end; function ShowDelayedEventsTreatingSepecialty(const ARadCaption: string; var AnEvent: TOrderDelayEvent; var ADlgLst: TStringlist; var ReleaseNow: boolean; AnLimitEvent: Char = #0): Boolean; var frmOrdersTS: TfrmOrdersTS; implementation uses ucore,fOrders, rMisc; {$R *.DFM} const TX_TRANSFER1= 'You selected the Transfer delayed event'; TX_TRANSFER = 'The release of orders entered ' + 'will be delayed until the patient is transferred to the ' + 'following specialty.'; TX_ADMIT1 = 'You selected the Admit delayed event'; TX_ADMIT = 'The release of orders entered ' + 'will be delayed until the patient is admitted to the ' + 'following specialty.'; TX_XISTEVT1 = 'Delayed orders already exist for event Delayed '; TX_XISTEVT2 = #13 + 'Do you want to view those orders?'; TX_MCHEVT1 = ' is already assigned to '; TX_MCHEVT2 = #13 + 'Do you still want to write delayed orders?'; function ShowDelayedEventsTreatingSepecialty(const ARadCaption: string; var AnEvent: TOrderDelayEvent; var ADlgLst: TStringlist; var ReleaseNow: boolean; AnLimitEvent: Char = #0): Boolean; var EvtInfo,speCap: string; begin frmOrdersTS := TfrmOrdersTS.Create(Application); frmOrdersTS.FCurrSpecialty := Piece(GetCurrentSpec(Patient.DFN),'^',1); frmOrdersTS.fraEvntDelayList.UserDefaultEvent := StrToIntDef(GetDefaultEvt(IntToStr(User.DUZ)),0); SetFormPosition(frmOrdersTS); //frmOrdersTs.fraEvntDelayList.Top := frmOrdersTS.Height - Result := frmOrdersTS.FResult; if Length(ARadCapTion)>0 then frmOrdersTS.radDelayed.Caption := ARadCaption; try ResizeFormToFont(TForm(frmOrdersTS)); if Length(frmOrdersTS.FCurrSpecialty)>0 then SpeCap := #13 + 'The current treating specialty is ' + frmOrdersTS.FCurrSpecialty else SpeCap := #13 + 'No treating specialty is available.'; if Patient.Inpatient then frmOrdersTS.lblPtInfo.Caption := Patient.Name + ' is currently admitted to ' + Encounter.LocationName + SpeCap else begin if (EnCounter.Location > 0) then frmOrdersTS.lblPtInfo.Caption := Patient.Name + ' is currently on ' + Encounter.LocationName + SpeCap else frmOrdersTS.lblPtInfo.Caption := Patient.Name + ' currently is an outpatient.' + SpeCap; end; if not (AnLimitEvent in ['A','D','T','M','O']) then AnLimitEvent := #0; frmOrdersTs.fraEvntDelayList.EvntLimit := AnLimitEvent; if AnEvent.EventIFN > 0 then begin frmOrdersTS.fraEvntDelayList.DefaultEvent := AnEvent.EventIFN; frmOrdersTS.radDelayed.Checked := True; end else begin frmOrdersTS.radReleaseNow.Enabled := True; frmOrdersTS.radReleaseNow.Checked := False; frmOrdersTS.radDelayed.Checked := False; end; frmOrdersTS.radDelayed.Checked := True; frmOrdersTS.ShowModal; if frmOrdersTS.FImmediatelyRelease then begin AnEvent.EventIFN := 0; AnEvent.EventName := ''; AnEvent.Specialty := 0; AnEvent.Effective := 0; ReleaseNow := frmOrdersTS.FImmediatelyRelease; Result := frmOrdersTS.FResult; end; if (frmOrdersTS.OKPressed) and (frmOrdersTS.radDelayed.Checked) then begin EvtInfo := frmOrdersTS.fraEvntDelayList.mlstEvents.Items[frmOrdersTS.fraEvntDelayList.mlstEvents.ItemIndex]; AnEvent.EventType := CharAt(Piece(EvtInfo,'^',3),1); AnEvent.EventIFN := StrToInt64Def(Piece(EvtInfo,'^',1),0); AnEvent.TheParent := TParentEvent.Create; if StrToInt64Def(Piece(EvtInfo,'^',13),0) > 0 then begin AnEvent.TheParent.Assign(Piece(EvtInfo,'^',13)); if AnEvent.EventType = #0 then AnEvent.EventType := AnEvent.TheParent.ParentType; end; AnEvent.EventName := frmOrdersTS.fraEvntDelayList.mlstEvents.DisplayText[frmOrdersTS.fraEvntDelayList.mlstEvents.ItemIndex]; AnEvent.Specialty := 0; if frmOrdersTS.fraEvntDelayList.orDateBox.Visible then AnEvent.Effective := frmOrdersTS.fraEvntDelayList.orDateBox.FMDateTime else AnEvent.Effective := 0; ADlgLst.Clear; if StrToIntDef(AnEvent.TheParent.ParentDlg,0)>0 then ADlgLst.Add(AnEvent.TheParent.ParentDlg) else if Length(Piece(EvtInfo,'^',5))>0 then ADlgLst.Add(Piece(EvtInfo,'^',5)); if Length(Piece(EvtInfo,'^',6))>0 then ADlgLst.Add(Piece(EvtInfo,'^',6)+ '^SET'); Result := frmOrdersTS.FResult; end; finally frmOrdersTS.Release; frmOrdersTS.FImmediatelyRelease := False; frmOrdersTS.FCurrSpecialty := ''; frmOrdersTS.fraEvntDelayList.ResetProperty; end; end; procedure TfrmOrdersTS.FormCreate(Sender: TObject); begin inherited; if not Patient.Inpatient then pnldif.Visible := False; OKPressed := False; FResult := False; FImmediatelyRelease := False; F1stClick := True; FCurrSpecialty := ''; end; procedure TfrmOrdersTS.cmdOKClick(Sender: TObject); begin inherited; if grpChoice.Tag = 0 then begin InfoBox('A release event has not been selected.', 'No Selection Made', MB_OK); Exit; end; if( not (fraEvntDelayList.mlstEvents.ItemIndex >= 0) ) and (radDelayed.Checked) then begin InfoBox('A release event must be selected.', 'No Selection Made', MB_OK); Exit; end; if (fraEvntDelayList.mlstEvents.ItemIndex >= 0) and F1stClick then begin fraEvntDelayList.CheckMatch; if fraEvntDelayList.MatchedCancel then begin OKPressed := False; Close; Exit; end; end; OKPressed := True; FResult := True; Close; end; procedure TfrmOrdersTS.cmdCancelClick(Sender: TObject); begin inherited; FResult := False; Close; end; procedure TfrmOrdersTS.radDelayedClick(Sender: TObject); begin inherited; fraEvntDelayList.Visible := True; fraEvntDelayList.DisplayEvntDelayList; grpChoice.Tag := 1; end; procedure TfrmOrdersTS.radReleaseNowClick(Sender: TObject); begin inherited; grpChoice.Tag := 1; if InfoBox('Would you like to close this window and return to the Orders Tab?', 'Confirmation', MB_OKCANCEL or MB_ICONQUESTION) = IDOK then begin FImmediatelyRelease := True; FResult := False; Close; end else begin fraEvntDelayList.mlstEvents.Items.Clear; FImmediatelyRelease := False; radReleaseNow.Checked := False; radDelayed.Checked := True; end; end; procedure TfrmOrdersTS.fraEvntDelayListcboEvntListChange(Sender: TObject); begin inherited; fraEvntDelayList.mlstEventsChange(Sender); F1stClick := False; if fraEvntDelayList.MatchedCancel then Close end; procedure TfrmOrdersTS.UMStillDelay(var message: TMessage); begin inherited; if grpChoice.Tag = 0 then begin InfoBox('A release event has not been selected.', 'No Selection Made', MB_OK); Exit; end; if(not (fraEvntDelayList.mlstEvents.ItemIndex >= 0)) and (radDelayed.Checked) then begin InfoBox('A release event must be selected.', 'No Selection Made', MB_OK); Exit; end; OKPressed := True; FResult := True; Close; end; procedure TfrmOrdersTS.fraEvntDelayListmlstEventsDblClick(Sender: TObject); begin inherited; if fraEvntDelayList.mlstEvents.ItemID > 0 then cmdOKClick(Self); end; procedure TfrmOrdersTS.FormClose(Sender: TObject; var Action: TCloseAction); begin inherited; SaveUserBounds(Self); Action := caFree; end; procedure TfrmOrdersTS.fraEvntDelayListmlstEventsChange(Sender: TObject); begin inherited; fraEvntDelayList.mlstEventsChange(Sender); if fraEvntDelayList.MatchedCancel then begin OKPressed := False; Close; Exit; end; end; procedure TfrmOrdersTS.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin inherited; if Key = VK_RETURN then cmdOKClick(Self); end; end.