unit fODMedNVA;

interface                         

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  fODBase, StdCtrls, ComCtrls, ExtCtrls, ORCtrls, Grids, Buttons, uConst, ORDtTm,
  Menus, XUDIGSIGSC_TLB, rMisc, uOrders, StrUtils, oRFn;

const
  UM_DELAYCLICK = 11037;  // temporary for listview click event
  NVA_CR = #13;
  NVA_LF = #10;

type
  TfrmODMedNVA = class(TfrmODBase)
    txtMed: TEdit;
    pnlMeds: TPanel;
    lstQuick: TCaptionListView;
    sptSelect: TSplitter;
    lstAll: TCaptionListView;
    dlgStart: TORDateTimeDlg;
    timCheckChanges: TTimer;
    pnlFields: TPanel;
    pnlTop: TPanel;
    lblRoute: TLabel;
    lblSchedule: TLabel;
    lblGuideline: TStaticText;
    tabDose: TTabControl;
    cboDosage: TORComboBox;
    cboRoute: TORComboBox;
    cboSchedule: TORComboBox;
    chkPRN: TCheckBox;
    pnlBottom: TPanel;
    lblComment: TLabel;
    memComment: TCaptionMemo;
    lblAdminTime: TStaticText;
    calStart: TORDateBox;
    Label1: TLabel;
    lbStatements: TORListBox;
    Label2: TLabel;
    btnSelect: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnSelectClick(Sender: TObject);
    procedure tabDoseChange(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure txtMedKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure txtMedKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure txtMedChange(Sender: TObject);
    procedure txtMedExit(Sender: TObject);
    procedure ListViewEditing(Sender: TObject; Item: TListItem;
      var AllowEdit: Boolean);
    procedure ListViewResize(Sender: TObject);
    procedure lstQuickData(Sender: TObject; Item: TListItem);
    procedure lstAllDataHint(Sender: TObject; StartIndex,
      EndIndex: Integer);
    procedure lstAllData(Sender: TObject; Item: TListItem);
    procedure lblGuidelineClick(Sender: TObject);
    procedure ListViewClick(Sender: TObject);
    procedure cboScheduleExit(Sender: TObject);
    procedure cboScheduleChange(Sender: TObject);
    procedure cboRouteChange(Sender: TObject);
    procedure ControlChange(Sender: TObject);
    procedure cboDosageClick(Sender: TObject);
    procedure cboDosageChange(Sender: TObject);
    procedure cboScheduleClick(Sender: TObject);
    procedure cboRouteExit(Sender: TObject);



    procedure grdDosesExit(Sender: TObject);
    procedure ListViewEnter(Sender: TObject);
    procedure timCheckChangesTimer(Sender: TObject);
    procedure cmdAcceptClick(Sender: TObject);
    procedure cboDosageExit(Sender: TObject);
    procedure chkPRNClick(Sender: TObject);
    procedure grdDosesKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure grdDosesEnter(Sender: TObject);
    procedure pnlMessageEnter(Sender: TObject);
    procedure pnlMessageExit(Sender: TObject);
    procedure memMessageKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormResize(Sender: TObject);
    procedure lbStatementsClickCheck(Sender: TObject; Index: Integer);
    procedure lstChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
  private
    {selection}
    FAllItems:   TStringList;
    FAllFirst:   Integer;
    FAllLast:    Integer;
    FAllList:    Integer;
    FQuickList:  Integer;
    FQuickItems: TStringList;
    FChangePending: Boolean;
    FKeyTimerActive: Boolean;
    FActiveMedList: TListView;
    FRowHeight: Integer;
    FFromSelf: Boolean;
    {edit}
    FAllDoses:  TStringList;
    FAllDrugs:  TStringList;
    FGuideline: TStringList;
    FLastUnits:    string;
    FLastSchedule: string;
    FLastDispDrug: string;
    FLastQuantity: Integer;
    FLastSupply:   Integer;
    FLastPickup:   string;
    FSIGVerb: string;
    FSIGPrep: string;
    FDrugID: string;
    fInptDlg: Boolean;
    FNonVADlg: Boolean;
    FUpdated: Boolean;
    FSuppressMsg: Boolean;
    FPtInstruct: string;
    FAltChecked: Boolean;
    FQOQuantity: Double;
    FQODosage: string;
    FNoZERO: boolean;
    FIsQuickOrder: boolean;
    FAdminTimeLbl: string;
    FDisabledDefaultButton: TButton;
    FDisabledCancelButton: TButton;
    FShrinked: boolean;
    FRemoveText : Boolean;
    {selection}
    procedure ChangeDelayed;
    procedure LoadNonVAMedCache(First, Last: Integer);
    function FindQuickOrder(const x: string): Integer;
    function isUniqueQuickOrder(iText: string): Boolean;
    procedure ScrollToVisible(AListView: TListView);
    procedure StartKeyTimer;
    procedure StopKeyTimer;
    procedure WMTimer(var Message: TWMTimer); message WM_TIMER;
    // NON VA MEDS
    procedure LoadOTCStatements(Dest: TStrings);

    {edit}
    procedure ResetOnMedChange;
    procedure SetOnMedSelect;
    procedure SetOnQuickOrder;
    procedure ShowMedSelect;
    procedure ShowMedFields;
    procedure ShowControlsSimple;
    procedure SetDosage(const x: string);
    procedure SetStatements(x: string);
    procedure SetStartDate(const x: string);
    procedure SetSchedule(const x: string);
    procedure CheckFormAltDose(DispDrug: Integer);
    function ConstructedDoseFields(const ADose: string; PrependName: Boolean = FALSE): string;
    function FindCommonDrug(DoseList: TStringList): string;
    function FindDoseFields(const Drug, ADose: string): string;
    function OutpatientSig: string;
    function  SearchStatements(StatementList:TStringList;Statement: string): Boolean;
    procedure UpdateRelated(DelayUpdate: Boolean = TRUE);
    procedure UpdateStartExpires(const CurSchedule: string);
    function DisableDefaultButton(Control: TWinControl): boolean;
    function DisableCancelButton(Control: TWinControl): boolean;
    procedure RestoreDefaultButton;
    procedure RestoreCancelButton;
    function ValueOf(FieldID: Integer; ARow: Integer = -1): string;
    function ValueOfResponse(FieldID: Integer; AnInstance: Integer = 1): string;
    procedure UMDelayClick(var Message: TMessage); message UM_DELAYCLICK;

  protected
    procedure InitDialog; override;
    procedure Validate(var AnErrMsg: string); override;
  public
    procedure SetupDialog(OrderAction: Integer; const ID: string); override;
    procedure CheckDecimal(var AStr: string);
  end;

var
  frmODMedNVA: TfrmODMedNVA;
  crypto: IXuDigSigS;

function OIForNVA(AnIEN: Integer; ForNonVAMed: Boolean; HavePI: boolean = True; PKIActive: Boolean = False): TStrings;
procedure CheckAuthForNVAMeds(var x: string);

implementation

{$R *.DFM}

uses rCore, uCore, rODMeds, rODBase, rOrders, fRptBox, fODMedOIFA,
  uAccessibleStringGrid, fFrame, ORNet;

const
  {grid columns for complex dosing }
  COL_SELECT   =  0;
  COL_DOSAGE   =  1;
  COL_ROUTE    =  2;
  COL_SCHEDULE =  3;
  COL_DURATION =  4;

  COL_SEQUENCE =  5;
  VAL_DOSAGE   = 10;
  VAL_ROUTE    = 20;
  VAL_SCHEDULE = 30;
  VAL_DURATION = 40;
  VAL_SEQUENCE = 50;
  TAB          = #9;
  {field identifiers}
  FLD_LOCALDOSE =  1;
  FLD_STRENGTH  =  2;
  FLD_DRUG_ID   =  3;
  FLD_DRUG_NM   =  4;
  FLD_DOSEFLDS  =  5;
  FLD_UNITNOUN  =  6;
  FLD_TOTALDOSE =  7;
  FLD_DOSETEXT  =  8;
  FLD_INSTRUCT  = 10;
  FLD_DOSEUNIT  = 11;
  FLD_ROUTE_ID  = 15;
  FLD_ROUTE_NM  = 16;
  FLD_ROUTE_AB  = 17;
  FLD_ROUTE_EX  = 18;
  FLD_SCHEDULE  = 20;
  FLD_SCHED_EX  = 21;
  FLD_SCHED_TYP = 22;
  FLD_DURATION  = 30;
  FLD_SEQUENCE  = 31;
  FLD_MISC_FLDS = 50;
  FLD_SUPPLY    = 51;
  FLD_QUANTITY  = 52;
  FLD_REFILLS   = 53;
  FLD_PICKUP    = 55;
  FLD_QTYDISP   = 56;
  FLD_SC        = 58;
  FLD_PRIOR_ID  = 60;
  FLD_PRIOR_NM  = 61;
  FLD_START_ID  = 70;
  FLD_START_NM  = 71;
  FLD_EXPIRE    = 72;
  FLD_ANDTHEN   = 73;
  FLD_NOW_ID    = 75;
  FLD_NOW_NM    = 76;
  FLD_COMMENT   = 80;
  FLD_PTINSTR   = 85;
  FLD_START     = 88;
  FLD_STATEMENTS = 90;
    {dosage type tab index values}
  TI_DOSE       =  0;
  TI_RATE       =  99;
  TI_COMPLEX    =  1;
  {misc constants}
  TIMER_ID = 6902;                                // arbitrary number
  TIMER_DELAY = 500;                              // 500 millisecond delay
  TIMER_FROM_DAYS = 1;
  TIMER_FROM_QTY  = 2;
  {text constants}
  TX_ADMIN      = 'Requested Start: ';
  TX_TAKE       = '';
  TX_NO_DEA     = 'Provider must have a DEA# or VA# to order this medication';
  TC_NO_DEA     = 'DEA# Required';
  TX_NO_MED     = 'Medication must be selected.';
  TX_NO_DOSE    = 'Dosage must be entered.';
  TX_DOSE_NUM   = 'Dosage may not be numeric only';
  TX_DOSE_LEN   = 'Dosage may not exceed 60 characters';
  TX_NO_ROUTE   = 'Route must be entered.';
  TX_NF_ROUTE   = 'Route not found in the Medication Routes file.';
  TX_NO_SCHED   = 'Schedule must be entered.';
  TX_NO_PICK    = 'A method for picking up the medication must be entered.';
  TX_RNG_REFILL = 'The number of refills must be in the range of 0 through ';
  TX_SCH_QUOTE  = 'Schedule must not have quotemarks in it.';
  TX_SCH_MINUS  = 'Schedule must not have a dash at the beginning.';
  TX_SCH_SPACE  = 'Schedule must have only one space in it.';
  TX_SCH_LEN    = 'Schedule must be less than 70 characters.';
  TX_SCH_PRN    = 'Schedule cannot include PRN - use Comments to enter PRN.';
  TX_SCH_ZERO   = 'Schedule cannot be Q0';
  TX_SCH_LSP    = 'Schedule may not have leading spaces.';
  TX_SCH_NS     = 'Unable to resolve non-standard schedule.';
  TX_MAX_STOP   = 'The maximum expiration for this order is ';
  TX_OUTPT_IV   = 'This patient has not been admitted.  Only IV orders may be entered.';
  TX_QTY_NV     = 'Unable to validate quantity.';
  TX_QTY_MAIL   = 'Quantity for mailed items must be a whole number.';
  TX_SUPPLY_LIM = 'Days Supply may not be greater than 90.';
  TX_SUPPLY_LIM1 = 'Days Supply may not be less than 1.';
  TX_SUPPLY_NINT= 'Days Supply is an invalid number.';
  TC_RESTRICT   = 'Ordering Restrictions';
  TC_GUIDELINE  = 'Restrictions/Guidelines';
  TX_QTY_PRE    = '>> Quantity Dispensed: ';
  TX_QTY_POST   = ' <<';
  TX_STARTDT    = 'Unable to interpret start date.';  //cla 7-17-03
  TX_FUTUREDT   = 'Dates in the future are not allowed.';  //cla 7-17-03
  TX_NO_FUTURE_DATES  = 'Dates in the future are not allowed.';
  TX_BAD_DATE         = 'Dates must be in the format mm/dd/yy or mm/yy';


{ procedures inherited from fODBase --------------------------------------------------------- }

procedure TfrmODMedNVA.FormCreate(Sender: TObject);
const
  TC_RESTRICT = 'Ordering Restrictions';
var
  ListCount: Integer;
  Restriction, x : string;
begin
  AutoSizeDisabled := True;
 // ActivateOrderDialog(Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
  inherited;
  if User.OrderRole in[OR_CLERK] then   // if user is clerk check restrictions else ok to write NonVA Order.
  begin
     CheckAuthForNVAMeds(Restriction);
     if Length(Restriction) > 0 then
     begin
       InfoBox(Restriction, TC_RESTRICT, MB_OK);
       Close;
       Exit;
     end;
  end;

  if DlgFormID = OD_MEDNONVA  then FNonVADlg := TRUE;
  FillerID := 'PSH';    // CLA 6/3/03
  FGuideline := TStringList.Create;
  FAllDoses  := TStringList.Create;
  FAllDrugs  := TStringList.Create;
  StatusText('Loading Dialog Definition');

  Responses.Dialog := 'PSH OERR';  // CLA 6/3/03
  Responses.SetPromptFormat('INSTR', '@');
  StatusText('Loading Schedules');
  LoadSchedules(cboSchedule.Items);               // load the schedules combobox (cached)
  StatusText('');
  FSuppressMsg := CtrlInits.DefaultText('DispMsg') = '1';
  InitDialog;

   // medication selection
  FRowHeight := MainFontHeight + 1;
  x := 'NV RX';  // CLA 6/3/03
  ListForOrderable(FAllList, ListCount, x);
  lstAll.Items.Count := ListCount;
  FAllItems := TStringList.Create;
  FAllFirst := -1;
  FAllLast  := -1;
  FQuickItems := TStringList.Create;
  ListForQuickOrders(FQuickList, ListCount, x);
 if ListCount > 0 then
  begin
    lstQuick.Items.Count := ListCount;
    SubsetOfQuickOrders(FQuickItems, FQuickList, 0, 0);
    FActiveMedList := lstQuick;
  end else
  begin
    lstQuick.Items.Count := 1;
    ListCount := 1;
    FQuickItems.Add('0^(No quick orders available)');
    FActiveMedList := lstAll;
  end;

  // set the height based on user parameter here
  with lstQuick do if ListCount < VisibleRowCount
    then Height := (((Height - 6) div VisibleRowCount) * ListCount) + 6;
  pnlFields.Height := cmdAccept.Top - 4 - pnlFields.Top;
  FNoZero := False;
  FShrinked := False;
  // Load OTC Statement/Explanations
  LoadOTCStatements(lbStatements.Items);
  FRemoveText := True;
end;

procedure TfrmODMedNVA.FormDestroy(Sender: TObject);
begin
  {selection}
  FQuickItems.Free;
  FAllItems.Free;
  {edit}
  FGuideline.Free;
  FAllDoses.Free;
  FAllDrugs.Free;
 // TAccessibleStringGrid.UnwrapControl(grdDoses);
  inherited;
end;

procedure TfrmODMedNVA.InitDialog;
{ Executed each time dialog is reset after pressing accept.  Clears controls & responses }
begin
  inherited;
  FLastPickup := ValueOf(FLD_PICKUP);
  Changing := True;
  ResetOnMedChange;
  txtMed.Text := '';
  txtMed.Tag := 0;
  lstQuick.Selected := nil;
  lstAll.Selected := nil;
  if Visible then ShowMedSelect;
  Changing := False;
  FIsQuickOrder := False;
  FQOQuantity := 0 ;
  FQODosage   := '';
  memComment.Clear;  // sometimes the sig is in the comment
  LoadOTCStatements(lbStatements.Items);

end;

procedure TfrmODMedNVA.SetupDialog(OrderAction: Integer; const ID: string);
var
  OrderID: string;
begin
  inherited;
 // if FInptDlg and (not FOutptIV) then DisplayGroup := DisplayGroupByName('UD RX')
  DisplayGroup := DisplayGroupByName('NV RX');   // CLA 6/3/03
  if XfInToOutNow then DisplayGroup := DisplayGroupByName('O RX');
  if CharAt(ID,1)='X' then
  begin
    OrderID := Copy(Piece(ID, ';', 1), 2, Length(ID));
    CheckExistingPI(OrderID, FPtInstruct);
  end;
  if OrderAction = ORDER_QUICK then
    FIsQuickOrder := True
  else
    FIsQuickOrder := False;
//  if OrderAction in [ORDER_COPY, ORDER_EDIT] then Responses.Remove('START', 1);
  if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then
  begin
    Changing := True;
    txtMed.Tag  := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0);
    SetOnMedSelect;
    SetOnQuickOrder;                                  // set up for this medication
    ShowMedFields;
    if (OrderAction = ORDER_EDIT) and OrderIsReleased(Responses.EditOrder)
      then btnSelect.Enabled := False;
    UpdateRelated(FALSE);
    Changing := False;
  end;

  ControlChange(Self);
