VistA-cprs/CPRS-Chart/fMedCopy.pas

333 lines
10 KiB
Plaintext

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.