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

361 lines
12 KiB
Plaintext

unit fODMedIn;
{$OPTIMIZATION OFF}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
fODBase, ORCtrls, StdCtrls, ORFn, ExtCtrls, uConst, ComCtrls, uCore,
Menus, VA508AccessibilityManager;
type
TfrmODMedIn = class(TfrmODBase)
lblMedication: TLabel;
cboMedication: TORComboBox;
lblDosage: TLabel;
lblRoute: TLabel;
cboRoute: TORComboBox;
lblSchedule: TLabel;
cboSchedule: TORComboBox;
Label5: TLabel;
cboDispense: TORComboBox;
lblComments: TLabel;
memComments: TMemo;
lblPriority: TLabel;
cboPriority: TORComboBox;
txtDosage: TCaptionEdit;
Bevel1: TBevel;
cboMedAlt: TORComboBox;
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);
private
{ Private declarations }
FLastDrug: Integer;
FLastMedID: string;
FDispenseMsg: string;
FMedCombo: TORComboBox;
procedure CheckFormAlt;
procedure ResetOnMedChange;
procedure SetAltCombo;
procedure SetOnOISelect;
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;
const
TX_NO_MED = 'Medication must be entered.';
TX_NO_DOSE = 'Dosage must be entered.';
TX_NO_AMPER = 'Dosage 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_DOSE_AMT = 'Dosage must be the amount given, not simply the number of units.';
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.';
{ TfrmODBase common methods }
procedure TfrmODMedIn.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 := 'PSI'; // does 'on Display' order check **KCM**
StatusText('Loading Dialog Definition');
Responses.Dialog := 'PSJ OR PAT OE'; // loads formatting info
StatusText('Loading Default Values');
CtrlInits.LoadDefaults(ODForMedIn); // ODForMedIn returns TStrings with defaults
InitDialog;
end;
procedure TfrmODMedIn.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');
end;
StatusText('Initializing Long List');
cboMedAlt.Visible := False;
cboMedication.Visible := True;
cboMedication.InitLongList('');
ActiveControl := cboMedication; //SetFocusedControl(FMedCombo);
StatusText('');
end;
procedure TfrmODMedIn.SetupDialog(OrderAction: Integer; const ID: string);
begin
inherited;
if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses do
begin
Changing := True; //v12a
SetControl(cboMedication, 'ORDERABLE', 1);
ResetOnMedChange; //v12a
SetOnOISelect; //v12a
SetAltCombo; //v12a
//cboMedicationSelect(Self);
SetControl(cboDispense, 'DRUG', 1);
SetControl(txtDosage, 'INSTR', 1);
SetControl(cboRoute, 'ROUTE', 1);
SetControl(cboSchedule, 'SCHEDULE', 1);
SetControl(memComments, 'COMMENT', 1);
SetControl(cboPriority, 'URGENCY', 1);
{ 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; //v12a
ControlChange(Self); //v12a
end;
if OrderAction <> ORDER_EDIT then SetFocusedControl(FMedCombo);
end;
procedure TfrmODMedIn.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 Length(txtDosage.Text) = 0 then SetError(TX_NO_DOSE);
if Pos('&', txtDosage.Text) > 0 then SetError(TX_NO_AMPER);
if Length(cboRoute.Text) = 0 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);
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;
if (Length(txtDosage.Text) > 0) and (not ContainsAlpha(txtDosage.Text))
then SetError(TX_DOSE_AMT);
if (not OrderForInpatient) and (not MedTypeIsIV(cboMedAlt.ItemIEN))
then SetError(TX_OUTPT_IV);
end;
{ cboMedication methods }
procedure TfrmODMedIn.ResetOnMedChange;
begin
ClearControl(cboDispense);
ClearControl(txtDosage);
ClearControl(cboRoute); // routes should be cached
ResetControl(cboSchedule);
ClearControl(memComments);
ClearControl(memOrder);
end;
procedure TfrmODMedIn.SetAltCombo;
begin
with cboMedication do
begin
FMedCombo := cboMedAlt;
if cboMedAlt.Items.Count = 0 then
begin
CtrlInits.SetListOnly(cboMedAlt, 'ShortList');
cboMedAlt.InsertSeparator;
end;
cboMedAlt.SetExactByIEN(ItemIEN, TrimRight(Piece(Text, '<', 1)));
cboMedication.Visible := False;
cboMedAlt.Visible := True;
end;
end;
procedure TfrmODMedIn.SetOnOISelect;
begin
with CtrlInits do
begin
FLastMedID := FMedCombo.ItemID;
LoadOrderItem(OIForMedIn(FMedCombo.ItemIEN));
SetControl(cboDispense, 'Dispense');
if cboDispense.Items.Count = 1 then cboDispense.ItemIndex := 0;
SetControl(txtDosage, 'Instruct');
SetControl(cboRoute, 'Route');
if cboRoute.Items.Count = 1 then cboRoute.ItemIndex := 0;
//cboRoute.InsertSeparator;
//AppendMedRoutes(cboRoute.Items);
if DefaultText('DefSched') <> '' then cboSchedule.SelectByID(DefaultText('DefSched'));
OrderMessage(TextOf('Message'));
end;
end;
procedure TfrmODMedIn.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.UD RX'));
end;
procedure TfrmODMedIn.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);
SetControl(txtDosage, 'INSTR', 1);
SetControl(cboRoute, 'ROUTE', 1);
SetControl(cboSchedule, 'SCHEDULE', 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 TfrmODMedIn.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_UNIT_DOSE);
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}
end;
procedure TfrmODMedIn.cboDispenseExit(Sender: TObject);
var
AMsg: string;
begin
inherited;
with cboDispense do
begin
if ItemIEN <> FLastDrug then CheckFormAlt;
if ItemIEN > 0 then
begin
AMsg := DispenseMessage(ItemIEN);
if memMessage.Text <> AMsg then OrderMessage(AMsg);
end;
FLastDrug := ItemIEN;
end;
end;
procedure TfrmODMedIn.cboDispenseMouseClick(Sender: TObject);
begin
inherited;
with cboDispense do
begin
if ItemIEN <> FLastDrug then CheckFormAlt;
if ItemIEN > 0 then OrderMessage(DispenseMessage(ItemIEN));
FLastDrug := ItemIEN;
end;
end;
{ all controls }
procedure TfrmODMedIn.ControlChange(Sender: TObject);
begin
inherited;
if Changing then Exit;
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));
with txtDosage do if Length(Text) > 0 then Responses.Update('INSTR', 1, Text, Text);
with cboRoute do if ItemIndex > -1
then Responses.Update('ROUTE', 1, ItemID, Piece(Items[ItemIndex], U, 3))
else Responses.Update('ROUTE', 1, Text, Text);
with cboSchedule do if Length(Text) > 0 then Responses.Update('SCHEDULE', 1, Text, Text);
with cboPriority do if ItemIndex > -1 then Responses.Update('URGENCY', 1, ItemID, Text);
with memComments do Responses.Update('COMMENT', 1, TX_WPTYPE, Text);
memOrder.Text := Responses.OrderText;
end;
end.