end;

procedure TfrmODMedNVA.Validate(var AnErrMsg: string);
var
  i: Integer;
  StartDate: TFMDateTime;

  procedure SetError(const x: string);
  begin
    if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
    AnErrMsg := AnErrMsg + x;
  end;

  procedure ValidateDosage(const x: string);
  begin
    if Length(x) = 0 then SetError(TX_NO_DOSE);
  end;

  procedure ValidateRoute(const x: string; NeedLookup: Boolean; AnInstance: Integer);
  var
    RouteID, RouteAbbr: string;
  begin
    if (Length(x) = 0) and (not MedIsSupply(txtMed.Tag)) then SetError(TX_NO_ROUTE);
    if (Length(x) > 0) and NeedLookup then
    begin
      LookupRoute(x, RouteID, RouteAbbr);
      if RouteID = '0'
        then SetError(TX_NF_ROUTE)
        else Responses.Update('ROUTE', AnInstance, RouteID, RouteAbbr);
    end;
  end;

  procedure ValidateSchedule(const x: string; AnInstance: Integer);
  const
    SCH_BAD = 0;
    SCH_NO_RTN = -1;
  var
    ValidLevel: Integer;
    ARoute, ADrug: string;
  begin
    ARoute := ValueOfResponse(FLD_ROUTE_ID, AnInstance);
    ADrug  := ValueOfResponse(FLD_DRUG_ID,  AnInstance);
 {  if (Length(x) = 0) and (not FNonVADlg) then SetError(TX_NO_SCHED)
    else if (Length(x) = 0) and FNonVADlg and ScheduleRequired(txtMed.Tag, ARoute, ADrug)
    then SetError(TX_NO_SCHED);
}
    if Length(x) > 0 then
    begin
      ValidLevel := ValidSchedule(x, 'O');
      if ValidLevel = SCH_NO_RTN then
      begin
        if Pos('"', x) > 0                              then SetError(TX_SCH_QUOTE);
        if Copy(x, 1, 1) = '-'                          then SetError(TX_SCH_MINUS);
        if Pos(' ', Copy(x, Pos(' ', x) + 1, 999)) > 0  then SetError(TX_SCH_SPACE);
        if Length(x) > 70                               then SetError(TX_SCH_LEN);
        if (Pos('P RN', x) > 0) or (Pos('PR N', x) > 0) then SetError(TX_SCH_PRN);
        if Pos('Q0', x) > 0                             then SetError(TX_SCH_ZERO);
        if TrimLeft(x) <> x                             then SetError(TX_SCH_LSP);
      end;
      if ValidLevel = SCH_BAD then SetError(TX_SCH_NS);
    end;
  end;

