Module

fODDiet

Path

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

Last Modified

7/15/2014 3:26:42 PM

Open Todo-items for fODDiet (9)

Text Category Owner Priority Status
Need NFS input on this section (NPO and special instructions.) Outpatient Meals Rich V. - Open
Need to DC Tubefeeding order for OP meals? Outpatient Meals Rich V. - Open
Need to DC Tubefeeding order for OP meals? Outpatient Meals Rich V. - Open
Need to DC Tubefeeding order for OP meals? Outpatient Meals Rich V. - Open
Need to DC Tubefeeding order for OP meals? Outpatient Meals Rich V. - Open
Need to DC Tubefeeding order for OP meals? Outpatient Meals Rich V. - Open
Need to DC Tubefeeding order for OP meals? Outpatient Meals Rich V. - Open
Need to DC Tubefeeding order for OP meals? Outpatient Meals Rich V. - Open
Will these be selectable for an outpatient meal? Outpatient Meals Rich V. - Open

Units Used in Interface

Name Comments
fODBase -
uConst -

Units Used in Implementation

Name Comments
fODDietLT -
fOrders -
rCore -
rODBase -
rODDiet -
rOrders -
uCore -
uODBase -

Classes

Name Comments
TfrmODDiet -
TTFProduct -

Procedures

Name Owner Declaration Scope Comments
ActivateButton - procedure ActivateButton( Button: TRadioButton; const MealTime: string; var MoreActivated: boolean); Local -
AOChange TfrmODDiet procedure AOChange(Sender: TObject); Public/Published -
calELStartChange TfrmODDiet procedure calELStartChange(Sender: TObject); Public/Published -
calELStartEnter TfrmODDiet procedure calELStartEnter(Sender: TObject); Public/Published -
calELStartExit TfrmODDiet procedure calELStartExit(Sender: TObject); Public/Published -
calELStopChange TfrmODDiet procedure calELStopChange(Sender: TObject); Public/Published -
calOPStartChange TfrmODDiet procedure calOPStartChange(Sender: TObject); Public/Published -
calOPStartEnter TfrmODDiet procedure calOPStartEnter(Sender: TObject); Public/Published -
calOPStartExit TfrmODDiet procedure calOPStartExit(Sender: TObject); Public/Published -
calOPStopChange TfrmODDiet procedure calOPStopChange(Sender: TObject); Public/Published -
cboDietAvailExit TfrmODDiet procedure cboDietAvailExit(Sender: TObject); Public/Published -
cboDietAvailMouseClick TfrmODDiet procedure cboDietAvailMouseClick(Sender: TObject); Public/Published -
cboDietAvailNeedData TfrmODDiet procedure cboDietAvailNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
cboOPDietAvailExit TfrmODDiet procedure cboOPDietAvailExit(Sender: TObject); Public/Published -
cboOPDietAvailKeyDown TfrmODDiet procedure cboOPDietAvailKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
cboOPDietAvailMouseClick TfrmODDiet procedure cboOPDietAvailMouseClick(Sender: TObject); Public/Published Outpatient Meals Order tab -----------------------------------------------------------------
cboProductExit TfrmODDiet procedure cboProductExit(Sender: TObject); Public/Published -
cboProductMouseClick TfrmODDiet procedure cboProductMouseClick(Sender: TObject); Public/Published -
cboStrengthChange TfrmODDiet procedure cboStrengthChange(Sender: TObject); Public/Published -
cboStrengthEnter TfrmODDiet procedure cboStrengthEnter(Sender: TObject); Public/Published -
cboStrengthExit TfrmODDiet procedure cboStrengthExit(Sender: TObject); Public/Published -
cboStrengthKeyDown TfrmODDiet procedure cboStrengthKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
cmdAcceptClick TfrmODDiet procedure cmdAcceptClick(Sender: TObject); Public/Published
Common Buttons ---------------------------------------------------------------------------- 

CxMsg: string;
cmdOPRemoveClick TfrmODDiet procedure cmdOPRemoveClick(Sender: TObject); Public/Published -
cmdRemoveClick TfrmODDiet procedure cmdRemoveClick(Sender: TObject); Public/Published -
cmdTFRemoveClick TfrmODDiet procedure cmdTFRemoveClick(Sender: TObject); Public/Published -
DietChange TfrmODDiet procedure DietChange(Sender: TObject); Public/Published -
DietCheckForNPO TfrmODDiet procedure DietCheckForNPO; Private Diet Order tab ----------------------------------------------------------------------------
DietCheckForTF TfrmODDiet procedure DietCheckForTF; Private -
ELChange TfrmODDiet procedure ELChange(Sender: TObject); Public/Published -
FormCreate TfrmODDiet procedure FormCreate(Sender: TObject); Public/Published -
FormDestroy TfrmODDiet procedure FormDestroy(Sender: TObject); Public/Published -
FormKeyDown TfrmODDiet procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
FormResize TfrmODDiet procedure FormResize(Sender: TObject); Public/Published -
grdSelectedDrawCell TfrmODDiet procedure grdSelectedDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); Public/Published -
grdSelectedSelectCell TfrmODDiet procedure grdSelectedSelectCell(Sender: TObject; Col, Row: Integer; var CanSelect: Boolean); Public/Published -
grpMealClick TfrmODDiet procedure grpMealClick(Sender: TObject); Public/Published -
grpOPMealClick TfrmODDiet procedure grpOPMealClick(Sender: TObject); Public/Published -
InitDialog TfrmODDiet procedure InitDialog; override; Protected -
IPChange TfrmODDiet procedure IPChange(Sender: TObject); Public/Published -
nbkDietChange TfrmODDiet procedure nbkDietChange(Sender: TObject); Public/Published
Procedure TfrmODDiet.CheckForAutoDCOrders(EvtID: integer; CurrentText: string; var CancelText: string; Sender: TObject);
const
  TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet now unless' + CRLF +
              'you specify a start date for when the new diet should replace the current' + CRLF +
              'diet:' + CRLF + CRLF;
  TX_CX_FUT = 'A new diet order with no expiration date will CANCEL and REPLACE these diets:' + CRLF + CRLF;
  TX_CX_DELAYED1 =  'There are other delayed diet orders for this release event:';
  TX_CX_DELAYED2 =  'This new diet order may cancel and replace those other diets' + CRLF +
                    'IMMEDIATELY ON RELEASE, unless you either:' + CRLF + CRLF +

                    '1. Specify an expiration date/time for this order that will' + CRLF +
                    '   be prior to the start date/time of those other orders; or' + CRLF + CRLF +

                    '2. Specify a later start date/time for this order for when you' + CRLF +
                    '   would like it to cancel and replace those other orders.';

var
  i: integer;
  AStringList: TStringList;
  AList: TList;
  x, PtEvtIFN, PtEvtName: string;
  //AResponse: TResponse;
