VistA-cprs/CPRS-Chart/Orders/uOrders.pas

1848 lines
64 KiB
Plaintext

unit uOrders;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, uConst, rOrders, ORFn,
Dialogs, ORCtrls, stdCtrls, strUtils, fODBase;
type
EOrderDlgFail = class(Exception);
{ Ordering Environment }
function AuthorizedUser: Boolean;
function AuthorizedToVerify: Boolean;
function EncounterPresent: Boolean;
function EncounterPresentEDO: Boolean;
function LockedForOrdering: Boolean;
function IsValidActionOnComplexOrder(AnOrderID, AnAction: string;
AListBox: TListBox; var CheckedList: TStringList; var ErrMsg: string; var ParentOrderID: string): boolean; //PSI-COMPLEX
procedure UnlockIfAble;
function OrderCanBeLocked(OrderID: string): Boolean;
procedure UnlockOrderIfAble(OrderID: string);
procedure AddSelectedToChanges(AList: TList);
procedure ResetDialogProperties(const AnID: string; AnEvent: TOrderDelayEvent; var ResolvedDialog: TOrderDialogResolved);
function IsInvalidActionWarning(const AnOrderText,AnOrderID: String): boolean;
procedure InitialOrderVariables;
{ Write Orders }
function ActivateAction(const AnID: string; AnOwner: TComponent; ARefNum: Integer): Boolean;
function ActivateOrderDialog(const AnID: string; AnEvent: TOrderDelayEvent;
AnOwner: TComponent; ARefNum: Integer; ANeedVerify: boolean = True): Boolean;
function RetrieveOrderText(AnOrderID: string): string;
function ActivateOrderHTML(const AnID: string; AnEvent: TOrderDelayEvent;
AnOwner: TComponent; ARefNum: Integer): Boolean;
function ActivateOrderMenu(const AnID: string; AnEvent: TOrderDelayEvent;
AnOwner: TComponent; ARefNum: Integer): Boolean;
function ActivateOrderSet(const AnID: string; AnEvent: TOrderDelayEvent;
AnOwner: TComponent; ARefNum: Integer): Boolean;
function ActivateOrderList(AList: TStringList; AnEvent: TOrderDelayEvent;
AnOwner: TComponent; ARefNum: Integer; const KeyVarStr, ACaption: string): Boolean;
function ActiveOrdering: Boolean;
function CloseOrdering: Boolean;
function ReadyForNewOrder(AnEvent: TOrderDelayEvent): Boolean;
function ReadyForNewOrder1(AnEvent: TOrderDelayEvent): Boolean;
function ChangeOrdersEvt(AnOrderID: string; AnEvent: TOrderDelayEvent): boolean;
function CopyOrders(AList: TStringList; AnEvent: TOrderDelayEvent; var DoesEventOccur: boolean; ANeedVerify: boolean = True): boolean;
function TransferOrders(AList: TStringList; AnEvent: TOrderDelayEvent; var DoesEventOccur: boolean; ANeedVerify: boolean = True): boolean;
procedure SetConfirmEventDelay;
procedure ChangeOrders(AList: TStringList; AnEvent: TOrderDelayEvent);
procedure DestroyingOrderAction;
procedure DestroyingOrderDialog;
procedure DestroyingOrderHTML;
procedure DestroyingOrderMenu;
procedure DestroyingOrderSet;
function OrderIsLocked(const AnOrderID, AnAction: string): Boolean;
procedure PopLastMenu;
procedure QuickOrderSave;
procedure QuickOrderListEdit;
function RefNumFor(AnOwner: TComponent): Integer;
procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0);
procedure SetFontSize( FontSize: integer);
procedure NextMove(var NMRec: TNextMoveRec; LastIndex: Integer; NewIndex: Integer);
{ Inpatient medication for Outpatient}
function IsIMODialog(DlgID: integer): boolean;
function AllowActionOnIMO(AnEvtTyp: char): boolean;
function IMOActionValidation(AnId: string; var IsIMOOD: boolean; var x: string; AnEventType: char): boolean;
var
uAutoAc: Boolean;
InptDisp : Integer;
OutptDisp: Integer;
MedsDisp : Integer;
ClinDisp : Integer; //IMO
NurDisp : Integer;
IVDisp : Integer;
CsltDisp : Integer;
ProcDisp : Integer;
ImgDisp : Integer;
NonVADisp: Integer;
MedsInDlgIen : Integer;
MedsOutDlgIen : Integer;
MedsNVADlgIen : Integer;
MedsInDlgFormId : Integer;
MedsOutDlgFormId : Integer;
MedsNVADlgFormID : Integer;
MedsIVDlgIen: Integer;
MedsIVDlgFormID: Integer;
NSSchedule: boolean;
OriginalMedsOutHeight: Integer;
OriginalMedsInHeight: Integer;
OriginalNonVAMedsHeight: Integer;
implementation
uses fODDiet, fODMisc, fODGen, fODMedIn, fODMedOut, fODText, fODConsult, fODProc, fODRad,
fODLab, fodBBank, fODMeds, fODMedIV, fODVitals, fODAuto, (*fODAllgy,*) fOMNavA, rCore, uCore, fFrame,
fEncnt, fEffectDate, fOMVerify, fOrderSaveQuick, fOMSet, rMisc, uODBase, rODMeds,
fLkUpLocation, fOrdersPrint, fOMAction, fARTAllgy, fOMHTML, fOrders, rODBase,
fODChild, fMeds, rMeds, rPCE, frptBox, fODMedNVA, fODChangeUnreleasedRenew, rODAllergy,
UBAGlobals, fClinicWardMeds, uTemplateFields;
var
uPatientLocked: Boolean;
uKeepLock: Boolean;
uOrderAction: TfrmOMAction;
uOrderDialog: TfrmODBase;
uOrderHTML: TfrmOMHTML;
uOrderMenu: TfrmOMNavA;
uOrderSet: TfrmOMSet;
uLastConfirm: string;
uOrderSetTime: TFMDateTime;
uNewMedDialog: Integer;
const
TX_PROV_LOC = 'A provider and location must be selected before entering orders.';
TC_PROV_LOC = 'Incomplete Information';
TX_PROV_KEY = 'The provider selected for this encounter must' + CRLF +
'hold the PROVIDER key to enter orders.';
TC_PROV_KEY = 'PROVIDER Key Required';
TX_NOKEY = 'You do not have the keys required to take this action.';
TC_NOKEY = 'Insufficient Authority';
TX_BADKEYS = 'You have mutually exclusive order entry keys (ORES, ORELSE, or OREMAS).' +
CRLF + 'This must be resolved before you can take actions on orders.';
TC_BADKEYS = 'Multiple Keys';
TC_NO_LOCK = 'Unable to Lock';
TC_DISABLED = 'Item Disabled';
TX_DELAY = 'Now writing orders for ';
TX_DELAY1 = CRLF + CRLF + '(To write orders for current release rather than delayed release,' + CRLF +
'close the next window and select Active Orders from the View Orders pane.)';
TC_DELAY = 'Ordering Information';
TX_STOP_SET = 'Do you want to stop entering the current set of orders?';
TC_STOP_SET = 'Interupt order set';
TC_DLG_REJECT = 'Unable to Order';
TX_NOFORM = 'This selection does not have an associated windows form.';
TC_NOFORM = 'Missing Form ID';
TX_DLG_ERR = 'Error in activating order dialog.';
TC_DLG_ERR = 'Dialog Error';
TX_NO_SAVE_QO = 'An ordering dialog must be active to use this action.';
TC_NO_SAVE_QO = 'Save as Quick Order';
TX_NO_EDIT_QO = 'An ordering dialog must be active to use this action.';
TC_NO_EDIT_QO = 'Edit Common List';
TX_NO_QUICK = 'This ordering dialog does not support quick orders.';
TC_NO_QUICK = 'Save/Edit Quick Orders';
TX_CANT_SAVE_QO = 'This order contains TIU objects, which may result in patient-specific' + CRLF +
'information being included in the order. For this reason, it may not' + CRLF +
'be saved as a personal quick order for later reuse.';
TX_NO_COPY = CRLF + CRLF + '- cannot be copied.' + CRLF + CRLF + 'Reason: ';
TC_NO_COPY = 'Unable to Copy Order';
TX_NO_CHANGE = CRLF + CRLF + '- cannot be changed.' + CRLF + CRLF + 'Reason: ';
TC_NO_CHANGE = 'Unable to Change Order';
TC_NO_XFER = 'Unable to Transfer Order';
TC_NOLOCK = 'Unable to Lock Order';
TX_ONHOLD = 'The following order has been put on-hold, do you still want to continue?';
TX_COMPLEX = 'You can not take this action on a complex medication.' + #13 + 'You must enter a new order.';
STEP_FORWARD = 1;
STEP_BACK = -1;
TX_NOINPT = ': You cannot place inpatient medication orders from a clinic location for selected patient.';
TX_IMO_WARNING1 = 'You are ';
TX_IMO_WARNING2 = ' Clinic Orders. The New orders will be saved as Clinic Orders and MAY NOT be available in BCMA';
function CreateOrderDialog(Sender: TComponent; FormID: integer; AnEvent: TOrderDelayEvent; ODEvtID: integer = 0): TfrmODBase;
{ creates an order dialog based on the FormID and returns a pointer to it }
type
TDialogClass = class of TfrmODBase;
var
DialogClass: TDialogClass;
begin
Result := nil;
// allows the FormCreate to check event under which dialog is created
if AnEvent.EventType in ['A','D','T','M','O'] then
begin
SetOrderEventTypeOnCreate(AnEvent.EventType);
SetOrderEventIDOnCreate(AnEvent.EventIFN);
end else
begin
SetOrderEventTypeOnCreate(#0);
SetOrderEventIDOnCreate(0);
end;
SetOrderFormIDOnCreate(FormID);
// check to see if we should use the new med dialogs
if uNewMedDialog = 0 then
begin
if UseNewMedDialogs then uNewMedDialog := 1 else uNewMedDialog := -1;
end;
if (uNewMedDialog > 0) and ((FormID = OD_MEDOUTPT) or (FormID = OD_MEDINPT)) then
FormID := OD_MEDS;
// create the form for a given ordering dialog
case FormID of
OD_MEDIV: DialogClass := TfrmODMedIV;
OD_MEDINPT: DialogClass := TfrmODMedIn;
OD_MEDS: DialogClass := TfrmODMeds;
OD_MEDOUTPT: DialogClass := TfrmODMedOut;
OD_MEDNONVA: DialogClass := TfrmODMedNVA;
OD_MISC: DialogClass := TfrmODMisc;
OD_GENERIC:
begin
if ODEvtID>0 then
SetOrderEventIDOnCreate(ODEvtID);
DialogClass := TfrmODGen;
end;
OD_IMAGING: DialogClass := TfrmODRad;
OD_DIET: DialogClass := TfrmODDiet;
OD_LAB: DialogClass := TfrmODLab;
OD_BB: DialogClass := TfrmODBBank;
OD_CONSULT: DialogClass := TfrmODCslt;
OD_PROCEDURE: DialogClass := TfrmODProc;
OD_TEXTONLY: DialogClass := TfrmODText;
OD_VITALS: DialogClass := TfrmODVitals;
//OD_ALLERGY: DialogClass := TfrmODAllergy;
OD_AUTOACK: DialogClass := TfrmODAuto;
else Exit;
end;
if Sender = nil then Sender := Application;
Result := DialogClass.Create(Sender);
if Result <> nil then Result.CallOnExit := DestroyingOrderDialog;
SetOrderEventTypeOnCreate(#0);
SetOrderEventIDOnCreate(0);
SetOrderFormIDOnCreate(0);
end;
function AuthorizedUser: Boolean;
begin
Result := True;
if User.NoOrdering then Result := False;
if User.OrderRole = OR_BADKEYS then
begin
InfoBox(TX_BADKEYS, TC_BADKEYS, MB_OK);
Result := False;
end;
end;
function AuthorizedToVerify: Boolean;
begin
Result := True;
if not User.EnableVerify then Result := False;
if User.OrderRole = OR_BADKEYS then
begin
InfoBox(TX_BADKEYS, TC_BADKEYS, MB_OK);
Result := False;
end;
end;
function EncounterPresent: Boolean;
{ make sure a location and provider are selected, returns false if not }
begin
Result := True;
if (Encounter.Provider > 0) and not PersonHasKey(Encounter.Provider, 'PROVIDER')
then InfoBox(TX_PROV_KEY, TC_PROV_KEY, MB_OK);
if (Encounter.Provider = 0) or (Encounter.Location = 0) or
((Encounter.Provider > 0) and (not PersonHasKey(Encounter.Provider, 'PROVIDER'))) then
begin
// don't prompt provider if current user has ORES and is the provider
if (User.OrderRole = OR_PHYSICIAN) and (Encounter.Provider = User.DUZ) and (User.IsProvider)
then UpdateEncounter(NPF_SUPPRESS)
else UpdateEncounter(NPF_PROVIDER);
frmFrame.DisplayEncounterText;
end;
if (Encounter.Provider = 0) or (Encounter.Location = 0) then
begin
if not frmFrame.CCOWDrivedChange then //jdccow
InfoBox(TX_PROV_LOC, TC_PROV_LOC, MB_OK or MB_ICONWARNING); {!!!}
Result := False;
end;
if (Encounter.Provider > 0) and not PersonHasKey(Encounter.Provider, 'PROVIDER') then
begin
if not frmFrame.CCOWDrivedChange then //jdccow
InfoBox(TX_PROV_KEY, TC_PROV_KEY, MB_OK);
Result := False;
end;
end;
function EncounterPresentEDO: Boolean;
begin
Result := True;
if (Encounter.Provider > 0) and not PersonHasKey(Encounter.Provider, 'PROVIDER')
then InfoBox(TX_PROV_KEY, TC_PROV_KEY, MB_OK);
if (Encounter.Provider = 0) or
((Encounter.Provider > 0) and (not PersonHasKey(Encounter.Provider, 'PROVIDER'))) then
begin
UpdateEncounter(NPF_PROVIDER);
frmFrame.DisplayEncounterText;
end;
if (Encounter.Provider = 0) then
begin
InfoBox(TX_PROV_LOC, TC_PROV_LOC, MB_OK or MB_ICONWARNING); {!!!}
Result := False;
end;
if (Encounter.Provider > 0) and not PersonHasKey(Encounter.Provider, 'PROVIDER') then
begin
InfoBox(TX_PROV_KEY, TC_PROV_KEY, MB_OK);
Result := False;
end;
end;
function LockedForOrdering: Boolean;
var
ErrMsg: string;
begin
if uPatientLocked then Result := True else
begin
LockPatient(ErrMsg);
if ErrMsg = '' then
begin
Result := True;
uPatientLocked := True;
frmFrame.stsArea.Panels.Items[4].Text := 'LOCK';
end else
begin
Result := False;
InfoBox(ErrMsg, TC_NO_LOCK, MB_OK);
end;
end;
end;
procedure UnlockIfAble;
begin
if (Changes.Orders.Count = 0) and not uKeepLock then
begin
UnlockPatient;
uPatientLocked := False;
frmFrame.stsArea.Panels.Items[4].Text := '';
end;
end;
function OrderCanBeLocked(OrderID: string): Boolean;
var
ErrMsg: string;
begin
LockOrder(OrderID, ErrMsg);
if ErrMsg = '' then
begin
Result := True;
frmFrame.stsArea.Panels.Items[4].Text := 'LOCK';
end else
begin
Result := False;
InfoBox(ErrMsg, TC_NO_LOCK, MB_OK);
end;
end;
procedure UnlockOrderIfAble(OrderID: string);
begin
UnlockOrder(OrderID);
frmFrame.stsArea.Panels.Items[4].Text := '';
end;
procedure AddSelectedToChanges(AList: TList);
{ update Changes with orders that were created by taking actions }
var
i, CanSign: Integer;
AnOrder: TOrder;
begin
if (Encounter.Provider = User.DUZ) and User.CanSignOrders
then CanSign := CH_SIGN_YES
else CanSign := CH_SIGN_NA;
with AList do for i := 0 to Count - 1 do
begin
AnOrder := TOrder(Items[i]);
with AnOrder do Changes.Add(CH_ORD, ID, Text, '', CanSign);
if (Length(AnOrder.ActionOn) > 0)
and not Changes.ExistForOrder(Piece(AnOrder.ActionOn, ';', 1))
then UnlockOrder(AnOrder.ActionOn);
end;
end;
procedure ResetDialogProperties(const AnID: string; AnEvent: TOrderDelayEvent; var ResolvedDialog: TOrderDialogResolved);
begin
if StrToIntDef(AnID,0)>0 then
Exit;
if XfInToOutNow then
begin
ResolvedDialog.DisplayGroup := OutptDisp;
ResolvedDialog.DialogIEN := MedsOutDlgIen;
ResolvedDialog.FormID := MedsOutDlgFormID;
ResolvedDialog.QuickLevel := 0;
Exit;
end;
//if ResolvedDialog.DisplayGroup in [MedsDisp, OutptDisp, InptDisp, NonVADisp, ClinDisp] then
if (ResolvedDialog.DisplayGroup = InptDisp) or
(ResolvedDialog.DisplayGroup = OutptDisp) or
(ResolvedDialog.DisplayGroup = MedsDisp) or
(ResolvedDialog.DisplayGroup = NonVADisp) or
(ResolvedDialog.DisplayGroup = ClinDisp) then
begin
if (AnEvent.EventType <> 'D') and (AnEvent.EventIFN > 0) then
begin
if (AnEvent.EventType = 'T') and IsPassEvt(AnEvent.PtEventIFN,'T') then
begin
ResolvedDialog.DisplayGroup := OutptDisp;
ResolvedDialog.DialogIEN := MedsOutDlgIen;
ResolvedDialog.FormID := MedsOutDlgFormID;
ResolvedDialog.QuickLevel := 0;
end
else
begin
//AGP changes to handle IMO INV Dialog opening the unit dose dialog.
if (ResolvedDialog.DisplayGroup = ClinDisp) and (Resolveddialog.DialogIEN = MedsIVDlgIEN) and (ResolvedDialog.FormID = MedsIVDlgFormId) then
begin
ResolvedDialog.DisplayGroup := IVDisp;
ResolvedDialog.DialogIEN := MedsIVDlgIen;
ResolvedDialog.FormID := MedsIVDlgFormId;
end
else
begin
ResolvedDialog.DisplayGroup := InptDisp;
ResolvedDialog.DialogIEN := MedsInDlgIen;
ResolvedDialog.FormID := MedsInDlgFormId;
end;
if Length(ResolvedDialog.ShowText)>0 then
ResolvedDialog.QuickLevel := 2;
end;
end
else if (AnEvent.EventType = 'D') and (AnEvent.EventIFN > 0) then
begin
ResolvedDialog.DisplayGroup := OutptDisp;
ResolvedDialog.DialogIEN := MedsOutDlgIen;
ResolvedDialog.FormID := MedsOutDlgFormID;
ResolvedDialog.QuickLevel := 0;
end;
if XferOutToInOnMeds then
begin
ResolvedDialog.DisplayGroup := InptDisp;
ResolvedDialog.DialogIEN := MedsInDlgIen;
ResolvedDialog.FormID := MedsInDlgFormId;
ResolvedDialog.QuickLevel := 0;
end;
end;
if ResolvedDialog.DisplayGroup = IVDisp then
begin
if Length(ResolvedDialog.ShowText)>0 then
ResolvedDialog.QuickLevel := 2;
end;
if (CharAt(AnID,1) = 'C') and (ResolvedDialog.DisplayGroup in [CsltDisp, ProcDisp]) then
ResolvedDialog.QuickLevel := 0; // CSV - force dialog, to validate ICD code being copied into new order {RV}
end;
function IsInvalidActionWarning(const AnOrderText,AnOrderID: String): boolean;
var
AnErrLst, tmpList: TStringList;
begin
Result := False;
AnErrlst := TStringList.Create;
IsLatestAction(AnOrderID,AnErrLst);
if AnErrLst.Count > 0 then
begin
tmpList := TStringList.Create;
PiecesToList(AnsiReplaceStr(AnOrderText,'#D#A','^'),'^',tmpList);
tmpList.Add(' ');
tmpList.Add('Cannot be released to service(s) because of the following happened action(s):');
tmpList.Add(' ');
tmpList.AddStrings(TStrings(AnErrLst));
ReportBox(tmpList,'Cannot be released to service(s)',False);
tmpList.Free;
AnErrLst.Free;
Result := True;
end;
end;
procedure InitialOrderVariables;
begin
InptDisp := DisplayGroupByName('UD RX');
OutptDisp := DisplayGroupByName('O RX');
MedsDisp := DisplayGroupByName('RX');
IVDisp := DisplayGroupByName('IV RX');
ClinDisp := DisplayGroupByName('C RX');
NurDisp := DisplayGroupByName('NURS');
CsltDisp := DisplayGroupByName('CSLT');
ProcDisp := DisplayGroupByName('PROC');
ImgDisp := DisplayGroupByName('XRAY');
NonVADisp := DisplayGroupByName('NV RX');
MedsInDlgIen := DlgIENForName('PSJ OR PAT OE');
MedsOutDlgIen := DlgIENForName('PSO OERR');
MedsNVADlgIen := DlgIENForName('PSH OERR');
MedsIVDlgIen := DlgIENForName('PSJI OR PAT FLUID OE');
MedsInDlgFormId := FormIDForDialog(MedsInDlgIen);
MedsOutDlgFormId := FormIDForDialog(MedsOutDlgIen);
MedsNVADlgFormID := FormIDForDialog(MedsNVADlgIen);
MedsIVDlgFormID := FormIDForDialog(MedsIVDlgIen);
end;
function IsValidActionOnComplexOrder(AnOrderID, AnAction: string;
AListBox: TListBox; var CheckedList: TStringList; var ErrMsg: string; var ParentOrderID: string): boolean; //PSI-COMPLEX
const
COMPLEX_SIGN = 'You have requested to sign a medication order which was entered as part of a complex order.' +
'The following are the orders associated with the same complex order.';
COMPLEX_SIGN1 = ' Do you want to sign all of these orders?';
COMPLEX_DC = 'You have requested to discontinue a medication order which was entered as part of a complex order.' +
' The following are all of the associated orders.';
COMPLEX_DC1 =' Do you want to dicscontinue all of them?';
COMPLEX_HD = 'You have requested to hold a medication order which was entered as part of a complex order.' +
' The following are all of the associated orders.';
COMPLEX_HD1 = ' Do you want to hold all of them?';
COMPLEX_UNHD = 'You have requested to release the hold of a medication order which was entered as part of a complex order.' +
' The following are all of the associated orders.';
COMPLEX_UNHD1 = ' Do you want to release all of them?';
COMPLEX_RENEW = 'You can not take the renew action on a complex medication which has the following associated orders.';
COMPLEX_RENEW1 = ' You must enter a new order.';
COMPLEX_VERIFY ='You have requested to verify a medication order which was entered as part of a complex order.' +
' The following are all of the associated orders.';
COMPLEX_VERIFY1 =' Do you want to verify all of them?';
COMPLEX_OTHER = 'You can not take this action on a complex medication which has the following associated orders.'
+ ' You must enter a new order.';
COMPLEX_CANRENEW1 = 'The selected order for renew: ';
COMPLEX_CANRENEW2 = ' is a part of a complex order.';
COMPLEX_CANRENEW3 = 'The following whole complex order will be renewed.';
var
CurrentActID, POrderTxt, AChildOrderTxt, CplxOrderMsg: string;
ChildList,ChildIdxList,ChildTxtList, CategoryList: TStringList;
ShowCancelButton: boolean;
procedure RetrieveOrderTextPSI(AOrderList: TStringList; var AODTextList, AnIdxList: TStringList;
TheAction: string; AParentID: string = '');
var
ix,jx: integer;
tempid: string;
begin
for ix := 0 to AOrderList.count - 1 do
begin
if AListBox.Name = 'lstOrders' then with AListBox do
begin
for jx := 0 to Items.Count - 1 do
if TOrder(Items.Objects[jx]).ID = AOrderList[ix] then
begin
TOrder(Items.Objects[jx]).ParentID := AParentID;
if CategoryList.IndexOf(TheAction)>-1 then
Selected[jx] := True;
AODTextList.Add(TOrder(Items.Objects[jx]).ID + '^' + TOrder(Items.Objects[jx]).Text);
if AnIdxList.IndexOf(IntToStr(jx)) > -1 then
continue;
AnIdxList.Add(IntToStr(jx));
end;
end
else if (AListBox.Name = 'lstMedsOut' ) or (AListBox.Name = 'lstMedsIn')
or (AListBox.Name = 'lstMedsNonVA') then with AListBox do
begin
for jx := 0 to Items.Count - 1 do
begin
tempid := TMedListRec(AListBox.Items.Objects[jx]).OrderID;
if tempid = AOrderList[ix] then
begin
if CategoryList.IndexOf(TheAction)>-1 then
Selected[jx] := True;
AODTextList.Add(tempid + '^' + Items[jx]);
AnIdxList.Add(IntToStr(jx));
end;
end;
end;
end;
end;
procedure DeselectChild(AnIdxList: TStringList);
var
dix: integer;
begin
for dix := 0 to AnIdxList.Count - 1 do
begin
try
if StrToInt(AnIdxList[dix]) < AListBox.Items.Count then
AListBox.Selected[StrToInt(AnIdxList[dix])] := False;
except
// do nothing
end;
end;
end;
function MakeMessage(ErrMsg1,ErrMsg2,ErrMsg3: string): string;
begin
if Length(ErrMsg1)>0 then
Result := ErrMsg1 + ErrMsg2
else
Result := ErrMsg2 + ErrMsg3;
end;
begin
Result := True;
if AnAction = OA_COPY then Exit;
CurrentActID := Piece(AnOrderID,';',2);
CplxOrderMsg := '';
CategoryList := TStringList.Create;
CategoryList.Add('DC');
CategoryList.Add('HD');
CategoryList.Add('RL');
CategoryList.Add('VR');
CategoryList.Add('ES');
ShowCancelButton := False;
if Length(ErrMsg)>0 then ErrMsg := ErrMsg + #13#13;
ValidateComplexOrderAct(AnOrderID,CplxOrderMsg);
if Pos('COMPLEX-PSI',CplxOrderMsg)>0 then
begin
ParentOrderID := Piece(CplxOrderMsg,'^',2);
if CheckedList.IndexOf(ParentOrderID) >= 0 then
begin
ErrMsg := '';
Exit;
end;
if CheckedList.Count = 0 then
CheckedList.Add(ParentOrderID)
else
begin
if CheckedList.IndexOf(ParentOrderID) < 0 then
CheckedList.Add(ParentOrderID);
end;
ChildList := TStringList.Create;
GetChildrenOfComplexOrder(ParentOrderID,CurrentActID,ChildList);
ChildtxtList := TStringList.Create;
ChildIdxList := TStringList.Create;
RetrieveOrderTextPSI(ChildList,ChildtxtList,ChildIdxList,AnAction,ParentOrderID);
if ChildtxtList.Count > 0 then
begin
if (AnAction = 'RN') or (AnAction = 'EV') then
begin
if not IsValidSchedule(ParentOrderID) then
begin
POrderTxt := RetrieveOrderText(ParentOrderID);
if CharAt(POrderTxt,1)='+' then
POrderTxt := Copy(POrderTxt,2,Length(POrderTxt));
if Pos('First Dose NOW',POrderTxt)>1 then
Delete(POrderTxt, Pos('First Dose NOW',POrderTxt), Length('First Dose Now'));
InfoBox('Invalid schedule!' + #13#13 + 'The selected order is a part of a complex order:' + #13
+ POrderTxt + #13#13 + ' It contains an invalid schedule.',
'Warning', MB_OK or MB_ICONWARNING);
DeselectChild(ChildIdxList);
Result := False;
ErrMsg := '';
ChildtxtList.Free;
ChildList.Clear;
ChildList.Free;
CategoryList.Clear;
Exit;
end;
end;
if AnAction = OA_DC then
begin
if not ActionOnComplexOrder(ChildtxtList,MakeMessage(ErrMsg,COMPLEX_DC,COMPLEX_DC1),True) then
begin
DeselectChild(ChildIdxList);
Result := False;
end;
end
else if AnAction = OA_SIGN then
begin
if not ActionOnComplexOrder(ChildtxtList,MakeMessage(ErrMsg,COMPLEX_SIGN,COMPLEX_SIGN1),True) then
begin
DeselectChild(ChildIdxList);
Result := False;
end;
end
else if AnAction = OA_HOLD then
begin
if Length(ErrMsg) < 1 then ShowCancelButton := True;
if not ActionOnComplexOrder(ChildtxtList,MakeMessage(ErrMsg,COMPLEX_HD,COMPLEX_HD1),ShowCancelButton) then
begin
DeselectChild(ChildIdxList);
Result := False;
end;
end
else if AnAction = OA_UNHOLD then
begin
if Length(ErrMsg) < 1 then ShowCancelButton := True;
if not ActionOnComplexOrder(ChildtxtList,MakeMessage(ErrMsg,COMPLEX_UNHD,COMPLEX_UNHD1),ShowCancelButton) then
begin
DeselectChild(ChildIdxList);
Result := False;
end;
end
else if AnAction = OA_VERIFY then
begin
if Length(ErrMsg) < 1 then ShowCancelButton := True;
if not ActionOnComplexOrder(ChildtxtList,MakeMessage(ErrMsg,COMPLEX_VERIFY,COMPLEX_VERIFY1),ShowCancelButton) then
begin
DeselectChild(ChildIdxList);
Result := False;
end;
end
else if AnAction = OA_RENEW then
begin
if not IsRenewableComplexOrder(ParentOrderID) then
begin
if not ActionOnComplexOrder(ChildtxtList,MakeMessage(ErrMsg,COMPLEX_RENEW,COMPLEX_RENEW1),False) then
begin
DeselectChild(ChildIdxList);
Result := False;
end;
end
else
begin
POrderTxt := RetrieveOrderText(ParentOrderID);
if CharAt(POrderTxt,1)='+' then
POrderTxt := Copy(POrderTxt,2,Length(POrderTxt));
if Pos('First Dose NOW',POrderTxt)>1 then
Delete(POrderTxt, Pos('First Dose NOW',POrderTxt), Length('First Dose Now'));
AChildOrderTxt := RetrieveOrderText(AnOrderID);
if InfoBox(COMPLEX_CANRENEW1 + #13 + AChildOrderTxt
+ COMPLEX_CANRENEW2 + #13#13
+ COMPLEX_CANRENEW3 + #13 + POrderTxt,
'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDOK then
begin
if AListBox.Name = 'lstOrders' then
frmOrders.ParentComplexOrderID := ParentOrderID;
if (AListBox.Name = 'lstMedsOut' ) or (AListBox.Name = 'lstMedsIn') then
frmMeds.ParentComplexOrderID := ParentOrderID;
end;
DeselectChild(ChildIdxList);
end;
end;
end;
ErrMsg := '';
ChildtxtList.Free;
ChildList.Clear;
ChildList.Free;
end;
CategoryList.Clear;
end;
{ Write New Orders }
function ActivateAction(const AnID: string; AnOwner: TComponent; ARefNum: Integer): Boolean;
// AnID: DlgIEN {;FormID;DGroup}
type
TDialogClass = class of TfrmOMAction;
var
DialogClass: TDialogClass;
AFormID: Integer;
begin
Result := False;
AFormID := FormIDForDialog(StrToIntDef(Piece(AnID, ';', 1), 0));
if AFormID > 0 then
begin
case AFormID of
OM_ALLERGY: if ARTPatchInstalled then
DialogClass := TfrmARTAllergy
else
begin
Result := False;
Exit;
end;
OM_HTML: DialogClass := TfrmOMHTML;
999999: DialogClass := TfrmOMAction; // for testing!!!
else
Exit;
end;
if AnOwner = nil then AnOwner := Application;
uOrderAction := DialogClass.Create(AnOwner);
if (uOrderAction <> nil) (*and (not uOrderAction.AbortAction) *)then
begin
uOrderAction.CallOnExit := DestroyingOrderAction;
uOrderAction.RefNum := ARefNum;
uOrderAction.OrderDialog := StrToIntDef(Piece(AnID, ';', 1), 0);
Result := True;
if (not uOrderAction.AbortAction) then uOrderAction.ShowModal;
end;
end else
begin
//ShowMessage('Order Dialogs of type "Action" are available in List Manager only.');
Result := False;
end;
end;
function ActivateOrderDialog(const AnID: string; AnEvent: TOrderDelayEvent;
AnOwner: TComponent; ARefNum: Integer; ANeedVerify: boolean = True): Boolean;
const
TX_NO_DEA = 'Provider must have a DEA# or VA# to change this order';
TC_NO_DEA = 'DEA# Required';
TC_IMO_ERROR = 'Inpatient medication order on outpatient authorization required';
var
ResolvedDialog: TOrderDialogResolved;
x, EditedOrder, chkCopay, OrderID, PkgInfo,OrderPtEvtID,OrderEvtID,NssErr: string;
ODItem: integer;
IsInpatient, IsAnIMOOrder: boolean;
IsPsoSupply,IsDischargeOrPass,IsPharmacyOrder,IsConsultOrder,ForIMO: boolean;
tmpResp: TResponse;
begin
IsPsoSupply := False;
Result := False;
IsDischargeOrPass := False;
IsAnIMOOrder := False;
ForIMO := False;
// double check environment before continuing with order
if uOrderDialog <> nil then uOrderDialog.Close; // then x := uOrderDialog.Name else x := '';
//if ShowMsgOn(uOrderDialog <> nil, TX_DLG_ERR + CRLF + x, TC_DLG_ERR) then Exit;
if CharAt(AnID, 1) = 'X' then
begin
ValidateOrderAction(Copy(AnID, 2, Length(AnID)), OA_CHANGE, x);
if ( Length(x)<1 ) and not (AnEvent.EventIFN > 0) then
ValidateComplexOrderAct(Copy(AnID, 2, Length(AnID)),x);
if (Pos('COMPLEX-PSI',x)>0) then
x := TX_COMPLEX;
if Length(x) > 0 then
x := RetrieveOrderText(Copy(AnID, 2, Length(AnID))) + #13#10 + x;
if ShowMsgOn(Length(x) > 0, x, TC_NO_CHANGE) then Exit;
end;
if CharAt(AnID, 1) = 'C' then
begin
ValidateOrderAction(Copy(AnID, 2, Length(AnID)), OA_COPY, x);
if Length(x) > 0 then
x := RetrieveOrderText(Copy(AnID, 2, Length(AnID))) + #13#10 + x;
if ShowMsgOn(Length(x) > 0, x, TC_NO_COPY) then Exit;
end;
if CharAt(AnID, 1) = 'T' then
begin
ValidateOrderAction(Copy(AnID, 2, Length(AnID)), OA_TRANSFER, x);
if Length(x) > 0 then
x := RetrieveOrderText(Copy(AnID, 2, Length(AnID))) + #13#10 + x;
if ShowMsgOn(Length(x) > 0, x, TC_NO_XFER) then Exit;
end;
if not IMOActionValidation(AnID, IsAnIMOOrder, x, AnEvent.EventType) then
begin
ShowMsgOn(Length(x) > 0, x, TC_IMO_ERROR);
Exit;
end;
if ( (StrToIntDef(AnId,0)>0) and (AnEvent.EventIFN <= 0) ) then
ForIMO := IsIMODialog(StrToInt(AnId))
else if ( (IsAnIMOOrder) and (AnEvent.EventIFN <= 0) ) then
ForIMO := True;
OrderPtEvtID := GetOrderPtEvtID(Copy(AnID, 2, Length(AnID)));
OrderEvtID := Piece(EventInfo(OrderPtEvtID),'^',2);
// evaluate order dialog, build response list & see what form should be presented
FillChar(ResolvedDialog, SizeOf(ResolvedDialog), #0);
ResolvedDialog.InputID := AnID;
BuildResponses(ResolvedDialog, GetKeyVars, AnEvent, ForIMO);
if (ForIMO and ( (ResolvedDialog.DialogIEN = MedsInDlgIen)
or (ResolvedDialog.DialogIEN = MedsIVDlgIen)) ) then
ResolvedDialog.DisplayGroup := ClinDisp;
ResetDialogProperties(AnID, AnEvent, ResolvedDialog);
{* AGP CHANGE 26.20 Remove restriction to allowed for ordering of inpatient medication for an inpatient from an outpatient location
//jd imo change
if (ResolvedDialog.DisplayGroup = InptDisp) and (Patient.Inpatient) and (AnEvent.EventIFN < 1) then
begin
if IsClinicLoc(Encounter.Location) then
begin
MessageDlg(TX_NOINPT, mtWarning, [mbOK], 0);
Exit;
end;
end;
//jd imo change end *}
if (ResolvedDialog.DisplayGroup = InptDisp) or
(ResolvedDialog.DisplayGroup = OutptDisp) or
(ResolvedDialog.DisplayGroup = MedsDisp) or
(ResolvedDialog.DisplayGroup = IVDisp) or
(ResolvedDialog.DisplayGroup = NonVADisp) or
(ResolvedDialog.DisplayGroup = ClinDisp) then IsPharmacyOrder := True
else
IsPharmacyOrder := False;
(* IsPharmacyOrder := ResolvedDialog.DisplayGroup in [InptDisp, OutptDisp,
MedsDisp,IVDisp, NonVADisp, ClinDisp];*) //v25.27 range check error - RV
IsConsultOrder := ResolvedDialog.DisplayGroup in [CsltDisp,ProcDisp];
if (uAutoAC) and (not (ResolvedDialog.QuickLevel in [QL_REJECT,QL_CANCEL]))
and (not IsPharmacyOrder) and (not IsConsultOrder) then
ResolvedDialog.QuickLevel := QL_AUTO;
if (ResolvedDialog.DialogType = 'Q')
and (ResolvedDialog.DisplayGroup = InptDisp) then
begin
NssErr := IsValidQOSch(ResolvedDialog.InputID);
if (Length(NssErr) > 1) then
begin
if (NssErr <> 'OTHER') then
ShowMessage('The order contains invalid non-standard schedule.');
NSSchedule := True;
ResolvedDialog.QuickLevel := 0;
end;
end;
if ResolvedDialog.DisplayGroup = InptDisp then //nss
begin
if (CharAt(AnID, 1) = 'C') or (CharAt(AnID, 1) = 'T') or (CharAt(AnID, 1) = 'X') then
begin
if not IsValidSchedule(Copy(AnID, 2, Length(AnID))) then
begin
ShowMessage('The order contains invalid non-standard schedule.');
NSSchedule := True;
end;
end;
if NSSchedule then ResolvedDialog.QuickLevel := 0;
end;
with ResolvedDialog do if (QuickLevel = QL_VERIFY) and (HasTemplateField(ShowText)) then QuickLevel := QL_DIALOG;
with ResolvedDialog do
begin
if QuickLevel = QL_REJECT then InfoBox(ShowText, TC_DLG_REJECT, MB_OK);
if (QuickLevel = QL_VERIFY) and (IsPharmacyOrder or ANeedVerify) then ShowVerifyText(QuickLevel, ShowText, DisplayGroup=InptDisp);
if QuickLevel = QL_AUTO then FormID := OD_AUTOACK;
if (QuickLevel = QL_REJECT) or (QuickLevel = QL_CANCEL) then Exit;
PushKeyVars(ResolvedDialog.QOKeyVars);
end;
if ShowMsgOn(not (ResolvedDialog.FormID > 0), TX_NOFORM, TC_NOFORM) then Exit;
with ResolvedDialog do if DialogType = 'X' then
begin
EditedOrder := Copy(Piece(ResponseID, '-', 1), 2, Length(ResponseID));
end
else EditedOrder := '';
if XfInToOutNow then
begin
//if Transfer an order to outpatient and release immediately
// then changing the Eventtype to 'C' instead of 'D'
IsDischargeOrPass := True;
AnEvent.EventType := 'C';
AnEvent.Effective := 0;
end;
uOrderDialog := CreateOrderDialog(AnOwner, ResolvedDialog.FormID, AnEvent, StrToIntDef(OrderEvtID,0));
uOrderDialog.IsSupply := IsPsoSupply;
{For copy, change, transfer actions on an None-IMO order, the new order should not be treated as IMO order
although the IMO criteria could be met. }
//if (uOrderDialog.IsIMO) and (CharAt(AnID, 1) in ['X','C','T']) then
if not uOrderDialog.IsIMO then
uOrderDialog.IsIMO := ForIMO;
if (ResolvedDialog.DialogType = 'Q') and (ResolvedDialog.DisplayGroup in [MedsDisp, OutptDisp, InptDisp]) then
begin
if DoesOIPIInSigForQO(StrToInt(ResolvedDialog.InputID))=1 then
uOrderDialog.IncludeOIPI := True
else
uOrderDialog.IncludeOIPI := False;
end;
if (uOrderDialog <> nil) and not uOrderDialog.Closing then with uOrderDialog do
begin
SetKeyVariables(GetKeyVars);
if IsDischargeOrPass then
EvtForPassDischarge := 'D'
else
EvtForPassDischarge := #0;
Responses.SetEventDelay(AnEvent);
Responses.LogTime := uOrderSetTime;
DisplayGroup := ResolvedDialog.DisplayGroup; // used to pass ORTO
DialogIEN := ResolvedDialog.DialogIEN; // used to pass ORIT
RefNum := ARefNum;
case ResolvedDialog.DialogType of
'C': SetupDialog(ORDER_COPY, ResolvedDialog.ResponseID);
'D': SetupDialog(ORDER_NEW, '');
'X':
begin
SetupDialog(ORDER_EDIT, ResolvedDialog.ResponseID);
OrderID := Copy(ResolvedDialog.ResponseID,2,Length(ResolvedDialog.ResponseID));
IsInpatient := OrderForInpatient;
ODItem := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0);
PkgInfo := '';
if Length(OrderID)>0 then
PkgInfo := GetPackageByOrderID(OrderID);
if Pos('PS',PkgInfo)=1 then
begin
if DEACheckFailed(ODItem, IsInPatient) and (uOrderDialog.FillerID <> 'PSH') then
begin
InfoBox(TX_NO_DEA + #13 + Responses.OrderText, TC_NO_DEA, MB_OK);
if (ResolvedDialog.DialogType = 'X') and not Changes.ExistForOrder(EditedOrder)
then UnlockOrder(EditedOrder);
uOrderDialog.Close;
Exit;
end;
end;
end;
'Q':
begin
if IsPSOSupplyDlg(ResolvedDialog.DialogIEN,1) then
uOrderDialog.IsSupply := True;
SetupDialog(ORDER_QUICK, ResolvedDialog.ResponseID);
end;
end;
if Assigned(uOrderDialog) then
with uOrderDialog do if AbortOrder then
begin
Close;
Exit;
end;
if CharAt(AnID, 1) = 'T' then
begin
if ARefNum = -2 then
Responses.TransferOrder := '';
if ARefNum = -1 then
Responses.TransferOrder := AnID;
end;
if CharAt(AnID,1) = 'C' then ////////////////////////////////////////////////////////////////////////
begin
chkCopay := Copy(AnID,2,length(AnID)); //STRIP prepended C, T, or X from first position in order ID.
SetDefaultCoPay(chkCopay);
end; ////////////////////////////////////////////////////////////////////////'
if IsConsultOrder and (CharAt(AnID,1) = 'C') then
begin
tmpResp := uOrderDialog.Responses.FindResponseByName('CODE', 1);
if (tmpResp <> nil) then
begin
if IsActiveICDCode(tmpResp.EValue) then
ResolvedDialog.QuickLevel := QL_AUTO
else
ResolvedDialog.QuickLevel := QL_DIALOG;
end
else
ResolvedDialog.QuickLevel := QL_AUTO
end;
if ResolvedDialog.QuickLevel <> QL_AUTO then
begin
if CharAt(AnID, 1) in ['C','T','X'] then
begin
Position := poScreenCenter;
FormStyle := fsNormal;
ShowModal;
Result := uOrderDialog.AcceptOK;
end
else
begin
SetBounds(frmFrame.Left + 112, frmFrame.Top + frmFrame.Height - Height, Width, Height);
SetFormPosition(uOrderDialog);
FormStyle := fsStayOnTop;
if frmOrders.NeedShowModal then
begin
ShowModal;
Result := uOrderDialog.AcceptOK;
uOrderDialog.Destroy;
end
else
begin
Show;
Result := True;
end;
end;
end
else
begin
cmdAcceptClick(Application); // auto-accept order
Result := uOrderDialog.AcceptOK;
//BAPHII 1.3.2
//showmessage('DEBUG: About to copy BA CI''s to copied order from Order: '+AnID+'#13'+' in uOrders.ActivateOrderDialog()');
//End BAPHII 1.3.2
if Assigned(uOrderDialog) then
uOrderDialog.Destroy;
end;
end
else
begin
uOrderDialog.Release;
Result := False;
//Application.ProcessMessages; // to allow dialog to finish closing
//Exit; // so result is not returned true
end;
if NSSchedule then
NSSchedule := False;
if (ResolvedDialog.DialogType = 'X') and not Changes.ExistForOrder(EditedOrder)
then UnlockOrder(EditedOrder);
end;
function RetrieveOrderText(AnOrderID: string): string;
var
OrdList: TList;
theOrder: TOrder;
// i: integer;
begin
// if Assigned(OrdList) then
// begin
// for i := 0 to pred(OrdList.Count) do
// TObject(OrdList[i]).Free;
// UBAGlobals.tempDxList := nil;
// end;
OrdList := TList.Create;
theOrder := TOrder.Create;
theOrder.ID := AnOrderID;
OrdList.Add(theOrder);
RetrieveOrderFields(OrdList, 0, 0);
Result := TOrder(OrdList.Items[0]).Text;
if Assigned(OrdList) then OrdList.Free; //CQ:7554
end;
function ActivateOrderHTML(const AnID: string; AnEvent: TOrderDelayEvent;
AnOwner: TComponent; ARefNum: Integer): Boolean;
var
DialogIEN: Integer;
x: string;
ASetList: TStringList;
begin
Result := False;
DialogIEN := StrToIntDef(AnID, 0);
x := OrderDisabledMessage(DialogIEN);
if ShowMsgOn(Length(x) > 0, x, TC_DISABLED) then Exit;
if uOrderHTML = nil then
begin
uOrderHTML := TfrmOMHTML.Create(AnOwner);
with uOrderHTML do
begin
SetBounds(frmFrame.Left + 112, frmFrame.Top + frmFrame.Height - Height, Width, Height);
SetFormPosition(uOrderHTML);
FormStyle := fsStayOnTop;
SetEventDelay(AnEvent);
end;
end;
uOrderHTML.Dialog := DialogIEN;
uOrderHTML.RefNum := ARefNum;
uOrderHTML.OwnedBy := AnOwner;
uOrderHTML.ShowModal;
ASetList := TStringList.Create;
ASetList.Assign(uOrderHTML.SetList);
uOrderHTML.Release;
if ASetList.Count = 0 then Exit;
Result := ActivateOrderList(ASetList, AnEvent, AnOwner, ARefNum, '', '');
end;
function ActivateOrderMenu(const AnID: string; AnEvent: TOrderDelayEvent;
AnOwner: TComponent; ARefNum: Integer): Boolean;
var
MenuIEN: Integer;
x: string;
begin
Result := False;
MenuIEN := StrToIntDef(AnID, 0);
x := OrderDisabledMessage(MenuIEN);
if ShowMsgOn(Length(x) > 0, x, TC_DISABLED) then Exit;
if uOrderMenu = nil then
begin
uOrderMenu := TfrmOMNavA.Create(AnOwner);
with uOrderMenu do
begin
SetBounds(frmFrame.Left + 112, frmFrame.Top + frmFrame.Height - Height, Width, Height);
SetFormPosition(uOrderMenu);
FormStyle := fsStayOnTop;
SetEventDelay(AnEvent);
end;
end;
uOrderMenu.SetNewMenu(MenuIEN, AnOwner, ARefNum);
if not uOrderMenu.Showing then uOrderMenu.Show else uOrderMenu.BringToFront;
Result := True;
end;
function ActivateOrderSet(const AnID: string; AnEvent: TOrderDelayEvent;
AnOwner: TComponent; ARefNum: Integer): Boolean;
var
x, ACaption, KeyVarStr: string;
SetList: TStringList;
EvtDefaultDlg, PtEvtID: string;
function TakeoutDuplicateDlg(var AdlgList: TStringList; ANeedle: string): boolean;
var
i: integer;
begin
Result := False;
for i := 0 to AdlgList.Count - 1 do
begin
if Piece(AdlgList[i],'^',1)=ANeedle then
begin
ADlgList.Delete(i);
Result := True;
Break;
end;
end;
end;
begin
Result := False;
x := OrderDisabledMessage(StrToIntDef(AnID, 0));
if ShowMsgOn(Length(x) > 0, x, TC_DISABLED) then Exit;
SetList := TStringList.Create;
try
if uOrderSetTime = 0 then uOrderSetTime := FMNow;
LoadOrderSet(SetList, StrToIntDef(AnID, 0), KeyVarStr, ACaption);
if (AnEvent.EventIFN>0) and isExistedEvent(Patient.DFN, IntToStr(AnEvent.EventIFN), PtEvtID) then
begin
EvtDefaultDlg := GetEventDefaultDlg(AnEvent.EventIFN);
while TakeoutDuplicateDlg(SetList,EvtDefaultDlg) do
TakeoutDuplicateDlg(SetList,EvtDefaultDlg);
end;
Result := ActivateOrderList(SetList, AnEvent, AnOwner, ARefNum, KeyVarStr, ACaption);
finally
SetList.Free;
end;
end;
function ActivateOrderList(AList: TStringList; AnEvent: TOrderDelayEvent;
AnOwner: TComponent; ARefNum: Integer; const KeyVarStr, ACaption: string): Boolean;
var
InitialCall: Boolean;
begin
InitialCall := False;
if uOrderSet = nil then
begin
uOrderSet := TfrmOMSet.Create(AnOwner);
uOrderSet.SetEventDelay(AnEvent);
uOrderSet.RefNum := ARefNum;
InitialCall := True;
end;
if InitialCall then with uOrderSet do
begin
if Length(ACaption) > 0 then Caption := ACaption;
SetBounds(frmFrame.Left, frmFrame.Top + frmFrame.Height - Height, Width, Height);
SetFormPosition(uOrderSet);
Show;
end;
uOrderSet.InsertList(AList, AnOwner, ARefNum, KeyVarStr, AnEvent.EventType);
Application.ProcessMessages;
Result := uOrderSet <> nil;
end;
function ActiveOrdering: Boolean;
begin
if (uOrderDialog = nil) and (uOrderMenu = nil) and (uOrderSet = nil) and
(uOrderAction = nil) and (uOrderHTML = nil)
then Result := False
else Result := True;
end;
function CloseOrdering: Boolean;
begin
Result := False;
{ if an order set is being processed, see if want to interupt }
if uOrderSet <> nil then
begin
uOrderSet.Close;
Application.ProcessMessages;
if uOrderSet <> nil then Exit;
end;
{ if another ordering dialog is showing, make sure it is closed first }
if uOrderDialog <> nil then
begin
uOrderDialog.Close;
Application.ProcessMessages; // allow close to finish
if uOrderDialog <> nil then Exit;
end;
if uOrderHTML <> nil then
begin
uOrderHTML.Close;
Application.ProcessMessages; // allow browser to close
Assert(uOrderHTML = nil);
end;
{ close any open ordering menu }
if uOrderMenu <> nil then
begin
uOrderMenu.Close;
Application.ProcessMessages; // allow menu to close
Assert(uOrderMenu = nil);
end;
if uOrderAction <> nil then
begin
uOrderAction.Close;
Application.ProcessMessages;
if uOrderAction <> nil then Exit;
end;
Result := True;
end;
function ReadyForNewOrder(AnEvent: TOrderDelayEvent): Boolean;
var
x,tmpPtEvt: string;
begin
Result := False;
{ make sure a location and provider are selected before ordering }
if not AuthorizedUser then Exit;
if (not Patient.Inpatient) and (AnEvent.EventIFN > 0 ) then x := ''
else
begin
if not EncounterPresent then Exit;
end;
{ then try to lock the patient (provider & encounter checked first to not leave lock) }
if not LockedForOrdering then Exit;
{ make sure any current ordering process has completed, but don't drop patient lock }
uKeepLock := True;
if not CloseOrdering then Exit;
uKeepLock := False;
{ get the delay event for this order (if applicable) }
if AnEvent.EventType in ['A','D','T','M','O'] then
begin
if (AnEvent.EventName = '') and (AnEvent.EventType <> 'D') then
Exit;
x := AnEvent.EventType + IntToStr(AnEvent.Specialty);
if (uLastConfirm <> x ) and (not XfInToOutNow) then
begin
uLastConfirm := x;
case AnEvent.EventType of
'A','M','O','T': x := AnEvent.EventName;
'D': x := 'Discharge';
end;
if isExistedEvent(Patient.DFN,IntToStr(AnEvent.EventIFN),tmpPtEvt) then
if PtEvtEmpty(tmpPtEvt)then
InfoBox(TX_DELAY + x + TX_DELAY1, TC_DELAY, MB_OK or MB_ICONWARNING);
end;
end
else uLastConfirm := '';
Result := True;
end;
function ReadyForNewOrder1(AnEvent: TOrderDelayEvent): Boolean;
var
x: string;
begin
Result := False;
{ make sure a location and provider are selected before ordering }
if not AuthorizedUser then Exit;
if (not Patient.Inpatient) and (AnEvent.EventIFN > 0 ) then x := ''
else
begin
if not EncounterPresent then Exit;
end;
{ then try to lock the patient (provider & encounter checked first to not leave lock) }
if not LockedForOrdering then Exit;
{ make sure any current ordering process has completed, but don't drop patient lock }
uKeepLock := True;
if not CloseOrdering then Exit;
uKeepLock := False;
{ get the delay event for this order (if applicable) }
if AnEvent.EventType in ['A','D','T','M','O'] then
begin
x := AnEvent.EventType + IntToStr(AnEvent.Specialty);
if (uLastConfirm <> x ) and (not XfInToOutNow) then
begin
uLastConfirm := x;
case AnEvent.EventType of
'A','M','T','O': x := AnEvent.EventName;
'D': x := AnEvent.EventName; //'D': x := 'Discharge';
end;
end;
end
else uLastConfirm := '';
Result := True;
end;
procedure SetConfirmEventDelay;
begin
uLastConfirm := '';
end;
procedure ChangeOrders(AList: TStringList; AnEvent: TOrderDelayEvent);
var
i,txtOrder: Integer;
FieldsForEditRenewOrder: TOrderRenewFields;
param1, param2 : string;
OrSts: integer;
AnOrder: TOrder;
begin
if uOrderDialog <> nil then
begin
uOrderDialog.Close;
Application.ProcessMessages; // allow close to finish
end;
if not ActiveOrdering then // allow change while entering new
if not ReadyForNewOrder(AnEvent) then Exit;
for i := 0 to AList.Count - 1 do
begin
//if it's for unreleased renewed orders, then go to fODChangeUnreleasedRenew and continue
txtOrder := 0;
FieldsForEditRenewOrder := TOrderRenewFields.Create;
LoadRenewFields(FieldsForEditRenewOrder, AList[i]);
if FieldsForEditRenewOrder.BaseType = OD_TEXTONLY then
txtOrder := 1;
if CanEditSuchRenewedOrder(AList[i], txtOrder) then
begin
param1 := '0';
if txtOrder = 0 then
begin
param1 := IntToStr(FieldsForEditRenewOrder.Refills);
param2 := FieldsForEditRenewOrder.Pickup;
end else if txtOrder = 1 then
begin
param1 := FieldsForEditRenewOrder.StartTime;
param2 := FieldsForEditRenewOrder.StopTime;
end;
UBAGlobals.SourceOrderID := AList[i]; //hds6265 added
ExecuteChangeRenewedOrder(AList[i], param1, param2, txtOrder);
AnOrder := TOrder.Create;
SaveChangesOnRenewOrder(AnOrder, AList[i], param1, param2, txtOrder);
AnOrder.ActionOn := AnOrder.ID + '=RN';
SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_ACT, Integer(AnOrder));
Application.ProcessMessages;
Continue;
end else FieldsForEditRenewOrder.Free;
OrSts := GetOrderStatus(AList[i]);
if ( AnsiCompareText(NameOfStatus(OrSts),'active') = 0 ) and (AnEvent.PtEventIFN > 0) then
EventDefaultOD := 1;
ActivateOrderDialog('X' + AList[i], AnEvent, Application, -1); // X + ORIFN for change
if EventDefaultOD = 1 then
EventDefaultOD := 0;
Application.ProcessMessages; // give uOrderDialog a chance to go back to nil
if BILLING_AWARE then //hds6265
begin //hds6265
UBAGlobals.SourceOrderID := AList[i]; //hds6265
UBAGlobals.CopyTreatmentFactorsDxsToCopiedOrder(UBAGlobals.SourceOrderID,UBAGLobals.TargetOrderID); //hds6265
end;
end;
UnlockIfAble;
end;
function ChangeOrdersEvt(AnOrderID: string; AnEvent: TOrderDelayEvent): boolean;
begin
Result := False;
if uOrderDialog <> nil then
begin
uOrderDialog.Close;
Application.ProcessMessages;
end;
if not ActiveOrdering then
if not ReadyForNewOrder(AnEvent) then Exit;
Result := ActivateOrderDialog('X' + AnOrderID, AnEvent, Application, -1);
Application.ProcessMessages;
UnlockIfAble;
end;
function CopyOrders(AList: TStringList; AnEvent: TOrderDelayEvent; var DoesEventOccur: boolean; ANeedVerify: boolean = True): boolean;
var
i: Integer;
xx: string;
IsIMOOD,ForIVAlso: boolean;
begin
Result := False;
if not ReadyForNewOrder(AnEvent) then Exit; // no copy while entering new
for i := 0 to AList.Count - 1 do
begin
if (not DoesEventOccur) and (AnEvent.PtEventIFN>0) and IsCompletedPtEvt(AnEvent.PtEventIFN) then
begin
DoesEventOccur := True;
AnEvent.EventType := #0;
AnEvent.TheParent := TParentEvent.Create;
AnEvent.EventIFN := 0;
AnEvent.EventName := '';
AnEvent.PtEventIFN := 0;
end;
if CheckOrderGroup(AList[i])=1 then IsUDGroup := True
else IsUDGroup := False;
if (AnEvent.EventIFN>0) and isOnholdMedOrder(AList[i]) then
begin
xx := RetrieveOrderText(AList[i]);
if InfoBox(TX_ONHOLD+#13#13+xx, 'Warning', MB_YESNO or MB_ICONWARNING) = IDNO then
Continue;
end;
DEASig := GetDrugSchedule(AList[i]);
ForIVAlso := ForIVandUD(AList[i]);
IsIMOOD := IsIMOOrder(AList[i]);
if (IsUDGroup) and (ImmdCopyAct) and (not Patient.Inpatient) and (AnEvent.EventType = 'C') and (not IsIMOOD) and (not ForIVAlso) then
XfInToOutNow := True;
OrderSource := 'C';
if ActivateOrderDialog('C' + AList[i], AnEvent, Application, -1, ANeedVerify) then
Result := True;
Application.ProcessMessages; // give uOrderDialog a chance to go back to nil
OrderSource := '';
if (not DoesEventOccur) and (AnEvent.PtEventIFN>0) and IsCompletedPtEvt(AnEvent.PtEventIFN) then
DoesEventOccur := True;
if IsUDGroup then IsUDGroup := False;
if XfInToOutNOw then XfInToOutNow := False;
if BILLING_AWARE then
begin
UBAGlobals.SourceOrderID := AList[i]; //BAPHII 1.3.2
UBAGlobals.CopyTreatmentFactorsDxsToCopiedOrder(UBAGlobals.SourceOrderID,UBAGLobals.TargetOrderID);
end;
end; //for
UnlockIfAble;
end;
function TransferOrders(AList: TStringList; AnEvent: TOrderDelayEvent; var DoesEventOccur: boolean; ANeedVerify: boolean = True): boolean;
var
i, CountOfTfOrders: Integer;
xx: string;
//DoesEventOccur: boolean;
//OccuredEvtID: integer;
//OccuredEvtName: string;
begin
//DoesEventOccur := False;
//OccuredEvtID := 0;
Result := False;
if not ReadyForNewOrder(AnEvent) then Exit; // no xfer while entering new
CountOfTfOrders := AList.Count;
for i := 0 to CountOfTfOrders - 1 do
begin
if (not DoesEventOccur) and (AnEvent.PtEventIFN>0) and IsCompletedPtEvt(AnEvent.PtEventIFN) then
begin
DoesEventOccur := True;
//OccuredEvtID := AnEvent.PtEventIFN;
//OccuredEvtName := AnEvent.EventName;
AnEvent.EventType := #0;
AnEvent.TheParent := TParentEvent.Create;
AnEvent.EventIFN := 0;
AnEvent.EventName := '';
AnEvent.PtEventIFN := 0;
end;
if i = CountOfTfOrders - 1 then
begin
if (AnEvent.EventIFN>0) and isOnholdMedOrder(AList[i]) then
begin
xx := RetrieveOrderText(AList[i]);
if InfoBox(TX_ONHOLD+#13#13+xx, 'Warning', MB_YESNO or MB_ICONWARNING) = IDNO then
Continue;
end;
OrderSource := 'X';
if ActivateOrderDialog('T' + AList[i], AnEvent, Application, -2, ANeedVerify) then
Result := True;
end else
begin
if (AnEvent.EventIFN>0) and isOnholdMedOrder(AList[i]) then
begin
xx := RetrieveOrderText(AList[i]);
if InfoBox(TX_ONHOLD+#13#13+xx, 'Warning', MB_YESNO or MB_ICONWARNING) = IDNO then
Continue;
end;
OrderSource := 'X';
if ActivateOrderDialog('T' + AList[i], AnEvent, Application, -1, ANeedVerify) then
Result := True;
end;
Application.ProcessMessages; // give uOrderDialog a chance to go back to nil
OrderSource := '';
if (not DoesEventOccur) and (AnEvent.PtEventIFN>0) and IsCompletedPtEvt(AnEvent.PtEventIFN) then
DoesEventOccur := True;
UBAGlobals.SourceOrderID := AList[i];
UBAGlobals.CopyTreatmentFactorsDxsToCopiedOrder(UBAGlobals.SourceOrderID, UBAGLobals.TargetOrderID);
end;
UnlockIfAble;
end;
procedure DestroyingOrderAction;
begin
uOrderAction := nil;
if not ActiveOrdering then
begin
ClearOrderRecall;
UnlockIfAble;
end;
end;
procedure DestroyingOrderDialog;
begin
uOrderDialog := nil;
if not ActiveOrdering then
begin
ClearOrderRecall;
UnlockIfAble;
end;
end;
procedure DestroyingOrderHTML;
begin
uOrderHTML := nil;
if not ActiveOrdering then
begin
ClearOrderRecall;
UnlockIfAble;
end;
end;
procedure DestroyingOrderMenu;
begin
uOrderMenu := nil;
if not ActiveOrdering then
begin
ClearOrderRecall;
UnlockIfAble;
end;
end;
procedure DestroyingOrderSet;
begin
uOrderSet := nil;
uOrderSetTime := 0;
if not ActiveOrdering then
begin
ClearOrderRecall;
UnlockIfAble;
end;
end;
function OrderIsLocked(const AnOrderID, AnAction: string): Boolean;
var
ErrorMsg: string;
begin
Result := True;
if (AnAction = OA_COPY) then
Exit;
if ((AnAction = OA_HOLD) or (AnAction = OA_UNHOLD) or (AnAction = OA_RENEW) or
(AnAction = OA_DC) or (AnAction = OA_CHANGE)) and Changes.ExistForOrder(AnOrderID)
then Exit;
LockOrder(AnOrderID, ErrorMsg);
if Length(ErrorMsg) > 0 then
begin
Result := False;
InfoBox(ErrorMsg + CRLF + CRLF + TextForOrder(AnOrderID), TC_NOLOCK, MB_OK);
end;
end;
procedure PopLastMenu;
{ always called from fOMSet }
begin
if uOrderMenu <> nil then uOrderMenu.cmdDoneClick(uOrderSet);
end;
procedure QuickOrderSave;
begin
// would be better to prompt for dialog
if uOrderDialog = nil then
begin
InfoBox(TX_NO_SAVE_QO, TC_NO_SAVE_QO, MB_OK);
Exit;
end;
with uOrderDialog do
begin
if not AllowQuickOrder then
begin
InfoBox(TX_NO_QUICK, TC_NO_QUICK, MB_OK);
Exit;
end;
if Responses.OrderContainsObjects then
begin
InfoBox(TX_CANT_SAVE_QO, TC_NO_QUICK, MB_ICONERROR or MB_OK);
Exit;
end;
SaveAsQuickOrder(Responses);
end;
end;
procedure QuickOrderListEdit;
begin
// would be better to prompt for dialog
if uOrderDialog = nil then
begin
InfoBox(TX_NO_EDIT_QO, TC_NO_EDIT_QO, MB_OK);
Exit;
end;
with uOrderDialog do
begin
if not AllowQuickOrder then
begin
InfoBox(TX_NO_QUICK, TC_NO_QUICK, MB_OK);
Exit;
end;
EditCommonList(DisplayGroup);
end;
end;
function RefNumFor(AnOwner: TComponent): Integer;
begin
if (uOrderDialog <> nil) and (uOrderDialog.Owner = AnOwner)
then Result := uOrderDialog.RefNum
else if (uOrderMenu <> nil) and (uOrderMenu.Owner = AnOwner)
then Result := uOrderMenu.RefNum
else if (uOrderHTML <> nil) and (uOrderHTML.Owner = AnOwner)
then Result := uOrderHTML.RefNum
else if (uOrderSet <> nil) and (uOrderSet.Owner = AnOwner)
then Result := uOrderSet.RefNum
else Result := -1;
end;
procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0);
const
TX_NEW_LOC1 = 'The patient''s location has changed to ';
TX_NEW_LOC2 = '.' + CRLF + 'Should the orders be printed using the new location?';
TC_NEW_LOC = 'New Patient Location';
TX_SIGN_LOC = 'No location was selected. Orders could not be printed!';
TC_REQ_LOC = 'Orders Not Printed';
TX_LOC_PRINT = 'The selected location will be used to determine where orders are printed.';
var
ALocation: Integer;
AName, ASvc, DeviceInfo: string;
PrintIt: Boolean;
begin
if PrintLoc = 0 then
begin
CurrentLocationForPatient(Patient.DFN, ALocation, AName, ASvc);
if (ALocation > 0) and (ALocation <> Encounter.Location) then
begin
if InfoBox(TX_NEW_LOC1 + AName + TX_NEW_LOC2, TC_NEW_LOC, MB_YESNO) = IDYES
then Encounter.Location := ALocation;
end;
end
else
Encounter.Location := PrintLoc;
if Encounter.Location = 0
then Encounter.Location := CommonLocationForOrders(OrderList);
if Encounter.Location = 0 then // location required for DEVINFO
begin
LookupLocation(ALocation, AName, LOC_ALL, TX_LOC_PRINT);
if ALocation > 0 then Encounter.Location := ALocation;
end;
frmFrame.DisplayEncounterText;
if Encounter.Location <> 0 then
begin
SetupOrdersPrint(OrderList, DeviceInfo, Nature, False, PrintIt);
if PrintIt then
PrintOrdersOnReview(OrderList, DeviceInfo)
else
PrintServiceCopies(OrderList);
end
else InfoBox(TX_SIGN_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING);
end;
procedure SetFontSize( FontSize: integer);
begin
if uOrderDialog <> nil then
uOrderDialog.SetFontSize( FontSize);
if uOrderMenu <> nil then
uOrderMenu.ResizeFont;
end;
procedure NextMove(var NMRec: TNextMoveRec; LastIndex: Integer; NewIndex: Integer);
begin
if LastIndex = 0 then
LastIndex := NewIndex;
if (LastIndex - NewIndex) <= 0 then
NMRec.NextStep := STEP_FORWARD
else
NMRec.NextStep := STEP_BACK;
NMRec.LastIndex := NewIndex;
end;
function IsIMODialog(DlgID: integer): boolean; //IMO
var
IsInptDlg, IsIMOLocation: boolean;
Td: TFMDateTime;
begin
result := False;
IsInptDlg := False;
Td := FMToday;
if ( (DlgID = MedsInDlgIen) or (DlgID = MedsIVDlgIen) or (IsInptQO(dlgId)) or (IsIVQO(dlgId))) then IsInptDlg := TRUE;
IsIMOLocation := IsValidIMOLoc(Encounter.Location,Patient.DFN);
if (IsInptDlg or IsInptQO(DlgID)) and (not Patient.Inpatient) and IsIMOLocation and (Encounter.DateTime > Td) then
result := True;
end;
function AllowActionOnIMO(AnEvtTyp: char): boolean;
var
Td: TFMDateTime;
begin
Result := False;
if (Patient.Inpatient) then
begin
Td := FMToday;
if IsValidIMOLoc(Encounter.Location,Patient.DFN) and (Encounter.DateTime > Td) then
Result := True;
end
else
begin
Td := FMToday;
if IsValidIMOLoc(Encounter.Location,Patient.DFN) and (Encounter.DateTime > Td) then
Result := True
else if AnEvtTyp in ['A','T'] then
Result := True;
end;
end;
function IMOActionValidation(AnId: string; var IsIMOOD: boolean; var x: string; AnEventType: char): boolean;
var
actName: string;
begin
// jd imo change
Result := True;
if CharAt(AnID, 1) in ['X','C'] then // transfer IMO order doesn't need check
begin
IsIMOOD := IsIMOOrder(Copy(AnID, 2, Length(AnID)));
If IsIMOOD then
begin
if (not AllowActionOnIMO(AnEventType)) then
begin
if CharAt(AnID,1) = 'X' then actName := 'change';
if CharAt(AnID,1) = 'C' then actName := 'copy';
x := 'You cannot ' + actName + ' the clinical medication order.';
x := RetrieveOrderText(Copy(AnID, 2, Length(AnID))) + #13#13#10 + x;
UnlockOrder(Copy(AnID, 2, Length(AnID)));
result := False;
end
else
begin
if patient.Inpatient then
begin
if CharAt(AnID,1) = 'X' then actName := 'changing';
if CharAt(AnID,1) = 'C' then actName := 'copying';
if MessageDlg(TX_IMO_WARNING1 + actName + TX_IMO_WARNING2 + #13#13#10 + x, mtWarning,[mbOK,mbCancel],0) = mrCancel then
begin
UnlockOrder(Copy(AnID, 2, Length(AnID)));
result := False;
end;
end;
end;
end;
end;
if Piece(AnId,'^',1)='RENEW' then
begin
IsIMOOD := IsIMOOrder(Piece(AnID,'^',2));
If IsIMOOD then
begin
if (not AllowActionOnIMO(AnEventType)) then
begin
x := 'You cannot renew the clinical medication order.';
x := RetrieveOrderText(Piece(AnID,'^',2)) + #13#13#10 + x;
UnlockOrder(Piece(AnID,'^',2));
result := False;
end
else
begin
if Patient.Inpatient then
begin
if MessageDlg(TX_IMO_WARNING1 + 'renewing' + TX_IMO_WARNING2, mtWarning,[mbOK,mbCancel],0) = mrCancel then
begin
UnlockOrder(Copy(AnID, 2, Length(AnID)));
result := False;
end;
end;
end;
end;
end;
end;
initialization
uPatientLocked := False;
uKeepLock := False;
uLastConfirm := '';
uOrderSetTime := 0;
uNewMedDialog := 0;
uOrderAction := nil;
uOrderDialog := nil;
uOrderHTML := nil;
uOrderMenu := nil;
uOrderSet := nil;
NSSchedule := False;
OriginalMedsOutHeight := 0;
OriginalMedsInHeight := 0;
OriginalNonVAMedsHeight := 0;
end.