begin
  inherited;
   begin
  AnErrMsg := '';
  if User.NoOrdering then AnErrMsg := 'Ordering has been disabled. Press Quit';

  ControlChange(Self);                            // make sure everything is updated
  if txtMed.Tag = 0 then SetError(TX_NO_MED);
  if Responses.InstanceCount('INSTR') < 1 then SetError(TX_NO_DOSE);
  i := Responses.NextInstance('INSTR', 0);
  while i > 0 do
  begin
 {   if (ValueOfResponse(FLD_DRUG_ID, i) = '') then
     begin
      if not ContainsAlpha(Responses.IValueFor('INSTR', i)) then SetError(TX_DOSE_NUM);
      if Length(Responses.IValueFor('INSTR', i)) > 60       then SetError(TX_DOSE_LEN);
     end;
    ValidateRoute(Responses.EValueFor('ROUTE', i), Responses.IValueFor('ROUTE', i) = '', i);
    ValidateSchedule(ValueOfResponse(FLD_SCHEDULE, i), i);
 }
    i := Responses.NextInstance('INSTR', i);
  //  inherited;  -  do not reject past dates - historical would not be allowed

       if calStart.Text <> '' then
     begin
        StartDate := ValidDateTimeStr(calStart.Text,'TS');
        if StartDate > FMNow then SetError(TX_NO_FUTURE_DATES);
        if StartDate < 0 then SetError(TX_BAD_DATE);
     end;
   end;
  end;
end;


{ Navigate medication selection lists ------------------------------------------------------- }

{ txtMed methods (including timers) }

procedure TfrmODMedNVA.WMTimer(var Message: TWMTimer);
begin
  inherited;
  if (Message.TimerID = TIMER_ID) then
  begin
    StopKeyTimer;
    ChangeDelayed;
  end;
end;

procedure TfrmODMedNVA.StartKeyTimer;
{ start (or restart) a timer (done on keyup to delay before calling OnKeyPause) }
var
  ATimerID: Integer;
begin
  StopKeyTimer;
  ATimerID := SetTimer(Handle, TIMER_ID, TIMER_DELAY, nil);
  FKeyTimerActive := ATimerID > 0;
  // if can't get a timer, just call the event immediately  F
  if not FKeyTimerActive then Perform(WM_TIMER, TIMER_ID, 0);
end;

procedure TfrmODMedNVA.StopKeyTimer;
{ stop the timer (done whenever a key is pressed or the combobox no longer has focus) }
begin
  if FKeyTimerActive then
  begin
    KillTimer(Handle, TIMER_ID);
    FKeyTimerActive := False;
  end;
end;

procedure TfrmODMedNVA.txtMedKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  i: Integer;
  x: string;
begin
  if Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN] then             // navigation
  begin
    FActiveMedList.Perform(WM_KEYDOWN, Key, 0);
    FFromSelf := True;
    txtMed.Text := FActiveMedList.Selected.Caption;
    txtMed.SelectAll;
    FFromSelf := False;
    Key := 0;
  end
  else if Key = VK_BACK then
  begin
    FFromSelf := True;
    x := txtMed.Text;
    i := txtMed.SelStart;
    if i > 1 then Delete(x, i + 1, Length(x)) else x := '';
    txtMed.Text := x;
    if i > 1 then txtMed.SelStart := i;
    FFromSelf := False;
  end
  else {StartKeyTimer};
end;

procedure TfrmODMedNVA.txtMedKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if not (Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN]) then StartKeyTimer;
end;

procedure TfrmODMedNVA.txtMedChange(Sender: TObject);
begin
  if FFromSelf then Exit;
  FChangePending := True;
end;

procedure TfrmODMedNVA.ScrollToVisible(AListView: TListView);
var
  Offset: Integer;
begin
  AListView.Selected.MakeVisible(FALSE);
  Offset := AListView.Selected.Index - AListView.TopItem.Index;
  Application.ProcessMessages;
  if Offset > 0 then AListView.Scroll(0, (Offset * FRowHeight));
  Application.ProcessMessages;
end;

procedure TfrmODMedNVA.ChangeDelayed;
var
  QuickIndex, AllIndex: Integer;
  NewText, OldText, UserText: string;
  UniqueText: Boolean;
begin
  FRemoveText := False;
  UniqueText := False;
  FChangePending := False;
  if (Length(txtMed.Text) > 0) and (txtMed.SelStart = 0) then Exit;  // don't lookup null
  // lookup item in appropriate list box
  NewText := '';
  UserText := Copy(txtMed.Text, 1, txtMed.SelStart);
  QuickIndex := FindQuickOrder(UserText);
  AllIndex := IndexOfOrderable(FAllList, UserText);  // but always synch the full list
  if UserText <> Copy(txtMed.Text, 1, txtMed.SelStart) then Exit;  // if typing during lookup
  if AllIndex > -1 then
  begin
    lstAll.Selected := lstAll.Items[AllIndex];
    FActiveMedList := lstAll;
  end;
  if QuickIndex > -1 then
  begin
    try
      lstQuick.Selected := lstQuick.Items[QuickIndex];
      lstQuick.ItemFocused := lstQuick.Selected;
      NewText := lstQuick.Selected.Caption;
      FActiveMedList := lstQuick;
      //Search Quick List for Uniqueness
      UniqueText := isUniqueQuickOrder(UserText);
    except
      //doing nothing  short term solution related to 117
    end;
  end
  else if AllIndex > -1 then
  begin
    lstAll.Selected := lstAll.Items[AllIndex];
    lstAll.ItemFocused := lstAll.Selected;
    NewText := lstAll.Selected.Caption;
    lstQuick.Selected := nil;
    FActiveMedList := lstAll;
    //List is alphabetical, So compare next Item in list to establish uniqueness.
    if CompareText(UserText, Copy(lstAll.Items[AllIndex+1].Caption, 1, Length(UserText))) <> 0 then
      UniqueText := True;
  end
  else
  begin
    lstQuick.Selected := nil;
    lstAll.Selected := nil;
    FActiveMedList := lstAll;
    NewText := txtMed.Text;
  end;
  if (AllIndex > -1) and (QuickIndex > -1) then  //Not Unique Between Lists
    UniqueText := False;
  FFromSelf := True;
  if UniqueText then
  begin
    OldText := Copy(txtMed.Text, 1, txtMed.SelStart);
    txtMed.Text := NewText;
    //txtMed.SelStart := Length(OldText);  // v24.14 RV
    txtMed.SelStart := Length(UserText);   // v24.14 RV
    txtMed.SelLength := Length(NewText);
  end
  else begin
    txtMed.Text := UserText;
    txtMed.SelStart := Length(txtMed.Text);
  end;
  FFromSelf := False;
  if lstAll.Selected <> nil then
    ScrollToVisible(lstAll);
  if lstQuick.Selected <> nil then
    ScrollToVisible(lstQuick);
  if Not UniqueText then
  begin
    lstQuick.ItemIndex := -1;
    lstAll.ItemIndex := -1;
  end;
  FRemoveText := True;
end;

procedure TfrmODMedNVA.txtMedExit(Sender: TObject);
begin
  StopKeyTimer;
  if not ((ActiveControl = lstAll) or (ActiveControl = lstQuick)) then ChangeDelayed;
end;

{ lstAll & lstQuick methods }

procedure TfrmODMedNVA.ListViewEnter(Sender: TObject);
begin
  inherited;
  FActiveMedList := TListView(Sender);
  with Sender as TListView do
  begin
    if Selected = nil then Selected := TopItem;
    if Name = 'lstQuick' then lstAll.Selected := nil else lstQuick.Selected := nil;
    ItemFocused := Selected;
  end;
end;

procedure TfrmODMedNVA.ListViewClick(Sender: TObject);
begin
  inherited;
  btnSelect.Visible := True;
  btnSelect.Enabled := True;
  //txtMed.Text := FActiveMedList.Selected.Caption;
  PostMessage(Handle, UM_DELAYCLICK, 0, 0);
end;

procedure TfrmODMedNVA.UMDelayClick(var Message: TMessage);
begin
  btnSelectClick(Self);
end;

procedure TfrmODMedNVA.ListViewEditing(Sender: TObject; Item: TListItem;
  var AllowEdit: Boolean);
begin
  AllowEdit := FALSE;
end;

procedure TfrmODMedNVA.ListViewResize(Sender: TObject);
begin
  with Sender as TListView do Columns.Items[0].Width := ClientWidth - 20;
end;

{ lstAll Methods (lstAll is TListView) }

procedure TfrmODMedNVA.LoadNonVAMedCache(First, Last: Integer);
const
  MAX_CACHE_ITEMS = 1000;
begin
  // if range is within cache range we don't need to update anything
  if (First >= FAllFirst) and (Last <= FAllLast) then Exit;
  // if range is outside of cache or a superset of cache, start over
  if (Last < Pred(FAllFirst)) or (First > Succ(FAllLast)) or
     ((First < FAllFirst) and (Last > FAllLast)) or
     (FAllItems.Count > MAX_CACHE_ITEMS) then
  begin
    FAllItems.Clear;
    FAllFirst := -1;
    FAllLast  := -1;
  end;
  // if getting items immediately before cache range
  if (First < FAllFirst) and (Last  >= FAllFirst) then Last  := Pred(FAllFirst);
  // if getting items immediately after cache range
  if (Last  > FAllLast)  and (First <= FAllLast)  then First := Succ(FAllLast);
  // retrieve the items and append (First>FAllLast) or prepend them to FAllItems
  SubsetOfOrderable(FAllItems, First>FAllLast, FAllList, First, Last);
  // reset FAllFirst & FAllLast indexes to reflect current FAllItems
  if FAllFirst < 0     then FAllFirst := First;
  if FAllLast  < 0     then FAllLast  := Last;
  if First < FAllFirst then FAllFirst := First;
  if Last > FAllLast   then FAllLast := Last;
end;

procedure TfrmODMedNVA.lstAllData(Sender: TObject; Item: TListItem);
var
  x: string;
begin
  if (FAllFirst = -1) or (Item.Index < FAllFirst) or (Item.Index > FAllLast)
    then LoadNonVAMedCache(Item.Index, Item.Index);
  x := FAllItems[Item.Index - FAllFirst];
  Item.Caption := Piece(x, U, 2);
  Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
