//kt -- Modified with SourceScanner on 8/8/2007 unit fOrdersTS; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fAutoSz, StdCtrls, ORCtrls, ORFn, ExtCtrls, rOrders, ORDtTm, mEvntDelay,uConst, DKLang; 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'; <-- original line. //kt 8/8/2007 //TX_TRANSFER = 'The release of orders entered ' + <-- original line. //kt 8/8/2007 // 'will be delayed until the patient is transferred to the ' + <-- original line. //kt 8/8/2007 // 'following specialty.'; <-- original line. //kt 8/8/2007 //TX_ADMIT1 = 'You selected the Admit delayed event'; <-- original line. //kt 8/8/2007 //TX_ADMIT = 'The release of orders entered ' + <-- original line. //kt 8/8/2007 // 'will be delayed until the patient is admitted to the ' + <-- original line. //kt 8/8/2007 // 'following specialty.'; <-- original line. //kt 8/8/2007 //TX_XISTEVT1 = 'Delayed orders already exist for event Delayed '; <-- original line. //kt 8/8/2007 //TX_XISTEVT2 = #13 + 'Do you want to view those orders?'; <-- original line. //kt 8/8/2007 //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 TX_TRANSFER1 : string; //kt TX_TRANSFER : string; //kt TX_ADMIT1 : string; //kt TX_ADMIT : string; //kt TX_XISTEVT1 : string; //kt TX_XISTEVT2 : string; //kt TX_MCHEVT1 : string; //kt TX_MCHEVT2 : string; //kt procedure SetupVars; //kt Added entire function to replace constant declarations 8/8/2007 begin TX_TRANSFER1:= DKLangConstW('fOrdersTS_You_selected_the_Transfer_delayed_event'); TX_TRANSFER := DKLangConstW('fOrdersTS_The_release_of_orders_entered') + DKLangConstW('fOrdersTS_will_be_delayed_until_the_patient_is_transferred_to_the') + DKLangConstW('fOrdersTS_following_specialtyx'); TX_ADMIT1 := DKLangConstW('fOrdersTS_You_selected_the_Admit_delayed_event'); TX_ADMIT := DKLangConstW('fOrdersTS_The_release_of_orders_entered') + DKLangConstW('fOrdersTS_will_be_delayed_until_the_patient_is_admitted_to_the') + DKLangConstW('fOrdersTS_following_specialtyx'); TX_XISTEVT1 := DKLangConstW('fOrdersTS_Delayed_orders_already_exist_for_event_Delayed'); TX_XISTEVT2 := #13 + DKLangConstW('fOrdersTS_Do_you_want_to_view_those_ordersx'); TX_MCHEVT1 := DKLangConstW('fOrdersTS_is_already_assigned_to'); TX_MCHEVT2 := #13 + DKLangConstW('fOrdersTS_Do_you_still_want_to_write_delayed_ordersx'); end; 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 <-- original line. //kt 8/8/2007 SpeCap := #13 + DKLangConstW('fOrdersTS_The_current_treating_specialty_is') + frmOrdersTS.FCurrSpecialty //kt added 8/8/2007 else // SpeCap := #13 + 'No treating specialty is available.'; <-- original line. //kt 8/8/2007 SpeCap := #13 + DKLangConstW('fOrdersTS_No_treating_specialty_is_availablex'); //kt added 8/8/2007 if Patient.Inpatient then // frmOrdersTS.lblPtInfo.Caption := Patient.Name + ' is currently admitted to ' + Encounter.LocationName + SpeCap <-- original line. //kt 8/8/2007 frmOrdersTS.lblPtInfo.Caption := Patient.Name + DKLangConstW('fOrdersTS_is_currently_admitted_to') + Encounter.LocationName + SpeCap //kt added 8/8/2007 else begin if (EnCounter.Location > 0) then // frmOrdersTS.lblPtInfo.Caption := Patient.Name + ' is currently on ' + Encounter.LocationName + SpeCap <-- original line. //kt 8/8/2007 frmOrdersTS.lblPtInfo.Caption := Patient.Name + DKLangConstW('fOrdersTS_is_currently_on') + Encounter.LocationName + SpeCap //kt added 8/8/2007 else // frmOrdersTS.lblPtInfo.Caption := Patient.Name + ' currently is an outpatient.' + SpeCap; <-- original line. //kt 8/8/2007 frmOrdersTS.lblPtInfo.Caption := Patient.Name + DKLangConstW('fOrdersTS_currently_is_an_outpatientx') + SpeCap; //kt added 8/8/2007 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); <-- original line. //kt 8/8/2007 InfoBox(DKLangConstW('fOrdersTS_A_release_event_has_not_been_selectedx'), DKLangConstW('fOrdersTS_No_Selection_Made'), MB_OK); //kt added 8/8/2007 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); <-- original line. //kt 8/8/2007 InfoBox(DKLangConstW('fOrdersTS_A_release_event_must_be_selectedx'), DKLangConstW('fOrdersTS_No_Selection_Made'), MB_OK); //kt added 8/8/2007 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?', <-- original line. //kt 8/8/2007 if InfoBox(DKLangConstW('fOrdersTS_Would_you_like_to_close_this_window_and_return_to_the_Orders_Tabx'), //kt added 8/8/2007 // 'Confirmation', MB_OKCANCEL or MB_ICONQUESTION) = IDOK then <-- original line. //kt 8/8/2007 DKLangConstW('fOrdersTS_Confirmation'), MB_OKCANCEL or MB_ICONQUESTION) = IDOK then //kt added 8/8/2007 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); <-- original line. //kt 8/8/2007 InfoBox(DKLangConstW('fOrdersTS_A_release_event_has_not_been_selectedx'), DKLangConstW('fOrdersTS_No_Selection_Made'), MB_OK); //kt added 8/8/2007 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); <-- original line. //kt 8/8/2007 InfoBox(DKLangConstW('fOrdersTS_A_release_event_must_be_selectedx'), DKLangConstW('fOrdersTS_No_Selection_Made'), MB_OK); //kt added 8/8/2007 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.