Module

fODMeds

Path

C:\CPRS\CPRS30\Orders\fODMeds.pas

Last Modified

7/15/2014 3:26:42 PM

Comments

REMOVE AFTER UNIT IS DEBUGGED

Units Used in Interface

Name Comments
fODBase -
uConst -
XuDigSigSC_TLB -

Units Used in Implementation

Name Comments
fFrame -
fODMedOIFA -
fOtherSchedule -
fRptBox -
rCore -
rODBase -
rODMeds -
rOrders -
uCore -
uOrders -

Classes

Name Comments
TfrmODMeds -

Procedures

Name Owner Declaration Scope Comments
btnSelectClick TfrmODMeds procedure btnSelectClick(Sender: TObject); Public/Published
Medication is now selected ---------------------------------------------------------------- 

MedName: string;
btnXDurationClick TfrmODMeds procedure btnXDurationClick(Sender: TObject); Public/Published -
btnXInsertClick TfrmODMeds procedure btnXInsertClick(Sender: TObject); Public/Published -
btnXRemoveClick TfrmODMeds procedure btnXRemoveClick(Sender: TObject); Public/Published -
cboDosageChange TfrmODMeds procedure cboDosageChange(Sender: TObject); Public/Published -
cboDosageClick TfrmODMeds procedure cboDosageClick(Sender: TObject); Public/Published -
cboDosageExit TfrmODMeds procedure cboDosageExit(Sender: TObject); Public/Published -
cboDosageKeyUp TfrmODMeds procedure cboDosageKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
cboPriorityKeyUp TfrmODMeds procedure cboPriorityKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
cboRouteChange TfrmODMeds procedure cboRouteChange(Sender: TObject); Public/Published CboRoute --------------------------------------
cboRouteExit TfrmODMeds procedure cboRouteExit(Sender: TObject); Public/Published -
cboRouteKeyUp TfrmODMeds procedure cboRouteKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
cboScheduleChange TfrmODMeds procedure cboScheduleChange(Sender: TObject); Public/Published -
cboScheduleClick TfrmODMeds procedure cboScheduleClick(Sender: TObject); Public/Published CboSchedule -----------------------------------
cboScheduleEnter TfrmODMeds procedure cboScheduleEnter(Sender: TObject); Public/Published -
cboScheduleExit TfrmODMeds procedure cboScheduleExit(Sender: TObject); Public/Published -
cboScheduleKeyUp TfrmODMeds procedure cboScheduleKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
cboXDosageChange TfrmODMeds procedure cboXDosageChange(Sender: TObject); Public/Published -
cboXDosageClick TfrmODMeds procedure cboXDosageClick(Sender: TObject); Public/Published -
cboXDosageEnter TfrmODMeds procedure cboXDosageEnter(Sender: TObject); Public/Published -
cboXDosageExit TfrmODMeds procedure cboXDosageExit(Sender: TObject); Public/Published TempTag: integer;
cboXDosageKeyUp TfrmODMeds procedure cboXDosageKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
cboXRouteChange TfrmODMeds procedure cboXRouteChange(Sender: TObject); Public/Published -
cboXRouteClick TfrmODMeds procedure cboXRouteClick(Sender: TObject); Public/Published -
cboXRouteEnter TfrmODMeds procedure cboXRouteEnter(Sender: TObject); Public/Published -
cboXRouteExit TfrmODMeds procedure cboXRouteExit(Sender: TObject); Public/Published -
cboXScheduleChange TfrmODMeds procedure cboXScheduleChange(Sender: TObject); Public/Published -
cboXScheduleClick TfrmODMeds procedure cboXScheduleClick(Sender: TObject); Public/Published -
cboXScheduleEnter TfrmODMeds procedure cboXScheduleEnter(Sender: TObject); Public/Published -
cboXScheduleExit TfrmODMeds procedure cboXScheduleExit(Sender: TObject); Public/Published -
cboXScheduleKeyUp TfrmODMeds procedure cboXScheduleKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
cboXSequence1Exit TfrmODMeds procedure cboXSequence1Exit(Sender: TObject); Public/Published -
cboXSequenceChange TfrmODMeds procedure cboXSequenceChange(Sender: TObject); Public/Published -
cboXSequenceEnter TfrmODMeds procedure cboXSequenceEnter(Sender: TObject); Public/Published -
cboXSequenceExit TfrmODMeds procedure cboXSequenceExit(Sender: TObject); Public/Published -
cboXSequenceKeyUp TfrmODMeds procedure cboXSequenceKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
ChangeDelayed TfrmODMeds procedure ChangeDelayed; Private -
CheckDecimal TfrmODMeds procedure CheckDecimal(var AStr: string); Public -
CheckFormAltDose TfrmODMeds procedure CheckFormAltDose(DispDrug: Integer); Private CboDosage -------------------------------------
chkDoseNowClick TfrmODMeds procedure chkDoseNowClick(Sender: TObject); Public/Published -
chkPRNClick TfrmODMeds procedure chkPRNClick(Sender: TObject); Public/Published -
chkPtInstructClick TfrmODMeds procedure chkPtInstructClick(Sender: TObject); Public/Published -
chkXPRNClick TfrmODMeds procedure chkXPRNClick(Sender: TObject); Public/Published -
cmdAcceptClick TfrmODMeds procedure cmdAcceptClick(Sender: TObject); Public/Published -
ControlChange TfrmODMeds procedure ControlChange(Sender: TObject); Public/Published -
DisplayDoseNow TfrmODMeds procedure DisplayDoseNow(Status: boolean); Private -
DispOrderMessage TfrmODMeds procedure DispOrderMessage(const AMessage: string); Private -
DropLastSequence TfrmODMeds procedure DropLastSequence(ASign: integer = 0); Private -
FindInCombo - procedure FindInCombo(const x: string; AComboBox: TORComboBox); Global -
FormClose TfrmODMeds procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmODMeds procedure FormCreate(Sender: TObject); Public/Published Procedures inherited from fODBase ---------------------------------------------------------
FormDestroy TfrmODMeds procedure FormDestroy(Sender: TObject); Public/Published -
FormKeyDown TfrmODMeds procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
FormKeyPress TfrmODMeds procedure FormKeyPress(Sender: TObject; var Key: Char); Public/Published -
FormResize TfrmODMeds procedure FormResize(Sender: TObject); Public/Published -
FormShow TfrmODMeds procedure FormShow(Sender: TObject); Public/Published -
grdDosesDrawCell TfrmODMeds procedure grdDosesDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); Public/Published -
grdDosesEnter TfrmODMeds procedure grdDosesEnter(Sender: TObject); Public/Published -
grdDosesExit TfrmODMeds procedure grdDosesExit(Sender: TObject); Public/Published -
grdDosesKeyDown TfrmODMeds procedure grdDosesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
grdDosesKeyPress TfrmODMeds procedure grdDosesKeyPress(Sender: TObject; var Key: Char); Public/Published -
grdDosesMouseDown TfrmODMeds procedure grdDosesMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
grdDosesMouseUp TfrmODMeds procedure grdDosesMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
InitDialog TfrmODMeds procedure InitDialog; override; Protected Executed each time dialog is reset after pressing accept. Clears controls & responses
KillDrug - procedure KillDrug(const ADrug: string); Local -
lblAdminSchSetText TfrmODMeds procedure lblAdminSchSetText(str: string); Private -
lblGuidelineClick TfrmODMeds procedure lblGuidelineClick(Sender: TObject); Public/Published -
ListViewClick TfrmODMeds procedure ListViewClick(Sender: TObject); Public/Published -
ListViewEditing TfrmODMeds procedure ListViewEditing(Sender: TObject; Item: TListItem; var AllowEdit: Boolean); Public/Published -
ListViewEnter TfrmODMeds procedure ListViewEnter(Sender: TObject); Public/Published LstAll & lstQuick methods
ListViewKeyUp TfrmODMeds procedure ListViewKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
ListViewResize TfrmODMeds procedure ListViewResize(Sender: TObject); Public/Published -
Loaded TfrmODMeds procedure Loaded; override; Protected LstAll Methods (lstAll is TListView)
LoadMedCache TfrmODMeds procedure LoadMedCache(First, Last: Integer); Private Cache is a list of 100 string lists, starting at idx 0
lstAllData TfrmODMeds procedure lstAllData(Sender: TObject; Item: TListItem); Public/Published -
lstAllDataHint TfrmODMeds procedure lstAllDataHint(Sender: TObject; StartIndex, EndIndex: Integer); Public/Published -
lstChange TfrmODMeds procedure lstChange(Sender: TObject; Item: TListItem; Change: TItemChange); Public/Published -
lstQuickData TfrmODMeds procedure lstQuickData(Sender: TObject; Item: TListItem); Public/Published LstQuick methods (lstQuick is TListView)
lstQuickDataHint TfrmODMeds procedure lstQuickDataHint(Sender: TObject; StartIndex, EndIndex: Integer); Public/Published -
memCommentClick TfrmODMeds procedure memCommentClick(Sender: TObject); Public/Published -
memMessageKeyDown TfrmODMeds procedure memMessageKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
memPIClick TfrmODMeds procedure memPIClick(Sender: TObject); Public/Published -
memPIKeyDown TfrmODMeds procedure memPIKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
MoveCombo - procedure MoveCombo(SrcCombo, DestCombo: TORComboBox; CompSch: boolean = false); Local AGP Changes 26.12 PSI-04-63
PlaceControl - procedure PlaceControl(AControl: TWinControl); Local -
pnlFieldsResize TfrmODMeds procedure pnlFieldsResize(Sender: TObject); Public/Published -
pnlMessageEnter TfrmODMeds procedure pnlMessageEnter(Sender: TObject); Public/Published -
pnlMessageExit TfrmODMeds procedure pnlMessageExit(Sender: TObject); Public/Published -
pnlXAdminTimeClick TfrmODMeds procedure pnlXAdminTimeClick(Sender: TObject); Public/Published -
pnlXDurationButtonEnter TfrmODMeds procedure pnlXDurationButtonEnter(Sender: TObject); Public/Published -
pnlXDurationEnter TfrmODMeds procedure pnlXDurationEnter(Sender: TObject); Public/Published -
pnlXDurationExit TfrmODMeds procedure pnlXDurationExit(Sender: TObject); Public/Published -
pnlXScheduleEnter TfrmODMeds procedure pnlXScheduleEnter(Sender: TObject); Public/Published -
pnlXScheduleExit TfrmODMeds procedure pnlXScheduleExit(Sender: TObject); Public/Published -
popDurationClick TfrmODMeds procedure popDurationClick(Sender: TObject); Public/Published -
QuantityMessageCheck TfrmODMeds procedure QuantityMessageCheck(Tag: integer) ; Public/Published -
ResetOnMedChange TfrmODMeds procedure ResetOnMedChange; Private Edit
ResetOnTabChange TfrmODMeds procedure ResetOnTabChange; Private -
RestoreCancelButton TfrmODMeds procedure RestoreCancelButton; Private -
RestoreDefaultButton TfrmODMeds procedure RestoreDefaultButton; Private -
SaveDrug - procedure SaveDrug(const ADrug: string; UnitsPerDose: Extended); Local -
ScrollToVisible TfrmODMeds procedure ScrollToVisible(AListView: TListView); Private -
SetControlsInpatient TfrmODMeds procedure SetControlsInpatient; Private -
SetControlsOutpatient TfrmODMeds procedure SetControlsOutpatient; Private -
SetDosage TfrmODMeds procedure SetDosage(const x: string); Private -
SetError - procedure SetError(const x: string); Local -
SetOnMedSelect TfrmODMeds procedure SetOnMedSelect; Private -
SetOnQuickOrder TfrmODMeds procedure SetOnQuickOrder; Private -
SetPickup TfrmODMeds procedure SetPickup(const x: string); Private -
SetSchedule TfrmODMeds procedure SetSchedule(const x: string); Private -
SetupDialog TfrmODMeds procedure SetupDialog(OrderAction: Integer; const ID: string); override; Public -
SetVisibleCommentRows TfrmODMeds procedure SetVisibleCommentRows( Rows: integer ); Private -
ShowControlsComplex TfrmODMeds procedure ShowControlsComplex; Private -
ShowControlsSimple TfrmODMeds procedure ShowControlsSimple; Private
Var
dosagetxt: string;
ShowEditor TfrmODMeds procedure ShowEditor(ACol, ARow: Integer; AChar: Char); Private -
ShowMedFields TfrmODMeds procedure ShowMedFields; Private -
ShowMedSelect TfrmODMeds procedure ShowMedSelect; Private -
StartKeyTimer TfrmODMeds procedure StartKeyTimer; Private Start (or restart) a timer (done on keyup to delay before calling OnKeyPause)
StopKeyTimer TfrmODMeds procedure StopKeyTimer; Private Stop the timer (done whenever a key is pressed or the combobox no longer has focus)
SynchCombo - procedure SynchCombo(ACombo: TORComboBox; const ItemText, EditText: string); Local -
tabDoseChange TfrmODMeds procedure tabDoseChange(Sender: TObject); Public/Published
Medication edit --------------------------------------------------------------------------- 

text,x, tmpsch: string;
timCheckChangesTimer TfrmODMeds procedure timCheckChangesTimer(Sender: TObject); Public/Published -
txtMedChange TfrmODMeds procedure txtMedChange(Sender: TObject); Public/Published -
txtMedExit TfrmODMeds procedure txtMedExit(Sender: TObject); Public/Published -
txtMedKeyDown TfrmODMeds procedure txtMedKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
txtMedKeyUp TfrmODMeds procedure txtMedKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
txtNSSClick TfrmODMeds procedure txtNSSClick(Sender: TObject); Public/Published -
txtQuantityChange TfrmODMeds procedure txtQuantityChange(Sender: TObject); Public/Published -
txtQuantityClick TfrmODMeds procedure txtQuantityClick(Sender: TObject); Public/Published -
txtRefillsChange TfrmODMeds procedure txtRefillsChange(Sender: TObject); Public/Published -
txtRefillsClick TfrmODMeds procedure txtRefillsClick(Sender: TObject); Public/Published -
txtSupplyChange TfrmODMeds procedure txtSupplyChange(Sender: TObject); Public/Published TxtSupply, txtQuantity --------------------------
txtSupplyClick TfrmODMeds procedure txtSupplyClick(Sender: TObject); Public/Published -
txtXDurationChange TfrmODMeds procedure txtXDurationChange(Sender: TObject); Public/Published -
UMDelayClick TfrmODMeds procedure UMDelayClick(var Message: TMessage); message UM_DELAYCLICK; Private -
UMDelayEvent TfrmODMeds procedure UMDelayEvent(var Message: TMessage); message UM_DELAYEVENT; Private After focusing events are completed for a combobox, set the key the user typed
UMShowNSSBuilder TfrmODMeds procedure UMShowNSSBuilder(var Message: TMessage); message UM_NSSOTHER; Private -
UpdateDefaultSupply TfrmODMeds procedure UpdateDefaultSupply(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string; var CurSupply: Integer; var CurQuantity: double; var SkipQtyCheck: Boolean); Private -
UpdateDurationControls TfrmODMeds procedure UpdateDurationControls( FreeText: boolean); Private Duration -----------------------------
UpdateRefills TfrmODMeds procedure UpdateRefills(const CurDispDrug: string; CurSupply: Integer); Private -
UpdateRelated TfrmODMeds procedure UpdateRelated(DelayUpdate: Boolean = TRUE); Private -
updateSig TfrmODMeds procedure updateSig; override; Protected -
UpdateStartExpires TfrmODMeds procedure UpdateStartExpires(const CurSchedule: string); Private -
UpdateSupplyQuantity TfrmODMeds procedure UpdateSupplyQuantity(const CurUnits, CurSchedule, CurDuration, CurDispDrug, CurInstruct: string; var CurSupply: Integer; var CurQuantity: double); Private
Add CURInstrcut to this procedure. This address a problem with an user starting with a free-text dosage and changing
to another free-text dose and the quantity value not updating.
Validate TfrmODMeds procedure Validate(var AnErrMsg: string); override; Protected -
ValidateDosage - procedure ValidateDosage(const x: string); Local -
ValidateInpatientSchedule TfrmODMeds procedure ValidateInpatientSchedule(ScheduleCombo: TORComboBox); Private -
ValidateRoute - procedure ValidateRoute(const x: string; NeedLookup: Boolean; AnInstance: Integer); Local -
ValidateSchedule - procedure ValidateSchedule(const x: string; AnInstance: Integer); Local -
WMClose TfrmODMeds procedure WMClose(var Msg : TWMClose); message WM_CLOSE; Public/Published -
WMTimer TfrmODMeds procedure WMTimer(var Message: TWMTimer); message WM_TIMER; Private TxtMed methods (including timers)

Functions

Name Owner Declaration Scope Comments
ConstructedDoseFields TfrmODMeds function ConstructedDoseFields(const ADose: string; PrependName: Boolean = FALSE): string; Private -
CreateOtherScheduel TfrmODMeds function CreateOtherScheduel: string; Private
NSS
NSS
CreateOtherScheduelComplex TfrmODMeds function CreateOtherScheduelComplex: string; Private -
DisableCancelButton TfrmODMeds function DisableCancelButton(Control: TWinControl): boolean; Private -
DisableDefaultButton TfrmODMeds function DisableDefaultButton(Control: TWinControl): boolean; Private -
DurationToDays TfrmODMeds function DurationToDays: Integer; Private
Procedure TfrmODMeds.DurationToDays;
var
  i, DoseHours, TotalHours: Integer;
  AllRows: Boolean;
  Days: Extended;
  x: string;
begin
  Exit;  // don't try to figure out days supply from duration for now
  if txtSupply.Tag = 1 then Exit;
  AllRows := True;
  with grdDoses do for i := 1 to Pred(RowCount) do
    if (Length(ValFor(COL_DOSAGE, i)) > 0) and (Length(ValFor(VAL_DURATION, i)) = 0)
      then AllRows := False;
  if not AllRows then Exit;
  Changing := True;
  TotalHours := 0;
  with grdDoses do for i := 1 to Pred(RowCount) do
    if Length(ValFor(COL_DOSAGE, i)) > 0 then
    begin
      x := ValFor(VAL_DURATION, i);
      if Piece(x, U, 2) = 'D'
        then DoseHours := ExtractInteger(x) * 24
        else DoseHours := ExtractInteger(x);
      TotalHours := TotalHours + DoseHours;
    end;
  Days := TotalHours / 24;
  if Days > Int(Days) then Days := Days + 1;
  txtSupply.Text := IntToStr(Trunc(Days));
  //timDayQty.Tag := TIMER_FROM_DAYS;
  //timDayQtyTimer(Self);
  Changing := False;
end;
FieldsForDose TfrmODMeds function FieldsForDose(ARow: Integer): string; Private -
FieldsForDrug TfrmODMeds function FieldsForDrug(const DrugID: string): string; Private -
FindCommonDrug TfrmODMeds function FindCommonDrug(DoseList: TStringList): string; Private DoseList[n] = DoseText ^ Dispense Drug Pointer
FindDoseFields TfrmODMeds function FindDoseFields(const Drug, ADose: string): string; Private -
FindQuickOrder TfrmODMeds function FindQuickOrder(const x: string): Integer; Private -
GetCacheChunkIndex TfrmODMeds function GetCacheChunkIndex(idx: integer): integer; Private CQ: 7397 - Inpatient med orders with PRN cancel due to invalid schedule.
GetComplexDoseSchedule - function GetComplexDoseSchedule: string; Local -
GetComplexDoseScheduleEX - function GetComplexDoseScheduleEX: string; Local -
GetSchedListIndex TfrmODMeds function GetSchedListIndex(SchedCombo: TORComboBox; pSchedule: String):integer; Private -
GetSingleDoseSchedule - function GetSingleDoseSchedule: string; Local
The following functions were created to get rid of a compile warning saying the
 return value may be undefined - too much branching logic in the case statements
 for the compiler to handle
GetSingleDoseScheduleEX - function GetSingleDoseScheduleEX: string; Local -
IfIsIMODialog TfrmODMeds function IfIsIMODialog: boolean; Private -
InpatientSig TfrmODMeds function InpatientSig: string; Private -
IsSupplyAndOutPatient TfrmODMeds function IsSupplyAndOutPatient : boolean; Private Function ValidateRoute(RouteCombo: TORComboBox) : Boolean; Removed based on Site feeback. See CQ: 7518
isUniqueQuickOrder TfrmODMeds function isUniqueQuickOrder(iText: string): Boolean; Private
Removed based on Site feeback. See CQ: 7518
function TfrmODMeds.ValidateRoute(RouteCombo: TORComboBox) : Boolean;
begin
{CQ: 7331 - Medications - Route - Can not enter any route not listed in Route field in window}
  Result := True;
  if (Length(RouteCombo.Text) > 0) and (RouteCombo.ItemIndex < 0) and (Not IsSupplyAndOutPatient) then
  begin
    Application.MessageBox('Please select a correct route from the list.',
                           'Incorrect Route.');
    if RouteCombo.CanFocus then
      RouteCombo.SetFocus;
    RouteCombo.SelStart := Length(RouteCombo.Text);
    Result := False;
  end;
end;
lblAdminSchGetText TfrmODMeds function lblAdminSchGetText: string; Private -
OutpatientSig TfrmODMeds function OutpatientSig: string; Private Values changing
TextDosage TfrmODMeds function TextDosage(ADosage: string): string; Private -
ValFor TfrmODMeds function ValFor(FieldID, ARow: Integer): string; Private
General Functions - get & set cell values

 Contents of grid cells  (Only the first tab piece for each cell is drawn)
    Dosage    <TAB> DosageFields
    RouteText <TAB> IEN^RouteName^Abbreviation
    Schedule  <TAB> (nothing)
    Duration  <TAB> Duration^Units
ValueOf TfrmODMeds function ValueOf(FieldID: Integer; ARow: Integer = -1): string; Private
Contents of cboDosage
    DrugName^Strength^NF^TDose&Units&U/D&Noun&LDose&Drug^DoseText^CostText^MaxRefills
  Contents of grid cells  (Only the first tab piece for each cell is drawn)
    Dosage    <TAB> DosageFields
    RouteText <TAB> IEN^RouteName^Abbreviation
    Schedule  <TAB> (nothing)
    Duration  <TAB> Duration^Units 






 the following functions were created to get rid of a compile warning saying the
 return value may be undefined - too much branching logic in the case statements
 for the compiler to handle