end;

procedure TfrmODMedNVA.lstAllDataHint(Sender: TObject; StartIndex,
  EndIndex: Integer);
begin
  LoadNonVAMedCache(StartIndex, EndIndex);
end;

{ Medication is now selected ---------------------------------------------------------------- }

procedure TfrmODMedNVA.btnSelectClick(Sender: TObject);
var
  MedIEN: Integer;
  MedName: string;
  QOQuantityStr: string;
  ErrMsg: string;
begin
  inherited;
  QOQuantityStr := '';
  btnSelect.SetFocus;                             // let the exit events finish
  if pnlMeds.Visible then                         // display the medication fields
  begin
    Changing := True;
    ResetOnMedChange;
  if (FActiveMedList = lstAll) and (lstAll.Selected <> nil) then  // orderable item
    begin
      MedIEN := Integer(lstAll.Selected.Data);
      MedName := lstAll.Selected.Caption;
      txtMed.Tag := MedIEN;
      ErrMsg := '';
      IsActivateOI(ErrMsg, txtMed.Tag);
      if Length(ErrMsg)>0 then
      begin
        btnSelect.Enabled := False;
        ShowMessage(ErrMsg);
        Exit;
      end;

     { if Pos(' NF', MedName) > 0 then
      begin
        CheckFormularyOI(MedIEN, MedName, FNonVADlg);
        FAltChecked := True;
      end;
     }
      if MedIEN <> txtMed.Tag then
      begin
        txtMed.Tag := MedIEN;
        txtMed.Text := MedName;
      end;
      SetOnMedSelect;
      ShowMedFields;
    end
    else                                                                 // no selection
    begin
      MessageBeep(0);
      Exit;
    end;
    UpdateRelated(False);
    Changing := False;
    ControlChange(Self);
  end
  else ShowMedSelect;                             // show the selection fields
  FNoZERO   := False;

end;

procedure TfrmODMedNVA.ResetOnMedChange;
begin
  cboDosage.Items.Clear;
  cboDosage.Text := '';
  cboRoute.Items.Clear;
  cboRoute.Text := '';
  cboRoute.Hint := cboRoute.Text;
  ResetControl(cboSchedule);        /// cla 2/26/04
  Responses.Clear;
end;

procedure TfrmODMedNVA.SetOnMedSelect;
var
  i,j: Integer;
  x: string;
  QOPiUnChk: boolean;
  PKIEnviron: boolean;
begin
  // clear controls?
  cboDosage.Tag := -1;
  QOPiUnChk := False;
  PKIEnviron := False;
  if GetPKISite and GetPKIUse then  //PKI check for crypto object on workstation
    begin
      try  //PKI object creation
        crypto := CoXuDigSigS.Create;
        crypto.GetCSP;
        StatusText(crypto.Reason);
        PKIEnviron := True;
      except
        on  E: Exception do
          begin
            {ShowMessage('An error has been encountered while trying to create PKI environment: '+ E.Message +
            '.  This order will be processed without Digital Signature encryption.');}
            PKIEnviron := False;
          end;
      end;
      crypto := nil;
    end;
  if PKIEnviron = False then
    if GetPKISite then PKIEnviron := True;
  with CtrlInits do
  begin
    // set up CtrlInits for orderable item
    LoadOrderItem(OIForNVA(txtMed.Tag, FNonVADlg, IncludeOIPI, PKIEnviron));
    // set up lists & initial values based on orderable item
    SetControl(txtMed,       'Medication');
    SetControl(cboDosage,    'Dosage');
    SetControl(cboRoute,     'Route');
    SetControl(calStart,     'START');   //cla 7-17-03
    if cboRoute.Items.Count = 1 then cboRoute.ItemIndex := 0;
    cboRouteChange(Self);
    x := DefaultText('Schedule');
    if x <> '' then
    begin
      cboSchedule.SelectByID(x);
      cboSchedule.Text := x;
    end;
    if Length(ValueOf(FLD_QTYDISP))>10 then
    begin
    end;
    FAllDoses.Text := TextOf('AllDoses');
    FAllDrugs.Text := TextOf('Dispense');
    FGuideline.Text := TextOf('Guideline');
    case FGuideline.Count of
    0: lblGuideline.Visible := False;
    1:   begin
           lblGuideline.Caption := FGuideline[0];
           lblGuideline.Visible := TRUE;
         end;
    else begin
           lblGuideline.Caption := 'Display Restrictions/Guidelines';
           lblGuideline.Visible := TRUE;
         end;
    end;

      DEASig := '';
      if GetPKISite then DEASig := DefaultText('DEASchedule');
      FSIGVerb := DefaultText('Verb');
      if Length(FSIGVerb) = 0 then FSIGVerb := TX_TAKE;
      FSIGPrep := DefaultText('Preposition');
      for j := 0 to Responses.TheList.Count - 1 do
      begin
        if (TResponse(Responses.theList[j]).PromptID = 'PI') and (TResponse(Responses.theList[j]).EValue = ' ') then
          QOPiUnChk := True;
      end;
      FPtInstruct := TextOf('PtInstr');
      for i := 1 to Length(FPtInstruct) do if Ord(FPtInstruct[i]) < 32 then FPtInstruct[i] := ' ';
      FPtInstruct := TrimRight(FPtInstruct);
      if Length(FPtInstruct) > 0 then
      begin
        if FShrinked then
        begin
           FShrinked := False;
        end;
        if QOPiUnChk then
       end else
      begin
        if not FShrinked then
        begin
           FShrinked := True;
        end;
      end;
 //   end;
    pnlMessage.TabOrder := cboDosage.TabOrder + 1;
    OrderMessage(TextOf('Message'));
  end;
end;

procedure TfrmODMedNVA.SetOnQuickOrder;
var
  AResponse: TResponse;
  x,LocRoute,TempSch,DispGrp: string;
  i, DispDrug: Integer;
begin
  // txtMed already set by SetOnMedSelect
  with Responses do
  begin
    if (InstanceCount('INSTR') > 1) or (InstanceCount('DAYS') > 0) then // complex dose
    begin
      i := Responses.NextInstance('INSTR', 0);
      while i > 0 do
      begin
        SetDosage(IValueFor('INSTR', i));
        with cboDosage do
          if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text;
        SetControl(cboRoute,  'ROUTE', i);
        with cboRoute do
          if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text;
        if FIsQuickOrder then TempSch := cboSchedule.Text;
        SetSchedule(IValueFor('SCHEDULE', i));
        if (cboSchedule.Text = '') and FIsQuickOrder then
        begin
          cboSchedule.SelectByID(TempSch);
          cboSchedule.Text := TempSch;
        end;
        x := cboSchedule.Text;
        if chkPRN.Checked then x := x + ' PRN';
        with cboSchedule do
          if ItemIndex > -1 then x := x + TAB + Items[ItemIndex];
        if      IValueFor('CONJ', i) = 'A' then x := 'AND'
        else if IValueFor('CONJ', i) = 'T' then x := 'THEN'
        else if IValueFor('CONJ', i) = 'X' then x := 'EXCEPT'
        else x := '';
        i := Responses.NextInstance('INSTR', i);
      end; {while}
    end else                                      // single dose
    begin
      if FIsQuickOrder then
      begin
        FQODosage := IValueFor('INSTR', 1);
        SetDosage(FQODosage);
        TempSch := cboSchedule.Text;
      end
      else
        SetDosage(IValueFor('INSTR', 1));
        SetControl(cboRoute,  'ROUTE',     1);
        SetSchedule(IValueFor('SCHEDULE',  1));
      if (cboSchedule.Text = '') and FIsQuickOrder then
      begin
        cboSchedule.SelectByID(TempSch);
        cboSchedule.Text := TempSch;
      end;
      DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID), 0);
      if DispDrug > 0 then x := QuantityMessage(DispDrug) else x := '';
    SetControl(memComment ,  'COMMENT',  1);
    SetControl(calStart, 'START', 1);
    SetStartDate(EValueFor('START', 1));
    SetStatements(EValueFor('STATEMENTS', 1));
    if FIsQuickOrder then
      begin
        if not QOHasRouteDefined(Responses.QuickOrder) then
        begin
          LocRoute := GetPickupForLocation(IntToStr(Encounter.Location));
        end;
      end;
      AResponse := Responses.FindResponseByName('SC',     1);
      DispGrp := NameOfDGroup(Responses.DisplayGroup);
     if (AResponse = nil) or ((StrToIntDef(Piece(Responses.CopyOrder,';',1),0)>0) and AnsiSameText('Out. Meds',DispGrp)) then
      begin
        LocRoute := GetPickupForLocation(IntToStr(Encounter.Location));
      end;

    end;
  end; {with}
  if FInptDlg then
  begin
    x := ValueOfResponse(FLD_SCHEDULE, 1);
    if Length(x) > 0 then UpdateStartExpires(x);
  end;
end;


procedure TfrmODMedNVA.ShowMedSelect;
begin
  txtMed.SelStart := Length(txtMed.Text);
  ChangeDelayed;  // synch the listboxes with display
  pnlFields.Enabled := False;
  pnlFields.Visible := False;
  pnlMeds.Enabled   := True;
  pnlMeds.Visible   := True;
  btnSelect.Caption := 'OK';
  btnSelect.Top     := cmdAccept.Top;
  btnSelect.Anchors := [akRight, akBottom];
  btnSelect.BringToFront;
  cmdAccept.Visible := False;
  cmdAccept.Default := False;
  btnSelect.Default := True;
  btnSelect.TabOrder := cmdAccept.TabOrder;
  cmdAccept.TabStop := False;
  txtMed.Font.Color := clWindowText;
  txtMed.Color      := clWindow;
  txtMed.ReadOnly   := False;
  txtMed.SelectAll;
  txtMed.SetFocus;
  FDrugID := '';
end;

