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

620 lines
21 KiB
Plaintext

unit fODMedOut;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
fODBase, ORCtrls, StdCtrls, ORFn, ExtCtrls, uConst, ComCtrls, uCore, Mask,
Menus, Buttons;
type
TfrmODMedOut = class(TfrmODBase)
lblMedication: TLabel;
cboMedication: TORComboBox;
lblDosage: TLabel;
lblRoute: TLabel;
cboRoute: TORComboBox;
lblSchedule: TLabel;
cboSchedule: TORComboBox;
lblDispense: TLabel;
cboDispense: TORComboBox;
memComments: TMemo;
cboPriority: TORComboBox;
Bevel1: TBevel;
cboMedAlt: TORComboBox;
cboInstructions: TORComboBox;
lblQuantity: TLabel;
cboPickup: TORComboBox;
lblPickup: TLabel;
cboSC: TORComboBox;
lblSC: TLabel;
lblRefills: TLabel;
txtQuantity: TCaptionEdit;
lblComment: TLabel;
lblPriority: TLabel;
txtRefills: TCaptionEdit;
spnRefills: TUpDown;
cmdComplex: TButton;
btnUnits: TSpeedButton;
txtSIG: TCaptionEdit;
lblSIG: TLabel;
popUnits: TPopupMenu;
memComplex: TMemo;
procedure cboMedicationNeedData(Sender: TObject; const StartFrom: string;
Direction, InsertAt: Integer);
procedure cboMedicationSelect(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ControlChange(Sender: TObject);
procedure cboDispenseExit(Sender: TObject);
procedure cboDispenseMouseClick(Sender: TObject);
procedure cboSCEnter(Sender: TObject);
procedure txtQuantityEnter(Sender: TObject);
procedure btnUnitsClick(Sender: TObject);
procedure cmdComplexClick(Sender: TObject);
procedure memCommentsEnter(Sender: TObject);
private
{ Private declarations }
FLastDrug: Integer;
FLastMedID: string;
FDispenseMsg: string;
FMedCombo: TORComboBox;
procedure CheckFormAlt;
procedure ResetOnMedChange;
procedure SetAskSC;
procedure SetAltCombo;
procedure SetInstructions;
procedure SetOnOISelect;
procedure SetMaxRefills;
procedure SetupNouns;
procedure SetComplex;
procedure SetSimple;
procedure UnitClick(Sender: TObject);
protected
procedure InitDialog; override;
procedure Validate(var AnErrMsg: string); override;
public
procedure SetupDialog(OrderAction: Integer; const ID: string); override;
end;
implementation
{$R *.DFM}
uses rOrders, rODBase, fODMedFA, fODMedComplex;
const
REFILLS_DFLT = '0';
REFILLS_MAX = 11;
TX_NO_MED = 'Medication must be entered.';
TX_NO_DOSE = 'Instructions must be entered.';
TX_NO_AMPER = 'Instructions may not contain the ampersand (&) character.';
TX_NO_ROUTE = 'Route must be entered.';
TX_NF_ROUTE = 'Route not found in the Medication Routes file.';
TX_NO_SCHED = 'Schedule must be entered.';
TX_NO_PICK = 'A method for picking up the medication must be entered.';
TX_RNG_REFILL = 'The number of refills must be in the range of 0 through ';
TX_SCH_QUOTE = 'Schedule must not have quotemarks in it.';
TX_SCH_MINUS = 'Schedule must not have a dash at the beginning.';
TX_SCH_SPACE = 'Schedule must have only one space in it.';
TX_SCH_LEN = 'Schedule must be less than 70 characters.';
TX_SCH_PRN = 'Schedule cannot include PRN - use Comments to enter PRN.';
TX_SCH_ZERO = 'Schedule cannot be Q0';
TX_SCH_LSP = 'Schedule may not have leading spaces.';
TX_SCH_NS = 'Unable to resolve non-standard schedule.';
TX_OUTPT_IV = 'This patient has not been admitted. Only IV orders may be entered.';
TX_QTY_NV = 'Unable to validate quantity.';
TX_QTY_MAIL = 'Quantity for mailed items must be a whole number.';
{ TfrmODBase common methods }
procedure TfrmODMedOut.FormCreate(Sender: TObject);
const
TC_RESTRICT = 'Ordering Restrictions';
var
Restriction: string;
begin
inherited;
AllowQuickOrder := True;
CheckAuthForMeds(Restriction);
if Length(Restriction) > 0 then
begin
InfoBox(Restriction, TC_RESTRICT, MB_OK);
Close;
Exit;
end;
FillerID := 'PSO'; // does 'on Display' order check **KCM**
StatusText('Loading Dialog Definition');
Responses.Dialog := 'PSO OERR'; // loads formatting info
StatusText('Loading Default Values');
CtrlInits.LoadDefaults(ODForMedOut); // ODForMedOut returns TStrings with defaults
InitDialog;
CtrlInits.SetControl(cboPickup, 'Pickup'); // do only once, so don't do in InitDialog
PreserveControl(cboPickup);
end;
procedure TfrmODMedOut.InitDialog;
begin
inherited;
FLastDrug := 0;
FLastMedID := '';
FDispenseMsg := '';
FMedCombo := cboMedication; // this must be before SetControl(cboMedication)
with CtrlInits do
begin
SetControl(cboMedication, 'ShortList');
cboMedication.InsertSeparator;
//SetControl(cboMedAlt, 'ShortList'); can't do this since it calls InitLongList
SetControl(cboSchedule, 'Schedules');
SetControl(cboPriority, 'Priorities');
//SetControl(cboPickup, 'Pickup');
SetControl(cboSC, 'SCStatus');
end;
SetAskSC;
StatusText('Retrieving List of Medications');
cboMedAlt.Visible := False;
cboMedication.Visible := True;
cboMedication.InitLongList('');
ActiveControl := cboMedication; //SetFocusedControl(FMedCombo);
SetSimple;
StatusText('');
end;
procedure TfrmODMedOut.SetupDialog(OrderAction: Integer; const ID: string);
var
AnInstr: string;
begin
inherited;
if OrderAction in [ORDER_COPY, ORDER_EDIT] then Responses.Remove('START', 1);
if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses do
begin
Changing := True;
SetControl(cboMedication, 'ORDERABLE', 1);
ResetOnMedChange;
SetOnOISelect;
SetAltCombo;
//cboMedicationSelect(Self);
SetControl(cboDispense, 'DRUG', 1);
SetInstructions;
SetControl(txtQuantity, 'QTY', 1);
SetControl(txtRefills, 'REFILLS', 1);
spnRefills.Position := StrToIntDef(txtRefills.Text, 0);
SetControl(cboPickup, 'PICKUP', 1);
SetControl(memComments, 'COMMENT', 1);
SetControl(cboPriority, 'URGENCY', 1);
{ prevent the SIG from being part of the comments on pre-CPRS prescriptions }
if (OrderAction in [ORDER_COPY, ORDER_EDIT]) and (cboInstructions.Text = '') then
begin
AnInstr := TextForOrder(ID); //'SIG: ' + memComments.Text;
OrderMessage(AnInstr);
lblSIG.Visible := True;
txtSIG.Visible := True;
txtSIG.Text := memComments.Text;
memComments.Clear;
end;
{ can't edit the orderable item for a med order that has been released }
if (OrderAction = ORDER_EDIT) and OrderIsReleased(EditOrder)
then FMedCombo.Enabled := False;
Changing := False;
ControlChange(Self);
end;
if OrderAction <> ORDER_EDIT then SetFocusedControl(FMedCombo);
end;
procedure TfrmODMedOut.Validate(var AnErrMsg: string);
var
Sched: Integer;
RouteID, RouteAbbr: string;
procedure SetError(const x: string);
begin
if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
AnErrMsg := AnErrMsg + x;
end;
begin
inherited;
if Length(cboMedAlt.Text) = 0 then SetError(TX_NO_MED);
// if memComplex is Visible, then the dosage fields were validated in fMedComplex
if memComplex.Visible = False then
begin
if Length(cboInstructions.Text) = 0 then SetError(TX_NO_DOSE);
if Pos('&', cboInstructions.Text) > 0 then SetError(TX_NO_AMPER);
if (Length(cboRoute.Text) = 0) and (not MedIsSupply(cboMedAlt.ItemIEN))
then SetError(TX_NO_ROUTE);
if (Length(cboRoute.Text) > 0) and (cboRoute.ItemIndex < 0) then
begin
LookupRoute(cboRoute.Text, RouteID, RouteAbbr);
if RouteID = '0'
then SetError(TX_NF_ROUTE)
else Responses.Update('ROUTE', 1, RouteID, RouteAbbr);
end;
if Length(cboSchedule.Text) = 0 then SetError(TX_NO_SCHED);
end;
if cboPickup.ItemID = '' then SetError(TX_NO_PICK);
if StrToIntDef(txtRefills.Text, 99) > spnRefills.Max
then SetError(TX_RNG_REFILL + IntToStr(spnRefills.Max));
with cboSchedule do if Length(Text) > 0 then
begin
Sched := ValidSchedule(Text);
if Sched = -1 then
begin
if Pos('"', Text) > 0 then SetError(TX_SCH_QUOTE);
if Copy(Text, 1, 1) = '-' then SetError(TX_SCH_MINUS);
if Pos(' ', Copy(Text, Pos(' ', Text) + 1, 999)) > 0 then SetError(TX_SCH_SPACE);
if Length(Text) > 70 then SetError(TX_SCH_LEN);
if (Pos('P RN', Text) > 0) or (Pos('PR N', Text) > 0) then SetError(TX_SCH_PRN);
if Pos('Q0', Text) > 0 then SetError(TX_SCH_ZERO);
if TrimLeft(Text) <> Text then SetError(TX_SCH_LSP);
end;
if Sched = 0 then SetError(TX_SCH_NS);
end;
with txtQuantity do if Length(Text) > 0 then
begin
if not ValidQuantity(Text) then SetError(TX_QTY_NV);
//if (cboPickup.ItemID = 'M') and (IntToStr(StrToIntDef(Text,-1)) <> Text)
// then SetError(TX_QTY_MAIL);
end;
end;
{ cboMedication methods }
procedure TfrmODMedOut.ResetOnMedChange;
begin
ClearControl(cboDispense);
ClearControl(cboInstructions);
btnUnits.Caption := '';
ResetControl(cboRoute);
ResetControl(cboSchedule);
ClearControl(txtQuantity);
txtRefills.Text := REFILLS_DFLT;
spnRefills.Max := REFILLS_MAX;
ClearControl(memComments);
ClearControl(memOrder);
end;
procedure TfrmODMedOut.SetAltCombo;
begin
with cboMedication do
begin
FMedCombo := cboMedAlt;
if cboMedAlt.Items.Count = 0 then CtrlInits.SetListOnly(cboMedAlt, 'ShortList');
cboMedAlt.SetExactByIEN(ItemIEN, TrimRight(Piece(Text, '<', 1)));
cboMedication.Visible := False;
cboMedAlt.Visible := True;
end;
end;
procedure TfrmODMedOut.SetOnOISelect;
begin
with CtrlInits do
begin
FLastMedID := FMedCombo.ItemID;
LoadOrderItem(OIForMedOut(FMedCombo.ItemIEN));
SetControl(cboDispense, 'Dispense');
if cboDispense.Items.Count = 1 then cboDispense.ItemIndex := 0;
lblDosage.Caption := DefaultText('Verb');
if lblDosage.Caption = '' then lblDosage.Caption := 'Amount';
SetControl(cboInstructions, 'Instruct');
SetupNouns;
SetControl(cboRoute, 'Route');
if cboRoute.Items.Count = 1 then cboRoute.ItemIndex := 0;
if DefaultText('DefSched') <> '' then cboSchedule.SelectByID(DefaultText('DefSched'));
OrderMessage(TextOf('Message'));
end;
end;
procedure TfrmODMedOut.cboMedicationNeedData(Sender: TObject; const StartFrom: string;
Direction, InsertAt: Integer);
{ retrieves a subset of inpatient medication orderable items }
begin
inherited;
FMedCombo.ForDataUse(SubSetOfOrderItems(StartFrom, Direction, 'S.O RX'));
end;
procedure TfrmODMedOut.cboMedicationSelect(Sender: TObject);
{ sets related controls whenever orderable item changes (MouseClick or Exit) }
begin
inherited;
with FMedCombo do
begin
if ItemID <> FLastMedID then FLastMedID := ItemID else Exit;
Changing := True;
if Sender <> Self then Responses.Clear; // Sender=Self when called from SetupDialog
ResetOnMedChange;
if CharAt(ItemID, 1) = 'Q' then
begin
Responses.QuickOrder := ExtractInteger(ItemID);
Responses.SetControl(FMedCombo, 'ORDERABLE', 1);
end;
if ItemIEN > 0 then SetOnOISelect;
end;
with Responses do if QuickOrder > 0 then
begin
SetControl(FMedCombo, 'ORDERABLE', 1);
SetControl(cboDispense, 'DRUG', 1);
SetInstructions;
SetControl(txtQuantity, 'QTY', 1);
SetControl(txtRefills, 'REFILLS', 1);
spnRefills.Position := StrToIntDef(txtRefills.Text, 0);
SetControl(cboPickup, 'PICKUP', 1);
SetControl(memComments, 'COMMENT', 1);
SetControl(cboPriority, 'URGENCY', 1);
end;
Changing := False;
ControlChange(Self);
if FMedCombo = cboMedication then SetAltCombo;
// if the Dispense drug was stuffed - still do the checks (form alt, refills)
if cboDispense.ItemIndex > -1 then cboDispenseMouseClick(Self);
end;
{ cboDispense methods }
procedure TfrmODMedOut.CheckFormAlt;
var
DrugName, OIName: string;
Drug, OI: Integer;
begin
with cboDispense do if (ItemIndex > -1) and (Piece(Items[ItemIndex], U, 4) = 'NF') then
begin
SelectFormularyAlt(ItemIEN, Drug, OI, DrugName, OIName, PST_OUTPATIENT);
if Drug > 0 then
begin
if FMedCombo.ItemIEN <> OI then
begin
FMedCombo.InitLongList(OIName);
FMedCombo.SelectByIEN(OI);
cboMedicationSelect(Self);
end;
cboDispense.SelectByIEN(Drug);
end; {if FormAlt}
end; {if ItemIndex}
SetAskSC; // now check enabled for the service connected prompt
end;
procedure TfrmODMedOut.SetMaxRefills;
begin
with cboDispense do if (ItemIndex > -1) and (Length(Piece(Items[ItemIndex], U, 6)) > 0) then
begin
spnRefills.Max := StrToIntDef(Piece(Items[ItemIndex], U, 6), REFILLS_MAX);
if StrToIntDef(txtRefills.Text, 0) > spnRefills.Max then
begin
txtRefills.Text := IntToStr(spnRefills.Max);
spnRefills.Position := spnRefills.Max;
end;
end;
end;
procedure TfrmODMedOut.cboDispenseExit(Sender: TObject);
var
AMsg: string;
begin
inherited;
SetMaxRefills;
with cboDispense do
begin
if ItemIEN <> FLastDrug then CheckFormAlt;
if ItemIEN > 0 then
begin
AMsg := DispenseMessage(ItemIEN) + CRLF;
if memMessage.Text <> AMsg then OrderMessage(AMsg);
end;
FLastDrug := ItemIEN;
end;
end;
procedure TfrmODMedOut.cboDispenseMouseClick(Sender: TObject);
begin
inherited;
SetMaxRefills;
with cboDispense do
begin
if ItemIEN <> FLastDrug then CheckFormAlt;
if ItemIEN > 0 then OrderMessage(DispenseMessage(ItemIEN));
FLastDrug := ItemIEN;
end;
end;
{ dosage instructions }
procedure TfrmODMedOut.SetupNouns;
var
AvailWidth, MaxWidth: Integer;
begin
CtrlInits.SetPopupMenu(popUnits, UnitClick, 'Nouns');
if popUnits.Items.Count > 0 then
begin
// Make sure cboInstructions is at least 40 pixels wide so it can show values
// like "1/2". Allow for a 3 pixel space between the the Units button & Route.
AvailWidth := (cboRoute.Left - 3) - (cboInstructions.Left + 40);
MaxWidth := popUnits.Tag + 9; // allow 9 pixels for the down arrow & button border
if MaxWidth > AvailWidth then MaxWidth := AvailWidth;
btnUnits.Width := MaxWidth;
btnUnits.Left := cboRoute.Left - MaxWidth - 3;
cboInstructions.Width := btnUnits.Left - cboInstructions.Left;
btnUnits.Caption := popUnits.Items[0].Caption;
btnUnits.Visible := True;
end else
begin
btnUnits.Visible := False;
// Allow for a 6 pixel margin between the Instructions box & Route
cboInstructions.Width := cboRoute.Left - cboInstructions.Left - 6;
end;
end;
procedure TfrmODMedOut.btnUnitsClick(Sender: TObject);
var
APoint: TPoint;
begin
inherited;
APoint := btnUnits.ClientToScreen(Point(0, btnUnits.Height));
popUnits.Popup(APoint.X, APoint.Y);
end;
procedure TfrmODMedOut.UnitClick(Sender: TObject);
begin
btnUnits.Caption := TMenuItem(Sender).Caption;
end;
procedure TfrmODMedOut.SetComplex;
begin
lblDosage.Visible := False;;
lblRoute.Visible := False;;
lblSchedule.Visible := False;;
cboInstructions.Visible := False;
btnUnits.Visible := False;;
cboRoute.Visible := False;
cboSchedule.Visible := False;
memComplex.Visible := True;
cmdComplex.Caption := 'Change Dose...';
end;
procedure TfrmODMedOut.SetSimple;
begin
memComplex.Visible := False;
lblDosage.Visible := True;;
lblRoute.Visible := True;;
lblSchedule.Visible := True;;
cboInstructions.Visible := True;
btnUnits.Visible := (popUnits.Items.Count > 0) or (btnUnits.Caption <> '');
cboRoute.Visible := True;
cboSchedule.Visible := True;
cmdComplex.Caption := 'Complex Dose...';
end;
procedure TfrmODMedOut.SetInstructions;
var
x: string;
AnInstance: Integer;
begin
case Responses.InstanceCount('INSTR') of
0: begin
cboInstructions.ItemIndex := -1;
// there may still be a route & schedule (for copied orders)
if Responses.EValueFor('MISC', 1) <> ''
then btnUnits.Caption := Responses.EValueFor('MISC', 1);
Responses.SetControl(cboRoute, 'ROUTE', 1);
with cboRoute do if ItemIndex > -1 then Text := DisplayText[ItemIndex];
Responses.SetControl(cboSchedule, 'SCHEDULE', 1);
SetSimple;
end;
1: begin
AnInstance := Responses.NextInstance('INSTR', 0);
Responses.SetControl(cboInstructions, 'INSTR', AnInstance);
btnUnits.Caption := Responses.IValueFor('MISC', AnInstance);
Responses.SetControl(cboRoute, 'ROUTE', AnInstance);
with cboRoute do if ItemIndex > -1 then Text := DisplayText[ItemIndex];
Responses.SetControl(cboSchedule, 'SCHEDULE', AnInstance);
SetSimple;
end;
else begin
memComplex.Clear;
AnInstance := Responses.NextInstance('INSTR', 0);
while AnInstance > 0 do
begin
x := Responses.EValueFor('INSTR', AnInstance);
x := x + ' ' + Responses.EValueFor('MISC', AnInstance);
x := x + ' ' + Responses.EValueFor('ROUTE', AnInstance);
x := x + ' ' + Responses.EValueFor('SCHEDULE', AnInstance);
if Length(Responses.EValueFor('DAYS', AnInstance)) > 0
then x := x + ' ' + Responses.EValueFor('DAYS', AnInstance) + ' day(s)';
memComplex.Lines.Add(x);
AnInstance := Responses.NextInstance('INSTR', AnInstance);
end;
SetComplex;
end;
end; {case}
memOrder.Text := Responses.OrderText;
end; {if ExecuteComplexDose}
procedure TfrmODMedOut.cmdComplexClick(Sender: TObject);
begin
inherited;
if FMedCombo.ItemIEN = 0 then
begin
InfoBox(TX_NO_MED, 'Error', MB_OK);
Exit;
end;
if ExecuteComplexDose(CtrlInits, Responses) then SetInstructions;
end;
{ quantity }
procedure TfrmODMedOut.txtQuantityEnter(Sender: TObject);
begin
inherited;
with cboDispense do if ItemIEN > 0 then OrderMessage(QuantityMessage(ItemIEN));
end;
{ service connection }
procedure TfrmODMedOut.SetAskSC;
const
SC_NO = 0;
SC_YES = 1;
begin
if Patient.ServiceConnected and RequiresCopay(FLastDrug) then
begin
lblSC.Font.Color := clWindowText;
cboSC.Enabled := True;
cboSC.Color := clWindow;
if Patient.SCPercent > 50 then cboSC.SelectByIEN(SC_YES) else cboSC.SelectByIEN(SC_NO);
end else
begin
lblSC.Font.Color := clGrayText;
cboSC.Enabled := False;
cboSC.Color := clBtnFace;
cboSC.ItemIndex := -1;
end;
end;
procedure TfrmODMedOut.cboSCEnter(Sender: TObject);
begin
inherited;
OrderMessage(RatedDisabilities);
end;
{ comments }
procedure TfrmODMedOut.memCommentsEnter(Sender: TObject);
begin
inherited;
OrderMessage(''); // make sure Order Message disappears when in comments box
end;
{ all controls }
procedure TfrmODMedOut.ControlChange(Sender: TObject);
begin
inherited;
if csLoading in ComponentState then Exit; // to prevent error caused by txtRefills
if Changing then Exit;
if FMedCombo.ItemIEN = 0 then Exit; // prevent txtRefills from updating early
with FMedCombo do if ItemIEN > 0
then Responses.Update('ORDERABLE', 1, ItemID, Piece(Items[ItemIndex], U, 3))
else Responses.Update('ORDERABLE', 1, '', '');
with cboDispense do if ItemIEN > 0
then Responses.Update('DRUG', 1, ItemID, Piece(Items[ItemIndex], U, 2))
else Responses.Update('DRUG', 1, '', '');
if memComplex.Visible = False then
begin
with cboInstructions do Responses.Update('INSTR', 1, Text, Text);
with btnUnits do if Visible then Responses.Update('MISC', 1, Caption, Caption);
with cboRoute do if ItemIndex > -1
then Responses.Update('ROUTE', 1, ItemID, Piece(Items[ItemIndex], U, 3)) // abbreviation
else Responses.Update('ROUTE', 1, Text, Text);
with cboSchedule do Responses.Update('SCHEDULE', 1, Text, Text);
end;
with txtQuantity do Responses.Update('QTY', 1, Text, Text);
with txtRefills do Responses.Update('REFILLS', 1, Text, Text);
with cboPickup do Responses.Update('PICKUP', 1, ItemID, Text);
with cboPriority do Responses.Update('URGENCY', 1, ItemID, Text);
with memComments do Responses.Update('COMMENT', 1, TX_WPTYPE, Text);
with cboSC do if Enabled then Responses.Update('SC', 1, ItemID, Text);
memOrder.Text := Responses.OrderText;
end;
end.