ValueOfResponse TfrmODMeds function ValueOfResponse(FieldID: Integer; AnInstance: Integer = 1): string; Private -

Global Variables

Name Type Declaration Comments
crypto crypto: IXuDigSigS; -
frmODMeds TfrmODMeds frmODMeds: TfrmODMeds; -

Constants

Name Declaration Scope Comments
COL_ADMINTIME 5 Global -
COL_CHKXPRN 7 Global -
COL_DOSAGE 1 Global -
COL_DURATION 4 Global -
COL_ROUTE 2 Global -
COL_SCHEDULE 3 Global -
COL_SELECT 0 Global Grid columns for complex dosing
COL_SEQUENCE 6 Global -
FLD_ANDTHEN 73 Global -
FLD_COMMENT 80 Global -
FLD_DOSEFLDS 5 Global -
FLD_DOSETEXT 8 Global -
FLD_DOSEUNIT 11 Global -
FLD_DOSEUNIT_LOCAL 12 Global -
FLD_DRUG_ID 3 Global -
FLD_DRUG_ID_INT 90 Global -
FLD_DRUG_NM 4 Global -
FLD_DURATION 30 Global -
FLD_EXPIRE 72 Global -
FLD_INSTRUCT 10 Global -
FLD_LOCALDOSE 1 Global Field identifiers
FLD_MISC_FLDS 50 Global -
FLD_NOW_ID 75 Global -
FLD_NOW_NM 76 Global -
FLD_PICKUP 55 Global -
FLD_PRIOR_ID 60 Global -
FLD_PRIOR_NM 61 Global -
FLD_PTINSTR 85 Global -
FLD_QTYDISP 56 Global -
FLD_QUANTITY 52 Global -
FLD_REFILLS 53 Global -
FLD_ROUTE_AB 17 Global -
FLD_ROUTE_EX 18 Global -
FLD_ROUTE_ID 15 Global -
FLD_ROUTE_NM 16 Global -
FLD_SC 58 Global -
FLD_SCHED_EX 21 Global -
FLD_SCHED_TYP 22 Global -
FLD_SCHEDULE 20 Global -
FLD_SEQUENCE 31 Global -
FLD_START_ID 70 Global -
FLD_START_NM 71 Global -
FLD_STRENGTH 2 Global -
FLD_SUPPLY 51 Global -
FLD_TOTALDOSE 7 Global -
FLD_UNITNOUN 6 Global -
MED_CACHE_CHUNK_SIZE 100 Global -
TAB #9 Global -
TC_GUIDELINE 'Restrictions/Guidelines' Global -
TC_NO_DEA 'DEA# Required' Global -
TC_RESTRICT 'Ordering Restrictions' Global -
TI_COMPLEX 1 Global -
TI_DOSE 0 Global Dosage type tab index values
TI_RATE 99 Global -
TIMER_DELAY 500 Global 500 millisecond delay
TIMER_FROM_DAYS 1 Global -
TIMER_FROM_QTY 2 Global -
TIMER_ID 6902 Global
Misc constants

 arbitrary number
TX_ADMIN 'Requested Start: ' Global Text constants
TX_DOSE_LEN 'Dosage may not exceed 60 characters' Global -
TX_DOSE_NUM 'Dosage may not be numeric only' Global -
TX_MAX_STOP 'The maximum expiration for this order is ' Global -
TX_NF_ROUTE 'Route not found in the Medication Routes file.' Global -
TX_NO_DEA 'Provider must have a DEA# or VA# to order this medication' Global -
TX_NO_DOSE 'Dosage must be entered.' Global -
TX_NO_MED 'Medication must be selected.' Global -
TX_NO_PICK 'A method for picking up the medication must be entered.' Global -
TX_NO_ROUTE 'Route must be entered.' Global -
TX_NO_SCHED 'Schedule must be entered.' Global -
TX_NO_SEQ 'Missing one or more conjunction.' Global -
TX_OUTPT_IV 'This patient has not been admitted. Only IV orders may be entered.' Global -
TX_QTY_MAIL 'Quantity for mailed items must be a whole number.' Global -
TX_QTY_NV 'Unable to validate quantity.' Global -
TX_QTY_POST ' <<' Global -
TX_QTY_PRE '>> Quantity Dispensed: ' Global -
TX_RNG_REFILL 'The number of refills must be in the range of 0 through ' Global -
TX_SCH_LEN 'Schedule must be less than 70 characters.' Global -
TX_SCH_LSP 'Schedule may not have leading spaces.' Global -
TX_SCH_MINUS 'Schedule must not have a dash at the beginning.' Global -
TX_SCH_NS 'Unable to resolve non-standard schedule.' Global -
TX_SCH_PRN 'Schedule cannot include PRN - use Comments to enter PRN.' Global -
TX_SCH_QUOTE 'Schedule must not have quotemarks in it.' Global -
TX_SCH_SPACE 'Schedule must have only one space in it.' Global -
TX_SCH_ZERO 'Schedule cannot be Q0' Global -
TX_SUPPLY_LIM 'Days Supply may not be greater than 90.' Global -
TX_SUPPLY_LIM1 'Days Supply may not be less than 1.' Global -
TX_SUPPLY_NINT 'Days Supply is an invalid number.' Global -
TX_TAKE '' Global -
UM_DELAYCLICK 11037 Interfaced Temporary for listview click event
VAL_ADMINTIME 50 Global -
VAL_CHKXPRN 70 Global -
VAL_DOSAGE 10 Global -
VAL_DURATION 40 Global -
VAL_ROUTE 20 Global -
VAL_SCHEDULE 30 Global -
VAL_SEQUENCE 60 Global -


Module Source