procedure TfrmODMedNVA.ShowMedFields;
begin
   pnlMeds.Enabled   := False;
  pnlMeds.Visible   := False;
  pnlFields.Enabled := True;
  pnlFields.Visible := True;
  btnSelect.Caption := 'Change';
  btnSelect.Top     := txtMed.Top;
  btnSelect.Anchors := [akRight, akTop];
  btnSelect.Default := False;
  cmdAccept.Visible := True;
  cmdAccept.Default := True;
  btnSelect.TabOrder := txtMed.TabOrder + 1;
  cmdAccept.TabStop := True;
  txtMed.Width      := memOrder.Width;
  txtMed.Font.Color := clInfoText;
  txtMed.Color      := clInfoBk;
  txtMed.ReadOnly   := True;
  ShowControlsSimple;
end;

procedure TfrmODMedNVA.ShowControlsSimple;
begin
  tabDose.TabIndex := TI_DOSE;
  cboDosage.Visible := True;
  lblRoute.Visible := True;
  cboRoute.Visible := True;
  lblSchedule.Visible := True;
  cboSchedule.Visible := True;
  chkPRN.Visible := True;
  ActiveControl := cboDosage;
end;

procedure TfrmODMedNVA.SetDosage(const x: string);
var
  i, DoseIndex: Integer;
begin
  DoseIndex := -1;
  with cboDosage do
  begin
    ItemIndex := -1;
    for i := 0 to Pred(Items.Count) do
      if Piece(Items[i], U, 5) = x then
      begin
        DoseIndex := i;
        Break;
      end;
    if DoseIndex < 0 then Text := x else ItemIndex := DoseIndex;
  end;
end;

procedure TfrmODMedNVA.SetStatements(x: string);
var
i,stmtLen: integer;
stmt: string;
hldStr, matchStmt: string;
stmtList: TStringList;
begin
   stmt := x;
   stmtLen := Length(stmt);
   stmtList := TStringList.Create;
   stmtList.Clear;
   for i := 1 to stmtLen do
   if((stmt[i] <> NVA_CR) and (stmt[i] <> NVA_LF)) then
      hldStr := hldStr + stmt[i]
   else
      hldStr := hldStr + '^';
   hldStr := hldStr + '^';  //  end line with a '^' for piece.

   //  Load List of statements.
   stmtList.Add(Piece(hldStr,U,1));
   stmtList.Add(Piece(hldStr,U,3));
   stmtList.Add(Piece(hldStr,U,5));
   stmtList.Add(Piece(hldStr,U,7));

   for i := 0 to lbStatements.count-1 do
   begin
      matchStmt := lbStatements.Items.Strings[i];
      if SearchStatements(stmtList,matchStmt) then
         lbStatements.Checked[i] := True;
   end;

end;

function TfrmODMedNVA.SearchStatements(StatementList: TStringList; Statement: string): Boolean;
var
i : integer;
x: string;
begin

    Result := FALSE;
    for i := 0 to StatementList.Count-1 do
    begin
       x := StatementList.Strings[i];
       if Statement = Trim(StatementList.Strings[i]) then
       begin
           Result := TRUE;
           Break;
       end;
    end;
end;

procedure TfrmODMedNVA.SetStartDate(const x: string);
begin
     calStart.Text := x;
end;

procedure TfrmODMedNVA.SetSchedule(const x: string);
var
  NonPRNPart: string;
begin
  cboSchedule.ItemIndex := -1;
  if Pos('PRN', x) > 0 then
  begin
    NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
    cboSchedule.SelectByID(NonPRNPart);
    if cboSchedule.ItemIndex > -1 then chkPRN.Checked := True else
    begin
      cboSchedule.SelectByID(x);
      if cboSchedule.ItemIndex < 0 then cboSchedule.Text := x;
    end;
  end else
  begin
    chkPRN.Checked := False;
    cboSchedule.SelectByID(x);
    if cboSchedule.ItemIndex < 0 then cboSchedule.Text := x;
  end;
end;

{ Medication edit --------------------------------------------------------------------------- }

procedure TfrmODMedNVA.tabDoseChange(Sender: TObject);
begin
  inherited;
  case tabDose.TabIndex of
  TI_DOSE:    begin
                // clean up responses?
                ShowControlsSimple;
                ControlChange(Self);
              end;
  TI_RATE:    begin
                // for future use...
              end;
   end; {case}
end;

procedure TfrmODMedNVA.lblGuidelineClick(Sender: TObject);
var
  TextStrings: TStringList;
begin
  inherited;
  TextStrings := TStringList.Create;
  try
    TextStrings.Text := FGuideline.Text;
    ReportBox(TextStrings, TC_GUIDELINE, TRUE);
  finally
    TextStrings.Free;
  end;
end;

{ cboDosage ------------------------------------- }

procedure TfrmODMedNVA.CheckFormAltDose(DispDrug: Integer);
var
  OI: Integer;
  OIName: string;
begin
  if FAltChecked or (DispDrug = 0) then Exit;
  OI := txtMed.Tag;
  OIName := txtMed.Text;
  CheckFormularyDose(DispDrug, OI, OIName, FNonVADlg);
  if OI <> txtMed.Tag then
  begin
    ResetOnMedChange;
    txtMed.Tag  := OI;
    txtMed.Text := OIName;
    SetOnMedSelect;
  end;
end;

procedure TfrmODMedNVA.cboDosageClick(Sender: TObject);
var
  DispDrug: Integer;
  x: string;
begin
  inherited;
  UpdateRelated(False);
  DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID), 0);
  if cboDosage.Text = '' then    //cla 3/18/04
  begin
    DispDrug := 0;
    cboDosage.ItemIndex := -1;
  end;
  if DispDrug > 0 then
  begin
    if not FSuppressMsg then begin
      pnlMessage.TabOrder := cboDosage.TabOrder + 1;
      OrderMessage(DispenseMessage(DispDrug));
    end;
    x := QuantityMessage(DispDrug);
  end
  else x := '';
  with cboDosage do
    if (ItemIndex > -1) and (Piece(Items[ItemIndex], U, 3) = 'NF')
      then CheckFormAltDose(DispDrug);
end;

procedure TfrmODMedNVA.cboDosageChange(Sender: TObject);
begin
  inherited;
  UpdateRelated;
end;

procedure TfrmODMedNVA.cboDosageExit(Sender: TObject);
begin
  inherited;
  if ActiveControl = memMessage then
  begin
    memMessage.SendToBack;
    PnlMessage.Visible := False;
    Exit;
  end;
  if ActiveControl = memComment then
  begin
   if PnlMessage.Visible = true then
   begin
     memMessage.SendToBack;
     PnlMessage.Visible := False;
   end;
  end
  else if (ActiveControl <> btnSelect) and (ActiveControl <> memComment) then
  begin
   if PnlMessage.Visible = true then
   begin
     memMessage.SendToBack;
     PnlMessage.Visible := False;
   end;
   cboDosageClick(Self);
  end;
end;

{ cboRoute -------------------------------------- }

procedure TfrmODMedNVA.cboRouteChange(Sender: TObject);
begin
  inherited;
  with cboRoute do
    if ItemIndex > -1 then
    begin
      if Piece(Items[ItemIndex], U, 5) = '1'
        then tabDose.Tabs[0] := 'Dosage / Rate'
        else tabDose.Tabs[0] := 'Dosage';
    end;
  cboDosage.Caption := tabDose.Tabs[0];
  if Sender <> Self then ControlChange(Sender);
end;

procedure TfrmODMedNVA.cboRouteExit(Sender: TObject);
begin
  inherited;
end;

{ cboSchedule ----------------------------------- }

procedure TfrmODMedNVA.cboScheduleClick(Sender: TObject);
begin
  inherited;
  UpdateRelated(False);
end;

procedure TfrmODMedNVA.cboScheduleChange(Sender: TObject);
begin
  inherited;
  UpdateRelated;
end;

procedure TfrmODMedNVA.cboScheduleExit(Sender: TObject);
begin
end;

{ values changing }

function TfrmODMedNVA.OutpatientSig: string;
var
  Dose, Route, Schedule: string;
begin
  case tabDose.TabIndex of
  TI_DOSE:
    begin
      if ValueOf(FLD_TOTALDOSE) = ''
        then Dose := ValueOf(FLD_LOCALDOSE)
        else Dose := ValueOf(FLD_UNITNOUN);
      CheckDecimal(Dose);
      Route := ValueOf(FLD_ROUTE_EX);
      if (Length(Route) > 0) and (Length(FSigPrep) > 0) then Route := FSigPrep + ' ' + Route;
      if Length(Route) = 0 then Route := ValueOf(FLD_ROUTE_NM);
      Schedule := ValueOf(FLD_SCHED_EX);
      if Length(Schedule) = 0 then Schedule := ValueOf(FLD_SCHEDULE);
      Result := FSIGVerb + ' ' + Dose + ' ' + Route + ' ' + Schedule;
    end;
  end; {case}
end;

function TfrmODMedNVA.ConstructedDoseFields(const ADose: string; PrependName: Boolean = FALSE): string;
var
  i, DrugIndex: Integer;
  UnitsPerDose, Strength: Extended;
  Units, Noun, AName: string;
begin
  DrugIndex := -1;
  for i := 0 to Pred(FAllDrugs.Count) do
    if AnsiSameText(Piece(FAllDrugs[i], U, 1), FDrugID) then
    begin
      DrugIndex := i;
      Break;
    end;
  Strength := StrToFloatDef(Piece(FAllDrugs[DrugIndex], U, 2), 0);
  Units    := Piece(FAllDrugs[DrugIndex], U, 3);
  AName    := Piece(FAllDrugs[DrugIndex], U, 4);
  if FAllDoses.Count > 0
    then Noun := Piece(Piece(FAllDoses[0], U, 3), '&', 4)
    else Noun := '';
  if Strength > 0
    then UnitsPerDose := ExtractFloat(ADose) / Strength
    else UnitsPerDose := 0;
  if (UnitsPerDose > 1) and (Noun <> '') and (CharAt(Noun, Length(Noun)) <> 'S')
    then Noun := Noun + 'S';
  Result := FloatToStr(ExtractFloat(ADose)) + '&' + Units + '&' + FloatToStr(UnitsPerDose)
            + '&' + Noun + '&' + ADose + '&' + FDrugID + '&' + FloatToStr(Strength) + '&'
            + Units;
  if PrependName then Result := AName + U + FloatToStr(Strength) + Units + U + U +
                                Result + U + ADose;
  Result := UpperCase(Result);