begin
  if Self.EvtID = 0 then   // check current and future released diets
  begin
    x := CurrentText;
    if Piece(x, #13, 1) <> 'Current Diet:  ' then
    begin
      AStringList := TStringList.Create;
      try
        AStringList.Text := x;
        CancelText := TX_CX_CUR + #9 + Piece(AStringList[0], ':', 1) + ':' + CRLF + CRLF
                 + #9 + Copy(AStringList[0], 16, 99) + CRLF;
        if AStringList.Count > 1 then
        begin
          CancelText := CancelText + CRLF + CRLF +
                   TX_CX_FUT + #9 + Piece(AStringList[1], ':', 1) + ':' + CRLF + CRLF
                   + #9 + Copy(AStringList[1], 22, 99) + CRLF;
          if AStringList.Count > 2 then
          for i := 2 to AStringList.Count - 1 do
            CancelText := CancelText + #9 + TrimLeft(AStringList[i]) + CRLF;
        end;
      finally
        AStringList.Free;
      end;
    end;
  end 
  else if Sender is TButton then     // delayed orders code here - on accept only
  begin
    //AResponse := Responses.FindResponseByName('STOP', 1);
    //if (AResponse <> nil) and (AResponse.EValue <> '') then exit;
    AList := TList.Create;
    try
      PtEvtIFN := IntToStr(frmOrders.TheCurrentView.EventDelay.PtEventIFN);
      PtEvtName := frmOrders.TheCurrentView.EventDelay.EventName;
      LoadOrdersAbbr(AList, frmOrders.TheCurrentView, PtEvtIFN);
      for i := AList.Count - 1 downto 0 do
      begin
        if TOrder(Alist.Items[i]).DGroup <> Self.DisplayGroup then
        begin
          TOrder(AList.Items[i]).Free;
          AList.Delete(i);
        end;
      end;
      if AList.Count > 0 then
      begin
        x := '';
        RetrieveOrderFields(AList, 0, 0);
        CancelText := TX_CX_DELAYED1 + CRLF + CRLF + 'Release event: ' + PtEvtName; 
        for i := 0 to AList.Count - 1 do
          with TOrder(AList.Items[i]) do
          begin
            x := x + #9 + Text + CRLF;
(*            if StartTime <> '' then
              x := #9 + x + 'Start:   ' + StartTime + CRLF
            else
              x := #9 + x + 'Ordered: ' + FormatFMDateTime('mmm dd,yyyy@hh:nn', OrderTime) + CRLF;
          end;
        CancelText := CancelText + CRLF + CRLF + x;
        CancelText := CancelText + CRLF + CRLF + TX_CX_DELAYED2;
      end;
    finally
      with AList do for i := 0 to Count - 1 do TOrder(Items[i]).Free;
      AList.Free;
    end;
  end;
end;
nbkDietChanging TfrmODDiet procedure nbkDietChanging(Sender: TObject; var AllowChange: Boolean); Public/Published Notebook tabs - general -------------------------------------------------------------------
OPChange TfrmODDiet procedure OPChange(Sender: TObject); Public/Published I: integer;
OPDietCheckForNPO TfrmODDiet procedure OPDietCheckForNPO; Private -
OPDietCheckForTF TfrmODDiet procedure OPDietCheckForTF; Private TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals?
PlaceControl - procedure PlaceControl(AControl: TWinControl); Local -
ResetControlsAO TfrmODDiet procedure ResetControlsAO; Private Additional Diet Order tab -----------------------------------------------------------------
ResetControlsDO TfrmODDiet procedure ResetControlsDO; Private -
ResetControlsEL TfrmODDiet procedure ResetControlsEL; Private Early/Late Tray tab -----------------------------------------------------------------------
ResetControlsIP TfrmODDiet procedure ResetControlsIP; Private Isolation Precautions tab -----------------------------------------------------------------
ResetControlsOP TfrmODDiet procedure ResetControlsOP; Private -
ResetControlsTF TfrmODDiet procedure ResetControlsTF; Private Tubefeeding tab ---------------------------------------------------------------------------
SetEnableDOW TfrmODDiet procedure SetEnableDOW(AllowUse: Boolean); Private -
SetEnableOPDOW TfrmODDiet procedure SetEnableOPDOW(AllowUse: Boolean; OneTimeDay: integer; DaysToCheck: string = ''); Private -
SetError - procedure SetError(const AnError: string); Local -
SetError - procedure SetError(const AnError: string); Local -
SetError - procedure SetError(const x: string); Local -
SetMealTimes - procedure SetMealTimes(const x: string); Local -
SetNextCell TfrmODDiet procedure SetNextCell(ACol, ARow: Integer); Private -
SetupDialog TfrmODDiet procedure SetupDialog(OrderAction: Integer; const ID: string); override; Public -
SetValuesFromResponsesAO TfrmODDiet procedure SetValuesFromResponsesAO; Private -
SetValuesFromResponsesDO TfrmODDiet procedure SetValuesFromResponsesDO; Private -
SetValuesFromResponsesEL TfrmODDiet procedure SetValuesFromResponsesEL; Private -
SetValuesFromResponsesIP TfrmODDiet procedure SetValuesFromResponsesIP; Private -
SetValuesFromResponsesOP TfrmODDiet procedure SetValuesFromResponsesOP; Private -
SetValuesFromResponsesTF TfrmODDiet procedure SetValuesFromResponsesTF; Private -
TFChange TfrmODDiet procedure TFChange(Sender: TObject); Public/Published -
TFClearGrid TfrmODDiet procedure TFClearGrid; Private -
TFMoveToNextCell TfrmODDiet procedure TFMoveToNextCell; Private -
TFSetAmountForRow TfrmODDiet procedure TFSetAmountForRow(ARow: Integer); Private -
txtQuantityChange TfrmODDiet procedure txtQuantityChange(Sender: TObject); Public/Published -
txtQuantityEnter TfrmODDiet procedure txtQuantityEnter(Sender: TObject); Public/Published -
txtQuantityExit TfrmODDiet procedure txtQuantityExit(Sender: TObject); Public/Published -
txtQuantityKeyDown TfrmODDiet procedure txtQuantityKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
Validate TfrmODDiet procedure Validate(var AnErrMsg: string); override; Protected -

Functions

Name Owner Declaration Scope Comments
FMDays TfrmODDiet function FMDays(AStart, AEnd: TFMDateTime): string; Private -
FMDOW TfrmODDiet function FMDOW(AnFMDate: TFMDateTime): integer; Private Outpatient meal additions
GetDaysOfWeek TfrmODDiet function GetDaysOfWeek: string; Private -
GetMealTime TfrmODDiet function GetMealTime: string; Private -
GetOPDaysOfWeek TfrmODDiet function GetOPDaysOfWeek: string; Private -
GetOPMealWindow TfrmODDiet function GetOPMealWindow: string; Private -
IsEarlyTray TfrmODDiet function IsEarlyTray: Boolean; Private -
MealTimePassed - function MealTimePassed: Boolean; Local -
OPMealTimePassed - function OPMealTimePassed: Boolean; Local -
PatientHasRecurringMeals TfrmODDiet function PatientHasRecurringMeals(var MealList: TStringList; MealType: string = ''): boolean; Private -
TFStrengthCode TfrmODDiet function TFStrengthCode(const x: string): Integer; Private -

Global Variables

Name Type Declaration Comments
frmODDiet TfrmODDiet frmODDiet: TfrmODDiet; -
uDialogName UnicodeString uDialogName: string; -
uDietParams uDietParams: TDietParams; -
uFHAUTH Boolean uFHAUTH: boolean; -
uRecurringMealList TStringList uRecurringMealList: TStringList; -

Constants

Name Declaration Scope Comments
FMDayLetters array[1..7] of string[1] = ('M', 'T', 'W', 'R', 'F', 'S', 'X') Global -
TC_ACCEPT 'Unsaved Order' Global -
TC_CANCEL_TF 'Cancel Tubefeeding' Global -
TC_DIET_ERR 'Unable to Add Diet' Global -
TC_EL_SAVE_ERR 'Error Saving Late Tray Order' Global -
TC_INPT_ONLY 'Ordering Restriction' Global -
TC_NO_MEALS_DEFINED 'Unable to order outpatient meals' Global -
TC_NO_OUTPT_ORDERS 'Ordering Restriction' Global -
TC_NO_PARAMS 'Unable to Order Early/Late Tray' Global -
TC_NOSTART 'Start date required' Global -
TC_NOT_THIS_LOC 'Unable to order from this location' Global -
TC_OP_DIET_ERR 'Unable to Add Diet' Global
TX_OP_DIET_REG  = 'A regular diet may not be combined with other diets.';
TX_OP_DIET_NPO  = 'NPO may not be combined with other diets.';
TX_OP_DIET_LIM  = 'A maximum of 1 diet may be selected.';
TX_OP_DIET_DUP  = 'This diet has already been selected.';
TX_OP_DIET_PRC  = 'This diet conflicts with ';
TC_OP_SAVE_ERR 'Error Saving Outpatient Meal Order' Global -
TC_OUTPT_ONLY 'Ordering Restriction' Global -
TX_ACCEPT 'Accept the following order?' + CRLF + CRLF Global -
TX_AONONE 'Text for additional order has not been entered.' Global -
TX_BAD_START 'The effective date is not valid.' Global -
TX_BAD_STOP 'The expiration date is not valid.' Global -
TX_CANCEL_TF 'Cancel the current tubefeeding order?' + CRLF + CRLF Global -
TX_CONTINUE 'Continue editing the following order?' + CRLF + CRLF Global -
TX_DIET_DUP 'This diet has already been selected.' Global -
TX_DIET_LIM 'A maximum of 5 diet modifications may be selected.' Global -
TX_DIET_NPO 'NPO may not be combined with other diets.' Global -
TX_DIET_PRC 'This diet conflicts with ' Global -
TX_DIET_REG 'A regular diet may not be combined with other diets.' Global -
TX_DISCARD CRLF + CRLF + 'Answering NO will discard all changes.' Global -
TX_EL_SAVE_ERR 'An error occurred while saving this late tray order.' Global -
TX_ELDOW 'The days of the week must be selected for time ranges greater than 1 day.' Global -
TX_ELMEAL 'A meal must be selected.' Global -
TX_ELNOSTART 'A valid start date must be entered.' Global -
TX_ELNOSTOP 'A valid end date must be entered.' Global -
TX_ELPAST 'The selected meal time has already passed.' Global -
TX_ELSTART30 'The start date may not be more than 30 days in the future.' Global -
TX_ELSTARTLT 'The start date may not be earlier than today.' Global -
TX_ELSTOP30 'The end date may not be more than 30 days in the future.' Global -
TX_ELSTOPLT 'The end date may not be earlier than today.' Global -
TX_ELSTOPSTART 'The end date may not be earlier than the start date.' Global -
TX_ELTIME 'A meal time must be selected.' Global -
TX_HLPQTY CRLF + 'Valid entries for quantity:' + CRLF + CRLF + Global CQ #15833 - Removed references of 'c' and 'cc', changed 100CC example to 100ML - JCS
TX_INPT_ONLY 'This type of diet may be entered for inpatients only.' Global -
TX_IPNONE 'An isolation type must be selected.' Global -
TX_MINMAX 'At least 1 product must be selected (maximum: 5).' Global -
TX_NO_DIET 'At least one diet must be selected.' Global -
TX_NO_MEALS_DEFINED 'No diet types have been defined to be orderable for outpatients.' + CRLF + CRLF + Global -
TX_NO_OUTPT_ORDERS 'Diet orders may only be entered for inpatients.' Global -
TX_NO_PARAMS 'Placing Early or Late tray orders is not allowed until the IRM diet package' + CRLF + Global -
TX_NOSTART 'A valid start date must be entered.' Global -
TX_NOT_THIS_LOC 'This location has not been configured to' + CRLF + Global -
TX_OP_BAD_START 'The effective date is not valid.' Global -
TX_OP_BAD_STOP 'The expiration date is not valid.' Global -
TX_OP_NO_DIET 'One and only one diet must be selected.' Global -
TX_OP_SAVE_ERR 'An error occurred while saving this outpatient meal order.' Global -
TX_OPDOW 'The days of the week must be selected for time ranges greater than 1 day.' Global -
TX_OPMEAL 'A meal must be selected.' Global Outpatient meal additions
TX_OPNOSTART 'A valid start date must be entered.' Global -
TX_OPNOSTOP 'A valid end date must be entered.' Global -
TX_OPPAST 'The selected meal time has already passed.' Global -
TX_OPSTART_MAX1 'The start date may not be more than ' Global -
TX_OPSTART_MAX2 ' days in the future.' Global -
TX_OPSTARTLT 'The start date may not be earlier than today.' Global -
TX_OPSTOP_MAX1 'The end date may not be more than ' Global -
TX_OPSTOP_MAX2 ' days in the future.' Global -
TX_OPSTOPLT 'The end date may not be earlier than today.' Global -
TX_OPSTOPSTART 'The end date may not be earlier than the start date.' Global -
TX_OUTPT_ONLY 'This type of diet may be entered for outpatients only.' Global -
TX_STOPSTART 'The expiration date must be after the effective date.' Global -
TX_TF5000 'The total quantity ordered may not exceed 5000ml.' Global -
TX_TFAMT 'The quantity is invalid for ' Global -
TX_TFQTY 'A quantity must be entered for ' Global -


Module Source

1     unit fODDiet;
2     {$O-}
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fODBase, ComCtrls, ExtCtrls, StdCtrls, Grids, ORCtrls, ORDtTm, ORFn, uConst,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmODDiet = class(TfrmODBase)
12        nbkDiet: TPageControl;
13        pgeDiet: TTabSheet;
14        lblDietAvail: TLabel;
15        lblDietSelect: TLabel;
16        lblComment: TLabel;
17        lblStart: TLabel;
18        lblStop: TLabel;
19        lblDelivery: TLabel;
20        cboDietAvail: TORComboBox;
21        lstDietSelect: TORListBox;
22        cmdRemove: TButton;
23        txtDietComment: TCaptionEdit;
24        calDietStart: TORDateBox;
25        calDietStop: TORDateBox;
26        cboDelivery: TORComboBox;
27        pgeTubefeeding: TTabSheet;                                                        
28        lblTFProductList: TLabel;
29        lblTFComment: TLabel;                                                             
30        lblTFStrength: TLabel;
31        lblTFQuantity: TLabel;
32        lblTFProduct: TLabel;
33        cboProduct: TORComboBox;
34        txtTFComment: TCaptionEdit;
35        grdSelected: TCaptionStringGrid;
36        cmdTFRemove: TButton;
37        pgeEarlyLate: TTabSheet;
38        pgeIsolations: TTabSheet;
39        pgeAdditional: TTabSheet;
40        chkCancelTubefeeding: TCheckBox;
41        chkCancelTrays: TCheckBox;
42        txtQuantity: TCaptionEdit;
43        cboStrength: TCaptionComboBox;
44        lblTFAmount: TLabel;
45        grpMeal: TKeyClickRadioGroup;
46        grpMealTime: TGroupBox;
47        lblELStart: TLabel;
48        calELStart: TORDateBox;
49        lblELStop: TLabel;
50        calELStop: TORDateBox;
51        grpDoW: TGroupBox;
52        chkMonday: TCheckBox;
53        chkTuesday: TCheckBox;
54        chkWednesday: TCheckBox;
55        chkThursday: TCheckBox;
56        chkFriday: TCheckBox;
57        chkSaturday: TCheckBox;
58        chkSunday: TCheckBox;
59        chkBagged: TCheckBox;
60        radET1: TRadioButton;
61        radET2: TRadioButton;
62        radET3: TRadioButton;
63        radLT1: TRadioButton;
64        radLT2: TRadioButton;
65        radLT3: TRadioButton;
66        lblNoTimes: TLabel;
67        txtAOComment: TCaptionEdit;
68        lblAddlOrder: TLabel;
69        lstIsolation: TORListBox;
70        lblIsolation: TLabel;
71        lblIPComment: TLabel;
72        txtIPComment: TCaptionEdit;
73        lblIPCurrent: TLabel;
74        txtIPCurrent: TCaptionEdit;
75        pgeOutPt: TTabSheet;
76        grpOPMeal: TKeyClickRadioGroup;
77        grpOPDoW: TGroupBox;
78        chkOPMonday: TCheckBox;
79        chkOPTuesday: TCheckBox;
80        chkOPWednesday: TCheckBox;
81        chkOPThursday: TCheckBox;
82        chkOPFriday: TCheckBox;
83        chkOPSaturday: TCheckBox;
84        chkOPSunday: TCheckBox;
85        lblOPStart: TLabel;
86        calOPStart: TORDateBox;
87        lblOPStop: TLabel;
88        calOPStop: TORDateBox;
89        lblOPDietAvail: TLabel;
90        cboOPDietAvail: TORComboBox;
91        lblOPComment: TLabel;
92        txtOPDietComment: TCaptionEdit;
93        lblOPDelivery: TLabel;
94        cboOPDelivery: TORComboBox;
95        lblOPSelect: TLabel;
96        lstOPDietSelect: TORListBox;
97        cmdOPRemove: TButton;
98        chkOPCancelTubefeeding: TCheckBox;
99        calOPTFStart: TORDateBox;
100       lblOPTFStart: TLabel;
101       lblOPAOStart: TLabel;
102       calOPAOStart: TORDateBox;
103       cboOPAORecurringMeals: TORComboBox;
104       cboOPTFRecurringMeals: TORComboBox;
105       cboOPELRecurringMeals: TORComboBox;
106       procedure nbkDietChanging(Sender: TObject;
107         var AllowChange: Boolean);
108       procedure nbkDietChange(Sender: TObject);
109       procedure FormCreate(Sender: TObject);
110       procedure cboDietAvailNeedData(Sender: TObject;
111         const StartFrom: String; Direction, InsertAt: Integer);
112       procedure cboDietAvailMouseClick(Sender: TObject);
113       procedure cboDietAvailExit(Sender: TObject);
114       procedure cmdRemoveClick(Sender: TObject);
115       procedure DietChange(Sender: TObject);
116       procedure cmdAcceptClick(Sender: TObject);
117       procedure cboProductMouseClick(Sender: TObject);
118       procedure cboProductExit(Sender: TObject);
119       procedure FormDestroy(Sender: TObject);
120       procedure FormResize(Sender: TObject);
121       procedure grdSelectedSelectCell(Sender: TObject; Col, Row: Integer;
122         var CanSelect: Boolean);
123       procedure txtQuantityChange(Sender: TObject);
124       procedure txtQuantityExit(Sender: TObject);
125       procedure cboStrengthChange(Sender: TObject);
126       procedure cboStrengthExit(Sender: TObject);
127       procedure TFChange(Sender: TObject);
128       procedure cmdTFRemoveClick(Sender: TObject);
129       procedure grdSelectedDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
130         State: TGridDrawState);
131       procedure cboStrengthKeyDown(Sender: TObject; var Key: Word;
132         Shift: TShiftState);
133       procedure cboStrengthEnter(Sender: TObject);
134       procedure txtQuantityKeyDown(Sender: TObject; var Key: Word;
135         Shift: TShiftState);
136       procedure txtQuantityEnter(Sender: TObject);
137       procedure grpMealClick(Sender: TObject);
138       procedure calELStartExit(Sender: TObject);
139       procedure calELStopChange(Sender: TObject);
140       procedure ELChange(Sender: TObject);
141       procedure calELStartEnter(Sender: TObject);
142       procedure calELStartChange(Sender: TObject);
143       procedure IPChange(Sender: TObject);
144       procedure AOChange(Sender: TObject);
145       procedure FormKeyDown(Sender: TObject; var Key: Word;
146         Shift: TShiftState);
147       procedure cboOPDietAvailMouseClick(Sender: TObject);
148       procedure cboOPDietAvailExit(Sender: TObject);
149       procedure calOPStartExit(Sender: TObject);
150       procedure calOPStopChange(Sender: TObject);
151       procedure calOPStartEnter(Sender: TObject);
152       procedure calOPStartChange(Sender: TObject);
153       procedure OPChange(Sender: TObject);
154       procedure grpOPMealClick(Sender: TObject);
155       procedure cmdOPRemoveClick(Sender: TObject);
156       procedure cboOPDietAvailKeyDown(Sender: TObject; var Key: Word;
157         Shift: TShiftState);
158     private
159       FNextCol: Integer;
160       FNextRow: Integer;
161       FChangeStop: Boolean;
162       FIsolationID: string;
163       FTabChanging: Boolean;
164       FGiveMultiTabMessage: boolean;
165       procedure DietCheckForNPO;
166       procedure DietCheckForTF;
167       function GetMealTime: string;
168       function GetDaysOfWeek: string;
169       function IsEarlyTray: Boolean;
170       procedure ResetControlsDO;
171       procedure ResetControlsTF;
172       procedure ResetControlsEL;
173       procedure ResetControlsIP;
174       procedure ResetControlsAO;
175       procedure SetEnableDOW(AllowUse: Boolean);
176       procedure SetNextCell(ACol, ARow: Integer);
177       procedure SetValuesFromResponsesDO;
178       procedure SetValuesFromResponsesTF;
179       procedure SetValuesFromResponsesEL;
180       procedure SetValuesFromResponsesIP;
181       procedure SetValuesFromResponsesAO;
182       procedure TFMoveToNextCell;
183       procedure TFClearGrid;
184       procedure TFSetAmountForRow(ARow: Integer);
185       function TFStrengthCode(const x: string): Integer;
186      //  Outpatient meal additions
187       function  FMDOW(AnFMDate: TFMDateTime): integer;
188       function  FMDays(AStart, AEnd: TFMDateTime): string;
189       function  GetOPDaysOfWeek: string;
190       procedure SetEnableOPDOW(AllowUse: Boolean; OneTimeDay: integer; DaysToCheck: string = '');
191       procedure ResetControlsOP;
192       procedure SetValuesFromResponsesOP;
193       function  GetOPMealWindow: string;
194       procedure OPDietCheckForNPO;
195       procedure OPDietCheckForTF;
196       function  PatientHasRecurringMeals(var MealList: TStringList; MealType: string = ''): boolean;
197       //procedure CheckForAutoDCOrders(EvtID: integer; CurrentText: string; var CancelText: string; Sender: TObject);
198     protected
199       procedure InitDialog; override;
200       procedure Validate(var AnErrMsg: string); override;
201     public
202       procedure SetupDialog(OrderAction: Integer; const ID: string); override;
203     end;
204   
205   var
206     frmODDiet: TfrmODDiet;
207     uDialogName: string;
208     uFHAUTH: boolean;
209     uRecurringMealList: TStringList;
210   
211   implementation
212   
213   {$R *.DFM}
214   
215   uses uCore, rODBase, rODDiet, rCore, rOrders, fODDietLT, DateUtils,
216     fOrders, uODBase, VA508AccessibilityRouter;
217   
218   const
219     TX_DIET_REG = 'A regular diet may not be combined with other diets.';
220     TX_DIET_NPO = 'NPO may not be combined with other diets.';
221     TX_DIET_LIM = 'A maximum of 5 diet modifications may be selected.';
222     TX_DIET_DUP = 'This diet has already been selected.';
223     TX_DIET_PRC = 'This diet conflicts with ';
224     TC_DIET_ERR = 'Unable to Add Diet';
225     TX_INPT_ONLY = 'This type of diet may be entered for inpatients only.';
226     TC_INPT_ONLY = 'Ordering Restriction';
227     TX_CANCEL_TF = 'Cancel the current tubefeeding order?' + CRLF + CRLF;
228     TC_CANCEL_TF = 'Cancel Tubefeeding';
229     TX_NO_DIET   = 'At least one diet must be selected.';
230     TX_BAD_START = 'The effective date is not valid.';
231     TX_BAD_STOP  = 'The expiration date is not valid.';
232     TX_STOPSTART = 'The expiration date must be after the effective date.';
233     TX_MINMAX = 'At least 1 product must be selected (maximum: 5).';
234     TX_TFQTY  = 'A quantity must be entered for ';
235     TX_TFAMT  = 'The quantity is invalid for ';
236     TX_TF5000 = 'The total quantity ordered may not exceed 5000ml.';
237   
238     // CQ #15833 - Removed references of 'c' and 'cc', changed 100CC example to 100ML - JCS
239     TX_HLPQTY = CRLF + 'Valid entries for quantity:' + CRLF + CRLF +
240                 'Units             K for Kcals;  M for ml;  O for oz.;  U for units (e.g. cans), PKG' + CRLF +
241                 'Frequency     DAILY  HOUR  QH  BID  TID  QID  Q2H  Q3H  Q4H  Q6H' + CRLF + CRLF +
242                 'Or   100 ml/HR X 16  for 16 hours' + CRLF + CRLF +
243                 'IF powder form product, Then' + CRLF +
244                 '          (# GRAMS or # Unit or PKG) / FREQUENCY' + CRLF + CRLF +
245                 'Examples:' + CRLF +
246                 '          20 GRAMS/Day' + CRLF +
247                 '          1 PKG/TID' + CRLF +
248                 '          6 U/D' + CRLF +
249                 '          1 U/Q3H' + CRLF +
250                 '          50ml/TID' + CRLF +
251                 '          100 ML/HR';
252     TX_ELMEAL      = 'A meal must be selected.';
253     TX_ELTIME      = 'A meal time must be selected.';
254     TX_ELNOSTART   = 'A valid start date must be entered.';
255     TX_ELNOSTOP    = 'A valid end date must be entered.';
256     TX_ELSTARTLT   = 'The start date may not be earlier than today.';
257     TX_ELSTOPLT    = 'The end date may not be earlier than today.';
258     TX_ELSTOPSTART = 'The end date may not be earlier than the start date.';
259     TX_ELSTART30   = 'The start date may not be more than 30 days in the future.';
260     TX_ELSTOP30    = 'The end date may not be more than 30 days in the future.';
261     TX_ELDOW       = 'The days of the week must be selected for time ranges greater than 1 day.';
262     TX_ELPAST      = 'The selected meal time has already passed.';
263     TX_IPNONE      = 'An isolation type must be selected.';
264     TX_AONONE      = 'Text for additional order has not been entered.';
265     TX_ACCEPT      = 'Accept the following order?' + CRLF + CRLF;
266     TX_CONTINUE    = 'Continue editing the following order?' + CRLF + CRLF;
267     TX_DISCARD     = CRLF + CRLF + 'Answering NO will discard all changes.';
268     TC_ACCEPT      = 'Unsaved Order';
269     TX_EL_SAVE_ERR    = 'An error occurred while saving this late tray order.';
270     TC_EL_SAVE_ERR    = 'Error Saving Late Tray Order';
271      //  Outpatient meal additions
272     TX_OPMEAL       = 'A meal must be selected.';
273     TX_OPNOSTART    = 'A valid start date must be entered.';
274     TX_OPNOSTOP     = 'A valid end date must be entered.';
275     TX_OPSTARTLT    = 'The start date may not be earlier than today.';
276     TX_OPSTOPLT     = 'The end date may not be earlier than today.';
277     TX_OPSTOPSTART  = 'The end date may not be earlier than the start date.';
278     TX_OPSTART_MAX1 = 'The start date may not be more than ';
279     TX_OPSTART_MAX2 = ' days in the future.';
280     TX_OPSTOP_MAX1  = 'The end date may not be more than ';
281     TX_OPSTOP_MAX2  = ' days in the future.';
282     TX_OPDOW        = 'The days of the week must be selected for time ranges greater than 1 day.';
283     TX_OPPAST       = 'The selected meal time has already passed.';
284     TX_OP_SAVE_ERR  = 'An error occurred while saving this outpatient meal order.';
285     TC_OP_SAVE_ERR  = 'Error Saving Outpatient Meal Order';
286     TX_OP_NO_DIET   = 'One and only one diet must be selected.';
287     TX_OP_BAD_START = 'The effective date is not valid.';
288     TX_OP_BAD_STOP  = 'The expiration date is not valid.';
289     //TX_OP_DIET_REG  = 'A regular diet may not be combined with other diets.';
290     //TX_OP_DIET_NPO  = 'NPO may not be combined with other diets.';
291     //TX_OP_DIET_LIM  = 'A maximum of 1 diet may be selected.';
292     //TX_OP_DIET_DUP  = 'This diet has already been selected.';
293     //TX_OP_DIET_PRC  = 'This diet conflicts with ';
294     TC_OP_DIET_ERR  = 'Unable to Add Diet';
295     TX_OUTPT_ONLY   = 'This type of diet may be entered for outpatients only.';
296     TC_OUTPT_ONLY   = 'Ordering Restriction';
297     TX_NO_PARAMS    = 'Placing Early or Late tray orders is not allowed until the IRM diet package' + CRLF +
298                       'coordinator enters times for E/L trays for this location.';
299     TC_NO_PARAMS    = 'Unable to Order Early/Late Tray';
300     TX_NOSTART   = 'A valid start date must be entered.';
301     TC_NOSTART   = 'Start date required';
302     TX_NOT_THIS_LOC = 'This location has not been configured to' + CRLF +
303                       'allow ordering of meals for outpatients.' + CRLF + CRLF +
304                       'Please contact your IRM diet package coordinator.';
305     TC_NOT_THIS_LOC = 'Unable to order from this location';
306     TX_NO_OUTPT_ORDERS = 'Diet orders may only be entered for inpatients.';
307     TC_NO_OUTPT_ORDERS = 'Ordering Restriction';
308     TX_NO_MEALS_DEFINED = 'No diet types have been defined to be orderable for outpatients.' + CRLF + CRLF +
309                           'Please contact your IRM diet package coordinator.';
310     TC_NO_MEALS_DEFINED = 'Unable to order outpatient meals';
311   
312     FMDayLetters: array[1..7] of string[1] = ('M', 'T', 'W', 'R', 'F', 'S', 'X');
313   
314   type
315     TTFProduct = class
316     private
317       IEN: Integer;
318       Name: string;
319     end;
320   
321   var
322     uDietParams: TDietParams;
323   
324   procedure TfrmODDiet.FormCreate(Sender: TObject);
325   var
326     ALocation: string;   //ptr to #44 hospital location
327   begin
328     inherited;
329     FGiveMultiTabMessage := ScreenReaderSystemActive;
330     AbortOrder := False;
331     uRecurringMealList := TStringList.Create;
332     if OrderForInpatient then
333       begin
334         pgeDiet.TabVisible := True;
335         pgeOutPt.TabVisible := False;
336       end
337     else if OutpatientPatchInstalled then        // put here to only call RPCs if outpatient - remove "IF" later
338       begin
339         pgeDiet.TabVisible := False;
340         pgeOutPt.TabVisible := True;
341       end
342     else                                         // this block will go away after FH patch installed everywhere
343       begin
344         InfoBox(TX_NO_OUTPT_ORDERS, TC_NO_OUTPT_ORDERS, MB_OK);
345         AbortOrder := True;
346         Exit;
347       end;
348   
349     FillerID := 'FH';                     // does 'on Display' order check **KCM**
350     ALocation := '0';
351     if Self.EvtID > 0 then
352       ALocation := GetEventLoc1(IntToStr(Self.EvtID));
353     if StrToIntDef(ALocation, 0) < 1 then
354       ALocation := IntToStr(Encounter.Location);
355     if (not OrderForInpatient) and OutpatientPatchInstalled and (not OutpatientLocationConfigured(ALocation)) then
356       begin
357         InfoBox(TX_NOT_THIS_LOC, TC_NOT_THIS_LOC, MB_OK or MB_ICONINFORMATION);
358         AbortOrder := True;
359       end
360     else
361       begin
362         LoadDietParams(uDietParams, ALocation);
363         if pgeOutPt.TabVisible then
364           with uDietParams, cboOPDelivery do
365           begin
366             if Tray      then Items.Add('T^Tray');
367             if Cafeteria then Items.Add('C^Cafeteria');
368             if DiningRm  then Items.Add('D^Dining Room');
369             ItemIndex := 0;
370             chkBagged.Visible := uDietParams.Bagged;
371           end
372         else
373           with uDietParams, cboDelivery do
374           begin
375             if Tray      then Items.Add('T^Tray');
376             if Cafeteria then Items.Add('C^Cafeteria');
377             if DiningRm  then Items.Add('D^Dining Room');
378             ItemIndex := 0;
379             chkBagged.Visible := uDietParams.Bagged;
380           end;
381       end;
382   end;
383   
384   procedure TfrmODDiet.FormDestroy(Sender: TObject);
385   begin
386     TFClearGrid;
387     uRecurringMealList.Free;
388     inherited;
389   end;
390   
391   procedure TfrmODDiet.FormResize(Sender: TObject);
392   begin
393     inherited;
394     with grdSelected do
395     begin
396       ColWidths[1] := Canvas.TextWidth('XFULLX') + GetSystemMetrics(SM_CXVSCROLL);
397       ColWidths[2] := Canvas.TextWidth('100 GRAMS/HOUR X 24');
398       ColWidths[3] := Canvas.TextWidth('55000ml');
399       ColWidths[0] := ClientWidth - ColWidths[1] - ColWidths[2] - ColWidths[3] - 3;
400       lblTFStrength.Left := Left + ColWidths[0] + 3;
401       lblTFQuantity.Left := Left + ColWidths[0] + ColWidths[1] + 5;
402       lblTFAmount.Left   := Left + ColWidths[0] + ColWidths[1] + ColWidths[2] + 7;
403     end;
404   end;
405   
406   procedure TfrmODDiet.InitDialog;
407   begin
408     inherited;
409     // handle all initialization at the tab level
410     // if FTabChanging, then nbkDietChange is about to be called anyway
411     if not FTabChanging then nbkDietChange(Self);
412   end;
413   
414   procedure TfrmODDiet.SetupDialog(OrderAction: Integer; const ID: string);
415   begin
416     if AbortOrder then exit;
417     inherited;
418     uDialogName := ExternalName(DialogIEN, 101.41);
419     case DietDialogType(DisplayGroup) of
420     'D': begin
421            if not OrderForInpatient then
422              begin
423                InfoBox(TX_INPT_ONLY, TC_INPT_ONLY, MB_OK);
424                Close;
425                Exit;
426              end;
427            pgeDiet.TabVisible := True;
428            pgeOutPt.TabVisible := False;
429            nbkDiet.ActivePage := pgeDiet;
430            nbkDietChange(Self);
431            if OrderAction <> ORDER_NEW then SetValuesFromResponsesDO;
432          end;
433     'N': begin
434            if not OrderForInpatient then
435              begin
436                InfoBox(TX_INPT_ONLY, TC_INPT_ONLY, MB_OK);
437                Close;
438                Exit;
439              end;
440            nbkDiet.ActivePage := pgeDiet;
441            nbkDietChange(Self);
442            if OrderAction <> ORDER_NEW then SetValuesFromResponsesDO;
443          end;
444     'T': begin
445            if (not OrderForInpatient) and (not PatientHasRecurringMeals(uRecurringMealList)) then
446            begin
447              Close;
448              Exit;
449            end;
450            nbkDiet.ActivePage := pgeTubefeeding;
451            nbkDietChange(Self);
452            if OrderAction <> ORDER_NEW then SetValuesFromResponsesTF;
453          end;
454     'E': begin
455            if (not OrderForInpatient) and (not PatientHasRecurringMeals(uRecurringMealList)) then
456            begin
457              Close;
458              Exit;
459            end;
460            nbkDiet.ActivePage := pgeEarlyLate;
461            nbkDietChange(Self);
462            if OrderAction <> ORDER_NEW then SetValuesFromResponsesEL;
463          end;
464     'P': begin
465            nbkDiet.ActivePage := pgeIsolations;
466            nbkDietChange(Self);
467            if OrderAction <> ORDER_NEW then SetValuesFromResponsesIP;
468          end;
469     'A': begin
470            if (not OrderForInpatient) and (not PatientHasRecurringMeals(uRecurringMealList)) then
471            begin
472              Close;
473              Exit;
474            end;
475            nbkDiet.ActivePage := pgeAdditional;
476            nbkDietChange(Self);
477            if OrderAction <> ORDER_NEW then SetValuesFromResponsesAO;
478          end;
479     'M': begin
480            if OrderForInpatient then
481              begin
482                InfoBox(TX_OUTPT_ONLY, TC_OUTPT_ONLY, MB_OK);
483                Close;
484                Exit;
485              end;
486            uFHAUTH := UserHasFHAUTHKey;       // is this really needed for other than printing?
487            pgeDiet.TabVisible := False;
488            pgeOutPt.TabVisible := True;
489            nbkDiet.ActivePage := pgeOutPt;
490            nbkDietChange(Self);
491            if OrderAction <> ORDER_NEW then SetValuesFromResponsesOP;
492          end
493     else
494         begin
495           if not OrderForInpatient then
496            begin
497              InfoBox(TX_INPT_ONLY, TC_INPT_ONLY, MB_OK);
498              Close;
499              Exit;
500            end;
501           pgeDiet.TabVisible := True;
502           pgeOutPt.TabVisible := False;
503           nbkDiet.ActivePage := pgeDiet;
504           nbkDietChange(Self);
505           if OrderAction <> ORDER_NEW then SetValuesFromResponsesDO;
506           ActiveControl := cboOPDietAvail;
507         end;
508     end;
509     if OrderAction = ORDER_NEW then SetFocusedControl(nbkDiet);
510   end;
511   
512   procedure TfrmODDiet.Validate(var AnErrMsg: string);
513   var
514     ErrMsg: string;
515     i, Sum: Integer;
516   
517     procedure SetError(const x: string);
518     begin
519       if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
520       AnErrMsg := AnErrMsg + x;
521     end;
522   
523     function MealTimePassed: Boolean;
524     var
525       x: string;
526       ATime: Integer;
527     begin
528       Result := False;
529       if calELStart.FMDateTime <> FMToday then Exit;
530       x := GetMealTime;
531       if Pos(':', x) = 0 then Exit;
532       ATime := StrToIntDef(Piece(x, ':', 1) + Copy(Piece(x, ':', 2), 1, 2), 0);
533       if (Pos('P', x) > 0) and (ATime < 1200) then ATime := ATime + 1200;
534       if (Pos('A', x) > 0) and (ATime > 1200) then ATime := ATime - 1200;
535       if (ATime / 10000) < Frac(FMNow) then Result := True;
536     end;
537   
538     function OPMealTimePassed: Boolean;
539     var
540       WindowTimes: string;
541       EndWindow: integer;
542       x: extended;
543     begin
544       Result := False;
545       if calOPStart.FMDateTime <> FMToday then Exit;
546       WindowTimes := GetOPMealWindow;
547       if WindowTimes = U then exit;
548       EndWindow := StrToIntDef(Piece(WindowTimes, U, 2), 0);
549       x := Frac(calOPStart.FMDateTime);
550       if x = 0 then x := Frac(FMNow) * 10000;
551       if x > EndWindow then Result := True;
552     end;
553   
554   begin
555     // do the appropriate validation depending on the currently selected tab
556     if nbkDiet.ActivePage = pgeDiet then
557     begin
558       if lstDietSelect.Items.Count < 1 then SetError(TX_NO_DIET);
559       if not calDietStart.IsValid      then SetError(TX_BAD_START);
560       with calDietStop do
561       begin
562         Validate(ErrMsg);
563         if Length(ErrMsg) > 0          then SetError(TX_BAD_STOP);
564         if (Length(Text) > 0) and (FMDateTime <= calDietStart.FMDateTime)
565                                        then SetError(TX_STOPSTART);
566       end; {with calDietStop}
567     end; {pgeDiet}
568     if nbkDiet.ActivePage = pgeTubeFeeding then
569     begin
570       Sum := 0;
571       with grdSelected do for i := 0 to RowCount - 1 do if Objects[0, i] <> nil then Inc(Sum);
572       if (Sum < 1) or (Sum > 5) then SetError(TX_MINMAX);
573       Sum := 0;
574       with grdSelected do for i := 0 to RowCount - 1 do if Objects[0, i] <> nil then
575       begin
576         if  Length(Cells[2, i]) = 0  then SetError(TX_TFQTY + Cells[0, i]);
577         if (Length(Cells[2, i]) > 0) and (Length(Cells[3, i]) = 0)
578           then SetError(TX_TFAMT + Cells[0, i] + TX_HLPQTY);
579         Sum := Sum + StrToIntDef(Piece(Cells[3, i], 'c', 1), 0);
580       end;
581       if Sum > 5000 then SetError(TX_TF5000);
582       if not OrderForInpatient then
583         if not calOPTFStart.IsValid      then SetError(TX_BAD_START);
584     end;
585     if nbkDiet.ActivePage = pgeEarlyLate then
586     begin
587       if grpMeal.ItemIndex = 3                                   then SetError(TX_ELMEAL);
588       if not calELStart.IsValid                                  then SetError(TX_ELNOSTART);
589       if calELStart.FMDateTime < FMToday                         then SetError(TX_ELSTARTLT);
590       if calELStart.FMDateTime > FMDateTimeOffsetBy(FMToday, 30) then SetError(TX_ELSTART30);
591       if OrderForInpatient then
592       begin
593         if GetMealTime = ''                                        then SetError(TX_ELTIME);
594         if not calELStop.IsValid                                   then SetError(TX_ELNOSTOP);
595         if calELStop.FMDateTime < FMToday                          then SetError(TX_ELSTOPLT);
596         if calELStop.FMDateTime < calELStart.FMDateTime            then SetError(TX_ELSTOPSTART);
597         if calELStop.FMDateTime > FMDateTimeOffsetBy(FMToday, 30)  then SetError(TX_ELSTOP30);
598       end;
599       if grpDOW.Enabled and (GetDaysOfWeek = '')                 then SetError(TX_ELDOW);
600       if MealTimePassed                                          then SetError(TX_ELPAST);
601     end;
602     if nbkDiet.ActivePage = pgeIsolations then
603     begin
604       if lstIsolation.ItemIndex < 0                              then SetError(TX_IPNONE);
605     end;
606     if nbkDiet.ActivePage = pgeAdditional then
607     begin
608       if not ContainsVisibleChar(txtAOComment.Text)              then SetError(TX_AONONE);
609       if not OrderForInpatient then
610         if not calOPAOStart.IsValid                              then SetError(TX_BAD_START);
611     end;
612     if nbkDiet.ActivePage = pgeOutPt then
613     begin
614       if grpOPMeal.ItemIndex = 3           then SetError(TX_OPMEAL);
615       if lstOPDietSelect.Items.Count < 1   then SetError(TX_OP_NO_DIET);
616       if OPMealTimePassed                  then SetError(TX_OPPAST);
617       if uDialogName = 'FHW OP MEAL' then
618       begin
619         if not calOPStart.IsValid          then SetError(TX_OP_BAD_START);
620         with calOPStop do
621         begin
622           Validate(ErrMsg);
623           if Length(ErrMsg) > 0            then SetError(TX_OP_BAD_STOP);
624           if (Length(Text) > 0) and (FMDateTime < calOPStart.FMDateTime)
625                                            then SetError(TX_OPSTOPSTART);
626         end; {with calOPDietStop}
627         if calOPStart.FMDateTime > FMDateTimeOffsetBy(FMToday, uDietParams.OPMaxDays)
628                                            then SetError(TX_OPSTART_MAX1 + IntToStr(uDietParams.OPMaxDays) +
629                                            TX_OPSTART_MAX2);
630         if calOPStop.FMDateTime > FMDateTimeOffsetBy(FMToday, uDietParams.OPMaxDays)
631                                            then SetError(TX_OPSTOP_MAX1 + IntToStr(uDietParams.OPMaxDays) +
632                                            TX_OPSTOP_MAX2);
633         if grpOPDOW.Enabled and (GetOPDaysOfWeek = '')
634                                            then SetError(TX_OPDOW);
635       end;
636     end;
637   end;
638   
639   { notebook tabs - general ------------------------------------------------------------------- }
640   
641   procedure TfrmODDiet.nbkDietChanging(Sender: TObject; var AllowChange: Boolean);
642   begin
643     inherited;
644     with Responses do if (Length(CopyOrder) > 0) or (Length(EditOrder) > 0) then
645     begin
646       AllowChange := False;
647       Exit;
648     end;
649     FTabChanging := True;
650     if Length(memOrder.Text) > 0 then
651       begin
652         if nbkDiet.ActivePage = pgeOutpt then
653           begin
654             if InfoBox(TX_CONTINUE + memOrder.Text + TX_DISCARD, TC_ACCEPT, MB_YESNO) = ID_YES then
655               begin
656                 AllowChange := FALSE;
657               end else
658               begin
659                 memOrder.Text := '';
660                 memOrder.Lines.Clear;
661                 Responses.Clear;
662               end;
663           end
664         else
665           begin
666             if InfoBox(TX_ACCEPT + memOrder.Text, TC_ACCEPT, MB_YESNO) = ID_YES then
667               begin
668                 cmdAcceptClick(Self);
669                 AllowChange := AcceptOK;
670               end else
671               begin
672                 memOrder.Text := '';
673                 memOrder.Lines.Clear;
674                 Responses.Clear;
675               end;
676           end
677       end;
678     FTabChanging := False;
679   end;
680   
681   (*procedure TfrmODDiet.CheckForAutoDCOrders(EvtID: integer; CurrentText: string; var CancelText: string; Sender: TObject);
682   const
683     TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet now unless' + CRLF +
684                 'you specify a start date for when the new diet should replace the current' + CRLF +
685                 'diet:' + CRLF + CRLF;
686     TX_CX_FUT = 'A new diet order with no expiration date will CANCEL and REPLACE these diets:' + CRLF + CRLF;
687     TX_CX_DELAYED1 =  'There are other delayed diet orders for this release event:';
688     TX_CX_DELAYED2 =  'This new diet order may cancel and replace those other diets' + CRLF +
689                       'IMMEDIATELY ON RELEASE, unless you either:' + CRLF + CRLF +
690   
691                       '1. Specify an expiration date/time for this order that will' + CRLF +
692                       '   be prior to the start date/time of those other orders; or' + CRLF + CRLF +
693   
694                       '2. Specify a later start date/time for this order for when you' + CRLF +
695                       '   would like it to cancel and replace those other orders.';
696   
697   var
698     i: integer;
699     AStringList: TStringList;
700     AList: TList;
701     x, PtEvtIFN, PtEvtName: string;
702     //AResponse: TResponse;
703   begin
704     if Self.EvtID = 0 then   // check current and future released diets
705     begin
706       x := CurrentText;
707       if Piece(x, #13, 1) <> 'Current Diet:  ' then
708       begin
709         AStringList := TStringList.Create;
710         try
711           AStringList.Text := x;
712           CancelText := TX_CX_CUR + #9 + Piece(AStringList[0], ':', 1) + ':' + CRLF + CRLF
713                    + #9 + Copy(AStringList[0], 16, 99) + CRLF;
714           if AStringList.Count > 1 then
715           begin
716             CancelText := CancelText + CRLF + CRLF +
717                      TX_CX_FUT + #9 + Piece(AStringList[1], ':', 1) + ':' + CRLF + CRLF
718                      + #9 + Copy(AStringList[1], 22, 99) + CRLF;
719             if AStringList.Count > 2 then
720             for i := 2 to AStringList.Count - 1 do
721               CancelText := CancelText + #9 + TrimLeft(AStringList[i]) + CRLF;
722           end;
723         finally
724           AStringList.Free;
725         end;
726       end;
727     end 
728     else if Sender is TButton then     // delayed orders code here - on accept only
729     begin
730       //AResponse := Responses.FindResponseByName('STOP', 1);
731       //if (AResponse <> nil) and (AResponse.EValue <> '') then exit;
732       AList := TList.Create;
733       try
734         PtEvtIFN := IntToStr(frmOrders.TheCurrentView.EventDelay.PtEventIFN);
735         PtEvtName := frmOrders.TheCurrentView.EventDelay.EventName;
736         LoadOrdersAbbr(AList, frmOrders.TheCurrentView, PtEvtIFN);
737         for i := AList.Count - 1 downto 0 do
738         begin
739           if TOrder(Alist.Items[i]).DGroup <> Self.DisplayGroup then
740           begin
741             TOrder(AList.Items[i]).Free;
742             AList.Delete(i);
743           end;
744         end;
745         if AList.Count > 0 then
746         begin
747           x := '';
748           RetrieveOrderFields(AList, 0, 0);
749           CancelText := TX_CX_DELAYED1 + CRLF + CRLF + 'Release event: ' + PtEvtName; 
750           for i := 0 to AList.Count - 1 do
751             with TOrder(AList.Items[i]) do
752             begin
753               x := x + #9 + Text + CRLF;
754   (*            if StartTime <> '' then
755                 x := #9 + x + 'Start:   ' + StartTime + CRLF
756               else
757                 x := #9 + x + 'Ordered: ' + FormatFMDateTime('mmm dd,yyyy@hh:nn', OrderTime) + CRLF;*)
758   (*          end;
759           CancelText := CancelText + CRLF + CRLF + x;
760           CancelText := CancelText + CRLF + CRLF + TX_CX_DELAYED2;
761         end;
762       finally
763         with AList do for i := 0 to Count - 1 do TOrder(Items[i]).Free;
764         AList.Free;
765       end;
766     end;
767   end;*)
768   
769   procedure TfrmODDiet.nbkDietChange(Sender: TObject);
770   var
771     x: string ;
772     CxMsg: string;
773   begin
774     inherited;
775     // much of the logic here can be eliminated if ClearDialogControls starts clearing containers
776     if AbortOrder then
777     begin
778       cmdQuitClick(Self);
779       exit;
780     end;
781     StatusText('Loading Dialog Definition');
782     if Sender <> Self then Responses.Clear;
783     Changing := True;                                        // Changing set!
784     if nbkDiet.ActivePage = pgeDiet then
785     begin
786       AllowQuickOrder := True;
787       x := CurrentDietText;
788       CheckForAutoDCDietOrders(Self.EvtID, Self.DisplayGroup, x, CxMsg, nbkDiet);
789       if CxMsg <> '' then
790       begin
791         if InfoBox(CxMsg + CRLF +
792                   'Are you sure?', 'Confirm', MB_ICONWARNING or MB_YESNO) = ID_NO then
793         begin
794           AbortOrder := True;
795           cmdQuitClick(Self);
796           exit;
797         end;
798       end;
799       OrderMessage(x);
800       Responses.Dialog := 'FHW1';                            // Diet Order
801       DisplayGroup := DisplayGroupForDialog('FHW1');
802       LoadDietQuickList(cboDietAvail.Items, 'DO');
803       cboDietAvail.InsertSeparator;
804       cboDietAvail.InitLongList('');
805       chkCancelTubefeeding.State := cbGrayed;
806       chkCancelTubefeeding.Visible := False;
807       ResetControlsDO;
808     end;
809     if nbkDiet.ActivePage = pgeTubefeeding then
810     begin
811       if not OrderForInpatient then
812       begin
813         if not PatientHasRecurringMeals(uRecurringMealList) then
814           begin
815             Changing := False;
816             nbkDiet.ActivePage := pgeOutPt;
817             nbkDietChange(nbkDiet);
818             Exit;
819             end
820           else
821             FastAssign(uRecurringMealList, cboOPTFRecurringMeals.Items);
822       end;
823       cboOPTFRecurringMeals.Visible := not OrderForInpatient;
824       calOPTFStart.Visible := False;
825       lblOPTFStart.Visible := not OrderForInpatient;
826       AllowQuickOrder := True;
827       if Length(uDietParams.CurTF) > 0
828         then OrderMessage(TextForOrder(uDietParams.CurTF))
829         else OrderMessage('');
830       Responses.Dialog := 'FHW8';                            // Tubefeeding
831       DisplayGroup := DisplayGroupForDialog('FHW8');
832       with cboProduct do if Items.Count = 0 then
833       begin
834         LoadDietQuickList(Items, 'TF');
835         if Items.Count > 0 then
836         begin
837           Items.Add(LLS_LINE);
838           Items.Add(LLS_SPACE);
839         end;
840         AppendTFProducts(Items);
841       end;
842       cboProduct.Text := '';
843       ResetControlsTF;
844     end;
845     if nbkDiet.ActivePage = pgeEarlyLate then
846     begin
847       if not OrderForInpatient then
848         begin
849           if not PatientHasRecurringMeals(uRecurringMealList) then
850             begin
851               Changing := False;
852               nbkDiet.ActivePage := pgeOutPt;
853               nbkDietChange(nbkDiet);
854               Exit;
855             end
856           else
857             FastAssign(uRecurringMealList, cboOPELRecurringMeals.Items);
858         end
859       else if (StrToIntDef(uDietParams.EarlyIEN, 0) = 0) or (StrToIntDef(uDietParams.LateIEN, 0) = 0) then
860         begin
861           InfoBox(TX_NO_PARAMS, TC_NO_PARAMS, MB_ICONERROR or MB_OK);
862           if pgeEarlyLate <> nil then
863             nbkDiet.SelectNextPage(False);
864           Changing := False;
865           Exit;
866         end;
867       cboOPELRecurringMeals.Visible := not OrderForInpatient;
868       cboOPELRecurringMeals.TabStop := not OrderForInpatient;
869       calELStart.Visible := OrderForInpatient;
870       calELStart.TabStop := OrderForInpatient;
871       calELStop.Visible := OrderForInpatient;
872       lblELStop.Visible := OrderForInpatient;
873       grpDOW.Visible := OrderForInpatient;
874       grpDOW.Enabled := OrderForInpatient;
875       AllowQuickOrder := False;
876       OrderMessage('');
877       Responses.Dialog := 'FHW2';                            // Early/Late Tray
878       DisplayGroup := DisplayGroupForDialog('FHW2');
879       ResetControlsEL;
880     end;
881     if nbkDiet.ActivePage = pgeIsolations then
882     begin
883       AllowQuickOrder := False;
884       OrderMessage('');
885       Responses.Dialog := 'FHW3';                            // Isolations
886       DisplayGroup := DisplayGroupForDialog('FHW3');
887       if lstIsolation.Items.Count = 0 then LoadIsolations(lstIsolation.Items);
888       txtIPCurrent.Text := CurrentIsolation;
889       FIsolationID := IsolationID;
890       ResetControlsIP;
891     end;
892     if nbkDiet.ActivePage = pgeAdditional then
893     begin
894     if not OrderForInpatient then
895       begin
896         if not PatientHasRecurringMeals(uRecurringMealList) then
897           begin
898             Changing := False;
899             nbkDiet.ActivePage := pgeOutPt;
900             nbkDietChange(nbkDiet);
901             Exit;
902           end
903         else
904           FastAssign(uRecurringMealList, cboOPAORecurringMeals.Items);
905       end;
906       cboOPAORecurringMeals.Visible := not OrderForInpatient;
907       calOPAOStart.Visible := False;  //not OrderForInpatient;
908       lblOPAOStart.Visible := not OrderForInpatient;
909       AllowQuickOrder := False;
910       OrderMessage('');
911       Responses.Dialog := 'FHW7';                            // Additional Order
912       DisplayGroup := DisplayGroupForDialog('FHW7');
913       ResetControlsAO;
914     end;
915     if nbkDiet.ActivePage = pgeOutPt then
916     begin
917       x := CurrentDietText;
918       if Length(Piece(x, #$D, 1)) > Length('Current Diet:  ') then
919         OrderMessage(x)
920       else
921         OrderMessage('');
922       if (uDialogName <> 'FHW SPECIAL MEAL') and (uDialogName <> 'FHW OP MEAL') then
923         uDialogName := 'FHW OP MEAL';
924       Responses.Dialog := uDialogName;
925       DisplayGroup := DisplayGroupForDialog(uDialogName);
926       if uDialogName = 'FHW SPECIAL MEAL' then                 // Special meal
927         begin
928          AllowQuickOrder := False;
929          ResetControlsOP;
930          FastAddStrings(SubSetOfOPDiets, cboOPDietAvail.Items);
931          { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
932          chkOPCancelTubefeeding.State := cbGrayed;
933          chkOPCancelTubefeeding.Visible := False;
934          grpOPMeal.Caption := 'Special Meal';
935          pgeTubefeeding.TabVisible := False;
936          pgeIsolations.TabVisible := False;
937          pgeAdditional.TabVisible := False;
938          pgeEarlyLate.TabVisible := False;
939          cboOPDietAvail.SelectByIEN(uDietParams.OPDefaultDiet);
940          cboOPDietAvailMouseClick(Self);
941          Changing := False;
942         end
943       else if uDialogName = 'FHW OP MEAL' then                          // Recurring meal
944         begin
945          AllowQuickOrder := True;
946          ResetControlsOP;
947          LoadDietQuickList(cboOPDietAvail.Items, 'MEAL');              // use D.G. short name here
948          cboOPDietAvail.InsertSeparator;
949          FastAddStrings(SubSetOfOPDiets, cboOPDietAvail.Items);
950          cboOPDietAvail.SelectByIEN(uDietParams.OPDefaultDiet);
951          { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
952          chkOPCancelTubefeeding.State := cbGrayed;
953          chkOPCancelTubefeeding.Visible := False;
954          grpOPMeal.Caption := 'Recurring Meal';
955          SetEnableOPDOW(False, -1);
956          cboOPDietAvailMouseClick(Self);
957          Changing := False;
958         end;
959     end;
960     Changing := False;                                       // Changing reset
961     StatusText('');
962     if FGiveMultiTabMessage then  // CQ#15483
963     begin
964       FGiveMultiTabMessage := FALSE;
965       GetScreenReader.Speak('Multi Tab Form');
966     end;
967   end;
968   
969   { Diet Order tab ---------------------------------------------------------------------------- }
970   
971   procedure TfrmODDiet.DietCheckForNPO;
972   begin
973     if Piece(lstDietSelect.Items[0], U, 2) = 'NPO' then
974     begin
975       lblDelivery.Visible := False;
976       cboDelivery.Visible := False;
977       lblComment.Visible := True;          // <-- these changes added for 11a to suppress
978       txtDietComment.Visible := True;      // <-- prompting of special instructions except
979     end else                               // <-- for NPO
980     begin                                  // <--
981       lblComment.Visible := False;         // <--
982       txtDietComment.Visible := False;     // <--
983       txtDietComment.Text := '';           // <--
984     end;
985   end;
986   
987   procedure TfrmODDiet.DietCheckForTF;
988   var
989     x: string;
990   begin
991     with lstDietSelect do
992     begin
993       if (Items.Count = 1) and (Piece(Items[0], U, 2) <> 'NPO')
994         and (Length(uDietParams.CurTF) > 0) then
995       begin
996         x := TextForOrder(uDietParams.CurTF);
997         if InfoBox(TX_CANCEL_TF + x, TC_CANCEL_TF, MB_YESNO) = IDYES then
998         begin
999           chkCancelTubeFeeding.State := cbChecked;
1000          chkCancelTubeFeeding.Visible := True;
1001        end
1002        else chkCancelTubeFeeding.State := cbUnchecked;
1003      end; {if (Items...}
1004    end; {with lstDietSelect}
1005  end;
1006  
1007  procedure TfrmODDiet.ResetControlsDO;
1008  begin
1009    lstDietSelect.Clear;
1010    calDietStart.Text := 'Now';
1011    calDietStop.Text  := '';
1012    lblDelivery.Visible := True;
1013    cboDelivery.Visible := True;
1014    txtDietComment.Text := '';             // <-- suppress except for NPO
1015    txtDietComment.Visible := False;       // <--
1016    lblComment.Visible := False;           // <--
1017  end;
1018  
1019  procedure TfrmODDiet.SetValuesFromResponsesDO;
1020  var
1021    AnInstance: Integer;
1022    AResponse: TResponse;
1023    ADiet: string;
1024  begin
1025    Changing := True;                                        // Changing set!!
1026    ResetControlsDO;
1027    with Responses do
1028    begin
1029      AnInstance := NextInstance('ORDERABLE', 0);
1030      while AnInstance > 0 do
1031      begin
1032        AResponse := FindResponseByName('ORDERABLE', AnInstance);
1033        if AResponse <> nil then
1034        begin
1035          ADiet := DietAttributes(StrToIntDef(AResponse.IValue,0));
1036          if Piece(ADiet,'^',1)='0' then
1037          begin
1038            InfoBox(Piece(ADiet,'^',2), TC_DIET_ERR, MB_OK);
1039            cboDietAvail.ItemIndex := -1;
1040            Changing := False;
1041            Exit;
1042          end;
1043          lstDietSelect.Items.Add(ADiet);
1044        end;
1045        AnInstance := NextInstance('ORDERABLE', AnInstance);
1046      end; {while AnInstance - ORDERABLE}
1047      SetControl(calDietStart,   'START',    1);
1048      SetControl(calDietStop,    'STOP',     1);
1049      SetControl(cboDelivery,    'DELIVERY', 1);
1050      SetControl(txtDietComment, 'COMMENT',  1);
1051    end;
1052    DietCheckForNPO;
1053    DietCheckForTF;
1054    Changing := False;                                       // Changing reset
1055    DietChange(Self);
1056  end;
1057  
1058  procedure TfrmODDiet.cboDietAvailNeedData(Sender: TObject; const StartFrom: string;
1059    Direction, InsertAt: Integer);
1060  begin
1061    inherited;
1062    cboDietAvail.ForDataUse(SubSetOfDiets(StartFrom, Direction));
1063  end;
1064  
1065  procedure TfrmODDiet.cboDietAvailMouseClick(Sender: TObject);
1066  var
1067    NewDiet, ErrMsg: string;
1068    DupDiet: Boolean;
1069    i: Integer;
1070  
1071    procedure SetError(const AnError: string);
1072    begin
1073      if Length(ErrMsg) > 0 then Exit;
1074      ErrMsg := AnError;
1075    end;
1076  
1077  begin
1078    inherited;
1079    if CharAt(cboDietAvail.ItemID, 1) = 'Q' then              // setup quick order
1080    begin
1081      Responses.QuickOrder := ExtractInteger(cboDietAvail.ItemID);
1082      SetValuesFromResponsesDO;
1083      cboDietAvail.ItemIndex := -1;
1084      Exit;
1085    end;
1086    if cboDietAvail.ItemIEN > 0 then with lstDietSelect do
1087    begin
1088      ErrMsg := '';
1089      if Items.Count > 0 then  // disallow other diets with Regular & NPO
1090      begin
1091        if cboDietAvail.ItemIEN = uDietParams.RegIEN then SetError(TX_DIET_REG);
1092        if GetIEN(0) = uDietParams.RegIEN            then SetError(TX_DIET_REG);
1093        if cboDietAvail.ItemIEN = uDietParams.NPOIEN then SetError(TX_DIET_NPO);
1094        if GetIEN(0) = uDietParams.NPOIEN            then SetError(TX_DIET_NPO);
1095      end;
1096      if Items.Count = 5 then SetError(TX_DIET_LIM);    // maximum of 5 diet modifications
1097      DupDiet := False;
1098      for i := 0 to Items.Count - 1 do if cboDietAvail.ItemIEN = GetIEN(i) then DupDiet := True;
1099      if DupDiet         then SetError(TX_DIET_DUP);    // each diet mod must be unique
1100      NewDiet := DietAttributes(cboDietAvail.ItemIEN);
1101      if Piece(NewDiet,'^',1)='0' then
1102      begin
1103        InfoBox(Piece(NewDiet,'^',2),TC_DIET_ERR, MB_OK);
1104        cboDietAvail.ItemIndex := -1;
1105        Exit;
1106      end;
1107      for i := 0 to Items.Count - 1 do                  // check to make sure unique precedence
1108        if Piece(Items[i], U, 4) = Piece(NewDiet, U, 4)
1109          then SetError(TX_DIET_PRC + Piece(Items[i], U, 2));
1110      if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TC_DIET_ERR, MB_OK) else
1111      begin
1112        lstDietSelect.Items.Add(NewDiet);
1113        DietCheckForNPO;
1114        DietCheckForTF;
1115        OrderMessage(OIMessage(StrToIntDef(Piece(NewDiet, U, 1), 0)));
1116        DietChange(Sender);
1117      end; {else of if Length}
1118    end; {if cboDietAvail}
1119    cboDietAvail.ItemIndex := -1;
1120  end;
1121  
1122  procedure TfrmODDiet.cboDietAvailExit(Sender: TObject);
1123  begin
1124    inherited;
1125    if (cboDietAvail.ItemIEN > 0) or (CharAt(cboDietAvail.ItemID, 1) = 'Q') then
1126      cboDietAvailMouseClick(Self);
1127  end;
1128  
1129  procedure TfrmODDiet.cmdRemoveClick(Sender: TObject);
1130  begin
1131    inherited;
1132    with lstDietSelect do if ItemIndex > -1 then Items.Delete(ItemIndex);
1133    DietChange(Sender);
1134    with lstDietSelect do if Items.Count = 0 then
1135    begin
1136      chkCancelTubefeeding.State := cbGrayed;
1137      chkCancelTubefeeding.Visible := False;
1138      lblDelivery.Visible := True;
1139      cboDelivery.Visible := True;
1140    end;
1141  end;
1142  
1143  procedure TfrmODDiet.DietChange(Sender: TObject);
1144  var
1145    i: Integer;
1146  begin
1147    inherited;
1148    if Changing then Exit;
1149    if Sender <> Self then Responses.Clear;       // Sender=Self when called from SetupDialog
1150    with calDietStart   do {if Length(Text) > 0 then} Responses.Update('START',     1, Text,   Text);
1151    with calDietStop    do {if Length(Text) > 0 then} Responses.Update('STOP',      1, Text,   Text);
1152    with lstDietSelect  do for i := 0 to Items.Count - 1 do
1153      Responses.Update('ORDERABLE', i+1, Piece(Items[i], U, 1), Piece(Items[i], U, 2));
1154    with txtDietComment do {if Length(Text) > 0 then} Responses.Update('COMMENT',   1, Text,   Text);
1155    with cboDelivery    do if Visible            then Responses.Update('DELIVERY',  1, ItemID, Text);
1156    with chkCancelTubefeeding do case State of
1157                                   cbChecked:   Responses.Update('CANCEL', 1, '1', 'YES');
1158                                   cbUnchecked: Responses.Update('CANCEL', 1, '0', 'NO');
1159                                 end;
1160    with lstDietSelect do if (Items.Count = 1) and (GetIEN(0) = uDietParams.NPOIEN) then
1161    begin
1162      if Frac(calDietStart.FMDateTime) > 0.2358 then Responses.VarTrailing := 'at Midnight';
1163    end
1164    else Responses.VarTrailing := 'Diet';
1165    memOrder.Text := Responses.OrderText;
1166  end;
1167  
1168  { Tubefeeding tab --------------------------------------------------------------------------- }
1169  
1170  procedure TfrmODDiet.ResetControlsTF;
1171  begin
1172    TFClearGrid;
1173    chkCancelTrays.Checked := False;
1174    calOPTFStart.Text := '';
1175    txtTFComment.Text := '';
1176  end;
1177  
1178  procedure TfrmODDiet.SetValuesFromResponsesTF;
1179  var
1180    AnInstance: Integer;
1181    AResponse: TResponse;
1182    AProduct: TTFProduct;
1183  begin
1184    Changing := True;                                        // Changing set!!
1185    ResetControlsTF;
1186    with Responses do
1187    begin
1188      AnInstance := NextInstance('ORDERABLE', 0);
1189      while AnInstance > 0 do
1190      begin
1191        AResponse := FindResponseByName('ORDERABLE', AnInstance);
1192        if AResponse <> nil then
1193        begin
1194          AProduct := TTFProduct.Create;
1195          AProduct.IEN := StrToIntDef(AResponse.IValue, 0);
1196          AProduct.Name := AResponse.EValue;
1197          with grdSelected do
1198          begin
1199            if Objects[0, RowCount - 1] <> nil then RowCount := RowCount + 1;
1200            Objects[0, RowCount - 1] := AProduct;
1201            Cells[0, RowCount - 1] := AProduct.Name;
1202            AResponse := FindResponseByName('STRENGTH', AnInstance);
1203            if AResponse <> nil then Cells[1, RowCount - 1] := AResponse.EValue;
1204            AResponse := FindResponseByName('INSTR',   AnInstance);
1205            if AResponse <> nil then Cells[2, RowCount - 1] := AResponse.EValue;
1206            TFSetAmountForRow(RowCount - 1);
1207          end;
1208        end;
1209        AnInstance := NextInstance('ORDERABLE', AnInstance);
1210      end; {while AnInstance - ORDERABLE}
1211      AResponse := FindResponseByName('CANCEL', 1);
1212      if AResponse <> nil then chkCancelTrays.Checked := AResponse.IValue = '1';
1213      if not OrderForInpatient then
1214      begin
1215        SetControl(cboOPTFRecurringMeals, 'DATETIME', 1);
1216        SetControl(calOPTFStart, 'DATETIME', 1);
1217      end;
1218      SetControl(txtTFComment, 'COMMENT',  1);
1219    end;
1220    Changing := False;                                       // Changing reset
1221    TFChange(Self);
1222  end;
1223  
1224  procedure TfrmODDiet.TFClearGrid;
1225  var
1226    i: Integer;
1227  begin
1228    with grdSelected do for i := 0 to RowCount - 1 do
1229    begin
1230      TTFProduct(Objects[0, i]).Free;
1231      Rows[i].Clear;
1232    end;
1233    grdSelected.RowCount := 1;
1234  end;
1235  
1236  procedure TfrmODDiet.cboProductMouseClick(Sender: TObject);
1237  var
1238    AProduct: TTFProduct;
1239  begin
1240    inherited;
1241    // check quick order
1242    if CharAt(cboProduct.ItemID, 1) = 'Q' then              // setup quick order
1243    begin
1244      Responses.QuickOrder := ExtractInteger(cboProduct.ItemID);
1245      SetValuesFromResponsesTF;
1246      cboProduct.ItemIndex := -1;
1247      Exit;
1248    end;
1249    if cboProduct.ItemIEN <= 0 then Exit;
1250    AProduct := TTFProduct.Create;
1251    AProduct.IEN := cboProduct.ItemIEN;
1252    AProduct.Name := Piece(cboProduct.Items[cboProduct.ItemIndex], U, 3);
1253    cboProduct.ItemIndex := -1;
1254    with grdSelected do
1255    begin
1256      if Objects[0, RowCount - 1] <> nil then RowCount := RowCount + 1;
1257      Objects[0, RowCount - 1] := AProduct;
1258      Cells[0, RowCount - 1] := AProduct.Name;
1259      Cells[1, RowCount - 1] := 'FULL';
1260      Row := RowCount - 1;
1261      Col := 1;
1262    end;
1263    OrderMessage(OIMessage(AProduct.IEN));
1264    TFChange(Sender);
1265  end;
1266  
1267  procedure TfrmODDiet.cboProductExit(Sender: TObject);
1268  begin
1269    inherited;
1270    if (cboProduct.ItemIEN > 0) or (CharAt(cboProduct.ItemID, 1) = 'Q') then
1271      cboProductMouseClick(Self);
1272  end;
1273  
1274  procedure TfrmODDiet.grdSelectedDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
1275    State: TGridDrawState);
1276  begin
1277    inherited;
1278    if Sender = ActiveControl then Exit;
1279    if not (gdSelected in State) then Exit;
1280    with Sender as TStringGrid do
1281    begin
1282      Canvas.Brush.Color := Color;
1283      Canvas.Font := Font;
1284      Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Cells[ACol, ARow]);
1285    end;
1286  end;
1287  
1288  procedure TfrmODDiet.grdSelectedSelectCell(Sender: TObject; Col, Row: Integer;
1289    var CanSelect: Boolean);
1290  
1291    procedure PlaceControl(AControl: TWinControl);
1292    var
1293      ARect: TRect;
1294    begin
1295      with AControl do
1296      begin
1297        ARect := grdSelected.CellRect(Col, Row);
1298        SetBounds(ARect.Left + grdSelected.Left + 1,  ARect.Top  + grdSelected.Top + 1,
1299                  ARect.Right - ARect.Left + 1,       ARect.Bottom - ARect.Top + 1);
1300        BringToFront;
1301        Show;
1302        SetFocus;
1303      end;
1304    end;
1305  
1306  begin
1307    inherited;
1308    if (Col <> 1) and (Col <> 2) then Exit;
1309    if csDestroying in ComponentState then Exit;
1310    if Col = 1 then
1311    begin
1312      cboStrength.ItemIndex :=cboStrength.Items.IndexOf(grdSelected.Cells[Col, Row]);
1313      cboStrength.Tag := (Col * 256) + Row;
1314      PlaceControl(cboStrength);
1315    end;
1316    if Col = 2 then
1317    begin
1318      txtQuantity.Text := grdSelected.Cells[Col, Row];
1319      txtQuantity.Tag  := (Col * 256) + Row;
1320      PlaceControl(txtQuantity);
1321    end;
1322  end;
1323  
1324  procedure TfrmODDiet.SetNextCell(ACol, ARow: Integer);
1325  begin
1326    FNextCol := ACol;
1327    FNextRow := ARow;
1328  end;
1329  
1330  procedure TfrmODDiet.TFMoveToNextCell;
1331  var
1332    NextCol, NextRow: Integer;
1333  begin
1334    if (FNextCol < 0) or (FNextRow < 0) then Exit;
1335    if (ActiveControl = grdSelected) and not (csLButtonDown in grdSelected.ControlState) then
1336    begin
1337      NextCol := FNextCol;
1338      NextRow := FNextRow;
1339      with grdSelected do if NextCol <> Col then Col := NextCol;
1340      with grdSelected do if NextRow <> Row then Row := NextRow;
1341    end;
1342  end;
1343  
1344  procedure TfrmODDiet.TFSetAmountForRow(ARow: Integer);
1345  var
1346    Product, Strength: Integer;
1347    x: string;
1348  begin
1349    with grdSelected do
1350    begin
1351      if Objects[0, ARow] <> nil
1352        then Product := TTFProduct(Objects[0, ARow]).IEN
1353        else Product := 0;
1354      Strength := TFStrengthCode(Cells[1, ARow]);
1355      x := ExpandedQuantity(Product, Strength, Cells[2, ARow]);
1356      if Length(x) > 0 then
1357      begin
1358        grdSelected.Cells[2, ARow] := Piece(x, U, 2);
1359        grdSelected.Cells[3, ARow] := Piece(x, U, 1) + 'ml';
1360      end
1361      else grdSelected.Cells[3, ARow] := '';
1362    end;
1363  end;
1364  
1365  function TfrmODDiet.TFStrengthCode(const x: string): Integer;
1366  begin
1367    Result := 0;
1368    if      x = '1/4'  then Result := 1
1369    else if x = '1/2'  then Result := 2
1370    else if x = '3/4'  then Result := 3
1371    else if x = 'FULL' then Result := 4;
1372  end;
1373  
1374  procedure TfrmODDiet.cboStrengthEnter(Sender: TObject);
1375  begin
1376    inherited;
1377    SetNextCell(2, grdSelected.Row);
1378  end;
1379  
1380  procedure TfrmODDiet.cboStrengthKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
1381  begin
1382    inherited;
1383    with grdSelected do
1384      case Key of
1385      VK_LEFT:  SetNextCell(0, Row);
1386      VK_RIGHT: SetNextCell(2, Row);
1387      end;
1388    if Key in [VK_LEFT, VK_RIGHT] then
1389    begin
1390      Key := 0;
1391      if not (csDestroying in ComponentState) then grdSelected.SetFocus;
1392    end;
1393  end;
1394  
1395  procedure TfrmODDiet.cboStrengthChange(Sender: TObject);
1396  begin
1397    inherited;
1398    with cboStrength do
1399    begin
1400      if Tag < 0 then Exit;
1401      grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
1402    end;
1403    TFChange(Sender);
1404  end;
1405  
1406  procedure TfrmODDiet.cboStrengthExit(Sender: TObject);
1407  begin
1408    inherited;
1409    with cboStrength do
1410    begin
1411      grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
1412      TFSetAmountForRow(Tag mod 256);
1413      Tag := -1;
1414      Hide;
1415    end;
1416    TFChange(Sender);
1417    TFMoveToNextCell;
1418  end;
1419  
1420  procedure TfrmODDiet.txtQuantityEnter(Sender: TObject);
1421  begin
1422    inherited;
1423    SetNextCell(-1, -1);
1424  end;
1425  
1426  procedure TfrmODDiet.txtQuantityKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
1427  begin
1428    inherited;
1429    with grdSelected, txtQuantity do
1430      case Key of
1431      VK_UP:    SetNextCell(Col, HigherOf(Row - 1, 0));
1432      VK_DOWN:  SetNextCell(Col, LowerOf(Row + 1, RowCount - 1));
1433      VK_LEFT:  if (SelLength = 0) and (SelStart = 0) then SetNextCell(1, Row);
1434      VK_RIGHT: if (SelLength = 0) and (SelStart = Length(Text)) then SetNextCell(3, Row);
1435      VK_END:   if (SelLength = 0) and (SelStart = Length(Text)) then SetNextCell(3, Row);
1436      VK_HOME:  if (SelLength = 0) and (SelStart = 0) then SetNextCell(0, Row);
1437      VK_PRIOR: SetNextCell(Col, 0);
1438      VK_NEXT:  SetNextCell(Col, RowCount - 1);
1439      end;
1440    if FNextCol > -1 then
1441    begin
1442      Key := 0;
1443      if not (csDestroying in ComponentState) then grdSelected.SetFocus;
1444    end;
1445  end;
1446  
1447  procedure TfrmODDiet.txtQuantityChange(Sender: TObject);
1448  begin
1449    inherited;
1450    with txtQuantity do
1451    begin
1452      if Tag < 0 then Exit;
1453      grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
1454    end;
1455    TFChange(Sender);
1456  end;
1457  
1458  procedure TfrmODDiet.txtQuantityExit(Sender: TObject);
1459  begin
1460    inherited;
1461    with txtQuantity do
1462    begin
1463      grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
1464      TFSetAmountForRow(Tag mod 256);
1465      Tag := -1;
1466      Hide;
1467    end;
1468    TFChange(Sender);
1469    TFMoveToNextCell;
1470  end;
1471  
1472  procedure TfrmODDiet.cmdTFRemoveClick(Sender: TObject);
1473  var
1474    i: Integer;
1475  begin
1476    inherited;
1477    with grdSelected do
1478    begin
1479      if Row < 0 then Exit;
1480      if Objects[0, Row] <> nil then TTFProduct(Objects[0, Row]).Free;
1481      for i := Row to RowCount - 2 do Rows[i] := Rows[i + 1];
1482      Rows[RowCount - 1].Clear;
1483      RowCount := RowCount - 1;
1484    end;
1485    TFChange(Sender);
1486  end;
1487  
1488  procedure TfrmODDiet.TFChange(Sender: TObject);
1489  var
1490    i: Integer;
1491    AProduct: TTFProduct;
1492  
1493  begin
1494    inherited;
1495    if Changing then Exit;
1496    if Sender <> Self then Responses.Clear;       // Sender=Self when called from SetupDialog
1497    with grdSelected do for i := 0 to RowCount - 1 do
1498    begin
1499      AProduct := TTFProduct(Objects[0, i]);
1500      if AProduct = nil then Continue;
1501      with AProduct do if IEN > 0
1502        then Responses.Update('ORDERABLE', i+1, IntToStr(IEN), Name);
1503      if TFStrengthCode(Cells[1,i]) > 0
1504        then Responses.Update('STRENGTH',  i+1, IntToStr(TFStrengthCode(Cells[1,i])), Cells[1,i]);
1505      if Length(Cells[2,i]) > 0
1506        then Responses.Update('INSTR',     i+1, Cells[2,i], Cells[2,i]);
1507    end; {with grdSelected}
1508    with txtTFComment do if Text <> ''
1509      then Responses.Update('COMMENT', 1, Text, Text);
1510    with chkCancelTrays do if Checked
1511      then Responses.Update('CANCEL', 1, '1', 'Yes')
1512      else Responses.Update('CANCEL', 1, '0', 'No');
1513    if not OrderForInpatient then
1514    begin
1515      calOPTFStart.FMDateTime := StrToFloatDef(cboOPTFRecurringMeals.ItemID, 0);
1516      Responses.Update('DATETIME', 1, FloatToStr(calOPTFStart.FMDateTime), calOPTFStart.Text);
1517    end;
1518    memOrder.Text := Responses.OrderText;
1519  end;
1520  
1521  { Early/Late Tray tab ----------------------------------------------------------------------- }
1522  
1523  procedure TfrmODDiet.ResetControlsEL;
1524  begin
1525    grpMeal.ItemIndex    := 3;
1526    grpMeal.TabStop      := True;
1527    grpMealTime.TabStop  := False;
1528    radET1.Visible       := False;
1529    radET2.Visible       := False;
1530    radET3.Visible       := False;
1531    radLT1.Visible       := False;
1532    radLT2.Visible       := False;
1533    radLT3.Visible       := False;
1534    lblNoTimes.Visible   := False;
1535    calELStart.Text      := '';
1536    calELStop.Text       := '';
1537    chkMonday.Checked    := False;
1538    chkTuesday.Checked   := False;
1539    chkWednesday.Checked := False;
1540    chkThursday.Checked  := False;
1541    chkFriday.Checked    := False;
1542    chkSaturday.Checked  := False;
1543    chkSunday.Checked    := False;
1544    chkBagged.Checked    := False;
1545  end;
1546  
1547  procedure TfrmODDiet.SetValuesFromResponsesEL;
1548  var
1549    AResponse: TResponse;
1550  begin
1551    Changing := True;
1552    ResetControlsEL;
1553    with Responses do
1554    begin
1555      AResponse := FindResponseByName('MEAL', 1);
1556      if AResponse <> nil then
1557      begin
1558        if AResponse.IValue = 'B' then grpMeal.ItemIndex := 0;
1559        if AResponse.IValue = 'N' then grpMeal.ItemIndex := 1;
1560        if AResponse.IValue = 'E' then grpMeal.ItemIndex := 2;
1561      end;
1562      if grpMeal.ItemIndex <> 3 then grpMealClick(Self);
1563      AResponse := FindResponseByName('TIME', 1);
1564      if AResponse <> nil then
1565      begin
1566        if radET1.Caption = AResponse.IValue then radET1.Checked := True;
1567        if radET2.Caption = AResponse.IValue then radET2.Checked := True;
1568        if radET3.Caption = AResponse.IValue then radET3.Checked := True;
1569        if radLT1.Caption = AResponse.IValue then radLT1.Checked := True;
1570        if radLT2.Caption = AResponse.IValue then radLT2.Checked := True;
1571        if radLT3.Caption = AResponse.IValue then radLT3.Checked := True;
1572      end;
1573      if not OrderForInpatient then
1574        SetControl(cboOPELRecurringMeals, 'START', 1)
1575      else
1576      begin
1577        SetControl(calELStart, 'START', 1);
1578        SetControl(calELStop,  'STOP',  1);
1579      end;
1580      calELStopChange(Self);
1581      AResponse := FindResponseByName('SCHEDULE', 1);
1582      if AResponse <> nil then
1583      begin
1584        chkMonday.Checked    := Pos('M', AResponse.IValue) > 0;
1585        chkTuesday.Checked   := Pos('T', AResponse.IValue) > 0;
1586        chkWednesday.Checked := Pos('W', AResponse.IValue) > 0;
1587        chkThursday.Checked  := Pos('R', AResponse.IValue) > 0;
1588        chkFriday.Checked    := Pos('F', AResponse.IValue) > 0;
1589        chkSaturday.Checked  := Pos('S', AResponse.IValue) > 0;
1590        chkSunday.Checked    := Pos('X', AResponse.IValue) > 0;
1591      end;
1592      AResponse := FindResponseByName('YN', 1);
1593      if AResponse <> nil then chkBagged.Checked := AResponse.IValue = '1';
1594    end; {with Responses}
1595    Changing := False;
1596    ELChange(Self);
1597  end;
1598  
1599  function TfrmODDiet.GetMealTime: string;
1600  begin
1601    Result := '';
1602    if radET1.Checked then Result := radET1.Caption;
1603    if radET2.Checked then Result := radET2.Caption;
1604    if radET3.Checked then Result := radET3.Caption;
1605    if radLT1.Checked then Result := radLT1.Caption;
1606    if radLT2.Checked then Result := radLT2.Caption;
1607    if radLT3.Checked then Result := radLT3.Caption;
1608  end;
1609  
1610  function TfrmODDiet.GetDaysOfWeek: string;
1611  begin
1612    Result := '';
1613    if chkMonday.Checked    then Result := Result + 'M';
1614    if chkTuesday.Checked   then Result := Result + 'T';
1615    if chkWednesday.Checked then Result := Result + 'W';
1616    if chkThursday.Checked  then Result := Result + 'R';
1617    if chkFriday.Checked    then Result := Result + 'F';
1618    if chkSaturday.Checked  then Result := Result + 'S';
1619    if chkSunday.Checked    then Result := Result + 'X';
1620  end;
1621  
1622  function TfrmODDiet.IsEarlyTray: Boolean;
1623  begin
1624    Result := True;
1625    if radLT1.Checked then Result := False;
1626    if radLT2.Checked then Result := False;
1627    if radLT3.Checked then Result := False;
1628  end;
1629  
1630  procedure TfrmODDiet.grpMealClick(Sender: TObject);
1631  
1632    procedure SetMealTimes(const x: string);
1633  
1634      procedure ActivateButton( Button: TRadioButton; const MealTime: string;
1635        var MoreActivated: boolean);
1636      var
1637        Activate: boolean;
1638      begin
1639        Button.Caption := MealTime;
1640        Activate := Length(MealTime) > 0;
1641        Button.Visible := Activate;
1642        Button.Checked := Activate and not MoreActivated;
1643        MoreActivated := MoreActivated or Activate;
1644      end;
1645  
1646    var
1647      HasTimes: Boolean;
1648    begin
1649      HasTimes := False;
1650      ActivateButton(radET1, Piece(x, U, 1), HasTimes);
1651      ActivateButton(radET2, Piece(x, U, 2), HasTimes);
1652      ActivateButton(radET3, Piece(x, U, 3), HasTimes);
1653      ActivateButton(radLT1, Piece(x, U, 4), HasTimes);
1654      ActivateButton(radLT2, Piece(x, U, 5), HasTimes);
1655      ActivateButton(radLT3, Piece(x, U, 6), HasTimes);
1656      lblNoTimes.Visible := not HasTimes;
1657    end;
1658  var
1659    AMeal: string;
1660  begin
1661    inherited;
1662    Changing := True;
1663    case grpMeal.ItemIndex of
1664      0: begin
1665           SetMealTimes(uDietParams.BTimes);
1666           AMeal := 'B';
1667         end;
1668      1: begin
1669           SetMealTimes(uDietParams.NTimes);
1670           AMeal := 'N';
1671         end;
1672      2: begin
1673           SetMealTimes(uDietParams.ETimes);
1674           AMeal := 'E';
1675         end;
1676    else
1677      begin
1678        SetMealTimes('');
1679        AMeal := '';
1680      end;
1681    end;
1682    if not OrderForInpatient then
1683      begin
1684        if AMeal = '' then
1685        begin
1686          uRecurringMealList.Clear;
1687          cboOPELRecurringMeals.Clear;
1688        end
1689        else if not PatientHasRecurringMeals(uRecurringMealList, AMeal) then
1690          begin
1691            uRecurringMealList.Clear;
1692            cboOPELRecurringMeals.Clear;
1693            grpMeal.ItemIndex := 3;
1694          end
1695        else
1696          FastAssign(uRecurringMealList, cboOPELRecurringMeals.Items);
1697      end;
1698    Changing := False;
1699    ELChange(grpMeal);
1700  end;
1701  
1702  
1703  procedure TfrmODDiet.SetEnableDOW(AllowUse: Boolean);
1704  begin
1705    grpDOW.Enabled       := AllowUse;
1706    chkMonday.Enabled    := AllowUse;
1707    chkTuesday.Enabled   := AllowUse;
1708    chkWednesday.Enabled := AllowUse;
1709    chkThursday.Enabled  := AllowUse;
1710    chkFriday.Enabled    := AllowUse;
1711    chkSaturday.Enabled  := AllowUse;
1712    chkSunday.Enabled    := AllowUse;
1713  end;
1714  
1715  procedure TfrmODDiet.calELStartEnter(Sender: TObject);
1716  begin
1717    inherited;
1718    FChangeStop := Length(calELStop.Text) = 0;
1719  end;
1720  
1721  procedure TfrmODDiet.calELStartChange(Sender: TObject);
1722  begin
1723    inherited;
1724    if FChangeStop then
1725      calELStop.Text := calELStart.Text
1726    else
1727      ELChange(Sender);
1728  end;
1729  
1730  procedure TfrmODDiet.calELStartExit(Sender: TObject);
1731  begin
1732    inherited;
1733    if not OrderForInpatient then SetEnableDOW(False)
1734    else if (Length(calELStop.Text) > 0) and (calELStop.Text = calELStart.Text)
1735      then SetEnableDOW(False)
1736      else SetEnableDOW(True);
1737  end;
1738  
1739  procedure TfrmODDiet.calELStopChange(Sender: TObject);
1740  begin
1741    inherited;
1742    if (Length(calELStop.Text) > 0) and (calELStop.FMDateTime = calELStart.FMDateTime)
1743      then SetEnableDOW(False)
1744      else SetEnableDOW(True);
1745    ELChange(Sender);
1746  end;
1747  
1748  procedure TfrmODDiet.ELChange(Sender: TObject);
1749  var
1750    x: string;
1751  begin
1752    inherited;
1753    if Changing then Exit;
1754    if Sender <> Self then Responses.Clear;       // Sender=Self when called from SetupDialog
1755    case grpMeal.ItemIndex of
1756    0: Responses.Update('MEAL', 1, 'B', 'BREAKFAST');
1757    1: Responses.Update('MEAL', 1, 'N', 'NOON');
1758    2: Responses.Update('MEAL', 1, 'E', 'EVENING');
1759    end;
1760    x := GetMealTime;
1761    if Length(x) > 0 then
1762    begin
1763      Responses.Update('TIME', 1, x, x);
1764      if IsEarlyTray
1765        then Responses.Update('ORDERABLE', 1, uDietParams.EarlyIEN, 'EARLY TRAY')
1766        else Responses.Update('ORDERABLE', 1, uDietParams.LateIEN,  'LATE TRAY');
1767    end;
1768    if not OrderForInpatient then
1769    begin
1770      calELStart.FMDateTime := StrToFloatDef(cboOPELRecurringMeals.ItemID, 0);
1771      calELStop.FMDateTime := calELStart.FMDateTime;
1772    end;
1773    with calELStart   do if Length(Text) > 0 then Responses.Update('START',     1, Text,   Text);
1774    with calELStop    do if Length(Text) > 0 then Responses.Update('STOP',      1, Text,   Text);
1775    x := GetDaysOfWeek;
1776    if Length(x) > 0 then Responses.Update('SCHEDULE', 1, x, x);
1777    if chkBagged.Checked
1778      then Responses.Update('YN', 1, '1', 'YES')
1779      else Responses.Update('YN', 1, '0', 'NO');
1780    memOrder.Text := Responses.OrderText;
1781  end;
1782  
1783  { Isolation Precautions tab ----------------------------------------------------------------- }
1784  
1785  procedure TfrmODDiet.ResetControlsIP;
1786  begin
1787    lstIsolation.ItemIndex := -1;
1788    txtIPComment.Text := '';
1789  end;
1790  
1791  procedure TfrmODDiet.SetValuesFromResponsesIP;
1792  begin
1793    Changing := True;
1794    ResetControlsIP;
1795    Responses.SetControl(lstIsolation, 'ISOLATION', 1);
1796    Responses.SetControl(txtIPComment, 'COMMENT',   1);
1797    Changing := False;
1798    IPChange(Self);
1799  end;
1800  
1801  procedure TfrmODDiet.IPChange(Sender: TObject);
1802  begin
1803    inherited;
1804    if Changing then Exit;
1805    if Sender <> Self then Responses.Clear;       // Sender=Self when called from SetupDialog
1806    Responses.Update('ORDERABLE', 1, FIsolationID, 'Isolation Procedures');
1807    with lstIsolation do if ItemIEN > 0
1808      then Responses.Update('ISOLATION', 1, ItemID, DisplayText[ItemIndex]);
1809    with txtIPComment do if Text <> ''
1810      then Responses.Update('COMMENT', 1, Text, Text);
1811    memOrder.Text := Responses.OrderText;
1812  end;
1813  
1814  { Additional Diet Order tab ----------------------------------------------------------------- }
1815  
1816  procedure TfrmODDiet.ResetControlsAO;
1817  begin
1818    txtAOComment.Text := '';
1819    calOPAOStart.Text := '';
1820  end;
1821  
1822  procedure TfrmODDiet.SetValuesFromResponsesAO;
1823  begin
1824    Changing := True;
1825    ResetControlsAO;
1826    Responses.SetControl(txtAOComment, 'COMMENT', 1);
1827    //Responses.SetControl(calOPAOStart, 'DATETIME', 1);
1828    Responses.SetControl(cboOPAORecurringMeals, 'DATETIME', 1);
1829    Changing := False;
1830    AOChange(Self);
1831  end;
1832  
1833  procedure TfrmODDiet.AOChange(Sender: TObject);
1834  begin
1835    inherited;
1836    if Changing then Exit;
1837    with txtAOComment do if Text <> ''
1838      then Responses.Update('COMMENT', 1, Text, Text);
1839    if not OrderForInpatient then
1840      begin
1841        calOPAOStart.FMDateTime := StrToFloatDef(cboOPAORecurringMeals.ItemID, 0);
1842        Responses.Update('DATETIME', 1, FloatToStr(calOPAOStart.FMDateTime), calOPAOStart.Text);
1843      end;
1844    memOrder.Text := Responses.OrderText;
1845  end;
1846  
1847  
1848  { Outpatient Meals Order tab ----------------------------------------------------------------- }
1849  
1850  procedure TfrmODDiet.cboOPDietAvailMouseClick(Sender: TObject);
1851  var
1852    NewDiet,ErrMsg: string;
1853  
1854    procedure SetError(const AnError: string);
1855    begin
1856      if Length(ErrMsg) > 0 then Exit;
1857      ErrMsg := AnError;
1858    end;
1859  
1860  begin
1861    inherited;
1862    if cboOPDietAvail.Items.Count = 0 then
1863      begin
1864        InfoBox(TX_NO_MEALS_DEFINED, TC_NO_MEALS_DEFINED, MB_OK or MB_ICONINFORMATION);
1865        AbortOrder := True;
1866        exit;
1867      end  ;
1868    if CharAt(cboOPDietAvail.ItemID, 1) = 'Q' then              // setup quick order
1869    begin
1870      Responses.QuickOrder := ExtractInteger(cboOPDietAvail.ItemID);
1871      SetValuesFromResponsesOP;
1872      cboOPDietAvail.ItemIndex := -1;
1873      Exit;
1874    end;
1875    if cboOPDietAvail.ItemIEN > 0 then with lstOPDietSelect do
1876    begin
1877      ErrMsg := '';
1878      NewDiet := DietAttributes(cboOPDietAvail.ItemIEN);
1879      if Piece(NewDiet,'^',1)='0' then
1880      begin
1881        InfoBox(Piece(NewDiet,'^',2),TC_OP_DIET_ERR, MB_OK);     
1882        cboOPDietAvail.ItemIndex := -1;
1883        Exit;
1884      end;
1885      lstOPDietSelect.Items.Clear;
1886      lstOPDietSelect.Items.Add(NewDiet);
1887  { TODO -oRich V. -cOutpatient Meals : Will these be selectable for an outpatient meal? }
1888      OPDietCheckForNPO;
1889  { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
1890      OPDietCheckForTF;
1891      OrderMessage(OIMessage(StrToIntDef(Piece(NewDiet, U, 1), 0)));
1892      OPChange(Sender);
1893    end; {if cboOPDietAvail}
1894    OPChange(Sender);
1895    cboOPDietAvail.ItemIndex := -1;
1896  end;
1897  
1898  procedure TfrmODDiet.cboOPDietAvailExit(Sender: TObject);
1899  begin
1900    inherited;
1901    if (cboOPDietAvail.ItemIEN > 0) or (CharAt(cboOPDietAvail.ItemID, 1) = 'Q') then
1902      cboOPDietAvailMouseClick(Self);
1903  end;
1904  
1905  procedure TfrmODDiet.ResetControlsOP;
1906  begin
1907    lstOPDietSelect.Clear;
1908    cboOPDietAvail.ItemIndex := -1;
1909    grpOPMeal.ItemIndex    := 3;
1910    grpOPMeal.TabStop      := True;
1911    chkOPMonday.Checked    := False;
1912    chkOPTuesday.Checked   := False;
1913    chkOPWednesday.Checked := False;
1914    chkOPThursday.Checked  := False;
1915    chkOPFriday.Checked    := False;
1916    chkOPSaturday.Checked  := False;
1917    chkOPSunday.Checked    := False;
1918    lblOPComment.Visible   := False;
1919    txtOPDietComment.Visible := False;
1920    txtOPDietComment.Text := '';
1921    if uDialogName = 'FHW OP MEAL' then
1922      begin
1923        calOPStart.Text      := '';
1924        calOPStop.Text       := '';
1925        calOPStart.Enabled := True;
1926        calOPStop.Enabled := True;
1927        lblOPStart.Enabled := True;
1928        lblOPStop.Enabled := True;
1929        grpOPDOW.Visible := True;
1930      end
1931    else if uDialogName = 'FHW SPECIAL MEAL' then
1932      begin
1933        calOPStart.Text := 'TODAY';
1934        calOPStop.Text  := 'TODAY';
1935        calOPStart.Enabled := False;
1936        calOPStop.Enabled := False;
1937        lblOPStart.Enabled := False;
1938        lblOPStop.Enabled := False;
1939        grpOPDOW.Visible := False;
1940      end;
1941  end;
1942  
1943  procedure TfrmODDiet.SetValuesFromResponsesOP;
1944  var
1945    AResponse: TResponse;
1946    ADiet: string;
1947  begin
1948    Changing := True;
1949    ResetControlsOP;
1950    with Responses do
1951    begin
1952      AResponse := FindResponseByName('ORDERABLE', 1);
1953      if AResponse <> nil then
1954      begin
1955        ADiet := DietAttributes(StrToIntDef(AResponse.IValue,0));
1956        if Piece(ADiet,'^',1)='0' then
1957        begin
1958          InfoBox(Piece(ADiet,'^',2), TC_OP_DIET_ERR, MB_OK);
1959          cboOPDietAvail.ItemIndex := -1;
1960          Changing := False;
1961          Exit;
1962        end;
1963        SetControl(cboOPDietAvail,    'ORDERABLE', 1);
1964        lstOPDietSelect.Items.Add(ADiet);
1965      end;
1966      SetControl(cboOPDelivery,    'DELIVERY', 1);
1967      AResponse := FindResponseByName('MEAL', 1);
1968      if AResponse <> nil then
1969      begin
1970        if AResponse.IValue = 'B' then grpOPMeal.ItemIndex := 0;
1971        if AResponse.IValue = 'N' then grpOPMeal.ItemIndex := 1;
1972        if AResponse.IValue = 'E' then grpOPMeal.ItemIndex := 2;
1973      end;
1974      SetControl(calOPStart, 'START', 1);
1975      SetControl(calOPStop,  'STOP',  1);
1976      calOPStopChange(Self);
1977      AResponse := FindResponseByName('SCHEDULE', 1);
1978      if AResponse <> nil then
1979      begin
1980        chkOPMonday.Checked    := Pos('M', AResponse.IValue) > 0;
1981        chkOPTuesday.Checked   := Pos('T', AResponse.IValue) > 0;
1982        chkOPWednesday.Checked := Pos('W', AResponse.IValue) > 0;
1983        chkOPThursday.Checked  := Pos('R', AResponse.IValue) > 0;
1984        chkOPFriday.Checked    := Pos('F', AResponse.IValue) > 0;
1985        chkOPSaturday.Checked  := Pos('S', AResponse.IValue) > 0;
1986        chkOPSunday.Checked    := Pos('X', AResponse.IValue) > 0;
1987      end;
1988      SetControl(txtOPDietComment, 'COMMENT',  1);
1989    end; {with Responses}
1990    OPDietCheckForNPO;
1991    OPDietCheckForTF;
1992    Changing := False;
1993    OPChange(Self);
1994  end;
1995  
1996  procedure TfrmODDiet.calOPStartEnter(Sender: TObject);
1997  begin
1998    inherited;
1999    FChangeStop := Length(calOPStop.Text) = 0;
2000  end;
2001  
2002  procedure TfrmODDiet.calOPStartChange(Sender: TObject);
2003  begin
2004    inherited;
2005    if Changing then exit;
2006    if FChangeStop then
2007      calOPStop.Text := calOPStart.Text
2008    else
2009      OPChange(Sender);
2010  end;
2011  
2012  function TfrmODDiet.FMDOW(AnFMDate: TFMDateTime): integer;
2013  var
2014    WinDate: TDateTime;
2015    x: integer;
2016  begin
2017    WinDate := FMDateTimeToDateTime(AnFMDate);
2018    x := DayOfTheWeek(WinDate);
2019    Result := x;
2020  end;
2021  
2022  function TfrmODDiet.FMDays(AStart, AEnd: TFMDateTime): string;
2023  var
2024    AWinStart, AWinEnd: TDateTime;
2025    i: double;
2026    Days: string;
2027  begin
2028    AWinStart := FMDateTimeToDateTime(AStart);
2029    AWinEnd := FMDateTimeToDateTime(AEnd);
2030    i := AWinStart;
2031    repeat
2032      Days := Days + FMDayLetters[DayOfTheWeek(i)];
2033      i := i + 1;
2034    until i > AWinEnd;
2035    Result := Days;
2036  end;
2037  
2038  procedure TfrmODDiet.calOPStartExit(Sender: TObject);
2039  var
2040    Days: string;
2041  begin
2042    inherited;
2043    if not (calOPStart.FMDateTime > 0) then
2044    begin
2045      SetEnableOPDOW(False, -1);
2046      Exit ;
2047    end;
2048    if (Length(calOPStop.Text) > 0) and (calOPStop.Text = calOPStart.Text) then
2049      SetEnableOPDOW(False, FMDOW(calOPStart.FMDateTime))
2050    else
2051    begin
2052      Days := FMDays(calOPStart.FMDateTime, calOPStop.FMDateTime);
2053      SetEnableOPDOW(True, -1, Days);
2054    end;
2055  end;
2056  
2057  procedure TfrmODDiet.calOPStopChange(Sender: TObject);
2058  var
2059    Days: string;
2060  begin
2061    inherited;
2062    if Changing then exit;
2063    if not (calOPStop.FMDateTime > 0) then
2064    begin
2065      SetEnableOPDOW(False, -1);
2066      Exit ;
2067    end;
2068    if (Length(calOPStop.Text) > 0) and (calOPStop.FMDateTime = calOPStart.FMDateTime) then
2069      SetEnableOPDOW(False, FMDOW(calOPStart.FMDateTime))
2070    else
2071    begin
2072      Days := FMDays(calOPStart.FMDateTime, calOPStop.FMDateTime);
2073      SetEnableOPDOW(True, -1, Days);
2074    end;
2075    OPChange(Sender);
2076  end;
2077  
2078  procedure TfrmODDiet.OPChange(Sender: TObject);
2079  var
2080    x: string;
2081    //i: integer;
2082  begin
2083    inherited;
2084    if Changing then Exit;
2085    if Sender <> Self then Responses.Clear;       // Sender=Self when called from SetupDialog
2086    // Per NFS, only one selection allowed from any of 10-15 available OP diets
2087    with lstOPDietSelect do if Items.Count > 0 then
2088      Responses.Update('ORDERABLE', 1, Piece(Items[0], U, 1), Piece(Items[0], U, 2));
2089    case grpOPMeal.ItemIndex of
2090      0: Responses.Update('MEAL', 1, 'B', 'BREAKFAST');
2091      1: Responses.Update('MEAL', 1, 'N', 'NOON');
2092      2: Responses.Update('MEAL', 1, 'E', 'EVENING');
2093    end;
2094    with calOPStart   do (*if Length(Text) > 0 then*) Responses.Update('START',     1, Text,   Text);
2095    with calOPStop    do (*if Length(Text) > 0 then*) Responses.Update('STOP',      1, Text,   Text);
2096    if uDialogName = 'FHW OP MEAL' then
2097      begin
2098        x := GetOPDaysOfWeek;
2099        if Length(x) = 0 then x := 'ONCE';
2100        Responses.Update('SCHEDULE', 1, x, x);
2101      end;
2102    with txtOPDietComment do {if Length(Text) > 0 then} Responses.Update('COMMENT',   1, Text,   Text);
2103    with cboOPDelivery    do if Visible            then Responses.Update('DELIVERY',  1, ItemID, Text);
2104  { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
2105  (*  with chkOPCancelTubefeeding do case State of
2106                                   cbChecked:   Responses.Update('CANCEL', 1, '1', 'YES');
2107                                   cbUnchecked: Responses.Update('CANCEL', 1, '0', 'NO');
2108                                 end;*)
2109    Responses.VarTrailing := 'Meal';
2110    memOrder.Text := Responses.OrderText;
2111  end;
2112  
2113  procedure TfrmODDiet.grpOPMealClick(Sender: TObject);
2114  begin
2115    inherited;
2116    OPChange(Sender);
2117  end;
2118  
2119  procedure TfrmODDiet.SetEnableOPDOW(AllowUse: Boolean; OneTimeDay: integer; DaysToCheck: string = '');
2120  var
2121    i: integer;
2122  begin
2123    if (not AllowUse) and (OneTimeDay > -1) then
2124      begin
2125        for i := 0 to grpOPDOW.ControlCount - 1 do
2126        begin
2127          if grpOPDOW.Controls[i] is TCheckBox then
2128            TCheckBox(grpOPDOW.Controls[i]).Checked := False;
2129        end;
2130        //TCheckBox(grpOPDOW.Controls[OneTimeDay - 1]).Checked := True;  CQ #8305
2131      end;
2132    grpOPDOW.Enabled       := AllowUse;
2133    chkOPMonday.Enabled    := AllowUse and (Pos('M', DaysToCheck) > 0);
2134    chkOPTuesday.Enabled   := AllowUse and (Pos('T', DaysToCheck) > 0);
2135    chkOPWednesday.Enabled := AllowUse and (Pos('W', DaysToCheck) > 0);
2136    chkOPThursday.Enabled  := AllowUse and (Pos('R', DaysToCheck) > 0);
2137    chkOPFriday.Enabled    := AllowUse and (Pos('F', DaysToCheck) > 0);
2138    chkOPSaturday.Enabled  := AllowUse and (Pos('S', DaysToCheck) > 0);
2139    chkOPSunday.Enabled    := AllowUse and (Pos('X', DaysToCheck) > 0);
2140  end;
2141  
2142  function TfrmODDiet.GetOPDaysOfWeek: string;
2143  begin
2144    Result := '';
2145    if chkOPMonday.Checked    then Result := Result + 'M';
2146    if chkOPTuesday.Checked   then Result := Result + 'T';
2147    if chkOPWednesday.Checked then Result := Result + 'W';
2148    if chkOPThursday.Checked  then Result := Result + 'R';
2149    if chkOPFriday.Checked    then Result := Result + 'F';
2150    if chkOPSaturday.Checked  then Result := Result + 'S';
2151    if chkOPSunday.Checked    then Result := Result + 'X';
2152  end;
2153  
2154  procedure TfrmODDiet.cmdOPRemoveClick(Sender: TObject);
2155  begin
2156    inherited;
2157    with lstOPDietSelect do if ItemIndex > -1 then Items.Delete(ItemIndex);
2158    OPChange(Sender);
2159    with lstOPDietSelect do if Items.Count = 0 then
2160    begin
2161      lblOPDelivery.Visible := True;
2162      cboOPDelivery.Visible := True;
2163  { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
2164      chkOPCancelTubefeeding.State := cbGrayed;
2165      chkOPCancelTubefeeding.Visible := False;
2166    end;
2167  end;
2168  
2169  function TfrmODDiet.GetOPMealWindow: string;
2170  begin
2171    case grpOPMeal.ItemIndex of
2172      0:  Result := Pieces(uDietParams.Alarms, U, 1, 2);
2173      1:  Result := Pieces(uDietParams.Alarms, U, 3, 4);
2174      2:  Result := Pieces(uDietParams.Alarms, U, 5, 6);
2175    else
2176      Result := U;
2177    end;
2178  end;
2179  
2180  procedure TfrmODDiet.OPDietCheckForNPO;
2181  begin
2182  { TODO -oRich V. -cOutpatient Meals : Need NFS input on this section (NPO and special instructions.) }
2183    if Piece(lstOPDietSelect.Items[0], U, 2) = 'NPO' then
2184    begin
2185      lblOPDelivery.Visible := False;
2186      cboOPDelivery.Visible := False;
2187      lblOPComment.Visible := True;          
2188      txtOPDietComment.Visible := True;
2189    end else                                 
2190    begin                                    
2191      lblOPComment.Visible := False;         
2192      txtOPDietComment.Visible := False;     
2193      txtOPDietComment.Text := '';           
2194    end;
2195  end;
2196  
2197  { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
2198  procedure TfrmODDiet.OPDietCheckForTF;
2199  var
2200    x: string;
2201  begin
2202    with lstOPDietSelect do
2203    begin
2204      if (Items.Count = 1) and (Piece(Items[0], U, 2) <> 'NPO')
2205        and (Length(uDietParams.CurTF) > 0) then
2206      begin
2207        x := TextForOrder(uDietParams.CurTF);
2208        if InfoBox(TX_CANCEL_TF + x, TC_CANCEL_TF, MB_YESNO) = IDYES then
2209        begin
2210          chkOPCancelTubeFeeding.State := cbChecked;
2211          chkOPCancelTubeFeeding.Visible := True;
2212        end
2213        else chkOPCancelTubeFeeding.State := cbUnchecked;
2214      end; {if (Items...}
2215    end; {with lstOPDietSelect}
2216  end;
2217  
2218  { Common Buttons ---------------------------------------------------------------------------- }
2219  
2220  procedure TfrmODDiet.cmdAcceptClick(Sender: TObject);
2221  var
2222    DCOrder: TOrder;
2223    LateTrayFields: TLateTrayFields;
2224    //CxMsg: string;
2225  begin
2226    // these actions should be before inherited, so that InitDialog doesn't clear properties
2227    LateTrayFields.LateMeal := #0;      // #0 so only create late order if LT dialog invoked
2228    if nbkDiet.ActivePage = pgeDiet then
2229    begin
2230  (*    if Self.EvtID <> 0 then
2231      begin
2232        CheckForAutoDCDietOrders(Self.EvtID, Self.DisplayGroup, '', CxMsg, cmdAccept);
2233        if CxMsg <> '' then
2234        begin
2235          if InfoBox(CxMsg + CRLF + CRLF +
2236             'Have you done either of the above?', 'Possible delayed order conflict',
2237             MB_ICONWARNING or MB_YESNO) = ID_NO
2238             then exit;
2239        end;
2240      end;*)
2241      // create dc tubefeeding order
2242      if chkCancelTubeFeeding.State = cbChecked then
2243      begin
2244        DCOrder := TOrder.Create;
2245        DCOrder.ID := uDietParams.CurTF;
2246        SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_DC, Integer(DCOrder));
2247        DCOrder.Free;
2248      end;
2249      // check if late tray should be ordered
2250      LateTrayCheck(Responses, Self.EvtID, FALSE, LateTrayFields);
2251    end;
2252  { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
2253    if nbkDiet.ActivePage = pgeOutPt then
2254    begin
2255      // create dc tubefeeding order
2256      if chkOPCancelTubeFeeding.State = cbChecked then
2257      begin
2258        DCOrder := TOrder.Create;
2259        DCOrder.ID := uDietParams.CurTF;
2260        SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_DC, Integer(DCOrder));
2261        DCOrder.Free;
2262      end;
2263      // check if late tray should be ordered
2264      LateTrayCheck(Responses, Self.EvtID, TRUE, LateTrayFields);
2265    end;
2266    inherited;
2267    with LateTrayFields do if LateMeal <> #0 then LateTrayOrder(LateTrayFields, OrderForInpatient);
2268  end;
2269  
2270  procedure TfrmODDiet.FormKeyDown(Sender: TObject; var Key: Word;
2271    Shift: TShiftState);
2272  begin
2273    inherited;
2274    if (Key = VK_TAB) then begin
2275      if (ssCtrl in Shift) then begin
2276        if not (ActiveControl is TCustomMemo) or not TMemo(ActiveControl).WantTabs then begin
2277          nbkDiet.SelectNextPage( not (ssShift in Shift));
2278          Key := 0;
2279        end;
2280      end;
2281    end;
2282  end;
2283  
2284  procedure TfrmODDiet.cboOPDietAvailKeyDown(Sender: TObject; var Key: Word;
2285    Shift: TShiftState);
2286  begin
2287    inherited;
2288    if Key = VK_RETURN then cboOPDietAvailMouseClick(Self);
2289  end;
2290  
2291  function TfrmODDiet.PatientHasRecurringMeals(var MealList: TStringList; MealType: string = ''): boolean;
2292  const
2293    TX_NO_RECURRING_MEALS = 'For outpatients, this type of order requires association with an existing recurring' + CRLF +
2294                            'meal order.  There are currently no active recurring meal orders for this patient.' + CRLF + CRLF +
2295                            'Those orders must be signed and released before they can be linked to this item.'; 
2296    TC_NO_RECURRING_MEALS = 'Unable to order ' ;
2297  begin
2298    MealList.Clear;
2299    GetCurrentRecurringOPMeals(MealList, MealType);
2300    if MealList.Count = 0 then
2301      begin
2302        InfoBox(TX_NO_RECURRING_MEALS, TC_NO_RECURRING_MEALS + nbkDiet.ActivePage.Caption, MB_OK);
2303        Result := False;
2304      end
2305    else
2306      Result := True;
2307  end;
2308  
2309  end.

Module Calls (2 levels)


fODDiet
 ├fODBase
 │ ├fAutoSz
 │ ├uConst
 │ ├rOrders
 │ ├rODBase
 │ ├uCore
 │ ├UBAGlobals
 │ ├UBACore
 │ ├fOCAccept
 │ ├uODBase
 │ ├rCore
 │ ├rMisc
 │ ├fTemplateDialog
 │ ├uEventHooks
 │ ├uTemplates
 │ ├rConsults
 │ ├fOrders
 │ ├uOrders
 │ ├fFrame
 │ ├fODDietLT
 │ └rODDiet
 ├uConst
 ├uCore...
 ├rODBase...
 ├rODDiet...
 ├rCore...
 ├rOrders...
 ├fODDietLT...
 └uODBase...

Module Called-By (2 levels)


                     fODDiet
                   uOrders┘ 
                   uCore┤   
                 fODBase┤   
                 rODBase┤   
                  fFrame┤   
                 fOrders┤   
             fOrdersSign┤   
                   fMeds┤   
               fARTAllgy┤   
                  fNotes┤   
               fConsults┤   
         fReminderDialog┤   
                 fReview┤   
            fOrdersRenew┤   
               fOrdersCV┤   
                 fODMeds┤   
                 fOMNavA┤   
         fOrderSaveQuick┤   
                  fOMSet┤   
          fOrdersRelease┤   
                 fOMHTML┤   
               fODMedNVA┤   
fODChangeUnreleasedRenew┤   
          fOrdersOnChart┤   
         fODReleaseEvent┤   
               fODActive┘