unit fMedCopy; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ORDtTm, ORCtrls, ORFn, rOrders, uCore, rCore, mEvntDelay, fAutoSz, ExtCtrls, UConst; type TfrmMedCopy = class(TForm) Panel1: TPanel; lblPtInfo: TLabel; Panel2: TPanel; lblInstruction: TStaticText; Image1: TImage; Label1: TStaticText; Panel3: TPanel; GroupBox2: TGroupBox; radDelayed: TRadioButton; radRelease: TRadioButton; cmdOK: TButton; cmdCancel: TButton; Panel4: TPanel; fraEvntDelayList: TfraEvntDelayList; procedure cmdOKClick(Sender: TObject); procedure cmdCancelClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure radDelayedClick(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 FDelayEvent: TOrderDelayEvent; FOKPressed: Boolean; public { Public declarations } end; function SetDelayEventForMed(const RadCap: string; var ADelayEvent: TOrderDelayEvent; var IsNewEvent: Boolean; LimitEvent: Char): Boolean; var frmMedCopy: TfrmMedCopy; implementation {$R *.DFM} uses fODBase, fOrdersTS, fOrders; const TX_SEL_DATE = 'An effective date (approximate) must be selected for discharge orders.'; TC_SEL_DATE = 'Missing Effective Date'; function SetDelayEventForMed(const RadCap: string; var ADelayEvent: TOrderDelayEvent; var IsNewEvent: Boolean; LimitEvent: Char): Boolean; const TX_RELEASE1 = 'Release '; TX_RELEASE2 = ' orders immediately'; TX_DELAYED1 = 'Delay release of '; TX_DELAYED2 = ' orders until'; var EvtInfo,PtEvtID,AnEvtDlg: string; SpeCap, CurrTS: string; 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; begin if LimitEvent = 'C' then begin Result := True; ADelayEvent.EventType := 'C'; ADelayEvent.Specialty := 0; ADelayEvent.Effective := 0; Exit; end; Result := False; frmMedCopy := TfrmMedCopy.Create(Application); try if (LimitEvent = 'A') and (not Patient.Inpatient) then begin frmMedCopy.radDelayed.Checked := True; frmMedCopy.radRelease.Enabled := False; end; ResizeAnchoredFormToFont(frmMedCopy); 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.'; if Patient.Inpatient then frmMedCopy.lblPtInfo.Caption := ' ' + Patient.Name + ' is currently admitted to ' + Encounter.LocationName + SpeCap else begin if (Encounter.Location > 0) then frmMedCopy.lblPtInfo.Caption := Patient.Name + ' is currently at ' + Encounter.LocationName + SpeCap else frmMedCopy.lblPtInfo.Caption := Patient.Name + ' currently is an outpatient.' + SpeCap; end; frmMedCopy.fraEvntDelayList.EvntLimit := LimitEvent; if Pos('transfer',RadCap)>0 then frmMedCopy.Caption := 'Transfer Medication Orders'; frmMedCopy.radRelease.Caption := TX_RELEASE1 + RadCap + TX_RELEASE2; frmMedCopy.radDelayed.Caption := TX_DELAYED1 + RadCap + TX_DELAYED2; if LimitEvent='D' then begin frmMedCopy.Panel2.Visible := False; frmMedCopy.Height := frmMedCopy.Panel1.Height + frmMedCopy.GroupBox2.Height; end; frmMedCopy.ShowModal; if (frmMedCopy.FOKPressed) and (frmMedCopy.radRelease.Checked) then begin if (frmMedCopy.radRelease.Checked) and (LimitEvent = 'D') then XfInToOutNow := True else XfInToOutNow := False; ADelayEvent := frmMedCopy.FDelayEvent; Result := True; end else if (frmMedCopy.FOKPressed) and (frmMedCopy.radDelayed.Checked) then begin EvtInfo := frmMedCopy.fraEvntDelayList.mlstEvents.Items[frmMedCopy.fraEvntDelayList.mlstEvents.ItemIndex]; ADelayEvent.EventType := CharAt(Piece(EvtInfo,'^',3),1); ADelayEvent.EventIFN := StrToInt64Def(Piece(EvtInfo,'^',1),0); if StrToInt64Def(Piece(EvtInfo,'^',13),0) > 0 then begin ADelayEvent.TheParent.Assign(Piece(EvtInfo,'^',13)); ADelayEvent.EventType := ADelayEvent.TheParent.ParentType; end; ADelayEvent.EventName := frmMedCopy.fraEvntDelayList.mlstEvents.DisplayText[frmMedCopy.fraEvntDelayList.mlstEvents.ItemIndex]; ADelayEvent.Specialty := 0; if frmMedCopy.fraEvntDelayList.orDateBox.Visible then ADelayEvent.Effective := frmMedCopy.fraEvntDelayList.orDateBox.FMDateTime else ADelayEvent.Effective := 0; IsNewEvent := False; if TypeOfExistedEvent(Patient.DFN,ADelayEvent.EventIFN) = 0 then begin IsNewEvent := True; if ADelayEvent.TheParent.ParentIFN > 0 then begin if StrToIntDef(ADelayEvent.TheParent.ParentDlg,0)>0 then AnEvtDlg := ADelayEvent.TheParent.ParentDlg; end else AnEvtDlg := Piece(EvtInfo,'^',5); end; if (StrToIntDef(AnEvtDlg,0)>0) and (IsNewEvent) then if not DisplayEvntDialog(AnEvtDlg, ADelayEvent) then begin frmOrders.lstSheets.ItemIndex := 0; frmOrders.lstSheetsClick(nil); Result := False; Exit; end; if not isExistedEvent(Patient.DFN, IntToStr(ADelayEvent.EventIFN), PtEvtID) then begin IsNewEvent := True; if (ADelayEvent.TheParent.ParentIFN > 0) and (TypeOfExistedEvent(Patient.DFN,ADelayEvent.EventIFN) = 0 ) then SaveEvtForOrder(Patient.DFN,ADelayEvent.TheParent.ParentIFN,''); SaveEvtForOrder(Patient.DFN,ADelayEvent.EventIFN,''); if isExistedEvent(Patient.DFN, IntToStr(ADelayEvent.EventIFN),PtEvtID) then begin Highlight(PtEvtID); ADelayEvent.IsNewEvent := False; ADelayEvent.PtEventIFN := StrToIntDef(PtEvtID,0); end; end else begin Highlight(PtEvtID); ADelayEvent.PtEventIFN := StrToIntDef(PtEvtID,0); ADelayEvent.IsNewEvent := False; end; if frmOrders.lstSheets.ItemIndex > -1 then begin frmOrders.AskForCancel := False; frmOrders.lstSheetsClick(nil); frmOrders.AskForCancel := True; end; Result := True; end; finally frmMedCopy.fraEvntDelayList.ResetProperty; frmMedCopy.Release; end; end; procedure TfrmMedCopy.FormCreate(Sender: TObject); begin inherited; FOKPressed := False; FDelayEvent.EventType := #0; FDelayEvent.EventIFN := 0; radRelease.Checked := True; if not Patient.Inpatient then panel2.Visible := False; if not radDelayed.Checked then begin if not panel2.Visible then Height := Height - fraEvntDelayList.Height - panel2.Height else Height := Height - fraEvntDelayList.Height; end; end; procedure TfrmMedCopy.cmdOKClick(Sender: TObject); var today : TFMDateTime; begin inherited; today := FMToday; if (radDelayed.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) and (Pos('copied',radRelease.Caption)>0) then begin ImmdCopyAct := True; FDelayEvent.EventType := 'C'; FDelayEvent.Specialty := 0; FDelayEvent.Effective := 0; end else if (radRelease.Checked) and (Pos('transfer',radRelease.Caption)>0) then begin FDelayEvent.EventType := 'D'; FDelayEvent.Specialty := 0; FDelayEvent.Effective := today; end; FOKPressed := True; Close; end; procedure TfrmMedCopy.cmdCancelClick(Sender: TObject); begin inherited; Close; end; procedure TfrmMedCopy.radDelayedClick(Sender: TObject); const WarningMSG = 'If you''re writing medication orders to transfer these from Inpatient' + ' to Outpatient, please use the ''release immediately'' choice. These will be' + ' readied in advance by Pharmacy for the patient''s expected discharge date.'; begin inherited; frmMedCopy.fraEvntDelayList.UserDefaultEvent := StrToIntDef(GetDefaultEvt(IntToStr(User.DUZ)),0); fraEvntDelayList.DisplayEvntDelayList; if fraEvntDelayList.mlstEvents.Items.Count < 1 then begin ShowMessage(WarningMSG); radRelease.Checked := True; end else begin Height := Height + fraEvntDelayList.Height; fraEvntDelayList.Visible := True; end; end; procedure TfrmMedCopy.radReleaseClick(Sender: TObject); begin inherited; fraEvntDelayList.Visible := False; Height := Height - fraEvntDelayList.Height; end; procedure TfrmMedCopy.fraEvntDelayListcboEvntListChange(Sender: TObject); begin inherited; fraEvntDelayList.mlstEventsChange(Sender); if fraEvntDelayList.MatchedCancel then Close end; procedure TfrmMedCopy.UMStillDelay(var message: TMessage); begin CmdOKClick(Application); end; procedure TfrmMedCopy.fraEvntDelayListmlstEventsDblClick(Sender: TObject); begin if fraEvntDelayList.mlstEvents.ItemID > 0 then cmdOKClick(Self); end; procedure TfrmMedCopy.fraEvntDelayListmlstEventsChange(Sender: TObject); begin fraEvntDelayList.mlstEventsChange(Sender); if fraEvntDelayList.MatchedCancel then begin FOKPressed := False; Close; Exit; end; end; procedure TfrmMedCopy.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_RETURN then cmdOKClick(Self); end; end.