end;

function TfrmODMedNVA.FindDoseFields(const Drug, ADose: string): string;
var
  i: Integer;
  x: string;
begin
  Result := '';
  x := ADose + U + Drug + U;
  for i := 0 to Pred(FAllDoses.Count) do
  begin
    if AnsiSameText(x, Copy(FAllDoses[i], 1, Length(x))) then
    begin
      Result := Piece(FAllDoses[i], U, 3);
      Break;
    end;
  end;
end;

function TfrmODMedNVA.FindCommonDrug(DoseList: TStringList): string;
// DoseList[n] = DoseText ^ Dispense Drug Pointer
var
  i, j, UnitIndex: Integer;
  DrugStrength, DoseValue, UnitsPerDose: Extended;
  DrugOK, PossibleDoses, SplitTab: Boolean;
  ADrug, ADose, DoseFields, DoseUnits, DrugUnits: string;
  FoundDrugs: TStringList;

  procedure SaveDrug(const ADrug: string; UnitsPerDose: Extended);
  var
    i, DrugIndex: Integer;
    CurUnits: Extended;
  begin
    DrugIndex := -1;
    for i := 0 to Pred(FoundDrugs.Count) do
      if AnsiSameText(Piece(FoundDrugs[i], U, 1), ADrug) then DrugIndex := i;
    if DrugIndex = -1 then FoundDrugs.Add(ADrug + U + FloatToStr(UnitsPerDose)) else
    begin
      CurUnits := StrToFloatDef(Piece(FoundDrugs[DrugIndex], U, 2), 0);
      if UnitsPerDose > CurUnits
        then FoundDrugs[DrugIndex] := ADrug + U + FloatToStr(UnitsPerDose);
    end;
  end;

  procedure KillDrug(const ADrug: string);
  var
    i, DrugIndex: Integer;
  begin
    DrugIndex := -1;
    for i := 0 to Pred(FoundDrugs.Count) do
      if AnsiSameText(Piece(FoundDrugs[i], U, 1), ADrug) then DrugIndex := i;
    if DrugIndex > -1 then FoundDrugs.Delete(DrugIndex);
  end;

begin
  Result := '';
  if FInptDlg then                                // inpatient dialog
  begin
    DrugOK := True;
    for i := 0 to Pred(DoseList.Count) do
    begin
      ADrug := Piece(DoseList[i], U, 2);
      if ADrug = '' then DrugOK := False;
      if Result = '' then Result := ADrug;
      if not AnsiSameText(ADrug, Result) then DrugOK := False;
      if not DrugOK then Break;
    end;
    
    if not DrugOK then Result :='';
  end else                                        // outpatient dialog
  begin
    // check the dose combinations for each dispense drug
    FoundDrugs := TStringList.Create;
    try
      if FAllDoses.Count > 0
        then PossibleDoses := Length(Piece(Piece(FAllDoses[0], U, 3), '&', 1)) > 0
        else PossibleDoses := False;
      for i := 0 to Pred(FAllDrugs.Count) do
      begin
        ADrug := Piece(FAllDrugs[i], U, 1);
        DrugOK := True;
        DrugStrength := StrToFloatDef(Piece(FAllDrugs[i], U, 2), 0);
        DrugUnits := Piece(FAllDrugs[i], U, 3);
        SplitTab := Piece(FAllDrugs[i], U, 5) = '1';
        for j := 0 to Pred(DoseList.Count) do
        begin
          ADose:= Piece(DoseList[j], U, 1);
          DoseFields := FindDoseFields(ADrug, ADose);  // get the idnode for the dose/drug combination
          if not PossibleDoses then
          begin
            if DoseFields = '' then DrugOK := False else SaveDrug(ADrug, 0);
          end else
          begin
            DoseValue := StrToFloatDef(Piece(DoseFields, '&', 1), 0);
            if DoseValue = 0 then DoseValue := ExtractFloat(ADose);
            UnitsPerDose := DoseValue / DrugStrength;
            if (Frac(UnitsPerDose) = 0) or (SplitTab and (Frac(UnitsPerDose) = 0.5))
              then SaveDrug(ADrug, UnitsPerDose)
              else DrugOK := False;
            // make sure this dose is using the same units as the drug
            if DoseFields = '' then
            begin
              for UnitIndex := 1 to Length(ADose) do
                if not (ADose[UnitIndex] in ['0'..'9','.']) then Break;
              DoseUnits := Copy(ADose, UnitIndex, Length(ADose));
            end
            else DoseUnits := Piece(DoseFields, '&', 2);
            if not AnsiSameText(DoseUnits, DrugUnits) then DrugOK := False;
          end;
          if not DrugOK then
          begin
            KillDrug(ADrug);
            Break;
          end; {if not DrugOK}
        end; {with..for j}
      end; {for i}
      if FoundDrugs.Count > 0 then
      begin
        if not PossibleDoses then Result := Piece(FoundDrugs[0], U, 1) else
        begin
          UnitsPerDose := 99999999;
          for i := 0 to Pred(FoundDrugs.Count) do
          begin
            if StrToFloatDef(Piece(FoundDrugs[i], U, 2), 99999999) < UnitsPerDose then
            begin
              Result := Piece(FoundDrugs[i], U, 1);
              UnitsPerDose := StrToFloatDef(Piece(FoundDrugs[i], U, 2), 99999999);
            end; {if StrToFloatDef}
          end; {for i..FoundDrugs}
        end; {if not..else PossibleDoses}
      end; {if FoundDrugs}
    finally
      FoundDrugs.Free;
    end; {try}
  end; {if..else FInptDlg}
end; {FindCommonDrug}

procedure TfrmODMedNVA.ControlChange(Sender: TObject);
var
  x,ADose,AUnit,ADosageText: string;
  DoseList: TStringList;
begin
  inherited;
  if csLoading in ComponentState then Exit;       // to prevent error caused by txtRefills
  if Changing then Exit;
  if txtMed.Tag = 0 then Exit;
  ADose := '';
  AUnit := '';
  ADosageText := '';
  FUpdated := FALSE;
  Responses.Clear;
  Responses.Update('ORDERABLE',  1, IntToStr(txtMed.Tag), txtMed.Text);
  DoseList := TStringList.Create;
  case tabDose.TabIndex of
  TI_DOSE:
    begin
      if (cboDosage.ItemIndex < 0) and (Length(cboDosage.Text) > 0) then
      begin
        // try to resolve freetext dose and add it as a new item to the combobox
        ADosageText := cboDosage.Text;
        ADose := Piece(ADosageText,' ',1);
        Delete(ADosageText,1,Length(ADose)+1);
        ADosageText := ADose + Trim(ADosageText);
        DoseList.Add(ADosageText);
        FDrugID := FindCommonDrug(DoseList);
        if FDrugID <> '' then
        begin
          if ExtractFloat(cboDosage.Text) > 0 then
          begin
            x := ConstructedDoseFields(cboDosage.Text, TRUE);
            FDrugID := '';
            with cboDosage do ItemIndex := cboDosage.Items.Add(x);
          end;
        end;
      end;
      x := ValueOf(FLD_DOSETEXT);    Responses.Update('INSTR',    1, x,  x);
      x := ValueOf(FLD_DRUG_ID);     Responses.Update('DRUG',     1, x, '');
      x := ValueOf(FLD_DOSEFLDS);    Responses.Update('DOSE',     1, x, '');
      x := ValueOf(FLD_STRENGTH);
      // if outpt or inpt order with no total dose (i.e., topical)
      if (not FInptDlg) or (ValueOf(FLD_TOTALDOSE) = '')
                                then Responses.Update('STRENGTH', 1, x,  x);
      // if no strength for dosage, use dispense drug name
      if Length(x) = 0 then
      begin
        x := ValueOf(FLD_DRUG_NM);
        if Length(x) > 0        then Responses.Update('NAME',     1, x,  x);
      end;
      x := ValueOf(FLD_ROUTE_AB);
      if Length(x) = 0 then x := ValueOf(FLD_ROUTE_NM);
      if Length(ValueOf(FLD_ROUTE_ID)) > 0
                                then Responses.Update('ROUTE',    1, ValueOf(FLD_ROUTE_ID), x)
                                else Responses.Update('ROUTE',    1, '', x);
 //     x := ValueOf(FLD_SCHEDULE);    Responses.Update('SCHEDULE', 1, x,  x);
    end;
  end; {case TabDose.TabIndex}
  DoseList.Free;
  Responses.Update('URGENCY',   1, ValueOf(FLD_PRIOR_ID), '');
  Responses.Update('COMMENT',   1, TX_WPTYPE, ValueOf(FLD_COMMENT));

  if Length(calStart.Text) > 0 then
     Responses.Update('START', 1, calStart.Text, 'Start Date: ' + calStart.Text);  //cla 7-17-03

  x := ValueOf(FLD_STATEMENTS);
  Responses.Update('STATEMENTS',1, TX_WPTYPE, x);


 if FInptDlg then                       // inpatient orders
  begin
    Responses.Update('NOW',     1, ValueOf(FLD_NOW_ID), ValueOf(FLD_NOW_NM));
  end else
  begin
     x := OutpatientSig;                 Responses.Update('SIG',     1, TX_WPTYPE, x);
 end;
  memOrder.Text := Responses.OrderText;
end;

{ complex dose ------------------------------------------------------------------------------ }

{ General Functions - get & set cell values}

procedure FindInCombo(const x: string; AComboBox: TORComboBox);
var
  i, Found: Integer;
