Ignore:
Timestamp:
Jul 6, 2008, 8:20:14 PM (16 years ago)
Author:
Kevin Toppenberg
Message:

Uploading from OR_30_258

File:
1 edited

Legend:

Unmodified
Added
Removed

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODDiet.pas

    r459 r460  
    9696    cmdOPRemove: TButton;
    9797    chkOPCancelTubefeeding: TCheckBox;
     98    calOPTFStart: TORDateBox;
     99    lblOPTFStart: TLabel;
     100    lblOPAOStart: TLabel;
     101    calOPAOStart: TORDateBox;
     102    cboOPAORecurringMeals: TORComboBox;
     103    cboOPTFRecurringMeals: TORComboBox;
     104    cboOPELRecurringMeals: TORComboBox;
    98105    procedure nbkDietChanging(Sender: TObject;
    99106      var AllowChange: Boolean);
    … …  
    137144    procedure FormKeyDown(Sender: TObject; var Key: Word;
    138145      Shift: TShiftState);
    139    //  Outpatient meal additions
    140     procedure cboOPDietAvailNeedData(Sender: TObject;
    141       const StartFrom: String; Direction, InsertAt: Integer);
    142146    procedure cboOPDietAvailMouseClick(Sender: TObject);
    143147    procedure cboOPDietAvailExit(Sender: TObject);
    … …  
    149153    procedure grpOPMealClick(Sender: TObject);
    150154    procedure cmdOPRemoveClick(Sender: TObject);
     155    procedure cboOPDietAvailKeyDown(Sender: TObject; var Key: Word;
     156      Shift: TShiftState);
    151157  private
    152158    FNextCol: Integer;
    … …  
    177183    function TFStrengthCode(const x: string): Integer;
    178184   //  Outpatient meal additions
     185    function  FMDOW(AnFMDate: TFMDateTime): integer;
     186    function  FMDays(AStart, AEnd: TFMDateTime): string;
    179187    function  GetOPDaysOfWeek: string;
    180     procedure SetEnableOPDOW(AllowUse: Boolean);
     188    procedure SetEnableOPDOW(AllowUse: Boolean; OneTimeDay: integer; DaysToCheck: string = '');
    181189    procedure ResetControlsOP;
    182190    procedure SetValuesFromResponsesOP;
    … …  
    184192    procedure OPDietCheckForNPO;
    185193    procedure OPDietCheckForTF;
     194    function PatientHasRecurringMeals(var MealList: TStringList; MealType: string = ''): boolean;
    186195  protected
    187196    procedure InitDialog; override;
    … …  
    195204  uDialogName: string;
    196205  uFHAUTH: boolean;
     206  uRecurringMealList: TStringList;
    197207
    198208implementation
    … …  
    200210{$R *.DFM}
    201211
    202 uses uCore, rODBase, rODDiet, rCore, rOrders, fODDietLT, uAccessibleStringGrid;
     212uses uCore, rODBase, rODDiet, rCore, rOrders, fODDietLT, uAccessibleStringGrid, DateUtils;
    203213
    204214const
    … …  
    209219  TX_DIET_PRC = 'This diet conflicts with ';
    210220  TC_DIET_ERR = 'Unable to Add Diet';
    211   TX_INPT_ONLY = 'Diets may be entered for inpatients only.';
    212   //TX_INPT_ONLY = 'This type of diet may be entered for inpatients only.';
     221  TX_INPT_ONLY = 'This type of diet may be entered for inpatients only.';
    213222  TC_INPT_ONLY = 'Ordering Restriction';
    214223  TX_CANCEL_TF = 'Cancel the current tubefeeding order?' + CRLF + CRLF;
    … …  
    221230  TX_TFQTY  = 'A quantity must be entered for ';
    222231  TX_TFAMT  = 'The quantity is invalid for ';
    223   TX_TF5000 = 'The total quantity ordered may not exceed 5000cc.';
     232  TX_TF5000 = 'The total quantity ordered may not exceed 5000ml.';
    224233  TX_HLPQTY = CRLF + 'The following may be entered for quantity:' + CRLF +
    225               '  Units may be K for Kcals, C for cc''s, O for oz. or U for units (e.g. cans).' + CRLF +
     234              '  Units may be K for Kcals, C for cc''s, M for ml, O for oz. or U for units (e.g. cans).' + CRLF +
    226235              '  Frequency may be DAY, HOUR, QD, QH, BID, TID, QID, Q2H, Q3H, Q4H, or Q6H.' + CRLF +
    227236              '  May also input 100CC/HR X 16 for 16 hours.  Valid quantity for powder form' + CRLF +
    … …  
    242251  TX_AONONE      = 'Text for additional order has not been entered.';
    243252  TX_ACCEPT      = 'Accept the following order?' + CRLF + CRLF;
     253  TX_CONTINUE    = 'Continue editing the following order?' + CRLF + CRLF;
     254  TX_DISCARD     = CRLF + CRLF + 'Answering NO will discard all changes.';
    244255  TC_ACCEPT      = 'Unsaved Order';
    245256  TX_EL_SAVE_ERR    = 'An error occurred while saving this late tray order.';
    … …  
    274285                    'coordinator enters times for E/L trays for this location.';
    275286  TC_NO_PARAMS    = 'Unable to Order Early/Late Tray';
     287  TX_NOSTART   = 'A valid start date must be entered.';
     288  TC_NOSTART   = 'Start date required';
     289  TX_NOT_THIS_LOC = 'This location has not been configured to' + CRLF +
     290                    'allow ordering of meals for outpatients.' + CRLF + CRLF +
     291                    'Please contact your IRM diet package coordinator.';
     292  TC_NOT_THIS_LOC = 'Unable to order from this location';
     293  TX_NO_OUTPT_ORDERS = 'Diet orders may only be entered for inpatients.';
     294  TC_NO_OUTPT_ORDERS = 'Ordering Restriction';
     295  TX_NO_MEALS_DEFINED = 'No diet types have been defined to be orderable for outpatients.' + CRLF + CRLF +
     296                        'Please contact your IRM diet package coordinator.';
     297  TC_NO_MEALS_DEFINED = 'Unable to order outpatient meals';
     298
     299  FMDayLetters: array[1..7] of string[1] = ('M', 'T', 'W', 'R', 'F', 'S', 'X');
    276300
    277301type
    … …  
    290314begin
    291315  inherited;
     316  AbortOrder := False;
     317  uRecurringMealList := TStringList.Create;
    292318  if OrderForInpatient then
    293319    begin
    … …  
    302328  else                                         // this block will go away after FH patch installed everywhere
    303329    begin
    304       InfoBox(TX_INPT_ONLY, TC_INPT_ONLY, MB_OK);
    305       Close;
     330      InfoBox(TX_NO_OUTPT_ORDERS, TC_NO_OUTPT_ORDERS, MB_OK);
     331      AbortOrder := True;
    306332      Exit;
    307333    end;
    … …  
    313339  if StrToIntDef(ALocation, 0) < 1 then
    314340    ALocation := IntToStr(Encounter.Location);
    315   LoadDietParams(uDietParams, ALocation);
    316   if pgeOutPt.TabVisible then
    317     with uDietParams, cboOPDelivery do
    318     begin
    319       if Tray      then Items.Add('T^Tray');
    320       if Cafeteria then Items.Add('C^Cafeteria');
    321       if DiningRm  then Items.Add('D^Dining Room');
    322       //if Bagged    then Items.Add('B^Bagged');  // ????
    323       ItemIndex := 0;
    324       chkBagged.Visible := uDietParams.Bagged;    // ????
     341  if (not OrderForInpatient) and OutpatientPatchInstalled and (not OutpatientLocationConfigured(ALocation)) then
     342    begin
     343      InfoBox(TX_NOT_THIS_LOC, TC_NOT_THIS_LOC, MB_OK or MB_ICONINFORMATION);
     344      AbortOrder := True;
    325345    end
    326346  else
    327     with uDietParams, cboDelivery do
    328     begin
    329       if Tray      then Items.Add('T^Tray');
    330       if Cafeteria then Items.Add('C^Cafeteria');
    331       if DiningRm  then Items.Add('D^Dining Room');
    332       ItemIndex := 0;
    333       chkBagged.Visible := uDietParams.Bagged;
     347    begin
     348      LoadDietParams(uDietParams, ALocation);
     349      if pgeOutPt.TabVisible then
     350        with uDietParams, cboOPDelivery do
     351        begin
     352          if Tray      then Items.Add('T^Tray');
     353          if Cafeteria then Items.Add('C^Cafeteria');
     354          if DiningRm  then Items.Add('D^Dining Room');
     355          ItemIndex := 0;
     356          chkBagged.Visible := uDietParams.Bagged;
     357        end
     358      else
     359        with uDietParams, cboDelivery do
     360        begin
     361          if Tray      then Items.Add('T^Tray');
     362          if Cafeteria then Items.Add('C^Cafeteria');
     363          if DiningRm  then Items.Add('D^Dining Room');
     364          ItemIndex := 0;
     365          chkBagged.Visible := uDietParams.Bagged;
     366        end;
    334367    end;
    335368  TAccessibleStringGrid.WrapControl(grdSelected);
    … …  
    340373  TAccessibleStringGrid.UnwrapControl(grdSelected);
    341374  TFClearGrid;
     375  uRecurringMealList.Free;
    342376  inherited;
    343377end;
    … …  
    350384    ColWidths[1] := Canvas.TextWidth('XFULLX') + GetSystemMetrics(SM_CXVSCROLL);
    351385    ColWidths[2] := Canvas.TextWidth('100 GRAMS/HOUR X 24');
    352     ColWidths[3] := Canvas.TextWidth('55000cc');
     386    ColWidths[3] := Canvas.TextWidth('55000ml');
    353387    ColWidths[0] := ClientWidth - ColWidths[1] - ColWidths[2] - ColWidths[3] - 3;
    354388    lblTFStrength.Left := Left + ColWidths[0] + 3;
    … …  
    368402procedure TfrmODDiet.SetupDialog(OrderAction: Integer; const ID: string);
    369403begin
     404  if AbortOrder then exit;
    370405  inherited;
    371406  uDialogName := ExternalName(DialogIEN, 101.41);
    … …  
    396431       end;
    397432  'T': begin
     433         if (not OrderForInpatient) and (not PatientHasRecurringMeals(uRecurringMealList)) then
     434         begin
     435           Close;
     436           Exit;
     437         end;
    398438         nbkDiet.ActivePage := pgeTubefeeding;
    399439         nbkDietChange(Self);
    … …  
    401441       end;
    402442  'E': begin
     443         if (not OrderForInpatient) and (not PatientHasRecurringMeals(uRecurringMealList)) then
     444         begin
     445           Close;
     446           Exit;
     447         end;
    403448         nbkDiet.ActivePage := pgeEarlyLate;
    404449         nbkDietChange(Self);
    … …  
    411456       end;
    412457  'A': begin
     458         if (not OrderForInpatient) and (not PatientHasRecurringMeals(uRecurringMealList)) then
     459         begin
     460           Close;
     461           Exit;
     462         end;
    413463         nbkDiet.ActivePage := pgeAdditional;
    414464         nbkDietChange(Self);
    … …  
    442492        nbkDietChange(Self);
    443493        if OrderAction <> ORDER_NEW then SetValuesFromResponsesDO;
     494        ActiveControl := cboOPDietAvail;
    444495      end;
    445496  end;
    … …  
    517568    end;
    518569    if Sum > 5000 then SetError(TX_TF5000);
     570    if not OrderForInpatient then
     571      if not calOPTFStart.IsValid      then SetError(TX_BAD_START);
    519572  end;
    520573  if nbkDiet.ActivePage = pgeEarlyLate then
    521574  begin
    522575    if grpMeal.ItemIndex = 3                                   then SetError(TX_ELMEAL);
    523     if GetMealTime = ''                                        then SetError(TX_ELTIME);
    524576    if not calELStart.IsValid                                  then SetError(TX_ELNOSTART);
    525     if not calELStop.IsValid                                   then SetError(TX_ELNOSTOP);
    526577    if calELStart.FMDateTime < FMToday                         then SetError(TX_ELSTARTLT);
    527     if calELStop.FMDateTime < FMToday                          then SetError(TX_ELSTOPLT);
    528     if calELStop.FMDateTime < calELStart.FMDateTime            then SetError(TX_ELSTOPSTART);
    529578    if calELStart.FMDateTime > FMDateTimeOffsetBy(FMToday, 30) then SetError(TX_ELSTART30);
    530     if calELStop.FMDateTime > FMDateTimeOffsetBy(FMToday, 30)  then SetError(TX_ELSTOP30);
     579    if OrderForInpatient then
     580    begin
     581      if GetMealTime = ''                                        then SetError(TX_ELTIME);
     582      if not calELStop.IsValid                                   then SetError(TX_ELNOSTOP);
     583      if calELStop.FMDateTime < FMToday                          then SetError(TX_ELSTOPLT);
     584      if calELStop.FMDateTime < calELStart.FMDateTime            then SetError(TX_ELSTOPSTART);
     585      if calELStop.FMDateTime > FMDateTimeOffsetBy(FMToday, 30)  then SetError(TX_ELSTOP30);
     586    end;
    531587    if grpDOW.Enabled and (GetDaysOfWeek = '')                 then SetError(TX_ELDOW);
    532588    if MealTimePassed                                          then SetError(TX_ELPAST);
    … …  
    539595  begin
    540596    if not ContainsVisibleChar(txtAOComment.Text)              then SetError(TX_AONONE);
    541   end;
    542 { TODO -oRich V. -cOutpatient Meals : Add any required Outpatient Meals validation code here }
     597    if not OrderForInpatient then
     598      if not calOPAOStart.IsValid                              then SetError(TX_BAD_START);
     599  end;
    543600  if nbkDiet.ActivePage = pgeOutPt then
    544601  begin
    … …  
    580637  FTabChanging := True;
    581638  if Length(memOrder.Text) > 0 then
    582     if InfoBox(TX_ACCEPT + memOrder.Text, TC_ACCEPT, MB_YESNO) = ID_YES then
    583     begin
    584       cmdAcceptClick(Self);
    585       AllowChange := AcceptOK;
    586     end else
    587     begin
    588       memOrder.Text := '';
    589       memOrder.Lines.Clear;
    590       Responses.Clear;
     639    begin
     640      if nbkDiet.ActivePage = pgeOutpt then
     641        begin
     642          if InfoBox(TX_CONTINUE + memOrder.Text + TX_DISCARD, TC_ACCEPT, MB_YESNO) = ID_YES then
     643            begin
     644              AllowChange := FALSE;
     645            end else
     646            begin
     647              memOrder.Text := '';
     648              memOrder.Lines.Clear;
     649              Responses.Clear;
     650            end;
     651        end
     652      else
     653        begin
     654          if InfoBox(TX_ACCEPT + memOrder.Text, TC_ACCEPT, MB_YESNO) = ID_YES then
     655            begin
     656              cmdAcceptClick(Self);
     657              AllowChange := AcceptOK;
     658            end else
     659            begin
     660              memOrder.Text := '';
     661              memOrder.Lines.Clear;
     662              Responses.Clear;
     663            end;
     664        end
    591665    end;
    592666  FTabChanging := False;
    … …  
    594668
    595669procedure TfrmODDiet.nbkDietChange(Sender: TObject);
     670var
     671  x, CxMsg: string ;
     672  i: integer;
     673  AStringList: TStringList;
     674const
     675//  TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet:' + CRLF + CRLF;
     676  TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet now unless' + CRLF +
     677              'you specify a start date for when the new diet should replace the current' + CRLF +
     678              'diet:' + CRLF + CRLF;
     679  TX_CX_FUT = 'A new diet order with no expiration date will CANCEL and REPLACE these diets:' + CRLF + CRLF;
    596680begin
    597681  inherited;
    598682  // much of the logic here can be eliminated if ClearDialogControls starts clearing containers
     683  if AbortOrder then
     684  begin
     685    cmdQuitClick(Self);
     686    exit;
     687  end;
    599688  StatusText('Loading Dialog Definition');
    600689  if Sender <> Self then Responses.Clear;
    … …  
    603692  begin
    604693    AllowQuickOrder := True;
    605     OrderMessage(CurrentDietText);
     694    x := CurrentDietText;
     695    if Piece(x, #13, 1) <> 'Current Diet:  ' then
     696    begin
     697      AStringList := TStringList.Create;
     698      try
     699        AStringList.Text := x;
     700        CxMsg := TX_CX_CUR + #9 + Piece(AStringList[0], ':', 1) + ':' + CRLF + CRLF
     701                 + #9 + Copy(AStringList[0], 16, 99) + CRLF;
     702        if AStringList.Count > 1 then
     703        begin
     704          CxMsg := CxMsg + CRLF + CRLF +
     705                   TX_CX_FUT + #9 + Piece(AStringList[1], ':', 1) + ':' + CRLF + CRLF
     706                   + #9 + Copy(AStringList[1], 22, 99) + CRLF;
     707          if AStringList.Count > 2 then
     708          for i := 2 to AStringList.Count - 1 do
     709            CxMsg := CxMsg + #9 + TrimLeft(AStringList[i]) + CRLF;
     710        end;
     711      finally
     712        AStringList.Free;
     713      end;
     714    end;
     715    if CxMsg <> '' then
     716    begin
     717      if InfoBox(CxMsg + CRLF +
     718                'Are you sure?', 'Confirm', MB_ICONWARNING or MB_YESNO) = ID_NO then
     719      begin
     720        AbortOrder := True;
     721        cmdQuitClick(Self);
     722        exit;
     723      end;
     724    end;
     725    OrderMessage(x);
    606726    Responses.Dialog := 'FHW1';                            // Diet Order
    607727    DisplayGroup := DisplayGroupForDialog('FHW1');
    … …  
    615735  if nbkDiet.ActivePage = pgeTubefeeding then
    616736  begin
    617 { TODO -oRich V. -cOutpatient Meals : Prompt for which recurring meal(s) to apply this order against }
    618737    if not OrderForInpatient then
    619738    begin
    620       // get list of existing OP recurring meals
    621       // if none, then exit with message
    622       // if some, display and allow selection of multiple dates/times
    623       // set different dialog/display group?
    624     end;
     739      if not PatientHasRecurringMeals(uRecurringMealList) then
     740        begin
     741          Changing := False;
     742          nbkDiet.ActivePage := pgeOutPt;
     743          nbkDietChange(nbkDiet);
     744          Exit;
     745          end
     746        else
     747          cboOPTFRecurringMeals.Items.Assign(uRecurringMealList);
     748    end;
     749    cboOPTFRecurringMeals.Visible := not OrderForInpatient;
     750    calOPTFStart.Visible := False;
     751    lblOPTFStart.Visible := not OrderForInpatient;
    625752    AllowQuickOrder := True;
    626753    if Length(uDietParams.CurTF) > 0
    … …  
    644771  if nbkDiet.ActivePage = pgeEarlyLate then
    645772  begin
    646 { TODO -oRich V. -cOutpatient Meals : Prompt for which recurring meal to apply this order against }
    647773    if not OrderForInpatient then
    648     begin
    649       // get list of existing OP recurring meals
    650       // if none, then exit with message
    651       // if some, display and allow selection of one and only one
    652       // set different dialog/display group?
    653     end
     774      begin
     775        if not PatientHasRecurringMeals(uRecurringMealList) then
     776          begin
     777            Changing := False;
     778            nbkDiet.ActivePage := pgeOutPt;
     779            nbkDietChange(nbkDiet);
     780            Exit;
     781          end
     782        else
     783          cboOPELRecurringMeals.Items.Assign(uRecurringMealList);
     784      end
    654785    else if (StrToIntDef(uDietParams.EarlyIEN, 0) = 0) or (StrToIntDef(uDietParams.LateIEN, 0) = 0) then
    655     begin
    656       InfoBox(TX_NO_PARAMS, TC_NO_PARAMS, MB_ICONERROR or MB_OK);
    657       if pgeEarlyLate <> nil then
    658         nbkDiet.SelectNextPage(False);
    659       Exit;
    660     end;
     786      begin
     787        InfoBox(TX_NO_PARAMS, TC_NO_PARAMS, MB_ICONERROR or MB_OK);
     788        if pgeEarlyLate <> nil then
     789          nbkDiet.SelectNextPage(False);
     790        Changing := False;
     791        Exit;
     792      end;
     793    cboOPELRecurringMeals.Visible := not OrderForInpatient;
     794    cboOPELRecurringMeals.TabStop := not OrderForInpatient;
     795    calELStart.Visible := OrderForInpatient;
     796    calELStart.TabStop := OrderForInpatient;
     797    calELStop.Visible := OrderForInpatient;
     798    lblELStop.Visible := OrderForInpatient;
     799    grpDOW.Visible := OrderForInpatient;
     800    grpDOW.Enabled := OrderForInpatient;
    661801    AllowQuickOrder := False;
    662802    OrderMessage('');
    … …  
    678818  if nbkDiet.ActivePage = pgeAdditional then
    679819  begin
    680 { TODO -oRich V. -cOutpatient Meals : Prompt for which recurring meal(s) to apply this order against }
    681     if not OrderForInpatient then
    682     begin
    683       // get list of existing OP recurring meals
    684       // if none, then exit with message
    685       // if some, display and allow selection of multiple dates/times
    686       // set different dialog/display group?
    687     end;
     820  if not OrderForInpatient then
     821    begin
     822      if not PatientHasRecurringMeals(uRecurringMealList) then
     823        begin
     824          Changing := False;
     825          nbkDiet.ActivePage := pgeOutPt;
     826          nbkDietChange(nbkDiet);
     827          Exit;
     828        end
     829      else
     830        cboOPAORecurringMeals.Items.Assign(uRecurringMealList);
     831    end;
     832    cboOPAORecurringMeals.Visible := not OrderForInpatient;
     833    calOPAOStart.Visible := False;  //not OrderForInpatient;
     834    lblOPAOStart.Visible := not OrderForInpatient;
    688835    AllowQuickOrder := False;
    689836    OrderMessage('');
    … …  
    694841  if nbkDiet.ActivePage = pgeOutPt then
    695842  begin
    696     OrderMessage(CurrentDietText);
     843    x := CurrentDietText;
     844    if Length(Piece(x, #$D, 1)) > Length('Current Diet:  ') then
     845      OrderMessage(x)
     846    else
     847      OrderMessage('');
     848    if (uDialogName <> 'FHW SPECIAL MEAL') and (uDialogName <> 'FHW OP MEAL') then
     849      uDialogName := 'FHW OP MEAL';
    697850    Responses.Dialog := uDialogName;
    698851    DisplayGroup := DisplayGroupForDialog(uDialogName);
    699     if uDialogName = 'FHW OP MEAL' then                          // Recurring meal
    700       begin
    701        AllowQuickOrder := True;
    702        ResetControlsOP;
    703        LoadDietQuickList(cboOPDietAvail.Items, 'MEAL');              // use D.G. short name here
    704        cboOPDietAvail.InsertSeparator;
    705        cboOPDietAvail.InitLongList('');
    706        { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
    707        chkOPCancelTubefeeding.State := cbGrayed;
    708        chkOPCancelTubefeeding.Visible := False;
    709        grpOPMeal.Caption := 'Recurring Meal';
    710        SetEnableOPDOW(False);
    711       end
    712     else if uDialogName = 'FHW SPECIAL MEAL' then                 // Special meal
     852    if uDialogName = 'FHW SPECIAL MEAL' then                 // Special meal
    713853      begin
    714854       AllowQuickOrder := False;
    715855       ResetControlsOP;
    716        cboOPDietAvail.InitLongList('');
     856       cboOPDietAvail.Items.AddStrings(SubsetOfOPDiets);
    717857       { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
    718858       chkOPCancelTubefeeding.State := cbGrayed;
    … …  
    723863       pgeAdditional.TabVisible := False;
    724864       pgeEarlyLate.TabVisible := False;
    725        cboOPDietAvail.SelectByIEN(uDietParams.RegIEN);
     865       cboOPDietAvail.SelectByIEN(uDietParams.OPDefaultDiet);
    726866       cboOPDietAvailMouseClick(Self);
     867       Changing := False;
     868      end
     869    else if uDialogName = 'FHW OP MEAL' then                          // Recurring meal
     870      begin
     871       AllowQuickOrder := True;
     872       ResetControlsOP;
     873       LoadDietQuickList(cboOPDietAvail.Items, 'MEAL');              // use D.G. short name here
     874       cboOPDietAvail.InsertSeparator;
     875       cboOPDietAvail.Items.AddStrings(SubsetOfOPDiets);
     876       cboOPDietAvail.SelectByIEN(uDietParams.OPDefaultDiet);
     877       { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
     878       chkOPCancelTubefeeding.State := cbGrayed;
     879       chkOPCancelTubefeeding.Visible := False;
     880       grpOPMeal.Caption := 'Recurring Meal';
     881       SetEnableOPDOW(False, -1);
     882       cboOPDietAvailMouseClick(Self);
     883       Changing := False;
    727884      end;
    728885  end;
    … …  
    802959          InfoBox(Piece(ADiet,'^',2), TC_DIET_ERR, MB_OK);
    803960          cboDietAvail.ItemIndex := -1;
     961          Changing := False;
    804962          Exit;
    805963        end;
    … …  
    9351093  TFClearGrid;
    9361094  chkCancelTrays.Checked := False;
     1095  calOPTFStart.Text := '';
    9371096  txtTFComment.Text := '';
    9381097end;
    … …  
    9731132    AResponse := FindResponseByName('CANCEL', 1);
    9741133    if AResponse <> nil then chkCancelTrays.Checked := AResponse.IValue = '1';
     1134    if not OrderForInpatient then
     1135    begin
     1136      SetControl(cboOPTFRecurringMeals, 'DATETIME', 1);
     1137      SetControl(calOPTFStart, 'DATETIME', 1);
     1138    end;
    9751139    SetControl(txtTFComment, 'COMMENT',  1);
    9761140  end;
    … …  
    11141278    begin
    11151279      grdSelected.Cells[2, ARow] := Piece(x, U, 2);
    1116       grdSelected.Cells[3, ARow] := Piece(x, U, 1) + 'cc';
     1280      grdSelected.Cells[3, ARow] := Piece(x, U, 1) + 'ml';
    11171281    end
    11181282    else grdSelected.Cells[3, ARow] := '';
    … …  
    12681432    then Responses.Update('CANCEL', 1, '1', 'Yes')
    12691433    else Responses.Update('CANCEL', 1, '0', 'No');
     1434  if not OrderForInpatient then
     1435  begin
     1436    calOPTFStart.FMDateTime := StrToFloatDef(cboOPTFRecurringMeals.ItemID, 0);
     1437    Responses.Update('DATETIME', 1, FloatToStr(calOPTFStart.FMDateTime), calOPTFStart.Text);
     1438  end;
    12701439  memOrder.Text := Responses.OrderText;
    12711440end;
    … …  
    13231492      if radLT3.Caption = AResponse.IValue then radLT3.Checked := True;
    13241493    end;
    1325     SetControl(calELStart, 'START', 1);
    1326     SetControl(calELStop,  'STOP',  1);
     1494    if not OrderForInpatient then
     1495      SetControl(cboOPELRecurringMeals, 'START', 1)
     1496    else
     1497    begin
     1498      SetControl(calELStart, 'START', 1);
     1499      SetControl(calELStop,  'STOP',  1);
     1500    end;
    13271501    calELStopChange(Self);
    13281502    AResponse := FindResponseByName('SCHEDULE', 1);
    … …  
    14031577    lblNoTimes.Visible := not HasTimes;
    14041578  end;
    1405 
    1406 begin
    1407   inherited;
     1579var
     1580  AMeal: string;
     1581begin
     1582  inherited;
     1583  Changing := True;
    14081584  case grpMeal.ItemIndex of
    1409     0: SetMealTimes(uDietParams.BTimes);
    1410     1: SetMealTimes(uDietParams.NTimes);
    1411     2: SetMealTimes(uDietParams.ETimes);
    1412   else SetMealTimes('');
    1413   end;
     1585    0: begin
     1586         SetMealTimes(uDietParams.BTimes);
     1587         AMeal := 'B';
     1588       end;
     1589    1: begin
     1590         SetMealTimes(uDietParams.NTimes);
     1591         AMeal := 'N';
     1592       end;
     1593    2: begin
     1594         SetMealTimes(uDietParams.ETimes);
     1595         AMeal := 'E';
     1596       end;
     1597  else
     1598    begin
     1599      SetMealTimes('');
     1600      AMeal := '';
     1601    end;
     1602  end;
     1603  if not OrderForInpatient then
     1604    begin
     1605      if AMeal = '' then
     1606      begin
     1607        uRecurringMealList.Clear;
     1608        cboOPELRecurringMeals.Clear;
     1609      end
     1610      else if not PatientHasRecurringMeals(uRecurringMealList, AMeal) then
     1611        begin
     1612          uRecurringMealList.Clear;
     1613          cboOPELRecurringMeals.Clear;
     1614          grpMeal.ItemIndex := 3;
     1615        end
     1616      else
     1617        cboOPELRecurringMeals.Items.Assign(uRecurringMealList);
     1618    end;
     1619  Changing := False;
     1620  ELChange(grpMeal);
    14141621end;
    14151622
    … …  
    14451652begin
    14461653  inherited;
    1447   if (Length(calELStop.Text) > 0) and (calELStop.Text = calELStart.Text)
     1654  if not OrderForInpatient then SetEnableDOW(False)
     1655  else if (Length(calELStop.Text) > 0) and (calELStop.Text = calELStart.Text)
    14481656    then SetEnableDOW(False)
    14491657    else SetEnableDOW(True);
    … …  
    14781686      then Responses.Update('ORDERABLE', 1, uDietParams.EarlyIEN, 'EARLY TRAY')
    14791687      else Responses.Update('ORDERABLE', 1, uDietParams.LateIEN,  'LATE TRAY');
     1688  end;
     1689  if not OrderForInpatient then
     1690  begin
     1691    calELStart.FMDateTime := StrToFloatDef(cboOPELRecurringMeals.ItemID, 0);
     1692    calELStop.FMDateTime := calELStart.FMDateTime;
    14801693  end;
    14811694  with calELStart   do if Length(Text) > 0 then Responses.Update('START',     1, Text,   Text);
    … …  
    15251738begin
    15261739  txtAOComment.Text := '';
     1740  calOPAOStart.Text := '';
    15271741end;
    15281742
    … …  
    15321746  ResetControlsAO;
    15331747  Responses.SetControl(txtAOComment, 'COMMENT', 1);
     1748  //Responses.SetControl(calOPAOStart, 'DATETIME', 1);
     1749  Responses.SetControl(cboOPAORecurringMeals, 'DATETIME', 1);
    15341750  Changing := False;
    15351751  AOChange(Self);
    … …  
    15421758  with txtAOComment do if Text <> ''
    15431759    then Responses.Update('COMMENT', 1, Text, Text);
     1760  if not OrderForInpatient then
     1761    begin
     1762      calOPAOStart.FMDateTime := StrToFloatDef(cboOPAORecurringMeals.ItemID, 0);
     1763      Responses.Update('DATETIME', 1, FloatToStr(calOPAOStart.FMDateTime), calOPAOStart.Text);
     1764    end;
    15441765  memOrder.Text := Responses.OrderText;
    15451766end;
    15461767
     1768
    15471769{ Outpatient Meals Order tab ----------------------------------------------------------------- }
    1548 
    1549 procedure TfrmODDiet.cboOPDietAvailNeedData(Sender: TObject; const StartFrom: string;
    1550   Direction, InsertAt: Integer);
    1551 begin
    1552   inherited;
    1553   cboOPDietAvail.ForDataUse(SubsetOfOPDiets(StartFrom, Direction));
    1554 end;
    15551770
    15561771procedure TfrmODDiet.cboOPDietAvailMouseClick(Sender: TObject);
    … …  
    15661781begin
    15671782  inherited;
     1783  if cboOPDietAvail.Items.Count = 0 then
     1784    begin
     1785      InfoBox(TX_NO_MEALS_DEFINED, TC_NO_MEALS_DEFINED, MB_OK or MB_ICONINFORMATION);
     1786      AbortOrder := True;
     1787      exit;
     1788    end  ;
    15681789  if CharAt(cboOPDietAvail.ItemID, 1) = 'Q' then              // setup quick order
    15691790  begin
    … …  
    15921813    OPChange(Sender);
    15931814  end; {if cboOPDietAvail}
     1815  OPChange(Sender);
    15941816  cboOPDietAvail.ItemIndex := -1;
    1595   OPChange(Sender);
    15961817end;
    15971818
    … …  
    16431864procedure TfrmODDiet.SetValuesFromResponsesOP;
    16441865var
    1645   //AnInstance: Integer;
    16461866  AResponse: TResponse;
    16471867  ADiet: string;
    … …  
    16511871  with Responses do
    16521872  begin
    1653 (*    AnInstance := NextInstance('ORDERABLE', 0);
    1654     while AnInstance > 0 do
    1655     begin
    1656       AResponse := FindResponseByName('ORDERABLE', AnInstance);
    1657       if AResponse <> nil then
    1658       begin
    1659         ADiet := DietAttributes(StrToIntDef(AResponse.IValue,0));
    1660         if Piece(ADiet,'^',1)='0' then
    1661         begin
    1662           InfoBox(Piece(ADiet,'^',2), TC_OP_DIET_ERR, MB_OK);
    1663           cboOPDietAvail.ItemIndex := -1;
    1664           Exit;
    1665         end;
    1666         lstOPDietSelect.Items.Add(ADiet);
    1667       end;
    1668       AnInstance := NextInstance('ORDERABLE', AnInstance);
    1669     end; {while AnInstance - ORDERABLE}*)
    1670 
    16711873    AResponse := FindResponseByName('ORDERABLE', 1);
    16721874    if AResponse <> nil then
    … …  
    16771879        InfoBox(Piece(ADiet,'^',2), TC_OP_DIET_ERR, MB_OK);
    16781880        cboOPDietAvail.ItemIndex := -1;
     1881        Changing := False;
    16791882        Exit;
    16801883      end;
    … …  
    17211924begin
    17221925  inherited;
     1926  if Changing then exit;
    17231927  if FChangeStop then
    17241928    calOPStop.Text := calOPStart.Text
    … …  
    17271931end;
    17281932
     1933function TfrmODDiet.FMDOW(AnFMDate: TFMDateTime): integer;
     1934var
     1935  WinDate: TDateTime;
     1936  x: integer;
     1937begin
     1938  WinDate := FMDateTimeToDateTime(AnFMDate);
     1939  x := DayOfTheWeek(WinDate);
     1940  Result := x;
     1941end;
     1942
     1943function TfrmODDiet.FMDays(AStart, AEnd: TFMDateTime): string;
     1944var
     1945  AWinStart, AWinEnd: TDateTime;
     1946  i: double;
     1947  Days: string;
     1948begin
     1949  AWinStart := FMDateTimeToDateTime(AStart);
     1950  AWinEnd := FMDateTimeToDateTime(AEnd);
     1951  i := AWinStart;
     1952  repeat
     1953    Days := Days + FMDayLetters[DayOfTheWeek(i)];
     1954    i := i + 1;
     1955  until i > AWinEnd;
     1956  Result := Days;
     1957end;
     1958
    17291959procedure TfrmODDiet.calOPStartExit(Sender: TObject);
    1730 begin
    1731   inherited;
    1732   if (Length(calOPStop.Text) > 0) and (calOPStop.Text = calOPStart.Text)
    1733     then SetEnableOPDOW(False)
    1734     else SetEnableOPDOW(True);
     1960var
     1961  Days: string;
     1962begin
     1963  inherited;
     1964  if not (calOPStart.FMDateTime > 0) then
     1965  begin
     1966    SetEnableOPDOW(False, -1);
     1967    Exit ;
     1968  end;
     1969  if (Length(calOPStop.Text) > 0) and (calOPStop.Text = calOPStart.Text) then
     1970    SetEnableOPDOW(False, FMDOW(calOPStart.FMDateTime))
     1971  else
     1972  begin
     1973    Days := FMDays(calOPStart.FMDateTime, calOPStop.FMDateTime);
     1974    SetEnableOPDOW(True, -1, Days);
     1975  end;
    17351976end;
    17361977
    17371978procedure TfrmODDiet.calOPStopChange(Sender: TObject);
    1738 begin
    1739   inherited;
    1740   if (Length(calOPStop.Text) > 0) and (calOPStop.FMDateTime = calOPStart.FMDateTime)
    1741     then SetEnableOPDOW(False)
    1742     else SetEnableOPDOW(True);
     1979var
     1980  Days: string;
     1981begin
     1982  inherited;
     1983  if Changing then exit;
     1984  if not (calOPStop.FMDateTime > 0) then
     1985  begin
     1986    SetEnableOPDOW(False, -1);
     1987    Exit ;
     1988  end;
     1989  if (Length(calOPStop.Text) > 0) and (calOPStop.FMDateTime = calOPStart.FMDateTime) then
     1990    SetEnableOPDOW(False, FMDOW(calOPStart.FMDateTime))
     1991  else
     1992  begin
     1993    Days := FMDays(calOPStart.FMDateTime, calOPStop.FMDateTime);
     1994    SetEnableOPDOW(True, -1, Days);
     1995  end;
    17431996  OPChange(Sender);
    17441997end;
    … …  
    17522005  if Changing then Exit;
    17532006  if Sender <> Self then Responses.Clear;       // Sender=Self when called from SetupDialog
    1754   // Per NFS, only one selection allowed from any of 5 available OP diets
     2007  // Per NFS, only one selection allowed from any of 10-15 available OP diets
    17552008  with lstOPDietSelect do if Items.Count > 0 then
    17562009    Responses.Update('ORDERABLE', 1, Piece(Items[0], U, 1), Piece(Items[0], U, 2));
    … …  
    17652018    begin
    17662019      x := GetOPDaysOfWeek;
    1767       if Length(x) > 0 then Responses.Update('SCHEDULE', 1, x, x);
     2020      if Length(x) = 0 then x := 'ONCE';
     2021      Responses.Update('SCHEDULE', 1, x, x);
    17682022    end;
    17692023  with txtOPDietComment do {if Length(Text) > 0 then} Responses.Update('COMMENT',   1, Text,   Text);
    … …  
    17842038end;
    17852039
    1786 procedure TfrmODDiet.SetEnableOPDOW(AllowUse: Boolean);
    1787 begin
     2040procedure TfrmODDiet.SetEnableOPDOW(AllowUse: Boolean; OneTimeDay: integer; DaysToCheck: string = '');
     2041var
     2042  i: integer;
     2043begin
     2044  if (not AllowUse) and (OneTimeDay > -1) then
     2045    begin
     2046      for i := 0 to grpOPDOW.ControlCount - 1 do
     2047      begin
     2048        if grpOPDOW.Controls[i] is TCheckBox then
     2049          TCheckBox(grpOPDOW.Controls[i]).Checked := False;
     2050      end;
     2051      //TCheckBox(grpOPDOW.Controls[OneTimeDay - 1]).Checked := True;  CQ #8305
     2052    end;
    17882053  grpOPDOW.Enabled       := AllowUse;
    1789   chkOPMonday.Enabled    := AllowUse;
    1790   chkOPTuesday.Enabled   := AllowUse;
    1791   chkOPWednesday.Enabled := AllowUse;
    1792   chkOPThursday.Enabled  := AllowUse;
    1793   chkOPFriday.Enabled    := AllowUse;
    1794   chkOPSaturday.Enabled  := AllowUse;
    1795   chkOPSunday.Enabled    := AllowUse;
     2054  chkOPMonday.Enabled    := AllowUse and (Pos('M', DaysToCheck) > 0);
     2055  chkOPTuesday.Enabled   := AllowUse and (Pos('T', DaysToCheck) > 0);
     2056  chkOPWednesday.Enabled := AllowUse and (Pos('W', DaysToCheck) > 0);
     2057  chkOPThursday.Enabled  := AllowUse and (Pos('R', DaysToCheck) > 0);
     2058  chkOPFriday.Enabled    := AllowUse and (Pos('F', DaysToCheck) > 0);
     2059  chkOPSaturday.Enabled  := AllowUse and (Pos('S', DaysToCheck) > 0);
     2060  chkOPSunday.Enabled    := AllowUse and (Pos('X', DaysToCheck) > 0);
    17962061end;
    17972062
    … …  
    18962161    // check if late tray should be ordered
    18972162    AResponse := Responses.FindResponseByName('ORDERABLE', 1);
    1898     if (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
     2163    if (Self.EvtID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
    18992164    begin
    19002165      AResponse := Responses.FindResponseByName('START', 1);
    … …  
    19152180    // check if late tray should be ordered
    19162181    AResponse := Responses.FindResponseByName('ORDERABLE', 1);
    1917     if (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
     2182    if (Self.EvtID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
    19182183    begin
    19192184      AResponse := Responses.FindResponseByName('START', 1);
    … …  
    19302195    if NewOrder.ID <> '' then
    19312196    begin
    1932       if (Encounter.Provider = User.DUZ) and User.CanSignOrders
    1933         then CanSign := CH_SIGN_YES
    1934         else CanSign := CH_SIGN_NA;
     2197      if OrderForInpatient then
     2198        begin
     2199          if (Encounter.Provider = User.DUZ) and User.CanSignOrders
     2200            then CanSign := CH_SIGN_YES
     2201            else CanSign := CH_SIGN_NA;
     2202        end
     2203      else
     2204        begin
     2205          CanSign := CH_SIGN_NA;
     2206        end;
    19352207      Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, '', CanSign);
    19362208      SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_NEW, Integer(NewOrder))
    … …  
    19552227end;
    19562228
     2229procedure TfrmODDiet.cboOPDietAvailKeyDown(Sender: TObject; var Key: Word;
     2230  Shift: TShiftState);
     2231begin
     2232  inherited;
     2233  if Key = VK_RETURN then cboOPDietAvailMouseClick(Self);
     2234end;
     2235
     2236function TfrmODDiet.PatientHasRecurringMeals(var MealList: TStringList; MealType: string = ''): boolean;
     2237const
     2238  TX_NO_RECURRING_MEALS = 'For outpatients, this type of order requires association with an existing recurring' + CRLF +
     2239                          'meal order.  There are currently no active recurring meal orders for this patient.' + CRLF + CRLF +
     2240                          'Those orders must be signed and released before they can be linked to this item.';
     2241  TC_NO_RECURRING_MEALS = 'Unable to order ' ;
     2242begin
     2243  MealList.Clear;
     2244  GetCurrentRecurringOPMeals(MealList, MealType);
     2245  if MealList.Count = 0 then
     2246    begin
     2247      InfoBox(TX_NO_RECURRING_MEALS, TC_NO_RECURRING_MEALS + nbkDiet.ActivePage.Caption, MB_OK);
     2248      Result := False;
     2249    end
     2250  else
     2251    Result := True;
     2252end;
     2253
    19572254end.
    19582255
Note: See TracChangeset for help on using the changeset viewer.