1     unit fODMeds;
2     
3     {$OPTIMIZATION OFF}                              // REMOVE AFTER UNIT IS DEBUGGED
4     
5     interface
6     
7     uses
8       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
9       fODBase, StdCtrls, ComCtrls, ExtCtrls, ORCtrls, Grids, Buttons, uConst, ORDtTm,
10      Menus, XuDigSigSC_TLB, VA508AccessibilityManager, VAUtils, Contnrs;
11    
12    const
13      UM_DELAYCLICK = 11037;  // temporary for listview click event
14    
15    type
16      TfrmODMeds = class(TfrmODBase)
17        txtMed: TEdit;
18        pnlMeds: TPanel;
19        btnSelect: TButton;
20        pnlFields: TPanel;
21        lstQuick: TCaptionListView;
22        sptSelect: TSplitter;
23        lstAll: TCaptionListView;
24        dlgStart: TORDateTimeDlg;
25        cboXDosage: TORComboBox;
26        cboXRoute: TORComboBox;
27        pnlXDuration: TPanel;
28        timCheckChanges: TTimer;
29        popDuration: TPopupMenu;
30        popDays: TMenuItem;
31        popBlank: TMenuItem;
32        hours1: TMenuItem;
33        minutes1: TMenuItem;
34        months1: TMenuItem;
35        weeks1: TMenuItem;
36        pnlXSchedule: TPanel;
37        cboXSchedule: TORComboBox;
38        chkXPRN: TCheckBox;
39        txtXDuration: TCaptionEdit;
40        spnXDuration: TUpDown;
41        pnlXDurationButton: TKeyClickPanel;
42        btnXDuration: TSpeedButton;
43        pnlTop: TPanel;
44        lblRoute: TLabel;
45        lblSchedule: TLabel;
46        grdDoses: TCaptionStringGrid;
47        lblGuideline: TStaticText;
48        tabDose: TTabControl;
49        cboDosage: TORComboBox;
50        cboRoute: TORComboBox;
51        cboSchedule: TORComboBox;
52        chkPRN: TCheckBox;
53        btnXInsert: TButton;
54        btnXRemove: TButton;
55        pnlBottom: TPanel;
56        lblComment: TLabel;
57        lblDays: TLabel;
58        lblQuantity: TLabel;
59        lblRefills: TLabel;
60        lblPriority: TLabel;
61        chkDoseNow: TCheckBox;
62        memComment: TCaptionMemo;
63        lblQtyMsg: TStaticText;
64        txtSupply: TCaptionEdit;
65        spnSupply: TUpDown;
66        txtQuantity: TCaptionEdit;
67        spnQuantity: TUpDown;
68        txtRefills: TCaptionEdit;
69        spnRefills: TUpDown;
70        grpPickup: TGroupBox;
71        radPickWindow: TRadioButton;
72        radPickMail: TRadioButton;
73        radPickClinic: TRadioButton;
74        cboPriority: TORComboBox;
75        stcPI: TStaticText;
76        chkPtInstruct: TCheckBox;
77        memPI: TMemo;
78        Image1: TImage;
79        memDrugMsg: TMemo;
80        txtNSS: TLabel;
81        pnlXAdminTime: TPanel;
82        cboXSequence: TORComboBox;
83        lblAdminSch: TMemo;
84        lblAdminTime: TVA508StaticText;
85        procedure FormCreate(Sender: TObject);
86        procedure btnSelectClick(Sender: TObject);
87        procedure tabDoseChange(Sender: TObject);
88        procedure FormDestroy(Sender: TObject);
89        procedure txtMedKeyDown(Sender: TObject; var Key: Word;
90          Shift: TShiftState);
91        procedure txtMedKeyUp(Sender: TObject; var Key: Word;
92          Shift: TShiftState);
93        procedure txtMedChange(Sender: TObject);
94        procedure txtMedExit(Sender: TObject);
95        procedure ListViewEditing(Sender: TObject; Item: TListItem;
96          var AllowEdit: Boolean);
97        procedure ListViewKeyUp(Sender: TObject; var Key: Word;
98          Shift: TShiftState);
99        procedure ListViewResize(Sender: TObject);
100       procedure lstQuickData(Sender: TObject; Item: TListItem);
101       procedure lstQuickDataHint(Sender: TObject; StartIndex,
102         EndIndex: Integer);
103       procedure lstAllDataHint(Sender: TObject; StartIndex,
104         EndIndex: Integer);
105       procedure lstAllData(Sender: TObject; Item: TListItem);
106       procedure lblGuidelineClick(Sender: TObject);
107       procedure ListViewClick(Sender: TObject);
108       procedure cboScheduleChange(Sender: TObject);
109       procedure cboRouteChange(Sender: TObject);
110       procedure ControlChange(Sender: TObject);
111       procedure cboDosageClick(Sender: TObject);
112       procedure cboDosageChange(Sender: TObject);
113       procedure cboScheduleClick(Sender: TObject);
114       procedure txtSupplyChange(Sender: TObject);
115       procedure txtQuantityChange(Sender: TObject);
116       procedure cboRouteExit(Sender: TObject);
117       procedure grdDosesMouseDown(Sender: TObject; Button: TMouseButton;
118         Shift: TShiftState; X, Y: Integer);
119       procedure grdDosesKeyPress(Sender: TObject; var Key: Char);
120       procedure grdDosesMouseUp(Sender: TObject; Button: TMouseButton;
121         Shift: TShiftState; X, Y: Integer);
122       procedure grdDosesDrawCell(Sender: TObject; ACol, ARow: Integer;
123         Rect: TRect; State: TGridDrawState);
124       procedure cboXDosageClick(Sender: TObject);
125       procedure cboXDosageExit(Sender: TObject);
126       procedure cboXRouteClick(Sender: TObject);
127       procedure cboXRouteExit(Sender: TObject);
128       procedure cboXScheduleClick(Sender: TObject);
129       procedure pnlXDurationEnter(Sender: TObject);
130       procedure pnlXDurationExit(Sender: TObject);
131       procedure txtXDurationChange(Sender: TObject);
132       procedure cboXDosageEnter(Sender: TObject);
133       procedure cboXDosageChange(Sender: TObject);
134       procedure cboXRouteChange(Sender: TObject);
135       procedure cboXScheduleChange(Sender: TObject);
136       procedure grdDosesExit(Sender: TObject);
137       procedure ListViewEnter(Sender: TObject);
138       procedure timCheckChangesTimer(Sender: TObject);
139       procedure popDurationClick(Sender: TObject);
140       procedure cmdAcceptClick(Sender: TObject);
141       procedure btnXInsertClick(Sender: TObject);
142       procedure btnXRemoveClick(Sender: TObject);
143       procedure pnlXScheduleEnter(Sender: TObject);
144       procedure pnlXScheduleExit(Sender: TObject);
145       procedure chkPtInstructClick(Sender: TObject);
146       procedure pnlFieldsResize(Sender: TObject);
147       procedure chkDoseNowClick(Sender: TObject);
148       procedure cboDosageExit(Sender: TObject);
149       procedure chkXPRNClick(Sender: TObject);
150       procedure memCommentClick(Sender: TObject);
151       procedure btnXDurationClick(Sender: TObject);
152       procedure chkPRNClick(Sender: TObject);
153       procedure grdDosesKeyDown(Sender: TObject; var Key: Word;
154         Shift: TShiftState);
155       procedure grdDosesEnter(Sender: TObject);
156       procedure FormKeyPress(Sender: TObject; var Key: Char);
157       procedure FormKeyDown(Sender: TObject; var Key: Word;
158         Shift: TShiftState);
159       procedure cboXRouteEnter(Sender: TObject);
160       procedure pnlMessageEnter(Sender: TObject);
161       procedure pnlMessageExit(Sender: TObject);
162       procedure memMessageKeyDown(Sender: TObject; var Key: Word;
163         Shift: TShiftState);
164       procedure memPIClick(Sender: TObject);
165       procedure FormResize(Sender: TObject);
166       procedure memPIKeyDown(Sender: TObject; var Key: Word;
167         Shift: TShiftState);
168       procedure lstChange(Sender: TObject; Item: TListItem;
169         Change: TItemChange);
170       procedure FormClose(Sender: TObject; var Action: TCloseAction);
171       procedure txtNSSClick(Sender: TObject);
172       procedure cboScheduleEnter(Sender: TObject);
173       procedure FormShow(Sender: TObject);
174       procedure cboScheduleExit(Sender: TObject);
175       procedure cboXScheduleExit(Sender: TObject);
176       procedure cboDosageKeyUp(Sender: TObject; var Key: Word;
177         Shift: TShiftState);
178       procedure cboXDosageKeyUp(Sender: TObject; var Key: Word;
179         Shift: TShiftState);
180       procedure txtSupplyClick(Sender: TObject);
181       procedure txtQuantityClick(Sender: TObject);
182       procedure txtRefillsClick(Sender: TObject);
183       procedure WMClose(var Msg : TWMClose); message WM_CLOSE;
184       procedure cboXScheduleEnter(Sender: TObject);
185       procedure pnlXAdminTimeClick(Sender: TObject);
186       procedure cboXSequenceChange(Sender: TObject);
187       procedure cboXSequence1Exit(Sender: TObject);
188       procedure cboXSequenceExit(Sender: TObject);
189       procedure cboXSequenceEnter(Sender: TObject);
190       procedure txtRefillsChange(Sender: TObject);
191       procedure QuantityMessageCheck(Tag: integer)  ;
192       procedure pnlXDurationButtonEnter(Sender: TObject);
193       procedure cboRouteKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
194       procedure cboScheduleKeyUp(Sender: TObject; var Key: Word;
195         Shift: TShiftState);
196       procedure cboXScheduleKeyUp(Sender: TObject; var Key: Word;
197         Shift: TShiftState);
198       procedure cboXSequenceKeyUp(Sender: TObject; var Key: Word;
199         Shift: TShiftState);
200       procedure cboPriorityKeyUp(Sender: TObject; var Key: Word;
201         Shift: TShiftState);
202       //procedure btnNSSClick(Sender: TObject);
203     private
204       FCloseCalled : Boolean;
205       FScheduleChanged : Boolean;
206       {selection}
207       FMedCache:   TObjectList;
208       FCacheIEN:   Integer;
209       FQuickList:  Integer;
210       FQuickItems: TStringList;
211       FChangePending: Boolean;
212       FKeyTimerActive: Boolean;
213       FActiveMedList: TListView;
214       FRowHeight: Integer;
215       FFromSelf: Boolean;
216       {edit}
217       FAllDoses:  TStringList;
218       FAllDrugs:  TStringList;
219       FGuideline: TStringList;
220       FLastUnits:    string;
221       FLastSchedule: string;
222       FLastDuration: string;
223       FLastInstruct: string;
224       FLastDispDrug: string;
225       FLastQuantity: Double;
226       FLastSupply:   Integer;
227       FLastPickup:   string;
228       FSIGVerb: string;
229       FSIGPrep: string;
230       FDropColumn: Integer;
231       FDrugID: string;
232       FInptDlg: Boolean;
233       FUpdated: Boolean;
234       FSuppressMsg: Boolean;
235       FPtInstruct: string;
236       FAltChecked: Boolean;
237       FOutptIV: Boolean;
238       FQOQuantity: Double;
239       FQODosage: string;
240       FNoZERO: boolean;
241       FIsQuickOrder: boolean;
242       FDisabledDefaultButton: TButton;
243       FDisabledCancelButton: TButton;
244       FShrinked: boolean;
245       FShrinkDrugMsg: boolean;
246       FResizedAlready: boolean;
247       FQOInitial: boolean;
248       FOrigiMsgDisp: boolean;
249       FNSSOther: boolean;
250       {selection}
251       FShowPnlXScheduleOk : boolean;
252       FRemoveText : Boolean;
253       FSmplPRNChkd: Boolean;
254       {Admin Time}
255       FAdminTimeLbl: string;
256       FMedName: String;
257       FNSSAdminTime: string;
258       FNSSScheduleType: string;
259       FAdminTimeText: string;
260       //FOriginalAdminTime: string;
261       //FOriginalScheduleIndex: integer;
262       FOrderAction: integer;
263       JAWSON: boolean;
264       procedure ChangeDelayed;
265       function FindQuickOrder(const x: string): Integer;
266       function isUniqueQuickOrder(iText: string): Boolean;
267       function GetCacheChunkIndex(idx: integer): integer;
268       procedure LoadMedCache(First, Last: Integer);
269       procedure ScrollToVisible(AListView: TListView);
270       procedure StartKeyTimer;
271       procedure StopKeyTimer;
272       procedure WMTimer(var Message: TWMTimer); message WM_TIMER;
273       {edit}
274       procedure ResetOnMedChange;
275       procedure ResetOnTabChange;
276       procedure SetControlsInpatient;
277       procedure SetControlsOutpatient;
278       procedure SetOnMedSelect;
279       procedure SetOnQuickOrder;
280       procedure SetVisibleCommentRows( Rows: integer );
281       procedure ShowMedSelect;
282       procedure ShowMedFields;
283       procedure ShowControlsSimple;
284       procedure ShowControlsComplex;
285       procedure SetDosage(const x: string);
286       procedure SetPickup(const x: string);
287       procedure SetSchedule(const x: string);
288       procedure CheckFormAltDose(DispDrug: Integer);
289       function DurationToDays: Integer;
290       function ConstructedDoseFields(const ADose: string; PrependName: Boolean = FALSE): string;
291       function FieldsForDose(ARow: Integer): string;
292       function FieldsForDrug(const DrugID: string): string;
293       function FindCommonDrug(DoseList: TStringList): string;
294       function FindDoseFields(const Drug, ADose: string): string;
295       function InpatientSig: string;
296       function OutpatientSig: string;
297       procedure UpdateRelated(DelayUpdate: Boolean = TRUE);
298       procedure UpdateRefills(const CurDispDrug: string; CurSupply: Integer);
299       procedure UpdateStartExpires(const CurSchedule: string);
300       procedure UpdateDefaultSupply(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string;
301         var CurSupply: Integer; var CurQuantity: double; var SkipQtyCheck: Boolean);
302       procedure UpdateSupplyQuantity(const CurUnits, CurSchedule, CurDuration, CurDispDrug, CurInstruct: string;
303         var CurSupply: Integer; var CurQuantity: double);
304       procedure UpdateDurationControls( FreeText: boolean);
305       function DisableDefaultButton(Control: TWinControl): boolean;
306       function DisableCancelButton(Control: TWinControl): boolean;
307       procedure RestoreDefaultButton;
308       procedure RestoreCancelButton;
309       function ValueOf(FieldID: Integer; ARow: Integer = -1): string;
310       function ValueOfResponse(FieldID: Integer; AnInstance: Integer = 1): string;
311       function ValFor(FieldID, ARow: Integer): string;
312       function TextDosage(ADosage: string): string;
313       //NSS
314       function CreateOtherScheduel: string;
315       function CreateOtherScheduelComplex: string;
316       procedure ShowEditor(ACol, ARow: Integer; AChar: Char);
317       procedure DropLastSequence(ASign: integer = 0);
318       procedure DispOrderMessage(const AMessage: string);
319       procedure UMDelayClick(var Message: TMessage); message UM_DELAYCLICK;
320       procedure UMDelayEvent(var Message: TMessage); message UM_DELAYEVENT;
321       procedure UMShowNSSBuilder(var Message: TMessage); message UM_NSSOTHER;
322       function  IfIsIMODialog: boolean;
323       procedure ValidateInpatientSchedule(ScheduleCombo: TORComboBox);
324   //    function ValidateRoute(RouteCombo: TORComboBox) : Boolean; Removed based on Site feeback. See CQ: 7518
325       function IsSupplyAndOutPatient : boolean;
326       function GetSchedListIndex(SchedCombo: TORComboBox; pSchedule: String):integer;
327       procedure DisplayDoseNow(Status: boolean);
328       function lblAdminSchGetText: string;
329       procedure lblAdminSchSetText(str: string);
330     protected
331       procedure Loaded; override;
332       procedure InitDialog; override;
333       procedure Validate(var AnErrMsg: string); override;
334       procedure updateSig; override;
335     public
336       ARow1: integer;
337       procedure SetupDialog(OrderAction: Integer; const ID: string); override;
338       procedure CheckDecimal(var AStr: string);
339       property MedName: string read FMedName write FMedName;
340       property NSSAdminTime: string read FNSSAdminTime write FNSSAdminTime;
341       property NSSScheduleType: string read FNSSScheduleType write FNSSScheduleType;
342     end;
343   
344   var
345     frmODMeds: TfrmODMeds;
346     crypto: IXuDigSigS;
347   
348   implementation
349   
350   {$R *.DFM}
351   
352   uses rCore, uCore, ORFn, rODMeds, rODBase, rOrders, fRptBox, fODMedOIFA,
353     uOrders, fOtherSchedule, StrUtils, fFrame, VA508AccessibilityRouter;
354   
355   const
356     {grid columns for complex dosing}
357     COL_SELECT    =  0;
358     COL_DOSAGE    =  1;
359     COL_ROUTE     =  2;
360     COL_SCHEDULE  =  3;
361     COL_DURATION  =  4;
362     COL_ADMINTIME =  5;
363     COL_SEQUENCE  =  6;
364     COL_CHKXPRN   =  7;
365     VAL_DOSAGE    = 10;
366     VAL_ROUTE     = 20;
367     VAL_SCHEDULE  = 30;
368     VAL_DURATION  = 40;
369     VAL_ADMINTIME = 50;
370     VAL_SEQUENCE  = 60;
371     VAL_CHKXPRN   = 70;
372     TAB           = #9;
373     {field identifiers}
374     FLD_LOCALDOSE =  1;
375     FLD_STRENGTH  =  2;
376     FLD_DRUG_ID   =  3;
377     FLD_DRUG_NM   =  4;
378     FLD_DOSEFLDS  =  5;
379     FLD_UNITNOUN  =  6;
380     FLD_TOTALDOSE =  7;
381     FLD_DOSETEXT  =  8;
382     FLD_INSTRUCT  = 10;
383     FLD_DOSEUNIT  = 11;
384     FLD_DOSEUNIT_LOCAL = 12;
385     FLD_ROUTE_ID  = 15;
386     FLD_ROUTE_NM  = 16;
387     FLD_ROUTE_AB  = 17;
388     FLD_ROUTE_EX  = 18;
389     FLD_SCHEDULE  = 20;
390     FLD_SCHED_EX  = 21;
391     FLD_SCHED_TYP = 22;
392     FLD_DURATION  = 30;
393     FLD_SEQUENCE  = 31;
394     FLD_MISC_FLDS = 50;
395     FLD_SUPPLY    = 51;
396     FLD_QUANTITY  = 52;
397     FLD_REFILLS   = 53;
398     FLD_PICKUP    = 55;
399     FLD_QTYDISP   = 56;
400     FLD_SC        = 58;
401     FLD_PRIOR_ID  = 60;
402     FLD_PRIOR_NM  = 61;
403     FLD_START_ID  = 70;
404     FLD_START_NM  = 71;
405     FLD_EXPIRE    = 72;
406     FLD_ANDTHEN   = 73;
407     FLD_NOW_ID    = 75;
408     FLD_NOW_NM    = 76;
409     FLD_COMMENT   = 80;
410     FLD_PTINSTR   = 85;
411     FLD_DRUG_ID_INT = 90;
412     {dosage type tab index values}
413     TI_DOSE       =  0;
414     TI_RATE       =  99;
415     TI_COMPLEX    =  1;
416     {misc constants}
417     TIMER_ID = 6902;                                // arbitrary number
418     TIMER_DELAY = 500;                              // 500 millisecond delay
419     TIMER_FROM_DAYS = 1;
420     TIMER_FROM_QTY  = 2;
421   
422     MED_CACHE_CHUNK_SIZE = 100;
423     {text constants}
424     TX_ADMIN      = 'Requested Start: ';
425     TX_TAKE       = '';
426     TX_NO_DEA     = 'Provider must have a DEA# or VA# to order this medication';
427     TC_NO_DEA     = 'DEA# Required';
428     TX_NO_MED     = 'Medication must be selected.';
429     TX_NO_SEQ     = 'Missing one or more conjunction.';
430     TX_NO_DOSE    = 'Dosage must be entered.';
431     TX_DOSE_NUM   = 'Dosage may not be numeric only';
432     TX_DOSE_LEN   = 'Dosage may not exceed 60 characters';
433     TX_NO_ROUTE   = 'Route must be entered.';
434     TX_NF_ROUTE   = 'Route not found in the Medication Routes file.';
435     TX_NO_SCHED   = 'Schedule must be entered.';
436     TX_NO_PICK    = 'A method for picking up the medication must be entered.';
437     TX_RNG_REFILL = 'The number of refills must be in the range of 0 through ';
438     TX_SCH_QUOTE  = 'Schedule must not have quotemarks in it.';
439     TX_SCH_MINUS  = 'Schedule must not have a dash at the beginning.';
440     TX_SCH_SPACE  = 'Schedule must have only one space in it.';
441     TX_SCH_LEN    = 'Schedule must be less than 70 characters.';
442     TX_SCH_PRN    = 'Schedule cannot include PRN - use Comments to enter PRN.';
443     TX_SCH_ZERO   = 'Schedule cannot be Q0';
444     TX_SCH_LSP    = 'Schedule may not have leading spaces.';
445     TX_SCH_NS     = 'Unable to resolve non-standard schedule.';
446     TX_MAX_STOP   = 'The maximum expiration for this order is ';
447     TX_OUTPT_IV   = 'This patient has not been admitted.  Only IV orders may be entered.';
448     TX_QTY_NV     = 'Unable to validate quantity.';
449     TX_QTY_MAIL   = 'Quantity for mailed items must be a whole number.';
450     TX_SUPPLY_LIM = 'Days Supply may not be greater than 90.';
451     TX_SUPPLY_LIM1 = 'Days Supply may not be less than 1.';
452     TX_SUPPLY_NINT= 'Days Supply is an invalid number.';
453     TC_RESTRICT   = 'Ordering Restrictions';
454     TC_GUIDELINE  = 'Restrictions/Guidelines';
455     TX_QTY_PRE    = '>> Quantity Dispensed: ';
456     TX_QTY_POST   = ' <<';
457   
458   { procedures inherited from fODBase --------------------------------------------------------- }
459   
460   procedure TfrmODMeds.FormCreate(Sender: TObject);
461   var
462     ListCount: Integer;
463     x: string;
464   begin
465     frmFrame.pnlVisit.Enabled := false;
466     AutoSizeDisabled := True;
467     inherited;
468     FAdminTimeText := '';
469     btnXDuration.Align := alClient;
470     AllowQuickOrder := True;
471     FSmplPRNChkd := False; // GE CQ7585
472     CheckAuthForMeds(x);
473     if Length(x) > 0 then
474     begin
475       InfoBox(x, TC_RESTRICT, MB_OK);
476       Close;
477       Exit;
478     end;
479     if DlgFormID = OD_MEDINPT  then FInptDlg := TRUE;
480     if DlgFormID = OD_MEDOUTPT then FInptDlg := FALSE;
481     if DlgFormID = OD_MEDNONVA then FInptDlg := FALSE;
482     if DlgFormID = OD_MEDS  then FInptDlg := OrderForInpatient;
483     if XfInToOutNow then
484       FInptDlg := False;
485     if XferOuttoInOnMeds then
486       FInptDlg := True;
487     if ImmdCopyAct and isUDGroup and (Patient.Inpatient) then
488       FInptDlg := True;
489     if ImmdcopyAct and (not isUDGroup) then
490       FInptDlg := False;
491     if FInptDlg then FillerID := 'PSI' else FillerID := 'PSO';
492     FGuideline := TStringList.Create;
493     FAllDoses  := TStringList.Create;
494     FAllDrugs  := TStringList.Create;
495     StatusText('Loading Dialog Definition');
496     if      DlgFormID = OD_MEDINPT  then Responses.Dialog := 'PSJ OR PAT OE'
497     else if DlgFormID = OD_MEDOUTPT then Responses.Dialog := 'PSO OERR'
498     else if DlgFormID = OD_MEDNONVA then Responses.Dialog := 'PSH OERR'
499     else                                 Responses.Dialog := 'PS MEDS';  // loads formatting info
500     {if not FInptDlg then } Responses.SetPromptFormat('INSTR', '@');
501     StatusText('Loading Schedules');
502     //if (Self.EvtID > 0) then LoadSchedules(cboSchedule.Items)
503     //else LoadSchedules(cboSchedule.Items, FInptDlg);
504     LoadSchedules(cboSchedule.Items, FInptDlg);
505     StatusText('');
506     if FInptDlg then SetControlsInpatient else SetControlsOutpatient;
507     CtrlInits.SetControl(cboPriority, 'Priority');
508     FSuppressMsg := CtrlInits.DefaultText('DispMsg') = '1';
509     FOrigiMsgDisp := FSuppressMsg;
510     InitDialog;
511     isIMO := IfIsIMODialog;
512     if (isIMO) or ((FInptDlg) and (encounter.Location <> patient.Location)) then
513         FAdminTimeText := 'Not defined for Clinic Locations';
514     if FInptDlg then
515     begin
516       txtNss.Visible := True;
517       //cboSchedule.ListItemsOnly := True;
518       //cboXSchedule.ListItemsOnly := True;
519     end;
520     with grdDoses do
521     begin                                          
522       ColWidths[0] := 8;  // select
523       ColWidths[1] := 160; // dosage
524       ColWidths[2] := 82;  // route
525       ColWidths[3] := 102;  // schedule
526       ColWidths[4] := 70;  // duration
527       if (FInptDlg) and (FAdminTimeText <> 'Not defined for Clinic Locations') then
528         begin
529           ColWidths[5] := 102;  // administration times
530           ColWidths[6] := 58;  // and/then
531         end
532       else
533           ColWidths[5] := 0;
534           ColWidths[6] := 58;
535       Cells[1, 0]  := 'Dosage';
536       Cells[2, 0]  := 'Route';
537       Cells[3, 0]  := 'Schedule';
538       Cells[4, 0]  := 'Duration (optional)';
539       Cells[5, 0]  := 'Admin. Times';
540       Cells[6, 0]  := 'then/and';
541     end;
542   
543     // medication selection
544     FRowHeight := MainFontHeight + 1;
545   
546     //IsIMO := IfIsIMODialog; //IMO
547     if (Self.EvtID > 0) then IsIMO := False; // event order can not be IMO order.
548     if FInptDlg then x := 'UD RX'
549     else if (not FInptDlg) and (DlgFormID = OD_MEDNONVA) then x := 'NV RX'
550     else x := 'O RX';
551     if FInptDlg and (not OrderForInpatient) and (not IsIMO) then        //IMO
552     begin
553       FOutptIV := TRUE;
554       x := 'IVM RX';
555     end;
556     if self.EvtID > 0  then FAdminTimeText := 'To Be Determined';
557     if (isIMO = True) then self.Caption := 'Clinic Orders Medications'
558     else if FInptDlg = True then self.Caption := 'Inpatient Medications'
559     else if DlgFormID = OD_MEDOUTPT then self.Caption := 'Outpatient Medications'
560     else self.Caption := 'Medications Orders';
561     ListForOrderable(FCacheIEN, ListCount, x);
562     lstAll.Items.Count := ListCount;
563     FMedCache := TObjectList.Create;
564     FQuickItems := TStringList.Create;
565     ListForQuickOrders(FQuickList, ListCount, x);
566     if ListCount > 0 then
567     begin
568       lstQuick.Items.Count := ListCount;
569       SubsetOfQuickOrders(FQuickItems, FQuickList, 0, 0);
570       FActiveMedList := lstQuick;
571     end else
572     begin
573       lstQuick.Items.Count := 1;
574       ListCount := 1;
575       FQuickItems.Add('0^(No quick orders available)');
576       FActiveMedList := lstAll;
577     end;
578     // set the height based on user parameter here
579     with lstQuick do if ListCount < VisibleRowCount
580       then Height := (((Height - 6) div VisibleRowCount) * ListCount) + 6;
581     pnlFields.Height := memOrder.Top - 4 - pnlFields.Top;
582     FNoZero := False;
583     FShrinked := False;
584     FShrinkDrugMsg := False;
585     FResizedAlready := False;
586     FShowPnlXScheduleOk := True;
587     FRemoveText := True;
588     JAWSON := True;
589     if ScreenReaderActive = false then
590       begin
591         lblAdminTime.TabStop := false;
592         lblAdminSch.TabStop := false;
593         memOrder.TabStop := false;
594         JAWSON := false;
595       end;
596   end;
597   
598   procedure TfrmODMeds.FormDestroy(Sender: TObject);
599   begin
600     {selection}
601     FQuickItems.Free;
602     FMedCache.Free;
603     {edit}
604     FGuideline.Free;
605     FAllDoses.Free;
606     FAllDrugs.Free;
607     frmFrame.pnlVisit.Enabled := true;
608     inherited;
609   end;
610   
611   procedure TfrmODMeds.InitDialog;
612   { Executed each time dialog is reset after pressing accept.  Clears controls & responses }
613   begin
614     inherited;
615     FLastPickup := ValueOf(FLD_PICKUP);
616     Changing := True;
617     ResetOnMedChange;
618     txtMed.Text := '';
619     txtMed.Tag := 0;
620     lstQuick.Selected := nil;
621     lstAll.Selected := nil;
622     if Visible then ShowMedSelect;
623     Changing := False;
624     FIsQuickOrder := False;
625     FQOQuantity := 0 ;
626     FQODosage   := '';
627     FQOInitial  := False;
628     FNSSOther   := False;
629   end;
630   
631   procedure TfrmODMeds.SetupDialog(OrderAction: Integer; const ID: string);
632   var
633     AnInstr, OrderID, nsSch, Text, tempOrder, tempSchString, tempSchType, AdminTime, x, DEAFailStr, TX_INFO: string;
634     i, ix: integer;
635     LocChange: boolean;
636     AResponse: TResponse;
637   
638   begin
639     inherited;
640     FOrderAction := OrderAction;
641     if self.EvtID > 0 then DisplayDoseNow(false);
642     if XfInToOutNow then DisplayGroup := DisplayGroupByName('O RX');
643     if (CharAt(ID,1)='X') or (CharAt(ID,1)='C') then
644     begin
645       OrderID := Copy(Piece(ID, ';', 1), 2, Length(ID));
646       CheckExistingPI(OrderID, FPtInstruct);
647     end;
648     //AGP 27.72 Order Action behave similar to QO this is why Edit and Copy are setting FIsQuickOrder to true
649     //this is not the best approach but this should fix the problem with order edit losing the quantity value.
650     if ((OrderAction = ORDER_QUICK) or (OrderAction = ORDER_EDIT) or (OrderAction = ORDER_COPY)) then
651     begin
652       FIsQuickOrder := True;
653       FQOInitial := True;
654     end
655     else
656     begin
657       FIsQuickOrder := False;
658       FQOInitial := False;
659     end;
660     if lblDays.Visible then SetVisibleCommentRows(2) else SetVisibleCommentRows(4);
661     if OrderAction in [ORDER_COPY, ORDER_EDIT] then Responses.Remove('START', 1);
662     if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then
663     begin
664       Changing := True;
665       txtMed.Tag  := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0);
666       if (OrderAction = ORDER_QUICK) or (OrderAction = ORDER_COPY) then
667         begin
668           DEAFailStr := '';
669           DEAFailStr := DEACheckFailed(txtMed.Tag, FInptDlg);
670           while StrToIntDef(Piece(DEAFailStr,U,1),0) in [1..5] do
671             begin
672               //btnSelect.Visible := False;
673               btnSelect.Enabled := False;
674               case StrToIntDef(Piece(DEAFailStr,U,1),0) of
675                 1:  TX_INFO := TX_DEAFAIL;  //prescriber has an invalid or no DEA#
676                 2:  TX_INFO := TX_SCHFAIL + Piece(DEAFailStr,U,2) + '.';  //prescriber has no schedule privileges in 2,2N,3,3N,4, or 5
677                 3:  TX_INFO := TX_NO_DETOX;  //prescriber has an invalid or no Detox#
678                 4:  TX_INFO := TX_EXP_DEA1 + Piece(DEAFailStr,U,2) + TX_EXP_DEA2;  //prescriber's DEA# expired and no VA# is assigned
679                 5:  TX_INFO := TX_EXP_DETOX1 + Piece(DEAFailStr,U,2) + TX_EXP_DETOX2;  //valid detox#, but expired DEA#
680               end;
681               if InfoBox(TX_INFO + TX_INSTRUCT, TC_DEAFAIL, MB_RETRYCANCEL) = IDRETRY then
682                 begin
683                   DEAContext := True;
684                   fFrame.frmFrame.mnuFileEncounterClick(self);      //select another prescriber and perform DEA check again
685                   DEAFailStr := '';
686                   DEAFailStr := DEACheckFailed(txtMed.Tag, FInptDlg);
687                 end
688               else
689                 begin
690                   AbortOrder := True;
691                   Exit;
692                 end;
693             end;
694         end;
695       if (OrderAction = ORDER_QUICK) and (uOrders.PassDrugTstCall = False) and
696        (uOrders.OutptDisp = OutptDisp) and (PassDrugTest(txtMed.Tag, 'Q', false) = False) then Exit;
697       if (OrderAction = ORDER_QUICK) and (uOrders.PassDrugTstCall = False) and
698        ((uOrders.ClinDisp = ClinDisp) or (uOrders.InptDisp = InptDisp)) and (PassDrugTest(txtMed.Tag, 'Q', true) = False) then Exit;
699     (*  if (OrderAction = ORDER_QUICK) then
700         begin
701           tempAltIEN := GetQOAltOI;
702           if tempAltIEN > 0 then txtMed.Tag := tempAltIEN;
703         end; *)
704       SetOnMedSelect;                               // set up for this medication
705       SetOnQuickOrder;                              // insert quick order responses
706       ShowMedFields;
707       if (OrderAction = ORDER_EDIT) and OrderIsReleased(Responses.EditOrder)
708         then btnSelect.Enabled := False;
709       if (OrderAction in [ORDER_COPY, ORDER_EDIT]) and (self.EvtID <= 0) then //nss
710       begin
711          if NSSchedule then
712          begin
713            for ix := 0 to Responses.TheList.Count - 1 do
714            begin
715              if TResponse(Responses.TheList[ix]).promptid = 'SCHEDULE'  then
716              begin
717                nsSch :=  TResponse(Responses.theList[ix]).EVALUE;
718                if length(nsSch) > 0 then
719                begin
720                   SetSchedule(UpperCase(nsSch));
721                   {cboSchedule.SelectByID(nsSch);
722                   if cboSchedule.ItemIndex < 0 then
723                   begin
724                     cboSchedule.Items.Add(nsSch);
725                     cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(nsSch);
726                   end;}
727                end;
728              end;
729            end;
730          end;
731       end;  //nss
732       //if (FInptDlg) and (self.tabDose.TabIndex = TI_DOSE) and (OrderAction in [ORDER_COPY, ORDER_EDIT])  then
733       if (FInptDlg) and (OrderAction in [ORDER_COPY, ORDER_EDIT])  then
734         begin
735           TempOrder := Piece(id,';',1);
736           TempOrder := Copy(tempOrder, 2, Length(tempOrder));
737           LocChange := DifferentOrderLocations(tempOrder, Patient.Location);
738             if LocChange = false then
739               begin
740                 AResponse := Responses.FindResponseByName('ADMIN', 1);
741                 if AResponse <> nil then AdminTime := AResponse.EValue;
742                 if (self.cboSchedule.ItemIndex > -1) and (AdminTime <> '') then
743                   begin
744                     tempSchString := self.cboSchedule.Items.Strings[cboSchedule.itemindex];
745                     SetPiece(tempSchString,U,4,AdminTime);
746                     self.cboSchedule.Items.strings[cboSchedule.ItemIndex] := tempSchString;
747                   end;
748                 if (self.tabDose.TabIndex = TI_COMPLEX) and (Responses.InstanceCount('INSTR') = 1) and (AdminTime <> '') then
749                   begin
750                     if self.cboXSchedule.ItemIndex > -1 then
751                       begin
752                         tempSchString := self.cboXSchedule.Items.Strings[cboXSchedule.itemindex];
753                         SetPiece(tempSchString,U,4,AdminTime);
754                         self.cboXSchedule.Items.strings[cboXSchedule.ItemIndex] := tempSchString;
755                       end;
756                   end;
757                 AResponse := Responses.FindResponseByName('SCHTYPE', 1);
758                 if AResponse <> nil then tempSchType := AResponse.EValue;
759                 if self.cboSchedule.ItemIndex > -1 then
760                   begin
761                     if (Piece(self.cboSchedule.Items.Strings[self.cboSchedule.itemIndex], U, 3) = 'C') and (tempSchType = 'P') then
762                        self.chkPRN.Checked := True
763                     else
764                        begin
765                          tempSchString := self.cboSchedule.Items.Strings[cboSchedule.itemindex];
766                          SetPiece(tempSchString,U,3,tempSchType);
767                          self.cboSchedule.Items.strings[cboSchedule.ItemIndex] := tempSchString;
768                        end;
769                     end;
770                  if (self.tabDose.TabIndex = TI_COMPLEX) and (Responses.InstanceCount('INSTR') = 1) then
771                   begin
772                     if self.cboXSchedule.ItemIndex > -1 then
773                       begin
774                         if  (Piece(self.cboXSchedule.Items.Strings[self.cboXSchedule.itemIndex], U, 3) = 'C') and (tempSchType = 'P') then
775                             self.chkXPRN.Checked := True
776                         else
777                           begin
778                             tempSchString := self.cboXSchedule.Items.Strings[cboXSchedule.itemindex];
779                             SetPiece(tempSchString,U,3,tempSchType);
780                             self.cboXSchedule.Items.strings[cboXSchedule.ItemIndex] := tempSchString;
781                           end;
782                       end;
783                   end;
784               end;
785           if (FAdminTimeText <> 'Not defined for Clinic Locations') and (self.tabDose.TabIndex = TI_COMPLEX) then
786               lblAdminSchSetText('');
787           if (FAdminTimeText <> '') and (self.tabDose.TabIndex = TI_DOSE) then lblAdminSchSetText('Admin. Time: ' + FAdminTimeText);
788         end;
789       if ((OrderAction <> Order_COPY) and (OrderAction <> Order_EDIT)) or
790          (XfInToOutNow = true) or (FIsQuickOrder) then
791          begin
792            UpdateRelated(FALSE); //AGP Change
793            //Need to do the following code to reset the FLastUnits and FLastSchedule in case a free text Dose is found. If the following
794            //code is not done than the quantity will reset to zero
795            if not FInptDlg  then
796            begin
797              FLastUnits := '';
798              FLastSchedule := '';
799              FLastInstruct := '';
800              //Lasti := Responses.InstanceCount('INSTR');
801              //Lasti := Responses.NextInstance('DOSE', 0);
802              for I := 1 to Responses.InstanceCount('INSTR') do
803                begin
804                  x := ValueOfResponse(FLD_DOSEUNIT,  i);
805                  FLastUnits  := FLastUnits   + x  + U;
806                  x := Responses.IValueFor('INSTR',    i);
807                  FLastInstruct := FLastInstruct + x + U;
808                  x := ValueOfResponse(FLD_SCHEDULE,  i);
809                  FLastSchedule := FLastSchedule + x + U;
810                end;
811            end;
812          end;
813       Changing := False;
814       if ((OrderAction = Order_Copy) or (OrderAction = Order_Edit)) and
815           (self.cboSchedule.ItemIndex > -1) then
816             UpdateStartExpires(Piece(self.cboSchedule.items.strings[self.cboSchedule.itemindex], U, 1));
817     end;
818     { prevent the SIG from being part of the comments on pre-CPRS prescriptions }
819     if (OrderAction in [ORDER_COPY, ORDER_EDIT]) and (cboDosage.Text = '') then
820     begin
821       OrderID := Copy(Piece(ID, ';', 1), 2, Length(ID));
822       AnInstr := TextForOrder(OrderID);
823       pnlMessage.TabOrder := 0;
824       DispOrderMessage(AnInstr);
825       if OrderAction = ORDER_COPY
826         then AnInstr := 'Copy: ' + AnInstr
827         else AnInstr := 'Change: ' + AnInstr;
828       Text := AnsiReplaceText(AnInstr,CRLF,'');
829       Caption := Text;
830       memComment.Clear;  // sometimes the sig is in the comment
831     end;
832     FQOInitial := False;
833     ControlChange(Self);
834     if Self.IsSupply then
835       btnSelect.Enabled := False;
836   end;
837   
838   procedure TfrmODMeds.Validate(var AnErrMsg: string);
839   var
840     i,ie,code, curSupply, tempRefills: Integer;
841     curDispDrug, tmpError, temp, x: string;
842   
843     procedure SetError(const x: string);
844     begin
845       if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
846       AnErrMsg := AnErrMsg + x;
847     end;
848   
849     procedure ValidateDosage(const x: string);
850     begin
851       if Length(x) = 0 then SetError(TX_NO_DOSE);
852     end;
853   
854     procedure ValidateRoute(const x: string; NeedLookup: Boolean; AnInstance: Integer);
855     var
856       RouteID, RouteAbbr: string;
857     begin
858       //if order does not have route, and is not a supply order,
859       // and is not an outpaitent order, then display error text to require route
860       if (Length(x) = 0) and (Not IsSupplyAndOutPatient) then
861       begin
862         if cboRoute.Showing = true then cboRoute.SetFocus;  //CQ: 7467
863         SetError(TX_NO_ROUTE);
864       end;
865       if (Length(x) > 0) and NeedLookup then
866       begin
867         LookupRoute(x, RouteID, RouteAbbr);
868         if RouteID = '0'
869           then
870           begin
871            if cboRoute.Showing = true then cboRoute.SetFocus;    //CQ: 7467
872           SetError(TX_NF_ROUTE);
873           end
874           else Responses.Update('ROUTE', AnInstance, RouteID, RouteAbbr);
875       end;
876     end;
877   
878     procedure ValidateSchedule(const x: string; AnInstance: Integer);
879     const
880       SCH_BAD = 0;
881       SCH_NO_RTN = -1;
882     var
883       ValidLevel: Integer;
884       ARoute, ADrug, tmpX: string;
885     begin
886       ARoute := ValueOfResponse(FLD_ROUTE_ID, AnInstance);
887       ADrug  := ValueOfResponse(FLD_DRUG_ID,  AnInstance);
888       tmpX := x; //Changed for CQ: 7370 - it was tmpX := Trim(x);
889       if Pos(CRLF, tmpX)> 0 then
890         begin
891           SetError('Schedule cannot contains control characters');
892           Exit;
893         end;
894       if (Length(tmpX) = 0) and (not FInptDlg) then SetError(TX_NO_SCHED)
895       else if (Length(tmpX) = 0) and FInptDlg and ScheduleRequired(txtMed.Tag, ARoute, ADrug)
896         then SetError(TX_NO_SCHED);
897       if Length(tmpX) > 0 then
898       begin
899         if FInptDlg then ValidLevel := ValidSchedule(tmpX) else ValidLevel := ValidSchedule(tmpX, 'O');
900      (*   if FInptDlg and (tmpX <> '') and (cboSchedule.ItemIndex = -1) and
901         (self.tabDose.TabIndex = TI_DOSE) then
902            //SetError('Unique Schedule Selection Required');
903            SetError('More than one schedule starts with "'+tmpX+'". Please select a schedule from the list.');  *)
904         if ValidLevel = SCH_NO_RTN then
905         begin
906           if Pos('"', tmpX) > 0                              then SetError(TX_SCH_QUOTE);
907           if Copy(tmpX, 1, 1) = '-'                          then SetError(TX_SCH_MINUS);
908           if Pos(' ', Copy(tmpX, Pos(' ', tmpX) + 1, 999)) > 0  then SetError(TX_SCH_SPACE);
909           if Length(tmpX) > 70                               then SetError(TX_SCH_LEN);
910           if (Pos('P RN', tmpX) > 0) or (Pos('PR N', tmpX) > 0) then SetError(TX_SCH_PRN);
911           if Pos('Q0', tmpX) > 0                             then SetError(TX_SCH_ZERO);
912           if TrimLeft(tmpX) <> tmpX                             then SetError(TX_SCH_LSP);
913         end;
914         if ValidLevel = SCH_BAD then SetError(TX_SCH_NS);
915       end;
916     end;
917   
918   begin
919     inherited;
920     ControlChange(Self);                            // make sure everything is updated
921     if txtMed.Tag = 0 then SetError(TX_NO_MED);
922     if Responses.InstanceCount('INSTR') < 1 then SetError(TX_NO_DOSE);
923     if Pos(U, self.memComment.Text) > 0 then SetError('Comments cannot contain a "^".');
924     i := Responses.NextInstance('INSTR', 0);
925     while i > 0 do
926     begin
927       if (ValueOfResponse(FLD_DRUG_ID, i) = '') then
928       begin
929         if not ContainsAlpha(Responses.IValueFor('INSTR', i)) then
930         begin
931            SetError(TX_DOSE_NUM);
932            if tabDose.TabIndex = TI_DOSE then
933               cboDosage.SetFocus;    //CQ: 7467
934         end;
935         if Length(Responses.IValueFor('INSTR', i)) > 60       then
936         begin
937            if self.tabDose.TabIndex = TI_COMPLEX then
938              begin
939                 SetError('Dosage: ' + Responses.IValueFor('INSTR', i) + CRLF + TX_DOSE_LEN);
940              end
941            else
942              begin
943                 SetError(TX_DOSE_LEN);
944                 cboDosage.SetFocus;  //CQ: 7467
945              end;
946         end;
947       end;
948       ValidateRoute(Responses.EValueFor('ROUTE', i), Responses.IValueFor('ROUTE', i) = '', i);
949       ValidateSchedule(ValueOfResponse(FLD_SCHEDULE, i), i);
950       i := Responses.NextInstance('INSTR', i);
951     end;
952     if self.tabDose.TabIndex = TI_DOSE then
953        begin
954            if (LeftStr(cboDosage.Text,1)='.') then
955          begin
956            SetError('Dosage must have a leading numeric value');
957            Exit;
958          end;
959        end;
960     //AGP Change 26.45 Fix for then/and conjucntion PSI-04-069
961     if self.tabDose.TabIndex = TI_COMPLEX then
962       begin
963          for i := 1 to self.grdDoses.RowCount do
964            begin
965              temp := ValFor(COL_DOSAGE, i);
966              if (LeftStr(temp,1) = '.') then
967                begin
968                   SetError('All dosage must have a leading numeric value');
969                   Exit;
970                end;
971              if (i > 1) and ((ValFor(COL_DOSAGE, i-1) <> '') and (ValFor(COL_DOSAGE, i) <> '')) and (ValFor(COL_SEQUENCE,i-1) = '') then
972                 begin
973                   SetError(TX_NO_SEQ);
974                   Exit;
975                 end;
976              if Uppercase(ValFor(Col_Sequence, i)) = 'THEN' then
977                begin
978                   if ValFor(Col_Duration,i) = '' then
979                     begin
980                       SetError('A duration is required when using "Then" as a sequence.');
981                       Exit;
982                     end;
983                end;
984            end;
985       end;
986     if not FInptDlg then                            // outpatient stuff
987     begin
988       if Responses.IValueFor('PICKUP', 1) = '' then SetError(TX_NO_PICK);
989       temp := Responses.IValueFor('REFILLS', 1);
990       for i := 1 to Length(temp) do if not (temp[i] in ['0'..'9']) then
991         begin
992           SetError('Refills can only be a number');
993           Exit;
994         end;
995       tempRefills := StrToIntDef(temp, 0);
996       if (spnRefills.Max > 0) and (tempRefills > 0) then
997         begin
998           i := Responses.NextInstance('DOSE', 0);
999           while i > 0 do
1000          begin
1001            x := ValueOfResponse(FLD_DRUG_ID,   i);
1002            CurDispDrug := CurDispDrug + x + U;
1003            i := Responses.NextInstance('DOSE', i);
1004          end;
1005          CurSupply   := StrToIntDef(ValueOfResponse(FLD_SUPPLY)   ,0);
1006          UpdateRefills(CurDispDrug, CurSupply);
1007        end;
1008      if tempRefills > spnRefills.Max
1009        then SetError(TX_RNG_REFILL + IntToStr(spnRefills.Max));
1010      with txtQuantity do
1011        begin
1012          if not ValidQuantity(Responses.IValueFor('QTY', 1)) then
1013            SetError(TX_QTY_NV);
1014        (*  else
1015            begin
1016              Quantity := ValidateQuantityErrorMsg(StrtoIntDef(Responses.IValueFor('QTY', 1), 0));
1017              if Quantity <> '' then SetError(Quantity);
1018            end; *)
1019        end;
1020      with txtSupply do
1021      begin
1022        txtSupply.Text := Trim(txtSupply.Text);
1023        Val( txtSupply.Text, ie, code);
1024        if (code <> 0) and (ie = 0)then
1025        begin
1026          SetError(TX_SUPPLY_NINT);
1027          Exit;
1028        end;
1029        if (StrToIntDef(Responses.IValueFor('SUPPLY', 1), 0) > 90) then SetError(TX_SUPPLY_LIM);
1030        if (StrToIntDef(Responses.IValueFor('SUPPLY', 1), 0) < 1)  then SetError(TX_SUPPLY_LIM1);
1031        //Supply := ValidateDaySupplyandQuantityErrorMsg(strtoInt(Responses.IValueFor('SUPPLY',1)));
1032        //if Supply <> '' then  SetError(Supply);
1033      end;
1034      tmpError :=  ValidateDaySupplyandQuantityErrorMsg(strtoInt(Responses.IValueFor('SUPPLY',1)),StrtoIntDef(Responses.IValueFor('QTY', 1), 0));
1035      if tmpError <> '' then SetError(tmpError)
1036      else ClearMaxData;
1037    end;
1038  end;
1039  
1040  procedure TfrmODMeds.SetVisibleCommentRows( Rows: integer);
1041  begin
1042    memComment.Height := (Abs(Font.Height)+2)*Rows+8;
1043  end;
1044  
1045  procedure TfrmODMeds.SetControlsInpatient;
1046  begin
1047    FillerID := 'PSI';
1048    CtrlInits.LoadDefaults(ODForMedsIn);
1049    lblPriority.Top := pnlFields.Height - cboPriority.Height - lblPriority.Height - 1;
1050    cboPriority.Top := pnlFields.Height - cboPriority.Height;
1051    lblDays.Visible := False;
1052    txtSupply.Visible := False;
1053    spnSupply.Visible := False;
1054    lblQuantity.Visible := False;
1055    txtQuantity.Visible := False;
1056    spnQuantity.Visible := False;
1057    lblQtyMsg.Visible := False;
1058    lblRefills.Visible := False;
1059    txtRefills.Visible := False;
1060    spnRefills.Visible := False;
1061    grpPickup.Visible := False;
1062    lblPriority.Visible := True;
1063    cboPriority.Visible := True;
1064    chkDoseNow.Visible := True;
1065    lblAdminTime.Visible := True;
1066    lblAdminSch.Visible := True;
1067    lblAdminSch.Hint := AdminTimeHelpText;
1068    if cboXSequence.Items.IndexOf('except') > -1 then cboXSequence.Items.Delete(cboXSequence.Items.IndexOf('except'));
1069  end;
1070  
1071  procedure TfrmODMeds.SetControlsOutpatient;
1072  begin
1073    FillerID := 'PSO';
1074    CtrlInits.LoadDefaults(ODForMedsOut);
1075    lblPriority.Top := lblQuantity.Top;
1076    cboPriority.Top := txtQuantity.Top;
1077    lblDays.Visible := True;
1078    txtSupply.Visible := True;
1079    spnSupply.Visible := True;
1080    lblQuantity.Visible := True;
1081    txtQuantity.Visible := True;
1082    //if IsClozapineOrder = True then txtQuantity.Enabled := false;
1083    spnQuantity.Visible := True;
1084    lblQtyMsg.Visible := True;
1085    lblRefills.Visible := True;
1086    txtRefills.Visible := True;
1087    spnRefills.Visible := True;
1088    grpPickup.Visible := True;
1089    lblPriority.Visible := True;
1090    cboPriority.Visible := True;
1091    chkDoseNow.Visible := False;
1092    lblAdminTime.Visible := False;
1093    lblAdminSch.Visible := False;
1094    if cboXSequence.Items.IndexOf('except') = -1 then cboXSequence.Items.Add('except');
1095    
1096  end;
1097  
1098  { Navigate medication selection lists ------------------------------------------------------- }
1099  
1100  { txtMed methods (including timers) }
1101  
1102  procedure TfrmODMeds.WMTimer(var Message: TWMTimer);
1103  begin
1104    inherited;
1105    if (Message.TimerID = TIMER_ID) then
1106    begin
1107      StopKeyTimer;
1108      ChangeDelayed;
1109    end;
1110  end;
1111  
1112  procedure TfrmODMeds.StartKeyTimer;
1113  { start (or restart) a timer (done on keyup to delay before calling OnKeyPause) }
1114  var
1115    ATimerID: Integer;
1116  begin
1117    StopKeyTimer;
1118    ATimerID := SetTimer(Handle, TIMER_ID, TIMER_DELAY, nil);
1119    FKeyTimerActive := ATimerID > 0;
1120    // if can't get a timer, just call the event immediately  F
1121    if not FKeyTimerActive then Perform(WM_TIMER, TIMER_ID, 0);
1122  end;
1123  
1124  procedure TfrmODMeds.StopKeyTimer;
1125  { stop the timer (done whenever a key is pressed or the combobox no longer has focus) }
1126  begin
1127    if FKeyTimerActive then
1128    begin
1129      KillTimer(Handle, TIMER_ID);
1130      FKeyTimerActive := False;
1131    end;
1132  end;
1133  
1134  function TfrmODMeds.FindQuickOrder(const x: string): Integer;
1135  var
1136    i: Integer;
1137  begin
1138    Result := -1;
1139    if x = '' then Exit;
1140    for i := 0 to Pred(FQuickItems.Count) do
1141    begin
1142      if (Result > -1) or (FQuickItems[i] = '') then Break;
1143      if AnsiCompareText(x, Copy(Piece(FQuickItems[i],'^',2), 1, Length(x))) = 0 then Result := i;
1144    end;
1145  end;
1146  
1147  procedure TfrmODMeds.txtMedKeyDown(Sender: TObject; var Key: Word;
1148    Shift: TShiftState);
1149  var
1150    i: Integer;
1151    x: string;
1152  begin
1153    if txtMed.ReadOnly then    // v27.50 - RV - CQ #15365
1154    begin
1155      if not (Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_HOME, VK_END]) then           // navigation
1156      begin
1157        Key := 0;
1158        Exit;
1159      end;
1160    end
1161    else if (Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN]) then             // navigation
1162    begin
1163      FActiveMedList.Perform(WM_KEYDOWN, Key, 0);
1164      FFromSelf := True;
1165      //txtMed.Text := FActiveMedList.Selected.Caption;
1166      txtMed.SelectAll;
1167      FFromSelf := False;
1168      Key := 0;
1169    end
1170    else if Key = VK_BACK then
1171    begin
1172      FFromSelf := True;
1173      x := txtMed.Text;
1174      i := txtMed.SelStart;
1175      if i > 1 then Delete(x, i + 1, Length(x)) else x := '';
1176      txtMed.Text := x;
1177      if i > 1 then txtMed.SelStart := i;
1178      FFromSelf := False;
1179    end
1180    else {StartKeyTimer};
1181  end;
1182  
1183  procedure TfrmODMeds.txtMedKeyUp(Sender: TObject; var Key: Word;
1184    Shift: TShiftState);
1185  begin
1186    if txtMed.ReadOnly then exit;    // v27.50 - RV - CQ #15365
1187    if not (Key in [VK_PRIOR, VK_NEXT, VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_HOME, VK_END]) then StartKeyTimer;
1188  end;
1189  
1190  
1191  procedure TfrmODMeds.txtMedChange(Sender: TObject);
1192  begin
1193    if FFromSelf then Exit;
1194    FChangePending := True;
1195  end;
1196  
1197  procedure TfrmODMeds.ScrollToVisible(AListView: TListView);
1198  var
1199    Offset: Integer;
1200    SelRect: TRect;
1201  begin
1202    AListView.Selected.MakeVisible(FALSE);
1203    SelRect := AListView.Selected.DisplayRect(drBounds);
1204    FRowHeight := SelRect.Bottom - SelRect.Top;
1205    Offset := AListView.Selected.Index - AListView.TopItem.Index;
1206    Application.ProcessMessages;
1207    if Offset > 0 then AListView.Scroll(0, (Offset * FRowHeight));
1208    Application.ProcessMessages;
1209  end;
1210  
1211  procedure TfrmODMeds.ChangeDelayed;
1212  var
1213    QuickIndex, AllIndex: Integer;
1214    NewText, OldText, UserText: string;
1215    UniqueText: Boolean;
1216  begin
1217    FRemoveText := False;
1218    UniqueText := False;
1219    FChangePending := False;
1220    if (Length(txtMed.Text) > 0) and (txtMed.SelStart = 0) then Exit;  // don't lookup null
1221    // lookup item in appropriate list box
1222    NewText := '';
1223    UserText := Copy(txtMed.Text, 1, txtMed.SelStart);
1224    QuickIndex := FindQuickOrder(UserText);            // look in quick list first
1225    AllIndex := IndexOfOrderable(FCacheIEN, UserText);  // but always synch the full list
1226    if UserText <> Copy(txtMed.Text, 1, txtMed.SelStart) then Exit;  // if typing during lookup
1227    if AllIndex > -1 then
1228    begin
1229      lstAll.Selected := lstAll.Items[AllIndex];
1230      FActiveMedList := lstAll;
1231    end;
1232    if QuickIndex > -1 then
1233    begin
1234      try
1235        lstQuick.Selected := lstQuick.Items[QuickIndex];
1236        lstQuick.ItemFocused := lstQuick.Selected;
1237        NewText := lstQuick.Selected.Caption;
1238        FActiveMedList := lstQuick;
1239        //Search Quick List for Uniqueness
1240        UniqueText := isUniqueQuickOrder(UserText);
1241      except
1242        //doing nothing  short term solution related to 117
1243      end;
1244    end
1245    else if AllIndex > -1 then
1246    begin
1247      lstAll.Selected := lstAll.Items[AllIndex];
1248      lstAll.ItemFocused := lstAll.Selected;
1249      NewText := lstAll.Selected.Caption;
1250      lstQuick.Selected := nil;
1251      FActiveMedList := lstAll;
1252      //List is alphabetical, So compare next Item in list to establish uniqueness.
1253      if CompareText(UserText, Copy(lstAll.Items[AllIndex+1].Caption, 1, Length(UserText))) <> 0 then
1254        UniqueText := True;
1255    end
1256    else
1257    begin
1258      lstQuick.Selected := nil;
1259      lstAll.Selected := nil;
1260      FActiveMedList := lstAll;
1261      NewText := txtMed.Text;
1262    end;
1263    if (AllIndex > -1) and (QuickIndex > -1) then  //Not Unique Between Lists
1264      UniqueText := False;
1265    FFromSelf := True;
1266    {AutoSelection is only based upon uniquely matching characters.
1267     Several CQs have been resolved relating to this issue:
1268     See CQ:
1269     7326 - Auto complete does not work correctly if user has quick orders in Medication list
1270     7328 - PSI-05-016: TAM-0205-31170  Med Error due to pre-populated med screen
1271     6715 PSI-04-044 Orders: NJH-0804-20315  Physician unable to enter medication order
1272    }
1273    if UniqueText then
1274    begin
1275      OldText := Copy(txtMed.Text, 1, txtMed.SelStart);
1276      txtMed.Text := NewText;
1277      //txtMed.SelStart := Length(OldText);  // v24.14 RV
1278      txtMed.SelStart := Length(UserText);   // v24.14 RV
1279      txtMed.SelLength := Length(NewText);
1280    end
1281    else begin
1282      txtMed.Text := UserText;
1283      txtMed.SelStart := Length(txtMed.Text);
1284    end;
1285    FFromSelf := False;
1286    if lstAll.Selected <> nil then
1287      ScrollToVisible(lstAll);
1288    if lstQuick.Selected <> nil then
1289      ScrollToVisible(lstQuick);
1290    if Not UniqueText then
1291    begin
1292      lstQuick.ItemIndex := -1;
1293      lstAll.ItemIndex := -1;
1294    end;
1295    FRemoveText := True;
1296  end;
1297  
1298  procedure TfrmODMeds.txtMedExit(Sender: TObject);
1299  begin
1300    StopKeyTimer;
1301    if txtMed.ReadOnly then exit;        // v27.50 - RV - CQ #15365
1302    if not ((ActiveControl = lstAll) or (ActiveControl = lstQuick)) then ChangeDelayed;
1303  end;
1304  
1305  { lstAll & lstQuick methods }
1306  
1307  procedure TfrmODMeds.ListViewEnter(Sender: TObject);
1308  begin
1309    inherited;
1310    FActiveMedList := TListView(Sender);
1311    with Sender as TListView do
1312    begin
1313      if Selected = nil then Selected := TopItem;
1314      if Name = 'lstQuick' then lstAll.Selected := nil else lstQuick.Selected := nil;
1315      ItemFocused := Selected;
1316      //ScrollToVisible(TListView(Sender));
1317    end;
1318  end;
1319  
1320  procedure TfrmODMeds.ListViewClick(Sender: TObject);
1321  begin
1322    inherited;
1323    btnSelect.Visible := True;
1324    btnSelect.Enabled := True;
1325    //txtMed.Text := FActiveMedList.Selected.Caption;
1326    PostMessage(Handle, UM_DELAYCLICK, 0, 0);
1327  end;
1328  
1329  procedure TfrmODMeds.UMDelayClick(var Message: TMessage);
1330  begin
1331   btnSelectClick(Self);
1332  end;
1333  
1334  procedure TfrmODMeds.ListViewEditing(Sender: TObject; Item: TListItem;
1335    var AllowEdit: Boolean);
1336  begin
1337    AllowEdit := FALSE;
1338  end;
1339  
1340  procedure TfrmODMeds.ListViewKeyUp(Sender: TObject; var Key: Word;
1341    Shift: TShiftState);
1342  begin
1343  //This code emulates combo-box behavior on the quick view and all meds view.
1344  //I think this is a really bad idea because it cannot automatically be undone.
1345  //Example: pull up a valid medication.  Press change button.  Press tab.  Valid
1346  //medication is gone, replaced by first quick order entry.  Not good behavior
1347  //when tabbing through page.
1348  //If we are going to use an edit box to play combo box, I emphatically suggest
1349  //that we use a different edit box.
1350  (*
1351    with Sender as TListView do
1352    begin
1353      if txtMed.Text = Selected.Caption then Exit; // for tabs, arrows, etc.
1354      FFromSelf := True;
1355      txtMed.Text := Selected.Caption;
1356      txtMed.SelectAll;
1357      FFromSelf := False;
1358      Key := 0;
1359    end;
1360  *)
1361  end;
1362  
1363  procedure TfrmODMeds.ListViewResize(Sender: TObject);
1364  begin
1365    with Sender as TListView do Columns.Items[0].Width := ClientWidth - 20;
1366  end;
1367  
1368  { lstAll Methods (lstAll is TListView) }
1369  
1370  procedure TfrmODMeds.Loaded;
1371  begin
1372    inherited;
1373    if ScreenReaderSystemActive then
1374      tabDose.TabStop := TRUE;
1375  end;
1376  
1377  // Cache is a list of 100 string lists, starting at idx 0
1378  procedure TfrmODMeds.LoadMedCache(First, Last: Integer);
1379  var
1380    firstChunk, lastchunk, i: integer;
1381    list: TStringList;
1382    firstMed, LastMed: integer;
1383  
1384  begin
1385    firstChunk := GetCacheChunkIndex(First);
1386    lastChunk := GetCacheChunkIndex(Last);
1387    for i := firstChunk to lastChunk do
1388    begin
1389      if (FMedCache.Count <= i) or (not assigned(FMedCache[i])) then
1390      begin
1391        while FMedCache.Count <= i do
1392          FMedCache.add(nil);
1393        list := TStringList.Create;
1394        FMedCache[i] := list;
1395        firstMed := i * MED_CACHE_CHUNK_SIZE;
1396        LastMed := firstMed + MED_CACHE_CHUNK_SIZE - 1;
1397        if LastMed >= lstAll.Items.Count then
1398          LastMed := lstAll.Items.Count - 1;
1399        SubsetOfOrderable(list, false, FCacheIEN, firstMed, lastMed);
1400      end;
1401    end;
1402  end;
1403  
1404  procedure TfrmODMeds.lstAllData(Sender: TObject; Item: TListItem);
1405  var
1406    x: string;
1407    chunk: integer;
1408    list: TStringList;
1409  begin
1410    LoadMedCache(Item.Index, Item.Index);
1411    chunk := GetCacheChunkIndex(Item.Index);
1412    list := TStringList(FMedCache[chunk]);
1413    //This is to make sure that the index that is being used is not outside of the stringlist
1414    If Item.Index mod MED_CACHE_CHUNK_SIZE < list.Count then begin
1415     x := list[Item.Index mod MED_CACHE_CHUNK_SIZE];
1416     Item.Caption := Piece(x, U, 2);
1417     Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
1418    end;
1419  end;
1420  
1421  procedure TfrmODMeds.lstAllDataHint(Sender: TObject; StartIndex,
1422    EndIndex: Integer);
1423  begin
1424    LoadMedCache(StartIndex, EndIndex);
1425  end;
1426  
1427  { lstQuick methods (lstQuick is TListView) }
1428  
1429  procedure TfrmODMeds.lstQuickData(Sender: TObject; Item: TListItem);
1430  var
1431    x: string;
1432  begin
1433  {  try
1434      if FQuickItems[Item.Index] = '' then
1435        SubsetOfQuickOrders(FQuickItems, FQuickList, Item.Index, Item.Index);}
1436      x := FQuickItems[Item.Index];
1437      Item.Caption := Piece(x, U, 2);
1438      Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
1439  {  except
1440      // doing nothing
1441    end;}
1442  end;
1443  
1444  procedure TfrmODMeds.lstQuickDataHint(Sender: TObject; StartIndex,
1445    EndIndex: Integer);
1446  begin
1447  
1448  end;
1449  
1450  { Medication is now selected ---------------------------------------------------------------- }
1451  
1452  procedure TfrmODMeds.btnSelectClick(Sender: TObject);
1453  var
1454    MedIEN: Integer;
1455    //MedName: string;
1456    QOQuantityStr: string;
1457    ErrMsg, Temp: string;
1458    DEAFailStr, TX_INFO: string;
1459  begin
1460    inherited;
1461    QOQuantityStr := '';
1462    DEAFailStr := '';
1463    btnSelect.SetFocus;                             // let the exit events finish
1464    self.MedName := '';
1465    if pnlMeds.Visible then                         // display the medication fields
1466    begin
1467      Changing := True;
1468      ResetOnMedChange;
1469      if (FActiveMedList = lstQuick) and (lstQuick.Selected <> nil) then   // quick order
1470      begin
1471        ErrMsg := '';
1472        FIsQuickOrder := True;
1473        FQOInitial := True;
1474        Responses.QuickOrder := Integer(lstQuick.Selected.Data);
1475        txtMed.Tag  := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0);
1476        if (not FInptDLG) and (PassDrugTest(TXTmED.Tag, 'N', false) = false) then exit;
1477        if (FInptDLG) and (PassDrugTest(TXTmED.Tag, 'N', true) = false) then exit;
1478        IsActivateOI(ErrMsg, txtMed.Tag);
1479        if Length(ErrMsg)>0 then
1480        begin
1481          //btnSelect.Visible := False;
1482          btnSelect.Enabled := False;
1483          ShowMsg(ErrMsg);
1484          Exit;
1485        end;
1486        DEAFailStr := DEACheckFailed(txtMed.Tag, FInptDlg);
1487        while StrToIntDef(Piece(DEAFailStr,U,1),0) in [1..5] do
1488        begin
1489          //btnSelect.Visible := False;
1490          btnSelect.Enabled := False;
1491          case StrToIntDef(Piece(DEAFailStr,U,1),0) of
1492            1:  TX_INFO := TX_DEAFAIL;  //prescriber has an invalid or no DEA#
1493            2:  TX_INFO := TX_SCHFAIL + Piece(DEAFailStr,U,2) + '.';  //prescriber has no schedule privileges in 2,2N,3,3N,4, or 5
1494            3:  TX_INFO := TX_NO_DETOX;  //prescriber has an invalid or no Detox#
1495            4:  TX_INFO := TX_EXP_DEA1 + Piece(DEAFailStr,U,2) + TX_EXP_DEA2;  //prescriber's DEA# expired and no VA# is assigned
1496            5:  TX_INFO := TX_EXP_DETOX1 + Piece(DEAFailStr,U,2) + TX_EXP_DETOX2;  //valid detox#, but expired DEA#
1497          end;
1498          if InfoBox(TX_INFO + TX_INSTRUCT, TC_DEAFAIL, MB_RETRYCANCEL) = IDRETRY then
1499            begin
1500              DEAContext := True;
1501              fFrame.frmFrame.mnuFileEncounterClick(self);
1502              DEAFailStr := '';
1503              DEAFailStr := DEACheckFailed(txtMed.Tag, FInptDlg);
1504            end
1505          else
1506            begin
1507              txtMed.Tag := 0;
1508              txtMed.SetFocus;
1509              Exit;
1510            end;
1511        end;
1512        if txtMed.Tag = 0 then
1513        begin
1514          //btnSelect.Visible := False;
1515          btnSelect.Enabled := False;
1516          txtMed.SetFocus;
1517          Exit;
1518        end;
1519     (*   temp := self.MedName;
1520        tempIEN := txtMed.Tag;
1521        QOIEN := GetQOOrderableItem(InttoStr(Responses.QuickOrder));
1522        if QOIEN > 0 then
1523          begin
1524            CheckFormularyOI(tempIEN, temp, FInptDlg);
1525            if tempIEN <> txtMed.Tag then
1526              begin
1527                txtMed.Tag := tempIEN;
1528                txtMed.Text := temp;
1529              end;
1530          end; *)
1531        FAltChecked := True;
1532        SetOnMedSelect;   // set up for this medication
1533        SetOnQuickOrder;  // insert quick order responses
1534        if Length(txtQuantity.Text)>0 then
1535           QOQuantityStr := txtQuantity.Text;
1536        ShowMedFields;
1537        if self.tabDose.TabIndex = TI_COMPLEX then self.lblAdminSch.Visible := false;
1538        if (txtQuantity.Text = '0') and (Length(QOQuantityStr)>0) then
1539          txtQuantity.Text := QOQuantityStr;
1540        //FQOInitial := False;
1541      end
1542      else if (FActiveMedList = lstAll) and (lstAll.Selected <> nil) then  // orderable item
1543      begin
1544        MedIEN := Integer(lstAll.Selected.Data);
1545        self.MedName := lstAll.Selected.Caption;
1546        if (not FInptDLG) and (PassDrugTest(MedIEN, 'N', false) = false) then exit;
1547        if (FInptDLG) and (PassDrugTest(MedIEN, 'N', true) = false) then exit;
1548        txtMed.Tag := MedIEN;
1549        ErrMsg := '';
1550        IsActivateOI(ErrMsg, txtMed.Tag);
1551        if Length(ErrMsg)>0 then
1552        begin
1553          //btnSelect.Visible := False;
1554          btnSelect.Enabled := False;
1555          ShowMsg(ErrMsg);
1556          Exit;
1557        end;
1558        DEAFailStr := '';
1559        DEAFailStr := DEACheckFailed(txtMed.Tag, FInptDlg);
1560        while StrToIntDef(Piece(DEAFailStr,U,1),0) in [1..5] do
1561        begin
1562          //btnSelect.Visible := False;
1563          btnSelect.Enabled := False;
1564          case StrToIntDef(Piece(DEAFailStr,U,1),0) of
1565            1:  TX_INFO := TX_DEAFAIL;  //prescriber has an invalid or no DEA#
1566            2:  TX_INFO := TX_SCHFAIL + Piece(DEAFailStr,U,2) + '.';  //prescriber has no schedule privileges in 2,2N,3,3N,4, or 5
1567            3:  TX_INFO := TX_NO_DETOX;  //prescriber has an invalid or no Detox#
1568            4:  TX_INFO := TX_EXP_DEA1 + Piece(DEAFailStr,U,2) + TX_EXP_DEA2;  //prescriber's DEA# expired and no VA# is assigned
1569            5:  TX_INFO := TX_EXP_DETOX1 + Piece(DEAFailStr,U,2) + TX_EXP_DETOX2;  //valid detox#, but expired DEA#
1570          end;
1571          if InfoBox(TX_INFO + TX_INSTRUCT, TC_DEAFAIL, MB_RETRYCANCEL) = IDRETRY then
1572            begin
1573              DEAContext := True;
1574              fFrame.frmFrame.mnuFileEncounterClick(self);
1575              DEAFailStr := '';
1576              DEAFailStr := DEACheckFailed(txtMed.Tag, FInptDlg);
1577            end
1578          else
1579            begin
1580              txtMed.Tag := 0;
1581              txtMed.SetFocus;
1582              Exit;
1583            end;
1584        end;
1585        if Pos(' NF', self.MedName) > 0 then
1586        begin
1587          temp := self.MedName;
1588          CheckFormularyOI(medIEN, temp, FInptDlg);
1589          FAltChecked := True;
1590          txtMed.Text := '';
1591        end;
1592        if MedIEN <> txtMed.Tag then
1593        begin
1594          txtMed.Tag := MedIEN;
1595          temp := self.MedName;
1596          self.MedName := txtMed.Text;
1597          txtMed.Text := Temp;
1598        end;
1599        SetOnMedSelect;
1600        ShowMedFields;
1601      end
1602      else                                                                 // no selection
1603      begin
1604        //btnSelect.Visible := False;
1605        btnSelect.Enabled := False;
1606        MessageBeep(0);
1607        //btnSelect.Visible := False;
1608        btnSelect.Enabled := False;
1609        Exit;
1610      end;
1611      UpdateRelated(False);
1612      Changing := False;
1613      ControlChange(Self);
1614    end
1615    else ShowMedSelect;                             // show the selection fields
1616    FNoZERO   := False;
1617    if FQOInitial = True then FQOInitial := False;
1618    
1619  end;
1620  
1621  procedure TfrmODMeds.ResetOnMedChange;
1622  var
1623    i: Integer;
1624  begin
1625    Responses.Clear;
1626    // clear dialog controls individually, since they are on panels
1627    with grdDoses do for i := 1 to Pred(RowCount) do Rows[i].Clear;
1628    cboDosage.Items.Clear;
1629    cboDosage.Text := '';
1630    cboRoute.Items.Clear;
1631    cboRoute.Text := '';
1632    cboRoute.Hint := cboRoute.Text;
1633    cboSchedule.ItemIndex := -1;
1634    cboSchedule.Text := '';  // leave items intact
1635    chkPRN.Checked := False;
1636    memComment.Lines.Clear;
1637    txtSupply.Text := '';
1638    txtQuantity.Text := '';
1639    txtRefills.Text := '0';
1640    lblQtyMsg.Caption := '';
1641    lblQuantity.Caption := 'Quantity';
1642    chkDoseNow.Checked := FALSE;
1643    lblAdminTime.Caption := '';
1644    chkPtInstruct.Checked := False;
1645    chkPtInstruct.Visible := False;
1646    memPI.Visible := False;
1647    stcPI.Visible := False;
1648    image1.Visible := False;
1649    memDrugMsg.Visible := False;
1650    FLastUnits    := '';
1651    FLastSchedule := '';
1652    FLastDuration := '';
1653    FLastInstruct := '';
1654    FLastDispDrug := '-1';
1655    FLastQuantity := 0;
1656    FLastSupply   := 0;
1657    FAltChecked   := False;
1658    FPtInstruct   := '';
1659  end;
1660  
1661  procedure TfrmODMeds.ResetOnTabChange;
1662  var
1663    i: Integer;
1664  begin
1665    with grdDoses do for i := 1 to Pred(RowCount) do Rows[i].Clear;
1666    Responses.Clear('STRENGTH');
1667    Responses.Clear('NAME');
1668    Responses.Clear('INSTR');
1669    Responses.Clear('DOSE');
1670    Responses.Clear('DRUG');
1671    Responses.Clear('DAYS');
1672    Responses.Clear('ROUTE');
1673    Responses.Clear('SCHEDULE');
1674    Responses.Clear('START', 1);
1675    Responses.Clear('SIG');
1676    Responses.Clear('SUPPLY');
1677    Responses.Clear('QTY');
1678    cboDosage.ItemIndex := -1;
1679    cboDosage.Text := '';
1680    cboRoute.ItemIndex  := -1;
1681    cboRoute.Text := '';
1682    cboSchedule.ItemIndex := -1;
1683    cboSchedule.Text := '';  // leave items intact
1684    if FAdminTimeText <> 'Not defined for Clinic Locations' then lblAdminSchSetText('');
1685    txtSupply.Text := '';
1686    txtSupply.Tag := 0;
1687    txtQuantity.Text := '';
1688    txtQuantity.Tag := 0;
1689    lblQtyMsg.Caption := '';
1690    lblQuantity.Caption := 'Quantity';
1691    FSmplPRNChkd := chkPRN.Checked;  //  GE  CQ7585
1692    chkPRN.Checked := False;
1693    FLastUnits    := '';
1694    FLastSchedule := '';
1695    FLastDuration := '';
1696    FLastInstruct := '';
1697    FLastDispDrug := '';
1698    FDrugID := '';
1699  end;
1700  
1701  procedure TfrmODMeds.SetOnMedSelect;
1702  var
1703    i,j: Integer;
1704    temp,x: string;
1705    QOPiUnChk: boolean;
1706    PKIEnviron: boolean;
1707    AResponse: TResponse;
1708  begin
1709    // clear controls?
1710    cboDosage.Tag := -1;
1711    txtSupply.Tag := 0;
1712    txtQuantity.Tag := 0;
1713    spnQuantity.Tag := 0;
1714     QOPiUnChk := False;
1715    PKIEnviron := False;
1716    if GetPKISite then PKIEnviron := True;
1717    with CtrlInits do
1718    begin
1719      // set up CtrlInits for orderable item
1720      LoadOrderItem(OIForMed(txtMed.Tag, FInptDlg, IncludeOIPI, PKIEnviron));
1721      // set up lists & initial values based on orderable item
1722      SetControl(txtMed,       'Medication');
1723          if (self.MedName <> '') then
1724         begin
1725           if (txtMed.Text <> self.MedName) then
1726             begin
1727               temp := self.MedName;
1728               self.MedName := txtMed.Text;
1729               txtMed.Text := temp;
1730             end
1731           else MedName := '';
1732         end;
1733      SetControl(cboDosage,    'Dosage');
1734      SetControl(cboRoute,     'Route');
1735      if cboRoute.Items.Count = 1 then cboRoute.ItemIndex := 0;
1736      cboRouteChange(Self);
1737      x := DefaultText('Schedule');
1738      //AGP Change 27.72 trying to centralized the schedule setting code
1739      AResponse := Responses.FindResponseByName('SCHEDULE',1);
1740      if (AResponse <> nil) and (AResponse.EValue <> '') then  x := AResponse.EValue;
1741      SetSchedule(UpperCase(x));
1742     (* if x <> '' then
1743      begin
1744        cboSchedule.SelectByID(x);
1745        if cboSchedule.ItemIndex > -1 then
1746          AdminTime := Piece(cboSchedule.Items.Strings[cboSchedule.itemindex],U,4);
1747        if (cboSchedule.ItemIndex < 0) and (RightStr(x,3) = 'PRN')  then
1748          begin
1749            self.chkPRN.Checked := true;
1750            x := Copy(x,1,(Length(x)-3));
1751            if RightStr(X,1) = ' ' then x := Copy(x,1,(Length(x)-1))
1752          end;
1753        cboSchedule.Text := x;
1754      end; *)
1755      if Length(ValueOf(FLD_QTYDISP))>10 then
1756      begin
1757        lblQuantity.Caption := Copy(ValueOf(FLD_QTYDISP),0,7) + '...';
1758        lblQuantity.Hint := ValueOf(FLD_QTYDISP);
1759      end;
1760      FAllDoses.Text := TextOf('AllDoses');
1761      FAllDrugs.Text := TextOf('Dispense');
1762      FGuideline.Text := TextOf('Guideline');
1763      case FGuideline.Count of
1764      0: lblGuideline.Visible := False;
1765      1:   begin
1766             lblGuideline.Caption := FGuideline[0];
1767             lblGuideline.Visible := TRUE;
1768           end;
1769      else begin
1770             lblGuideline.Caption := 'Display Restrictions/Guidelines';
1771             lblGuideline.Visible := TRUE;
1772           end;
1773      end;
1774      if FInptDlg then
1775      begin
1776        if not FResizedAlready then
1777        begin
1778          pnlBottom.Height := pnlBottom.Height - lblDays.Height -  txtSupply.Height
1779            - stcPi.Height - memPi.Height + 6;
1780          FResizedAlready := True;
1781        end;
1782        pnlTop.Height := pnlFields.Height - pnlBottom.Height;
1783        chkDoseNow.Top := memComment.Top + memComment.Height + 1;
1784        lblPriority.Top := memcomment.Top + memComment.Height + 1;
1785        cboPriority.Top := lblPriority.Top + lblPriority.Height;
1786        lblAdminSch.Left := chkDoseNow.Left;
1787        lblAdminSch.Top := chkDoseNow.Top + chkDoseNow.Height - 1;
1788        lblAdminSch.Height := (MainFontHeight * 3) + 3;
1789        lblAdminSch.Width := cboPriority.Left - lblAdminSch.Left - 5;
1790        lblAdminTime.Left := lblAdminSch.Left;
1791        lblAdminTime.top := lblAdminSch.Top + lblAdminSch.Height -1;
1792        if self.tabDose.TabIndex = TI_Dose then lblAdminSchSetText('')
1793        else
1794          begin
1795            if FAdminTimeText = 'Not defined for Clinic Locations' then lblAdminSchSetText('Admin. Time: ' + FAdminTimeText)
1796            else self.lblAdminSch.Visible := False;
1797          end;
1798      end else
1799      begin
1800        DEASig := '';
1801        if GetPKISite then DEASig := DefaultText('DEASchedule');
1802        FSIGVerb := DefaultText('Verb');
1803        if Length(FSIGVerb) = 0 then FSIGVerb := TX_TAKE;
1804        FSIGPrep := DefaultText('Preposition');
1805        if FLastPickup <> '' then SetPickup(FLastPickup) else SetPickup(DefaultText('Pickup'));
1806        SetControl(txtRefills, 'Refills');
1807        for j := 0 to Responses.TheList.Count - 1 do
1808        begin
1809          if (TResponse(Responses.theList[j]).PromptID = 'PI') and (TResponse(Responses.theList[j]).EValue = ' ') then
1810            QOPiUnChk := True;
1811        end;
1812        //if Length(FPtInstruct) = 0 then
1813        if FPtInstruct = '' then FPtInstruct := TextOf('PtInstr');
1814        for i := 1 to Length(FPtInstruct) do if Ord(FPtInstruct[i]) < 32 then FPtInstruct[i] := ' ';
1815        FPtInstruct := TrimRight(FPtInstruct);
1816        if Length(FPtInstruct) > 0 then
1817        begin
1818          //chkPtInstruct.Caption := FPtInstruct;
1819          if memPI.Lines.Count > 0 then
1820            memPI.Lines.Clear;
1821          memPI.Lines.Add(FPtInstruct);
1822          chkPtInstruct.Visible := True;
1823          chkPtInstruct.Checked := True;
1824          stcPI.Visible := True;
1825          memPI.Visible := True;
1826          if FShrinked then
1827          begin
1828            pnlBottom.Height := pnlBottom.Height + memPi.Height + stcPI.Height + 2;
1829            FShrinked := False;
1830          end;
1831          if QOPiUnChk then
1832            chkPtInstruct.Checked := False;
1833        end else
1834        begin
1835          chkPtInstruct.Visible := False;
1836          chkPtInstruct.Checked := False;
1837          stcPI.Visible := False;
1838          memPI.Visible := False;
1839          if not FShrinked then
1840          begin
1841            pnlBottom.Height := pnlBottom.Height - stcPI.Height - memPI.Height - 2;
1842            FShrinked := True;
1843          end;
1844        end;
1845      end;
1846      pnlMessage.TabOrder := cboDosage.TabOrder + 1;
1847      DispOrderMessage(TextOf('Message'));
1848    end;
1849  end;
1850  
1851  procedure TfrmODMeds.SetOnQuickOrder;
1852  var
1853    AResponse: TResponse;
1854    x,LocRoute,TempSch,DispGrp, SchType: string;
1855    i, DispDrug: Integer;
1856  begin
1857    // txtMed already set by SetOnMedSelect
1858    with Responses do
1859    begin
1860      if (InstanceCount('INSTR') > 1) or (InstanceCount('DAYS') > 0) then // complex dose
1861      begin
1862        grdDoses.RowCount := HigherOf(InstanceCount('INSTR')+2, 4);
1863        i := Responses.NextInstance('INSTR', 0);
1864        while i > 0 do
1865        begin
1866          SetDosage(IValueFor('INSTR', i));
1867          with cboDosage do
1868            //agp change QO code to populate the Grid with the same fields after selection CQ 15933
1869            //if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex]
1870            if ItemIndex > -1 then x := Piece(Text, TAB, 1) + TAB + Items[ItemIndex]
1871           else x := IValueFor('INSTR',i); //AGP Change 26.41 for CQ 9102 PSI-05-015 affect copy and edit functionality
1872          grdDoses.Cells[COL_DOSAGE, i] := x;
1873          SetControl(cboRoute,  'ROUTE', i);
1874          with cboRoute do
1875            if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text;
1876          grdDoses.Cells[COL_ROUTE,  i] := x;
1877          SetSchedule(UpperCase(IValueFor('SCHEDULE', i)));
1878          if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = True) then cboSchedule.ItemIndex := -1;
1879          x := cboSchedule.Text;
1880          if chkPRN.Checked then x := x + ' PRN';
1881          with cboSchedule do
1882            if ItemIndex > -1 then x := x + TAB + Items[ItemIndex];
1883          grdDoses.Cells[COL_SCHEDULE, i] := x;
1884          if chkPRN.Checked = True then grdDoses.Cells[COL_CHKXPRN,i] := '1';
1885          grdDoses.Cells[COL_DURATION, i] := IValueFor('DAYS', i);
1886          if FInptDlg then
1887            begin
1888              if IValueFor('ADMIN', i) <> '' then grdDoses.Cells[COL_ADMINTIME, i] := IValueFor('ADMIN', i)
1889              else if (cboSchedule.ItemIndex > -1) and (chkPRN.Checked = false) then
1890                 grdDoses.Cells[COL_ADMINTIME, i] := Piece(cboSchedule.Items.Strings[cboSchedule.itemIndex],U,4)
1891              else grdDoses.Cells[COL_ADMINTIME, i] := '';
1892              if grdDoses.Cells[COL_ADMINTIME, i] = '' then grdDoses.Cells[COL_ADMINTIME, i] := 'Not Defined';
1893              if FAdminTimeText <> '' then grdDoses.Cells[COL_ADMINTIME, i] := FAdminTimeText;
1894              //done to prevent admin time showing up in schedules that should not have admin times. Also remove Not Defined for schedule
1895              //should not show the admin time
1896              if (cboSchedule.ItemIndex > -1) or (chkPRN.Checked = True) then
1897                begin
1898                  SchType := '';
1899                  if (cboSchedule.ItemIndex > -1) then SchType := Piece(cboSchedule.Items.Strings[cboSchedule.itemIndex],U,3);
1900                  if (SchType = 'P') or (SchType = 'O') or (SchType = 'OC') or (ChkPRN.Checked = True) then
1901                    grdDoses.Cells[COL_ADMINTIME, i] := '';
1902                end;
1903            end;
1904          chkPRN.Checked := false;
1905          if      IValueFor('CONJ', i) = 'A' then x := 'AND'
1906          else if IValueFor('CONJ', i) = 'T' then x := 'THEN'
1907          else if IValueFor('CONJ', i) = 'X' then x := 'EXCEPT'
1908          else x := '';
1909          grdDoses.Cells[COL_SEQUENCE, i] := x;
1910          i := Responses.NextInstance('INSTR', i);
1911        end; {while}
1912      end else                                      // single dose
1913      begin
1914        if FIsQuickOrder then
1915        begin
1916          FQODosage := IValueFor('INSTR', 1);
1917          SetDosage(FQODosage);
1918          TempSch := cboSchedule.Text;
1919        end
1920        else
1921          SetDosage(IValueFor('INSTR', 1));
1922        SetControl(cboRoute,  'ROUTE',     1);
1923        SetSchedule(UpperCase(IValueFor('SCHEDULE',  1)));
1924        if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = False) then
1925        begin
1926          cboSchedule.SelectByID(TempSch);
1927          cboSchedule.Text := TempSch;
1928        end;
1929        if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = True) then cboSchedule.ItemIndex := -1;
1930        if ((cboSchedule.Text = 'OTHER') and FIsQuickOrder)  then
1931           FNSSOther := True;
1932        DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID), 0);
1933        if Length(ValueOf(FLD_QTYDISP))>10 then
1934        begin
1935          lblQuantity.Caption := Copy(ValueOf(FLD_QTYDISP),0,7) + '...';
1936          lblQuantity.Hint := ValueOf(FLD_QTYDISP);
1937        end;
1938        if DispDrug > 0 then
1939        begin
1940          DispOrderMessage(DispenseMessage(DispDrug));
1941          x := QuantityMessage(DispDrug);
1942        end;
1943        if Length(x) > 0
1944          then lblQtyMsg.Caption := TX_QTY_PRE + x + TX_QTY_POST
1945          else lblQtyMsg.Caption := '';
1946      end;
1947      SetControl(memComment ,  'COMMENT',  1);
1948      SetControl(cboPriority,  'URGENCY',  1);
1949      if FInptDlg then
1950      begin
1951        SetControl(chkDoseNow, 'NOW', 1);
1952        chkDoseNowClick(Self);
1953      end else
1954      begin
1955        SetControl(txtSupply,   'SUPPLY',  1);
1956        txtSupply.Text := Trim(txtSupply.Text);
1957        spnSupply.Position   := StrToIntDef(txtSupply.Text, 0);
1958        { setting .Tag=1 was commented out because xfer & change were not auto-calculating }
1959        //if spnSupply.Position <> 0 then txtSupply.Tag   := 1;
1960        if Length(IValueFor('QTY',1))>0 then
1961        begin
1962          FQOQuantity := StrToFloat(IValueFor('QTY',1));
1963          txtQuantity.Text := FloatToStr(FQOQuantity);
1964        end;
1965        SetControl(txtQuantity, 'QTY',     1);
1966        SetControl(txtRefills,  'REFILLS', 1);
1967        spnRefills.Position  := StrToIntDef(txtRefills.Text, 0);
1968        AResponse := Responses.FindResponseByName('PICKUP', 1);
1969        if AResponse <> nil then SetPickup(AResponse.IValue);
1970        if (FIsQuickOrder) and (FOrderAction = ORDER_QUICK) then
1971        begin
1972          if not QOHasRouteDefined(Responses.QuickOrder) then
1973          begin
1974            LocRoute := GetPickupForLocation(IntToStr(Encounter.Location));
1975            SetPickup(LocRoute);
1976          end;
1977        end;
1978        DispGrp := NameOfDGroup(Responses.DisplayGroup);
1979        if (AResponse = nil) or ((StrToIntDef(Piece(Responses.CopyOrder,';',1),0)>0) and AnsiSameText('Out. Meds',DispGrp)) then
1980        begin
1981          LocRoute := GetPickupForLocation(IntToStr(Encounter.Location));
1982          SetPickup(LocRoute);
1983        end;
1984        if ValueOf(FLD_PICKUP) = '' then SetPickup(FLastPickup);
1985  //      AResponse := Responses.FindResponseByName('SC',     1);
1986        Responses.FindResponseByName('SC',     1);
1987      end; {if FInptDlg..else}
1988    end; {with}
1989   if (FInptDlg) then
1990    begin
1991      x := ValueOfResponse(FLD_SCHEDULE, 1);
1992      if Length(x) > 0 then UpdateStartExpires(x);
1993    end;
1994  end;
1995  
1996  procedure TfrmODMeds.ShowMedSelect;
1997  begin
1998    txtMed.SelStart := Length(txtMed.Text);
1999    ChangeDelayed;  // synch the listboxes with display
2000    pnlFields.Enabled := False;
2001    pnlFields.Visible := False;
2002    pnlMeds.Enabled   := True;
2003    pnlMeds.Visible   := True;
2004    pnlFields.Height := MemOrder.Top - 4 - pnlFields.Top;
2005    if btnSelect.Caption = 'Change' then
2006    begin
2007      btnSelect.Caption := 'OK';
2008      //btnSelect.Visible := false;
2009      btnSelect.Enabled := false;
2010    end;
2011    btnSelect.Top     := memOrder.Top;
2012    btnSelect.Anchors := [akRight, akBottom];
2013    btnSelect.BringToFront;
2014    cmdAccept.Visible := False;
2015    cmdAccept.Default := False;
2016    btnSelect.Default := True;
2017    cmdAccept.Left := cmdQuit.Left;
2018    cmdAccept.Top := MemOrder.Top;
2019    btnSelect.TabOrder := cmdAccept.TabOrder;
2020    cmdAccept.TabStop := False;
2021    txtMed.Width      := grdDoses.Width;
2022    txtMed.Font.Color := clWindowText;
2023    txtMed.Color      := clWindow;
2024    txtMed.ReadOnly   := False;
2025    txtMed.SelectAll;
2026    txtMed.SetFocus;
2027    FDrugID := '';
2028    //ShowOrderMessage( False );
2029  end;
2030  
2031  procedure TfrmODMeds.ShowMedFields;
2032  begin
2033    pnlMeds.Enabled   := False;
2034    pnlMeds.Visible   := False;
2035    pnlFields.Enabled := True;
2036    pnlFields.Visible := True;
2037    pnlFields.Height := MemOrder.Top - 4 - pnlFields.Top;
2038    btnSelect.Caption := 'Change';
2039    btnSelect.Visible := True;
2040    btnSelect.Enabled := True;
2041    btnSelect.Top     := txtMed.Top;
2042    btnSelect.Anchors := [akRight, akTop];
2043    btnSelect.Default := False;
2044    cmdAccept.Visible := True;
2045    cmdAccept.Default := False;
2046    cmdAccept.Left := cmdQuit.Left;
2047    cmdAccept.Top := MemOrder.Top;
2048    btnSelect.TabOrder := txtMed.TabOrder + 1;
2049    cmdAccept.TabStop := True;
2050    txtMed.Width      := memOrder.Width;
2051    txtMed.Font.Color := clInfoText;
2052    txtMed.Color      := clInfoBk;
2053    txtMed.ReadOnly   := True;
2054    if (Responses.InstanceCount('INSTR') > 1) or (Responses.InstanceCount('DAYS') > 0)
2055      then ShowControlsComplex else ShowControlsSimple;
2056  end;
2057  
2058  procedure TfrmODMeds.ShowControlsSimple;
2059  //var
2060    //dosagetxt: string;
2061  begin
2062    //Commented out, no longer using CharsNeedMatch Property
2063  {  NumCharsForMatch := 0;
2064    for i := 0 to cboDosage.Items.Count - 1 do         //find the shortest unit dose text on fifth piece
2065    begin
2066      dosagetxt := Piece(cboDosage.Items[i],'^',5);
2067      if Length(dosagetxt) < 1 then break;
2068      if NumCharsForMatch = 0 then
2069        NumCharsForMatch := Length(dosagetxt);
2070      if (NumCharsForMatch > Length(dosagetxt)) then
2071        NumCharsForMatch := Length(dosagetxt);
2072    end;
2073    if NumCharsForMatch > 1 then
2074      cboDosage.CharsNeedMatch := NumCharsForMatch - 1;
2075    if NumCharsForMatch > 5 then
2076      cboDosage.CharsNeedMatch := 5;}
2077    tabDose.TabIndex := TI_DOSE;
2078    grdDoses.Visible := False;
2079    btnXInsert.Visible := False;
2080    btnXRemove.Visible := False;
2081    cboDosage.Visible := True;
2082    lblRoute.Visible := True;
2083    cboRoute.Visible := True;
2084    lblSchedule.Visible := True;
2085    cboSchedule.Visible := True;
2086    if FInptDlg = True then lblAdminSch.Visible := True
2087    else lblAdminSch.Visible := false;
2088    chkPRN.Visible := True;
2089    ActiveControl := cboDosage;
2090  end;
2091  
2092  procedure TfrmODMeds.ShowControlsComplex;
2093  
2094    procedure MoveCombo(SrcCombo, DestCombo: TORComboBox; CompSch: boolean = false); //AGP Changes 26.12 PSI-04-63
2095    var
2096    cnt,i,index: integer;
2097    node,text: string;
2098    begin
2099    if (CompSch = false) or not (FInptDlg)then
2100      begin
2101        DestCombo.Items.Clear;
2102        FastAssign(SrcCombo.Items, DestCombo.Items);
2103        DestCombo.ItemIndex := SrcCombo.ItemIndex;
2104        DestCombo.Text := Piece(SrcCombo.Text, TAB, 1);
2105      end;
2106    if (CompSch = true) and (FInptDlg) then     // AGP Changes 26.12 PSI-04-63
2107      begin
2108      //AGP change 26.34 CQ 7201,6902 fix the problem with one time schedule still showing for inpatient complex orders
2109      DestCombo.ItemIndex := -1;
2110      Text := SrcCombo.Text;
2111      index := SrcCombo.ItemIndex;
2112      cnt := 0;
2113      for i := 0 to SrcCombo.Items.Count - 1 do
2114        begin
2115          node := SrcCombo.Items.Strings[i];
2116          if piece(node,U,3) <> 'O' then
2117            begin
2118              DestCombo.Items.Add(SrcCombo.Items.Strings[i]);
2119              if Piece(node,U,1) = text then DestCombo.ItemIndex := index - cnt;
2120            end
2121          else cnt := cnt+1;
2122        end;
2123      if (index = -1) and (Text <> '') then
2124         begin
2125           for I := 0 to DestCombo.Items.Count - 1 do
2126           if Piece(DestCombo.Items.Strings[i],U,1) = Text then
2127              begin
2128                 DestCombo.ItemIndex := i;
2129                 DestCombo.Text := Text;
2130                 Exit;
2131              end;
2132         end;
2133      end;
2134    end;
2135  
2136  //var
2137    //dosagetxt: string;
2138  begin
2139    tabDose.TabIndex := TI_COMPLEX;
2140    lblAdminSchSetText('');
2141    MoveCombo(cboDosage,   cboXDosage);
2142    MoveCombo(cboRoute,    cboXRoute);
2143    MoveCombo(cboSchedule, cboXSchedule, true);  //AGP Changes 26.12 PSI-04-063
2144    grdDoses.Visible := True;
2145    btnXInsert.Visible := True;
2146    btnXRemove.Visible := True;
2147    cboDosage.Visible := False;
2148    lblRoute.Visible := False;
2149    cboRoute.Visible := False;
2150    lblSchedule.Visible := False;
2151    cboSchedule.Visible := False;
2152    chkPRN.Visible := False;
2153    FDropColumn := -1;
2154    pnlFieldsResize(Self);
2155    ActiveControl := grdDoses;
2156    //Commented out, no longer using CharsNeedMatch Property
2157  {  NumCharsForMatch := 0;
2158    for i := 0 to cboXDosage.Items.Count - 1 do         //find the shortest unit dose text on fifth piece
2159    begin
2160      dosagetxt := Piece(cboXDosage.Items[i],'^',5);
2161      if Length(dosagetxt) < 1 then break;
2162      if NumCharsForMatch = 0 then
2163        NumCharsForMatch := Length(dosagetxt);
2164      if (NumCharsForMatch > Length(dosagetxt)) then
2165        NumCharsForMatch := Length(dosagetxt);
2166    end;
2167    if NumCharsForMatch > 1 then
2168      cboXDosage.CharsNeedMatch := NumCharsForMatch - 1;
2169    if NumCharsForMatch > 5 then
2170      cboDosage.CharsNeedMatch := 5;}
2171  end;
2172  
2173  procedure TfrmODMeds.SetDosage(const x: string);
2174  var
2175    i, DoseIndex: Integer;
2176  begin
2177    DoseIndex := -1;
2178    with cboDosage do
2179    begin
2180      ItemIndex := -1;
2181      for i := 0 to Pred(Items.Count) do
2182        if UpperCase(Piece(Items[i], U, 5)) = UpperCase(x) then
2183        begin
2184          DoseIndex := i;
2185          Break;
2186        end;
2187      if DoseIndex <0 then Text := x
2188    (*  if ((DoseIndex < 0) and (not IsTransferAction)) then Text := x
2189      else if ((DoseIndex < 0) and IsTransferAction) and (DosageTab = False) then Text := ''
2190      else if ((DoseIndex < 0) and IsTransferAction) and (DosageTab = True) then Text := x *)
2191      else ItemIndex := DoseIndex;
2192    end;
2193  end;
2194  
2195  procedure TfrmODMeds.SetPickup(const x: string);
2196  begin
2197    radPickClinic.Checked := FALSE;
2198    radPickMail.Checked   := FALSE;
2199    radPickWindow.Checked := FALSE;
2200    case CharAt(x, 1) of
2201    'C': radPickClinic.Checked := TRUE;
2202    'M': radPickMail.Checked   := TRUE;
2203    'W': radPickWindow.Checked := TRUE;
2204    else {leave all unchecked}
2205    end;
2206  end;
2207  
2208  procedure TfrmODMeds.SetSchedule(const x: string);
2209  var
2210  NonPRNPart,tempSch, tempText: string;
2211  begin
2212      //AGP Change 27.72 if schedule matches why goes through and reprocess the same info?
2213      if cboSchedule.ItemIndex > -1 then
2214        begin
2215          tempText := Piece(cboSchedule.Items.Strings[cboSchedule.itemindex], U, 1);
2216          if tempText = x then exit;
2217          if (Pos('PRN',x)>0) and (chkPRN.Checked = true) then
2218            begin
2219               NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
2220               if nonPRNPart = tempText then exit;
2221            end;
2222        end;
2223      cboSchedule.ItemIndex := -1;
2224      cboSchedule.Text := '';
2225      if chkPRN.Checked = True then chkPRN.Checked := False;
2226      cboSchedule.SelectByID(x);
2227      if cboSchedule.ItemIndex > -1 then exit;
2228      if (X = ' PRN') or (X = 'PRN') then
2229        begin
2230          chkPRN.Checked := True;
2231          Exit;
2232        end;
2233     // if cboSchedule.ItemIndex < 0 then
2234      //begin
2235        //if NSSchedule then
2236        //begin
2237        //  cboSchedule.Text := '';
2238        //end
2239        if FInptDlg then
2240          begin
2241            if (Pos('@', x) > 0) then
2242              begin
2243              tempSch := Piece(x, '@', 2);
2244              cboSchedule.SelectByID(tempSch);
2245              if cboSchedule.ItemIndex > -1 then
2246                begin
2247                  tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[cboSchedule.itemindex];
2248                  cboSchedule.Items.Add(tempSch);
2249                  cboSchedule.Text := (Piece(tempSch,U,1));
2250                  cboSchedule.SelectByID(Piece(tempSch,u,1));
2251                  EXIT;
2252                end;
2253              if Pos('PRN', tempSch) > 0 then
2254                begin
2255                  NonPRNPart := Trim(Copy(tempSch, 1, Pos('PRN', tempSch) - 1));
2256                  cboSchedule.SelectByID(NonPRNPart);
2257                  if cboSchedule.ItemIndex > -1 then
2258                    begin
2259                      tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[cboSchedule.itemindex];
2260                      cboSchedule.Items.Add(tempSch);
2261                      cboSchedule.Text := (Piece(tempSch,U,1));
2262                      cboSchedule.SelectByID(Piece(tempSch,u,1));
2263                      chkPRN.Checked := True;
2264                      EXIT;
2265                    end
2266                  else
2267                    begin
2268                      NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
2269                      chkPRN.Checked := true;
2270                      tempSch := NonPRNPart + U + U + U + Piece(NonPRNPart, '@', 2);
2271                      cboSchedule.Items.Add(tempSch);
2272                      cboSchedule.SelectByID(Piece(tempSch, U, 1));
2273                      EXIT;
2274                    end;
2275                end;
2276                cboSchedule.Items.Add(X + U + U + U + Piece(x, '@', 2));
2277                cboSchedule.Text := x;
2278                cboSchedule.SelectByID(x);
2279                EXIT;
2280              end
2281          else if Pos('PRN', x) > 0 then
2282            begin
2283              NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
2284              chkPRN.Checked := True;
2285              cboSchedule.SelectByID(NonPRNPart);
2286              if cboSchedule.ItemIndex > -1 then  EXIT;
2287            end;
2288        end
2289        else if Pos('PRN', x) > 0 then
2290          begin
2291           NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
2292           chkPRN.Checked := True;
2293           cboSchedule.SelectByID(NonPRNPart);
2294           if cboSchedule.ItemIndex > -1 then  EXIT;
2295           cboSchedule.Items.Add(NonPRNPart);
2296           cboSchedule.Text := NonPRNPart;
2297           cboSchedule.SelectByID(NonPRNPart);
2298           EXIT;
2299          end;
2300        cboSchedule.Items.Add(x);
2301        cboSchedule.Text := x;
2302        cboSchedule.SelectByID(x);
2303  end;
2304  
2305  { Medication edit --------------------------------------------------------------------------- }
2306  procedure TfrmODMeds.tabDoseChange(Sender: TObject);
2307  var
2308    //text,x, tmpsch: string;
2309    text, tmpAdmin, x: string;
2310    reset: integer;
2311  begin
2312    inherited;
2313    reset := 0;
2314    //AGP change for CQ 6521 added warning message
2315    //AGP Change for CQ 7508 added tab information
2316    //GE  Change warning message functionality show only   cq 7590
2317    //    when tab changes from complex to simple.
2318    //AGP Change for CQ 7834 and 7832 change text and added check to see if some values have been completed in row 1
2319    if (tabDose.TabIndex = 0) and ((ValFor(COL_DOSAGE, 1)<>'') or (ValFor(COL_SCHEDULE, 1)<>'') or (ValFor(COL_DURATION, 1)<>'') or
2320        (ValFor(COL_SEQUENCE, 1)<>''))  then
2321        begin
2322          text := 'By switching to the Dosage Tab, ' ;
2323           if (InfoBox(text +'you will lose all data on this screen. Click “OK” to continue or “Cancel”','Warning',MB_OKCANCEL)=IDCANCEL) then
2324              begin
2325               if tabDose.TabIndex = 1 then tabDose.TabIndex := 0
2326               else tabDose.TabIndex := 1;
2327               reset := 1;
2328              end;
2329        end;
2330    case tabDose.TabIndex of
2331    TI_DOSE:    begin
2332                  cboXSchedule.Clear;                       // Added to Fix CQ: 9603
2333                  cboXDosage.Clear;
2334                  // clean up responses?
2335                  FSuppressMsg := FOrigiMsgDisp;
2336                  ShowControlsSimple;
2337                  if reset = 0 then ResetOnTabChange;
2338                  txtNss.Left := lblSchedule.Left + lblSchedule.Width + 2;
2339                  if (FInptDlg) then txtNss.Visible := True
2340                  else txtNss.Visible := False;
2341                  cboXRoute.Hide;                           // Added to Fix CQ: 7640
2342                  ControlChange(Self);
2343                end;
2344    TI_RATE:    begin
2345                  // for future use...
2346                end;
2347    TI_COMPLEX: begin
2348                  FSuppressMsg := FOrigiMsgDisp;
2349                  if reset = 1 then exit;
2350                 (*  AGP Change admin wrap 27.73
2351                  tmpAdmin := Piece(self.lblAdminSch.text, ':', 2);
2352                  tmpAdmin := Copy(tmpAdmin,2,Length(tmpAdmin)); *)
2353                  tmpAdmin := lblAdminSchGetText;
2354                  if FAdminTimeText <> '' then
2355                    begin
2356                      tmpAdmin := FAdminTimeText;
2357                      if FAdminTimeText <> 'Not defined for Clinic Locations' then self.lblAdminSch.Visible := False;
2358                    end;               
2359                  ShowControlsComplex;
2360                  ResetOnTabChange;
2361                  txtNss.Left := grdDoses.Left + grdDoses.ColWidths[0] + grdDoses.ColWidths[1] + grdDoses.ColWidths[2] + 3;
2362                  txtNss.Visible := False;
2363                  x := cboXDosage.Text + TAB;
2364                  if LeftStr(x,1) = '.' then x := '';
2365                  with cboXDosage   do if ItemIndex > -1 then x := x + Items[ItemIndex];
2366                  grdDoses.Cells[COL_DOSAGE,   1] := x;
2367                  x := cboXRoute.Text + TAB;
2368                  with cboXRoute    do if ItemIndex > -1 then x := x + Items[ItemIndex];
2369                  grdDoses.Cells[COL_ROUTE,    1] := x;
2370                  x := cboXSchedule.Text + TAB;
2371                  with cboXSchedule do if ItemIndex > -1 then x := x + Items[ItemIndex];
2372                  grdDoses.Cells[COL_SCHEDULE, 1] := x;
2373                  //AGP Change 27.1 handle PRN not showing in schedule panel if a dose is not selected.
2374                  if FSmplPRNChkd then
2375                    begin
2376                      pnlXSchedule.Tag := 1;
2377                      self.chkXPRN.Checked := True;
2378                    end;
2379                  if FInptDLG then UpdateStartExpires(ValFor(VAL_SCHEDULE,1));
2380                  ControlChange(Self);
2381               end; {TI_COMPLEX}
2382    end; {case}
2383    if ScreenReaderSystemActive then
2384      GetScreenReader.Speak(tabDose.Tabs[tabDose.TabIndex] + ' tab');
2385  end;
2386  
2387  
2388  function TfrmODMeds.lblAdminSchGetText: string;
2389  var
2390  tempstr: string;
2391  i: integer;
2392  begin
2393    result := '';
2394    if self.lblAdminSch.Text = '' then exit;
2395    tempstr := '';
2396    if self.lblAdminSch.Lines.Count > 1 then
2397      begin
2398        for i := 0 to self.lblAdminSch.Lines.Count - 1 do
2399          tempstr := tempStr + self.lblAdminSch.Lines.Strings[i];
2400      end
2401    else if self.lblAdminSch.Lines.Count = 1 then
2402         begin
2403           tempstr := self.lblAdminSch.Text;
2404         end;
2405    Result := Piece(tempStr,':',2);
2406    Result := Copy(Result,2,Length(Result));
2407  end;
2408  
2409  procedure TfrmODMeds.lblAdminSchSetText(str: string);
2410  var
2411  cutoff: integer;
2412  begin
2413    cutoff := lblAdminSch.width div MainFontWidth;
2414    if Length(str) > cutoff then self.lblAdminSch.Text := Copy(str, 1, cutoff) + CRLF +
2415                                                Copy(str, cutoff + 1, Length(str))
2416    else self.lblAdminSch.Text := str;
2417  end;
2418  
2419  procedure TfrmODMeds.lblGuidelineClick(Sender: TObject);
2420  var
2421    TextStrings: TStringList;
2422  begin
2423    inherited;
2424    TextStrings := TStringList.Create;
2425    try
2426      TextStrings.Text := FGuideline.Text;
2427      ReportBox(TextStrings, TC_GUIDELINE, TRUE);
2428    finally
2429      TextStrings.Free;
2430    end;
2431    //if FGuideline.Count > 0 then InfoBox(FGuideline.Text, 'Restrictions/Guidelines', MB_OK);
2432  end;
2433  
2434  { cboDosage ------------------------------------- }
2435  
2436  procedure TfrmODMeds.CheckFormAltDose(DispDrug: Integer);
2437  var
2438    OI: Integer;
2439    OIName: string;
2440  begin
2441    if FAltChecked or (DispDrug = 0) then Exit;
2442    OI := txtMed.Tag;
2443    OIName := txtMed.Text;
2444    CheckFormularyDose(DispDrug, OI, OIName, FInptDlg);
2445    if OI <> txtMed.Tag then
2446    begin
2447      ResetOnMedChange;
2448      txtMed.Tag  := OI;
2449      txtMed.Text := OIName;
2450      SetOnMedSelect;
2451    end;
2452  end;
2453  
2454  procedure TfrmODMeds.cboDosageClick(Sender: TObject);
2455  var
2456    DispDrug: Integer;
2457    x: string;
2458  begin
2459    inherited;
2460    if FSuppressMsg then
2461    begin
2462       if PnlMessage.Visible = true then
2463       begin
2464         memMessage.SendToBack;
2465         PnlMessage.Visible := False;
2466       end;
2467    end;
2468    UpdateRelated(False);
2469    DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID), 0);
2470    if DispDrug > 0 then
2471    begin
2472      if not FSuppressMsg then
2473      begin
2474          DispOrderMessage(DispenseMessage(DispDrug));
2475      end;
2476      x := QuantityMessage(DispDrug);
2477    end
2478    else x := '';
2479    if Length(ValueOf(FLD_QTYDISP))>10 then
2480    begin
2481      lblQuantity.Caption := Copy(ValueOf(FLD_QTYDISP),0,7) + '...';
2482      lblQuantity.Hint := ValueOf(FLD_QTYDISP);
2483    end else
2484    begin
2485      lblQuantity.Caption := ValueOf(FLD_QTYDISP);
2486      lblQuantity.Hint := '';
2487    end;
2488    if Length(x) > 0
2489      then lblQtyMsg.Caption := TX_QTY_PRE + x + TX_QTY_POST
2490      else lblQtyMsg.Caption := '';
2491    with cboDosage do
2492      if (ItemIndex > -1) and (Piece(Items[ItemIndex], U, 3) = 'NF')
2493        then CheckFormAltDose(DispDrug);
2494  end;
2495  
2496  procedure TfrmODMeds.cboDosageChange(Sender: TObject);
2497  var
2498  temp1,temp2: string;
2499  Count: integer;
2500  begin
2501    inherited;
2502    Count := Pos(U,cboDosage.Text);
2503    if Count > 0 then
2504      begin
2505        temp1 := copy(cboDosage.Text,0,count-1);
2506        temp2 := copy(cboDosage.Text,count+1,Length(cboDosage.text));
2507        infoBox('An ^ is not allowed in the dosage value', 'Dosage Warning', MB_OK);
2508        cboDosage.Text := temp1 + temp2;
2509      end;
2510    UpdateRelated;
2511  end;
2512  
2513  procedure TfrmODMeds.cboDosageExit(Sender: TObject);
2514  var
2515  str: string;
2516  begin
2517    inherited;
2518    str := cboDosage.Text;
2519    if (length(cboDosage.Text)<1) then
2520        cboDosage.ItemIndex := -1;
2521   (* Probably not needed here since this on validation check on accept
2522    if (LeftStr(cboDosage.Text,1)='.') then
2523         begin
2524           infoBox('Dosage must have a leading numeric value','Invalid Dosage',MB_OK);
2525           if self.tabDose.TabIndex = TI_DOSE then cboDosage.SetFocus;
2526           Exit;
2527         end; *)
2528    if (length(cbodosage.Text)>0) and (cboDosage.ItemIndex > -1) and
2529      (trim(Piece(cboDosage.Items.Strings[cboDosage.ItemIndex],U,5)) <> trim(Piece(cboDosage.Text,tab,1))) then
2530      begin
2531        cboDosage.ItemIndex := -1;
2532        cboDosage.Text := Piece(str, tab, 1);
2533        UpdateRelated(false);
2534      end;
2535    if ActiveControl = memMessage then
2536    begin
2537      memMessage.SendToBack;
2538      PnlMessage.Visible := False;
2539      Exit;
2540    end;
2541    if ActiveControl = memComment then
2542    begin
2543     if PnlMessage.Visible = true then
2544     begin
2545       memMessage.SendToBack;
2546       PnlMessage.Visible := False;
2547     end;
2548    end
2549    else if (ActiveControl <> btnSelect) and (ActiveControl <> memComment) then
2550    begin
2551     if PnlMessage.Visible = true then
2552     begin
2553       memMessage.SendToBack;
2554       PnlMessage.Visible := False;
2555     end;
2556     //cboDosageClick(Self);
2557    end;
2558  end;
2559  
2560  { cboRoute -------------------------------------- }
2561  
2562  procedure TfrmODMeds.cboRouteChange(Sender: TObject);
2563  begin
2564    inherited;
2565    with cboRoute do
2566      if ItemIndex > -1 then
2567      begin
2568        if Piece(Items[ItemIndex], U, 5) = '1'
2569          then tabDose.Tabs[0] := 'Dosage / Rate'
2570          else tabDose.Tabs[0] := 'Dosage';
2571      end;
2572    cboDosage.Caption := tabDose.Tabs[0];
2573    if Sender <> Self then ControlChange(Sender);
2574  end;
2575  
2576  procedure TfrmODMeds.cboRouteExit(Sender: TObject);
2577  begin
2578    if Trim(cboRoute.Text) = '' then
2579      cboRoute.ItemIndex := -1;
2580  //  ValidateRoute(cboRoute); Removed based on Site feeback. See CQ: 7518
2581    inherited;
2582  end;
2583  
2584  procedure TfrmODMeds.cboRouteKeyUp(Sender: TObject; var Key: Word;
2585    Shift: TShiftState);
2586  begin
2587    inherited;
2588    if (Key = VK_BACK) and (cboRoute.Text = '') then cboRoute.ItemIndex := -1;
2589  end;
2590  
2591  { cboSchedule ----------------------------------- }
2592  
2593  procedure TfrmODMeds.cboScheduleClick(Sender: TObject);
2594  var
2595    othSch: string;
2596    idx : integer;
2597  begin
2598    inherited;
2599    if (FInptDlg) and (cboSchedule.Text = 'OTHER') then
2600    begin
2601      othSch := CreateOtherScheduel;
2602      if length(trim(othSch)) > 1 then
2603      begin
2604        othSch := othSch + U + U + NSSScheduleType + U + NSSAdminTime;
2605        cboSchedule.Items.Add(othSch);
2606        idx := cboSchedule.Items.IndexOf(Piece(OthSch, U, 1));
2607        cboSchedule.ItemIndex := idx;
2608      end;
2609    end
2610    else
2611      begin
2612        NSSAdminTime := '';
2613        FNSSScheduleType := '';
2614      end;
2615    UpdateRelated(False);
2616  end;
2617  
2618  
2619  procedure TfrmODMeds.cboScheduleChange(Sender: TObject);
2620  var
2621    othSch: string;
2622    idx : integer;
2623  begin
2624    inherited;
2625    if  (FInptDlg) and (cboSchedule.Text = 'OTHER') then
2626    begin
2627      othSch := CreateOtherScheduel;
2628      if length(trim(othSch)) > 1 then
2629      begin
2630        othSch := othSch + U + U + NSSScheduleType + U + NSSAdminTime;
2631        cboSchedule.Items.Add(othSch);
2632        idx := cboSchedule.Items.IndexOf(Piece(OthSch, U, 1));
2633        cboSchedule.ItemIndex := idx;
2634      end;
2635    end;
2636    FScheduleChanged := true;
2637    UpdateRelated;
2638  end;
2639  
2640  
2641  { Duration ----------------------------- }
2642  procedure TfrmODMeds.UpdateDurationControls( FreeText: boolean);
2643  begin
2644    if FreeText then
2645    begin
2646      pnlXDurationButton.Width := 8;
2647      pnlXDurationButton.Align := alRight;
2648      spnXDuration.Visible := False;
2649      txtXduration.Align := alClient;
2650    end
2651    else
2652    begin
2653      txtXduration.Align := alNone;
2654      txtXduration.Width := pnlXDuration.Width - (pnlXDuration.Width div 2) - spnXDuration.Width + 2;
2655      pnlXDurationButton.Width := pnlXDuration.Width div 2;
2656      pnlXDurationButton.Align := alRight;
2657      spnXDuration.Visible := True;
2658      spnXDuration.AlignButton := udRight;
2659    end;
2660  end;
2661  
2662  procedure TfrmODMeds.popDurationClick(Sender: TObject);
2663  var
2664    x: string;
2665  begin
2666    inherited;
2667    with TMenuItem(Sender) do
2668    begin
2669      if Tag > 0 then
2670      begin
2671        x := LowerCase(Caption);
2672        //Make sure duration is integer
2673        txtXDuration.Text := IntToStr(StrToIntDef(txtXDuration.Text,0));
2674        UpdateDurationControls(False);
2675      end
2676      else begin
2677        x := '';
2678        txtXDuration.Text := '';
2679        UpdateDurationControls(True);
2680      end;
2681    end;
2682    btnXDuration.Caption := x;
2683    txtXDurationChange(Sender);
2684    ControlChange(Sender);
2685  end;
2686  
2687  procedure TfrmODMeds.QuantityMessageCheck(tag: integer);
2688  var
2689  DispDrug: integer;
2690  x: string;
2691  
2692  begin
2693    if FInptDlg then Exit;
2694    DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID, tag), 0);
2695    if DispDrug > 0 then
2696    begin
2697      if not FSuppressMsg then
2698      begin
2699        DispOrderMessage(DispenseMessage(DispDrug));
2700        FSuppressMsg  := False;
2701      end;
2702      x := QuantityMessage(DispDrug);
2703    end
2704    else x := '';
2705    if Length(x) > 0
2706      then lblQtyMsg.Caption := TX_QTY_PRE + x + TX_QTY_POST
2707      else lblQtyMsg.Caption := '';
2708  end;
2709  
2710  { txtSupply, txtQuantity -------------------------- }
2711  
2712  procedure TfrmODMeds.txtSupplyChange(Sender: TObject);
2713  begin
2714    inherited;
2715    if Changing then Exit;
2716    if not Showing then Exit;
2717    if FNoZERO = False then FNoZERO := True;
2718  
2719    // if value = 0, change probably caused by the spin button
2720    if txtSupply.Text <> '0' then txtSupply.Tag := 1;
2721    UpdateRelated;
2722  end;
2723  
2724  procedure TfrmODMeds.txtQuantityChange(Sender: TObject);
2725  begin
2726    inherited;
2727    if Changing then Exit;
2728    if not Showing then
2729      begin
2730         if (FISQuickOrder = true) and (txtQuantity.Text = '0') and (FLastQuantity > 0) and (FLastQuantity <> StrtoInt64(txtQuantity.text)) then
2731           begin
2732             Changing := True;
2733             txtQuantity.Text := FloattoStr(FLastQuantity);
2734             Changing := False;
2735           end;
2736         Exit;
2737      end;
2738    if FNoZERO = False then FNoZERO := True;
2739    // if value = 0, change probably caused by the spin button
2740    if txtQuantity.Text <> '0' then txtQuantity.Tag := 1;
2741    UpdateRelated;
2742  end;
2743  
2744  { values changing }
2745  
2746  function TfrmODMeds.OutpatientSig: string;
2747  var
2748    Dose, Route, Schedule, Duration, x: string;
2749    i: Integer;
2750  begin
2751    case tabDose.TabIndex of
2752    TI_DOSE:
2753      begin
2754        if ValueOf(FLD_TOTALDOSE) = ''
2755          then Dose := ValueOf(FLD_LOCALDOSE)
2756          else Dose := ValueOf(FLD_UNITNOUN);
2757        CheckDecimal(Dose);
2758        Route := ValueOf(FLD_ROUTE_EX);
2759        if (Length(Route) > 0) and (Length(FSigPrep) > 0) then Route := FSigPrep + ' ' + Route;
2760        if Length(Route) = 0 then Route := ValueOf(FLD_ROUTE_NM);
2761        Schedule := ValueOf(FLD_SCHED_EX);
2762        (* Schedule := Piece(Temp,U,1);
2763        if Piece(Temp,U,3) = '1' then Schedule := Schedule + ' AS NEEDED';
2764        if UpperCase(Copy(Schedule, Length(Schedule) - 18, Length(Schedule))) = 'AS NEEDED AS NEEDED'
2765        then Schedule := Copy(Schedule, 1, Length(Schedule) - 10); *)
2766        if Length(Schedule) = 0 then
2767          begin
2768            Schedule := ValueOf(FLD_SCHEDULE);
2769            if RightStr(Schedule,3) = 'PRN' then
2770               begin
2771                 Schedule := Copy(Schedule,1,Length(Schedule)-3); //Remove the Trailing PRN
2772                 if (RightStr(Schedule,1) = ' ') or (RightStr(Schedule,1) = '-') then
2773                 Schedule := Copy(Schedule,1,Length(Schedule)-1);
2774                 Schedule := Schedule + ' AS NEEDED'
2775               end;
2776          end;
2777        Result := FSIGVerb + ' ' + Dose + ' ' + Route + ' ' + Schedule;
2778      end;
2779    TI_COMPLEX:
2780      begin
2781        with grdDoses do for i := 1 to Pred(RowCount) do
2782        begin
2783          if Length(ValueOf(FLD_LOCALDOSE, i)) = 0 then Continue;
2784          if FDrugID = '' then
2785          begin
2786           Dose := ValueOf(FLD_DOSETEXT, i);
2787           CheckDecimal(Dose);
2788          end
2789          else
2790          begin
2791            if ValueOf(FLD_TOTALDOSE, i) = ''
2792              then Dose := ValueOf(FLD_LOCALDOSE, i)
2793              else Dose := ValueOf(FLD_UNITNOUN, i);
2794            CheckDecimal(Dose);
2795          end;
2796          Route := ValueOf(FLD_ROUTE_EX, i);
2797          if (Length(Route) > 0) and (Length(FSigPrep) > 0) then Route := FSigPrep + ' ' + Route;
2798          if Length(Route) = 0 then Route := ValueOf(FLD_ROUTE_NM, i);
2799          Schedule := ValueOf(FLD_SCHED_EX, i);
2800          //if Length(Schedule) = 0 then Schedule := ValueOf(FLD_SCHEDULE, i);
2801          if Length(Schedule) = 0 then
2802          begin
2803            Schedule := ValueOf(FLD_SCHEDULE);
2804            if RightStr(Schedule,3) = 'PRN' then
2805               begin
2806                 Schedule := Copy(Schedule,1,Length(Schedule)-3); //Remove the Trailing PRN
2807                 if (RightStr(Schedule,1) = ' ') or (RightStr(Schedule,1) = '-') then
2808                 Schedule := Copy(Schedule,1,Length(Schedule)-1);
2809                 Schedule := Schedule + ' AS NEEDED'
2810               end;
2811          end;
2812          Duration := ValueOf(FLD_DURATION, i);
2813          if Length(Duration) > 0 then Duration := 'FOR ' + Duration;
2814          x := FSIGVerb + ' ' + Dose + ' ' + Route + ' ' + Schedule + ' ' + Duration;
2815          if i > 1
2816            then Result := Result + ' ' + ValueOf(FLD_SEQUENCE, i-1) + ' ' + x
2817            else Result := x;
2818        end; {with grdDoses}
2819      end; {TI__COMPLEX}
2820    end; {case}
2821  end;
2822  
2823  function TfrmODMeds.InpatientSig: string;
2824  var
2825    Dose, Route, Schedule, Duration, x: string;
2826    i: Integer;
2827  begin
2828    case tabDose.TabIndex of
2829    TI_DOSE:
2830      begin
2831        Dose  := ValueOf(FLD_LOCALDOSE);
2832        CheckDecimal(Dose);
2833        Route := ValueOf(FLD_ROUTE_AB);
2834        if Route = '' then Route := ValueOf(FLD_ROUTE_NM);
2835        Schedule := ValueOf(FLD_SCHEDULE);
2836        Result := Dose + ' ' + Route + ' ' + Schedule;
2837      end;
2838    TI_COMPLEX:
2839      begin
2840        with grdDoses do for i := 1 to Pred(RowCount) do
2841        begin
2842          if Length(ValueOf(FLD_LOCALDOSE, i)) = 0 then Continue;
2843          if FDrugID = ''
2844            then Dose := ValueOf(FLD_DOSETEXT,  i)
2845            else Dose := ValueOf(FLD_LOCALDOSE, i);
2846          CheckDecimal(Dose);
2847          Route := ValueOf(FLD_ROUTE_AB, i);
2848          if Route = '' then Route := ValueOf(FLD_ROUTE_NM, i);
2849          Schedule := ValueOf(FLD_SCHEDULE, i);
2850          Duration := ValueOf(FLD_DURATION, i);
2851          if Length(Duration) > 0 then Duration := 'FOR ' + Duration;
2852          x := Dose + ' ' + Route + ' ' + Schedule + ' ' + Duration;
2853          if i > 1
2854            then Result := Result + ' ' + ValueOf(FLD_SEQUENCE, i-1) + ' ' + x
2855            else Result := x;
2856        end; {with grdDoses}
2857      end; {TI__COMPLEX}
2858    end; {case}
2859  end;
2860  
2861  
2862  function TfrmODMeds.ConstructedDoseFields(const ADose: string; PrependName: Boolean = FALSE): string;
2863  var
2864    i, DrugIndex: Integer;
2865    UnitsPerDose, Strength: Extended;
2866    Units, Noun, AName: string;
2867  begin
2868    DrugIndex := -1;
2869    for i := 0 to Pred(FAllDrugs.Count) do
2870      if AnsiSameText(Piece(FAllDrugs[i], U, 1), FDrugID) then
2871      begin
2872        DrugIndex := i;
2873        Break;
2874      end;
2875    Strength := StrToFloatDef(Piece(FAllDrugs[DrugIndex], U, 2), 0);
2876    Units    := Piece(FAllDrugs[DrugIndex], U, 3);
2877    AName    := Piece(FAllDrugs[DrugIndex], U, 4);
2878    if FAllDoses.Count > 0
2879      then Noun := Piece(Piece(FAllDoses[0], U, 3), '&', 4)
2880      else Noun := '';
2881    if Strength > 0
2882      then UnitsPerDose := ExtractFloat(ADose) / Strength
2883      else UnitsPerDose := 0;
2884    if (UnitsPerDose > 1) and (Noun <> '') and (CharAt(Noun, Length(Noun)) <> 'S')
2885      then Noun := Noun + 'S';
2886    Result := FloatToStr(ExtractFloat(ADose)) + '&' + Units + '&' + FloatToStr(UnitsPerDose)
2887              + '&' + Noun + '&' + ADose + '&' + FDrugID + '&' + FloatToStr(Strength) + '&'
2888              + Units;
2889    if PrependName then Result := AName + U + FloatToStr(Strength) + Units + U + U +
2890                                  Result + U + ADose;
2891    Result := UpperCase(Result);
2892  end;
2893  
2894  function TfrmODMeds.FieldsForDrug(const DrugID: string): string;
2895  var
2896    i, DrugIndex: Integer;
2897  begin
2898    Result := '';
2899    DrugIndex := -1;
2900    for i := 0 to Pred(FAllDrugs.Count) do
2901    begin
2902      if AnsiSameText(Piece(FAllDrugs[i], U, 1), DrugID) then DrugIndex := i;
2903    end;
2904    if DrugIndex > -1 then Result := FAllDrugs[DrugIndex];
2905  end;
2906  
2907  function TfrmODMeds.FieldsForDose(ARow: Integer): string;
2908  var
2909    i: Integer;
2910    DoseDrug: string;
2911  begin
2912    Result := Piece(Piece(grdDoses.Cells[COL_DOSAGE, ARow], TAB, 2), U, 4);
2913    //AGP CHANGE 26.33 change for Remedy ticket 87476 fix for quick orders for complex
2914    //inpatient orders not displaying the correct unit dose in Pharmacy
2915    //if (not FInptDlg) and (Length(FDrugID) > 0) then
2916    if Length(FDrugID) > 0 then
2917    begin
2918      Result := '';
2919      DoseDrug := Piece(Piece(grdDoses.Cells[COL_DOSAGE, ARow], TAB, 2), U, 5);
2920      if DoseDrug = '' then DoseDrug := Piece(grdDoses.Cells[COL_DOSAGE, ARow], TAB, 1);
2921      DoseDrug := DoseDrug + U + FDrugID;
2922      for i := 0 to Pred(FAllDoses.Count) do
2923      begin
2924         // CQ #16957 - Corrected code that would potentially mis-match drugs - JCS
2925        //if AnsiSameText(DoseDrug, Copy(FAllDoses[i], 1, Length(DoseDrug))) then
2926        if AnsiSameText(DoseDrug, Pieces(FAllDoses[i],U,1,2)) then
2927        begin
2928          Result := Piece(FAllDoses[i], U, 3);
2929          Break;
2930        end; {if AnsiSameText}
2931      end; {for i}
2932      if Result = '' then Result := ConstructedDoseFields(Piece(DoseDrug, U, 1));
2933    end;
2934  end;
2935  
2936  function TfrmODMeds.FindDoseFields(const Drug, ADose: string): string;
2937  var
2938    i: Integer;
2939    x: string;
2940  begin
2941    Result := '';
2942    x := ADose + U + Drug + U;
2943    for i := 0 to Pred(FAllDoses.Count) do
2944    begin
2945      if AnsiSameText(x, Copy(FAllDoses[i], 1, Length(x))) then
2946      begin
2947        Result := Piece(FAllDoses[i], U, 3);
2948        Break;
2949      end;
2950    end;
2951  end;
2952  
2953  function TfrmODMeds.FindCommonDrug(DoseList: TStringList): string;
2954  // DoseList[n] = DoseText ^ Dispense Drug Pointer
2955  var
2956    i, j, UnitIndex: Integer;
2957    DrugStrength, DoseValue, UnitsPerDose: Extended;
2958    DrugOK, PossibleDoses, SplitTab: Boolean;
2959    ADrug, ADose, DoseFields, DoseUnits, DrugUnits: string;
2960    FoundDrugs: TStringList;
2961  
2962    procedure SaveDrug(const ADrug: string; UnitsPerDose: Extended);
2963    var
2964      i, DrugIndex: Integer;
2965      CurUnits: Extended;
2966    begin
2967      DrugIndex := -1;
2968      for i := 0 to Pred(FoundDrugs.Count) do
2969        if AnsiSameText(Piece(FoundDrugs[i], U, 1), ADrug) then DrugIndex := i;
2970      if DrugIndex = -1 then FoundDrugs.Add(ADrug + U + FloatToStr(UnitsPerDose)) else
2971      begin
2972        CurUnits := StrToFloatDef(Piece(FoundDrugs[DrugIndex], U, 2), 0);
2973        if UnitsPerDose > CurUnits
2974          then FoundDrugs[DrugIndex] := ADrug + U + FloatToStr(UnitsPerDose);
2975      end;
2976    end;
2977  
2978    procedure KillDrug(const ADrug: string);
2979    var
2980      i, DrugIndex: Integer;
2981    begin
2982      DrugIndex := -1;
2983      for i := 0 to Pred(FoundDrugs.Count) do
2984        if AnsiSameText(Piece(FoundDrugs[i], U, 1), ADrug) then DrugIndex := i;
2985      if DrugIndex > -1 then FoundDrugs.Delete(DrugIndex);
2986    end;
2987  
2988  begin
2989    Result := '';
2990   if FInptDlg then                                // inpatient dialog
2991    begin
2992      DrugOK := True;
2993      for i := 0 to Pred(DoseList.Count) do
2994      begin
2995        ADrug := Piece(DoseList[i], U, 2);
2996        if ADrug = '' then DrugOK := False;
2997        if Result = '' then Result := ADrug;
2998        if not AnsiSameText(ADrug, Result) then DrugOK := False;
2999        if not DrugOK then Break;
3000      end;
3001      if not DrugOK then Result :='';
3002    end else                                        // outpatient dialog
3003    begin
3004      // check the dose combinations for each dispense drug
3005      FoundDrugs := TStringList.Create;
3006      try
3007        if FAllDoses.Count > 0
3008          then PossibleDoses := Length(Piece(Piece(FAllDoses[0], U, 3), '&', 1)) > 0
3009          else PossibleDoses := False;
3010        for i := 0 to Pred(FAllDrugs.Count) do
3011        begin
3012          ADrug := Piece(FAllDrugs[i], U, 1);
3013          DrugOK := True;
3014          DrugStrength := StrToFloatDef(Piece(FAllDrugs[i], U, 2), 0);
3015          DrugUnits := Piece(FAllDrugs[i], U, 3);
3016          SplitTab := Piece(FAllDrugs[i], U, 5) = '1';
3017          for j := 0 to Pred(DoseList.Count) do
3018          begin
3019            ADose:= Piece(DoseList[j], U, 1);
3020            DoseFields := FindDoseFields(ADrug, ADose);  // get the idnode for the dose/drug combination
3021            if not PossibleDoses then
3022            begin
3023              if DoseFields = '' then DrugOK := False else SaveDrug(ADrug, 0);
3024            end else
3025            begin
3026              DoseValue := StrToFloatDef(Piece(DoseFields, '&', 1), 0);
3027              if DoseValue = 0 then DoseValue := ExtractFloat(ADose);
3028              UnitsPerDose := DoseValue / DrugStrength;
3029              if (Frac(UnitsPerDose) = 0) or (SplitTab and (Frac(UnitsPerDose) = 0.5))
3030                then SaveDrug(ADrug, UnitsPerDose)
3031                else DrugOK := False;
3032              // make sure this dose is using the same units as the drug
3033              if DoseFields = '' then
3034              begin
3035                for UnitIndex := 1 to Length(ADose) do
3036                  if not (ADose[UnitIndex] in ['0'..'9','.']) then Break;
3037                DoseUnits := Copy(ADose, UnitIndex, Length(ADose));
3038              end
3039              else DoseUnits := Piece(DoseFields, '&', 2);
3040              if (not AnsiSameText(DoseUnits, DrugUnits)) then DrugOK := False;
3041            end;
3042            if not DrugOK then
3043            begin
3044              KillDrug(ADrug);
3045              Break;
3046            end; {if not DrugOK}
3047          end; {with..for j}
3048        end; {for i}
3049        if FoundDrugs.Count > 0 then
3050        begin
3051          if not PossibleDoses then Result := Piece(FoundDrugs[0], U, 1) else
3052          begin
3053            UnitsPerDose := 99999999;
3054            for i := 0 to Pred(FoundDrugs.Count) do
3055            begin
3056              if (StrToFloatDef(Piece(FoundDrugs[i], U, 2), 99999999) = 1) or (StrToFloatDef(Piece(FoundDrugs[i], U, 2), 99999999) < UnitsPerDose) then
3057              begin
3058                Result := Piece(FoundDrugs[i], U, 1);
3059                UnitsPerDose := StrToFloatDef(Piece(FoundDrugs[i], U, 2), 99999999);
3060                if UnitsPerDose = 1 then Break;
3061              end; {if StrToFloatDef}
3062            end; {for i..FoundDrugs}
3063          end; {if not..else PossibleDoses}
3064        end; {if FoundDrugs}
3065      finally
3066        FoundDrugs.Free;
3067      end; {try}
3068    end; {if..else FInptDlg}
3069  end; {FindCommonDrug}
3070  
3071  procedure TfrmODMeds.ControlChange(Sender: TObject);
3072  var
3073    x,ADose,AUnit,ADosageText: string;
3074    i, LastDose: Integer;
3075    DoseList: TStringList;
3076  begin
3077    inherited;
3078    if csLoading in ComponentState then Exit;       // to prevent error caused by txtRefills
3079    if Changing then Exit;
3080    if txtMed.Tag = 0 then Exit;
3081    ADose := '';
3082    AUnit := '';
3083    ADosageText := '';
3084    FUpdated := FALSE;
3085    Responses.Clear;
3086    if self.MedName = '' then Responses.Update('ORDERABLE',  1, IntToStr(txtMed.Tag), txtMed.Text)
3087    else Responses.Update('ORDERABLE',  1, IntToStr(txtMed.Tag), self.MedName);
3088    DoseList := TStringList.Create;
3089    case tabDose.TabIndex of
3090    TI_DOSE:
3091      begin
3092        if (cboDosage.ItemIndex < 0) and (Length(cboDosage.Text) > 0) then
3093        begin
3094          // try to resolve freetext dose and add it as a new item to the combobox
3095          ADosageText := cboDosage.Text;
3096          ADose := Piece(ADosageText,' ',1);
3097          Delete(ADosageText,1,Length(ADose)+1);
3098          ADosageText := ADose + Trim(ADosageText);
3099          DoseList.Add(ADosageText);
3100          FDrugID := FindCommonDrug(DoseList);
3101          if FDrugID <> '' then
3102          begin
3103            if ExtractFloat(cboDosage.Text) > 0 then
3104            begin
3105              x := ConstructedDoseFields(cboDosage.Text, TRUE);
3106              FDrugID := '';
3107              with cboDosage do ItemIndex := cboDosage.Items.Add(x);
3108            end;
3109          end;
3110        end;
3111        x := ValueOf(FLD_DOSETEXT);    Responses.Update('INSTR',    1, x,  x);
3112        x := ValueOf(FLD_DRUG_ID);     Responses.Update('DRUG',     1, x, '');
3113        x := ValueOf(FLD_DOSEFLDS);    Responses.Update('DOSE',     1, x, '');
3114        x := ValueOf(FLD_STRENGTH);
3115        // if outpt or inpt order with no total dose (i.e., topical)
3116        if (not FInptDlg) or (ValueOf(FLD_TOTALDOSE) = '')
3117                                  then Responses.Update('STRENGTH', 1, x,  x);
3118        // if no strength for dosage, use dispense drug name
3119        if Length(x) = 0 then
3120        begin
3121          x := ValueOf(FLD_DRUG_NM);
3122          if Length(x) > 0        then Responses.Update('NAME',     1, x,  x);
3123        end;
3124        x := ValueOf(FLD_ROUTE_AB);
3125        if Length(x) = 0 then x := ValueOf(FLD_ROUTE_NM);
3126        if Length(ValueOf(FLD_ROUTE_ID)) > 0
3127                                  then Responses.Update('ROUTE',    1, ValueOf(FLD_ROUTE_ID), x)
3128                                  else Responses.Update('ROUTE',    1, '', x);
3129        x := ValueOf(FLD_SCHEDULE);    Responses.Update('SCHEDULE', 1, x,  x);
3130        if FInptDlg then
3131          begin
3132          (* AGP Change Admin Time Wrap 27.73
3133            x := Piece(self.lblAdminSch.text,':',2);
3134            x := Copy(x,2,Length(x));  *)
3135            x := lblAdminSchGetText;
3136            if FAdminTimeText <> '' then x := '';
3137            if x = 'Not Defined' then x := '';
3138            Responses.Update('ADMIN',1,x,x);
3139            X := ValueOf(FLD_SCHED_TYP);
3140            if self.chkPRN.Checked = true then x := 'P';
3141            Responses.Update('SCHTYPE',1,x,x);
3142          end;
3143      end;
3144    TI_COMPLEX:
3145      begin
3146        //if txtNss.Visible then txtNss.Visible := False;
3147        with grdDoses do for i := 1 to Pred(RowCount) do
3148        begin
3149          x := Piece(Piece(grdDoses.Cells[COL_DOSAGE, i], TAB, 2), U, 5);
3150          if x = '' then x := Piece(grdDoses.Cells[COL_DOSAGE, i], TAB, 1);
3151          if x = '' then Continue;
3152          x := x + U + Piece(Piece(grdDoses.Cells[COL_DOSAGE, i], U, 4), '&', 6);
3153          DoseList.Add(x);
3154        end;
3155        FDrugID := FindCommonDrug(DoseList);
3156        if FDrugID <> '' then                       // common drug found
3157        begin
3158          x := ValueOf(FLD_STRENGTH, 1);
3159          if (not FInptDlg) or (ValueOf(FLD_TOTALDOSE, 1) = '')
3160                                  then    Responses.Update('STRENGTH', 1, x, x);
3161          // if no strength, use dispense drug
3162          if Length(x) = 0 then
3163          begin
3164            x := ValueOf(FLD_DRUG_NM, 1);
3165            if Length(x) > 0      then    Responses.Update('NAME',     1, x, x);
3166          end;
3167          Responses.Update('DRUG', 1, FDrugID, '');
3168        end; {if FDrugID}
3169        LastDose := 0;
3170        with grdDoses do for i := 1 to Pred(RowCount) do
3171          if Length(ValueOf(FLD_DOSETEXT, i)) > 0 then LastDose := i;
3172        with grdDoses do for i := 1 to Pred(RowCount) do
3173        begin
3174          if Length(ValueOf(FLD_DOSETEXT, i)) = 0 then Continue;
3175          x := ValueOf(FLD_DOSETEXT, i);  Responses.Update('INSTR',    i, x, x);
3176          x := ValueOf(FLD_DOSEFLDS, i);  Responses.Update('DOSE',     i, x, '');
3177          x := ValueOf(FLD_ROUTE_AB, i);
3178          if Length(x) = 0 then x := ValueOf(FLD_ROUTE_NM, i);
3179          if Length(ValueOf(FLD_ROUTE_ID, i)) > 0
3180                                     then Responses.Update('ROUTE',    i, ValueOf(FLD_ROUTE_ID, i), x)
3181                                     else Responses.Update('ROUTE',    i, '', x);
3182          x := ValueOf(FLD_SCHEDULE, i);  Responses.Update('SCHEDULE', i, x, x);
3183          if FSmplPRNChkd then   // GE CQ7585  Carry PRN checked from simple to complex tab
3184          begin
3185             pnlXSchedule.Tag := 1;
3186             chkXPRN.Checked := True;
3187            //cboXScheduleClick(Self);// force onclick to fire when complex tab is entered
3188             FSmplPRNChkd := False;
3189          end;
3190          x := ValueOf(FLD_DURATION, i);  Responses.Update('DAYS',     i, UpperCase(x), x);
3191          if FInptDlg then
3192            begin
3193              x := ValFor(VAL_ADMINTIME,i);
3194              if FAdminTimeText <> '' then x := '';
3195              if x = 'Not Defined' then x := '';
3196              Responses.Update('ADMIN',i,x,x);
3197              x := ValueOf(FLD_SCHED_TYP, i);
3198              if ValFor(VAL_CHKXPRN, i) = '1' then x := 'P';
3199              Responses.Update('SCHTYPE', i, x, x);
3200            end;
3201          x := ValueOf(FLD_SEQUENCE, i);
3202          if      Uppercase(x) = 'THEN'   then x := 'T'
3203          else if Uppercase(x) = 'AND'    then x := 'A'
3204          else if Uppercase(x) = 'EXCEPT' then x := 'X'
3205          else x := '';
3206          if  i = LastDose then  x := '';            // no conjunction for last dose
3207          Responses.Update('CONJ',     i, x, x);
3208        end; {with grdDoses}
3209      end; {TI_COMPLEX}
3210    end; {case TabDose.TabIndex}
3211    DoseList.Free;
3212    Responses.Update('URGENCY',   1, ValueOf(FLD_PRIOR_ID), '');
3213    Responses.Update('COMMENT',   1, TX_WPTYPE, ValueOf(FLD_COMMENT));
3214    if FInptDlg then                       // inpatient orders
3215    begin
3216      Responses.Update('NOW',     1, ValueOf(FLD_NOW_ID), ValueOf(FLD_NOW_NM));
3217      x := InpatientSig;
3218      Responses.Update('SIG',     1, TX_WPTYPE, x);
3219    end else                                        // outpatient orders
3220    begin
3221      x := ValueOf(FLD_SUPPLY);           Responses.Update('SUPPLY',  1, x,  x);
3222      x := ValueOf(FLD_QUANTITY);         Responses.Update('QTY',     1, x,  x);
3223      x := ValueOf(FLD_REFILLS);          Responses.Update('REFILLS', 1, x,  x);
3224      x := ValueOf(FLD_SC);               Responses.Update('SC',      1, x, '');
3225      x := ValueOf(FLD_PICKUP);           Responses.Update('PICKUP',  1, x, '');