begin
  with AComboBox do
  begin
    i := 0;
    Found := -1;
    while (i < Items.Count) and (Found < 0) do
    begin
      if CompareText(Copy(DisplayText[i], 1, Length(x)), x) = 0 then Found := i;
      Inc(i);
    end; {while}
    if Found > -1 then
    begin
      ItemIndex := Found;
      Application.ProcessMessages;
      SelStart  := 1;
      SelLength := Length(Items[Found]);
    end else
    begin
      Text := x;
      SelStart := Length(x);
    end;
  end; {with AComboBox}
end;

procedure TfrmODMedNVA.grdDosesExit(Sender: TObject);
begin
  inherited;
  UpdateRelated(FALSE);
  RestoreDefaultButton;
  RestoreCancelButton;
end;

function TfrmODMedNVA.ValueOf(FieldID: Integer; ARow: Integer = -1): string;
var
  y: string;
  stmt: Integer;
{ 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 }
begin
  Result := '';
  if ARow < 0 then                                // use single dose controls
  begin
    case FieldID of
    FLD_DOSETEXT  : with cboDosage do
                      if ItemIndex > -1 then Result := Uppercase(Piece(Items[ItemIndex], U, 5))
                                        else Result := Uppercase(Text);
    FLD_LOCALDOSE : with cboDosage do
                      if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 5)
                                        else Result := Uppercase(Text);
    FLD_STRENGTH  : with cboDosage do
                     if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 2);
    FLD_DRUG_ID   : with cboDosage do
                     if ItemIndex > -1  then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 6);
    FLD_DRUG_NM   : with cboDosage do
                     if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 1);
    FLD_DOSEFLDS  : with cboDosage do
                     if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 4);
    FLD_TOTALDOSE : with cboDosage do
                      if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 1);
    FLD_UNITNOUN  : with cboDosage do
                      if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 3) + ' '
                                                     + Piece(Piece(Items[ItemIndex], U, 4), '&', 4);
    FLD_ROUTE_ID  : with cboRoute do
                     if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 1);
    FLD_ROUTE_NM  : with cboRoute do
                     if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 2)
                                        else Result := Text;
    FLD_ROUTE_AB  : with cboRoute do
                     if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 3);
    FLD_ROUTE_EX  : with cboRoute do
                     if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 4);
    FLD_SCHEDULE  : begin
                      Result := cboSchedule.Text;
                      if chkPRN.Checked then Result := Result + ' PRN';
                      if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN'
                        then Result := Copy(Result, 1, Length(Result) - 4);
                    end;
    FLD_SCHED_EX  : begin
                      with cboSchedule do
                        if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2);
                      if (Length(Result) > 0) and chkPRN.Checked then Result := Result + ' AS NEEDED';
                      if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED'
                        then Result := Copy(Result, 1, Length(Result) - 10);
                    end;
    FLD_SCHED_TYP : with cboSchedule do
                      if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 3);
    FLD_QTYDISP   : with cboDosage do
                      begin
                        if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 8);
                        if (Result = '') and (Items.Count > 0) then Result := Piece(Items[0], U, 8);
                        if Result <> ''
                          then Result := 'Qty (' + Result + ')'
                          else Result := 'Quantity';
                      end;

    FLD_COMMENT   : Result := memComment.Text;

    FLD_START     : Result := FormatFMDateTime('mmm dd,yy',calStart.FMDateTime);

    FLD_STATEMENTS : with lbStatements do
                     for stmt := 0 to lbStatements.Items.Count-1 do
                     if(lbStatements.Checked[stmt]) then
                     begin
                        y := #13#10 + lbStatements.Items.Strings[stmt] + '  ';
                          Result := Result + y;
                     end;

    end; {case FieldID}
   end;                          // use complex dose controls
end;

function TfrmODMedNVA.ValueOfResponse(FieldID: Integer; AnInstance: Integer = 1): string;
var
  x: string;
begin
  case FieldID of
  FLD_SCHEDULE  : Result := Responses.IValueFor('SCHEDULE', AnInstance);
  FLD_UNITNOUN  : begin
                    x := Responses.IValueFor('DOSE',   AnInstance);
                    Result := Piece(x, '&', 3) + ' ' + Piece(x, '&', 4);
                  end;
  FLD_DOSEUNIT  : begin
                    x := Responses.IValueFor('DOSE',   AnInstance);
                    Result := Piece(x, '&', 3);
                  end;
  FLD_DRUG_ID   : Result := Responses.IValueFor('DRUG',     AnInstance);
  FLD_INSTRUCT  : Result := Responses.IValueFor('INSTR',    AnInstance);
  FLD_SUPPLY    : Result := Responses.IValueFor('SUPPLY',   AnInstance);
  FLD_QUANTITY  : Result := Responses.IValueFor('QTY',      AnInstance);
  FLD_ROUTE_ID  : Result := Responses.IValueFor('ROUTE',    AnInstance);
  FLD_EXPIRE    : Result := Responses.IValueFor('DAYS',     AnInstance);
  FLD_ANDTHEN   : Result := Responses.IValueFor('CONJ',     AnInstance);
  end;
end;

procedure TfrmODMedNVA.UpdateStartExpires(const CurSchedule: string);
var
  ShowText, Duration, ASchedule: string;
  AdminTime:    TFMDateTime;
  Interval, PrnPos: Integer;
begin
  if Length(CurSchedule)=0 then Exit;
  ASchedule := Trim(CurSchedule);
  if (Pos('^',ASchedule)=0) then
  begin
    PrnPos := Pos('PRN',ASchedule);
    if (PrnPos > 1) and (CharAt(ASchedule,PrnPos-1) <> ';') then
      Delete(ASchedule, PrnPos, Length(ASchedule));
  end
  else if (Pos('^',ASchedule)>0) then
  begin
    PrnPos := Pos('PRN',ASchedule);
    if (PrnPos > 1) and (CharAt(ASchedule,PrnPos-1)=' ') then
      Delete(ASchedule, PrnPos-1, 4);
  end;
  ASchedule := Trim(ASchedule);
  if Length(ASchedule)>0 then
      LoadAdminInfo(ASchedule, txtMed.Tag, ShowText, AdminTime, Duration)
  else Exit;
  if AdminTime > 0 then
  begin
    ShowText := 'Expected First Dose: ';
    Interval := Trunc(FMDateTimeToDateTime(AdminTime) - FMDateTimeToDateTime(FMToday));
    case Interval of
    0: ShowText := ShowText + 'TODAY ' + FormatFMDateTime('(mmm dd, yy) at hh:nn', AdminTime);
    1: ShowText := ShowText + 'TOMORROW ' + FormatFMDateTime('(mmm dd, yy) at hh:nn', AdminTime);
    else ShowText := ShowText + FormatFMDateTime('mmm dd, yy at hh:nn', AdminTime);
    end;
  lblAdminTime.Caption := ShowText;
  FAdminTimeLbl := lblAdminTime.Caption;
  end
  else lblAdminTime.Caption := '';
end;

procedure TfrmODMedNVA.UpdateRelated(DelayUpdate: Boolean = TRUE);
begin
  timCheckChanges.Enabled := False;               // turn off timer
  if DelayUpdate
    then timCheckChanges.Enabled := True          // restart timer
    else timCheckChangesTimer(Self);              // otherwise call directly
end;

procedure TfrmODMedNVA.timCheckChangesTimer(Sender: TObject);
const
  UPD_NONE     = 0;
  UPD_QUANTITY = 1;
  UPD_SUPPLY   = 2;
var
  CurUnits, CurSchedule, CurInstruct, CurDispDrug, CurDuration, TmpSchedule, x, x1: string;
  CurScheduleIN, CurScheduleOut: string;
  CurQuantity, CurSupply, i, pNum, j: Integer;
 { LackQtyInfo,} SaveChanging: Boolean;
begin
  inherited;
  timCheckChanges.Enabled := False;
  ControlChange(Self);
  SaveChanging := Changing;
  Changing := TRUE;
  // don't allow Exit procedure so Changing gets reset appropriately
  CurUnits    := '';
  CurSchedule := '';
  CurDuration := '';
 // LackQtyInfo := False;
  i := Responses.NextInstance('DOSE', 0);
  while i > 0 do
  begin
    x := ValueOfResponse(FLD_DOSEUNIT,  i);
 //   if x = '' then LackQtyInfo := TRUE;  //StrToIntDef(x, 0) = 0
    CurUnits    := CurUnits   + x  + U;
    x := ValueOfResponse(FLD_SCHEDULE,  i);
 //   if Length(x) = 0         then LackQtyInfo := TRUE;
    CurScheduleOut := CurScheduleOut + x + U;
    x1 := ValueOf(FLD_SEQUENCE,i);
    if Length(x1)>0 then
    begin
      X1 := CharAt(X1,1);
      CurScheduleIn := CurScheduleIn + x1 + ';' + x + U;
    end
    else
      CurScheduleIn := CurScheduleIn + ';' + x + U;
    x := ValueOfResponse(FLD_EXPIRE,    i);
    CurDuration := CurDuration + x + '~';
    x := ValueOfResponse(FLD_ANDTHEN,   i);
    CurDuration := CurDuration + x + U;
    x := ValueOfResponse(FLD_DRUG_ID,   i);
    CurDispDrug := CurDispDrug + x + U;
    x := ValueOfResponse(FLD_INSTRUCT,  i);
    CurInstruct := CurInstruct + x + U;
    i := Responses.NextInstance('DOSE', i);
  end;

  pNum := 1;
  while Length( Piece(CurScheduleIn,U,pNum)) > 0 do
    pNum := pNum + 1;
  if Length(Piece(CurScheduleIn,U,pNum)) < 1 then
    for j := 1 to pNum - 1 do
    begin
      if j = pNum -1 then
        TmpSchedule := TmpSchedule + ';' + Piece(Piece(CurScheduleIn,U,j),';',2)
      else
        TmpSchedule := TmpSchedule + Piece(CurScheduleIn,U,j) + U
    end;
  CurScheduleIn := TmpSchedule;
  CurQuantity := StrToIntDef(ValueOfResponse(FLD_QUANTITY) ,0);
  CurSupply   := StrToIntDef(ValueOfResponse(FLD_SUPPLY)   ,0);
  if FInptDlg then
  begin
    CurSchedule := CurScheduleIn;
    if Pos('^',CurSchedule)>0 then
    begin
      if Pos('PRN',Piece(CurSchedule,'^',1))>0 then
        if lblAdminTime.Visible then
          lblAdminTime.Caption := '';
    end;
    if CurSchedule <> FLastSchedule then UpdateStartExpires(CurSchedule);
    if Responses.EventType in ['A','D','T','M','O'] then lblAdminTime.Visible := False;
  end;
  if not FInptDlg then
  begin
    CurSchedule := CurScheduleOut;
  end;

  FLastUnits    := CurUnits;
  FLastSchedule := CurSchedule;
  FLastDispDrug := CurDispDrug;
  FLastQuantity := CurQuantity;
  FLastSupply   := CurSupply;
  if (ActiveControl <> nil) and (ActiveControl.Parent <> cboDosage)
    then cboDosage.Text := Piece(cboDosage.Text, TAB, 1);
  Changing := SaveChanging;
  if FUpdated then ControlChange(Self);
end;

procedure TfrmODMedNVA.cmdAcceptClick(Sender: TObject);
begin
  cmdAccept.SetFocus;
  inherited;
end;
procedure TfrmODMedNVA.CheckDecimal(var AStr: string);
var
  Number: double;
  DUName,TabletNum,tempStr: string;
  ToWord: string;
  ie,code: integer;
begin
  ToWord := '';
  tempStr := AStr;
  TabletNum := Piece(AStr,' ',1);
  if CharAt(TabletNum,1)='.' then
  begin
    if CharAt(TabletNum,2) in ['0','1','2','3','4','5','6','7','8','9'] then
    begin
      TabletNum := '0' + TabletNum;
      AStr := '0' + AStr;
    end;
  end;
  DUName := Piece(AStr,' ',2);
  if Pos('TABLET',upperCase(DUName))= 0 then
    Exit;
  if (Length(TabletNum)>0) and (Length(DUName)>0) then
  begin
    if CharAt(TabletNum,1) <> '0' then
    begin
      Val(TabletNum, ie, code);
      if code <> 0 then
        Exit;
    end;
    try
      begin
        Number := StrToFloat(TabletNum);
        if Number = 0.5 then
          ToWord := 'ONE-HALF';
        if ( Number >= 0.333 ) and  ( Number <= 0.334 ) then
          ToWord := 'ONE-THIRD';
        if Number = 0.25 then
          ToWord := 'ONE-FOURTH';
        if ( Number >= 0.66 ) and ( Number <= 0.67 ) then
          ToWord := 'TWO-THIRDS';
        if Number = 0.75 then
          ToWord := 'THREE-FOURTHS';
        if Number = 1 then
          ToWord := 'ONE';
        if Number = 2 then
          ToWord := 'TWO';
        if Number = 3 then
          ToWord := 'THREE';
        if Number = 4 then
          ToWord := 'FOUR';
        if Number = 5 then
          ToWord := 'FIVE';
        if Number = 6 then
          ToWord := 'SIX';
        if (Length(ToWord) > 0) then
           AStr :=  ToWord + ' ' + DUName;
      end
    except
      on EConvertError do AStr := tempStr;
    end;
  end;
end;

procedure TfrmODMedNVA.chkPRNClick(Sender: TObject);
begin
  inherited;
  if chkPRN.Checked then lblAdminTime.Caption := ''
  else
  begin
    lblAdminTime.Caption := FAdminTimeLbl;
  end;
  ControlChange(Self);
end;

procedure TfrmODMedNVA.grdDosesKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  case Key of
  VK_ESCAPE:
    begin
      ActiveControl := FindNextControl(Sender as TWinControl, False, True, False); //Previous control
      Key := 0;
    end;
  VK_TAB:
    begin
      if ssShift in Shift then
      begin
        ActiveControl := tabDose; //Previeous control
        Key := 0;
      end
      else if ssCtrl	in Shift then
      begin
        ActiveControl := memComment;
        Key := 0;
      end;
    end;
  end;
end;

procedure TfrmODMedNVA.grdDosesEnter(Sender: TObject);
begin
  inherited;
  DisableDefaultButton(self);
  DisableCancelButton(self);
end;

function TfrmODMedNVA.DisableCancelButton(Control: TWinControl): boolean;
var
  i: integer;
begin
  if (Control is TButton) and TButton(Control).Cancel then begin
    result := True;
    FDisabledCancelButton := TButton(Control);
    TButton(Control).Cancel := False;
  end else begin
    result := False;
    for i := 0 to Control.ControlCount-1 do
      if (Control.Controls[i] is TWinControl) then
        if DisableCancelButton(TWinControl(Control.Controls[i])) then begin
          result := True;
          break;
        end;
  end;
end;

function TfrmODMedNVA.DisableDefaultButton(Control: TWinControl): boolean;
var
  i: integer;
begin
  if (Control is TButton) and TButton(Control).Default then begin
    result := True;
    FDisabledDefaultButton := TButton(Control);
    TButton(Control).Default := False;
  end else begin
    result := False;
    for i := 0 to Control.ControlCount-1 do
      if (Control.Controls[i] is TWinControl) then
        if DisableDefaultButton(TWinControl(Control.Controls[i])) then begin
          result := True;
          break;
        end;
  end;
end;

procedure TfrmODMedNVA.RestoreCancelButton;
begin
  if Assigned(FDisabledCancelButton) then begin
    FDisabledCancelButton.Cancel := True;
    FDisabledCancelButton := nil;
  end;
end;

procedure TfrmODMedNVA.RestoreDefaultButton;
begin
  if Assigned(FDisabledDefaultButton) then begin
    FDisabledDefaultButton.Default := True;
    FDisabledDefaultButton := nil;
  end;
end;

procedure TfrmODMedNVA.pnlMessageEnter(Sender: TObject);
begin
  inherited;
  DisableDefaultButton(self);
  DisableCancelButton(self);
end;

procedure TfrmODMedNVA.pnlMessageExit(Sender: TObject);
begin
  inherited;
  RestoreDefaultButton;
  RestoreCancelButton;
end;

procedure TfrmODMedNVA.memMessageKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if (Key = VK_RETURN) or (Key = VK_ESCAPE) then
  begin
    Perform(WM_NEXTDLGCTL, 0, 0);
    Key := 0;
  end;
end;

procedure TfrmODMedNVA.FormResize(Sender: TObject);
begin
  inherited;
  pnlFields.Height := cmdAccept.Top - 4 - pnlFields.Top;
end;

procedure TfrmODMedNVA.lstQuickData(Sender: TObject; Item: TListItem);
var
  x: string;
begin
    x := FQuickItems[Item.Index];
    Item.Caption := Piece(x, U, 2);
    Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
end;

procedure TfrmODMedNVA.LoadOTCStatements(Dest: TStrings);
var tmplst: TStringList;
  s: string;
  i :Integer;
begin
    tmplst := TStringList.Create;
    tmplst.Clear;
    tCallV(tmplst, 'ORWPS REASON', [nil]);
    if tmplst.Count > 0 then
    begin
      //  sort := tmplst.Strings[0];
        for i := 0 to tmplst.Count-1 do
        begin
            s:= tmplst.Strings[i];
            tmplst.Strings[i] := Piece(s,U,2);
        end;
        Dest.Assign(tmplst);
    end;
 end;

function TfrmODMedNVA.FindQuickOrder(const x: string): Integer;
var
  i: Integer;
begin
  Result := -1;
  if x = '' then Exit;
  for i := 0 to Pred(FQuickItems.Count) do
  begin
    if (Result > -1) or (FQuickItems[i] = '') then Break;
    if AnsiCompareText(x, Copy(Piece(FQuickItems[i],'^',2), 1, Length(x))) = 0 then Result := i;
  end;
end;
procedure TfrmODMedNVA.lbStatementsClickCheck(Sender: TObject;
  Index: Integer);
begin
  inherited;
   ControlChange(self);
end;

procedure TfrmODMedNVA.lstChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
  inherited;
  btnSelect.Enabled := (lstAll.ItemIndex > -1) or
                       ((lstQuick.ItemIndex > -1) and
                       (Assigned(lstQuick.Items[lstQuick.ItemIndex].Data)) and
                       (Integer(lstQuick.Selected.Data) > 0)) ;
  if (btnSelect.Enabled) and (FRemoveText) then
    txtMed.Text := '';
end;

procedure TfrmODMedNVA.FormKeyPress(Sender: TObject; var Key: Char);
begin
 if (Key = #13) and (ActiveControl = txtMed) then
  Key := #0   //Don't let the base class turn it into a forward tab!
 else
  inherited;
end;

function OIForNVA(AnIEN: Integer; ForNonVAMed: Boolean; HavePI: Boolean; PKIActive: Boolean): TStrings;
var
  PtType: Char;
  NeedPI: Char;
  IsPKIActive: Char;
begin
  if HavePI then NeedPI := 'Y' else NeedPI := 'N';
  if ForNonVAMed then PtType := 'X' else PtType := 'O';
  if PKIActive then IsPKIActive := 'Y' else IsPKIActive := 'N';
  CallV('ORWDPS2 OISLCT', [AnIEN, PtType, Patient.DFN, NeedPI, IsPKIActive]);
  Result := RPCBrokerV.Results;
end;

procedure CheckAuthForNVAMeds(var x: string);
begin
  x := Piece(sCallV('ORWDPS32 AUTHNVA', [Encounter.Provider]), U, 2);
end;

function TfrmODMedNVA.isUniqueQuickOrder(iText: string): Boolean;
var
  counter,i: Integer;
begin
  counter := 0;
  Result := False;
  if iText = '' then Exit;
  for i := 0 to FQuickItems.Count-1 do
    if AnsiCompareText(iText, Copy(Piece(FQuickItems[i],'^',2), 1, Length(iText))) = 0 then
      Inc(counter);               //Found a Match
  Result := counter = 1;
end;

end.
