Module

fODDietLT

Path

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

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fAutoSz -
fODBase -
rODBase -

Units Used in Implementation

Name Comments
rCore -
rODDiet -
rOrders -
uConst -
uCore -

Classes

Name Comments
TfrmODDietLT -

Procedures

Name Owner Declaration Scope Comments
CheckLateTray - procedure CheckLateTray(const StartTime: string; var LateTrayFields: TLateTrayFields; IsOutpatient: boolean; AMeal: char = #0); Interfaced -
cmdNoClick TfrmODDietLT procedure cmdNoClick(Sender: TObject); Public/Published -
cmdYesClick TfrmODDietLT procedure cmdYesClick(Sender: TObject); Public/Published -
FormCreate TfrmODDietLT procedure FormCreate(Sender: TObject); Public/Published ---------- frmODDietLT procedures ---------------
LateTrayCheck - procedure LateTrayCheck(SomeResponses: TResponses; EventId: integer; IsOutpatient: boolean; var LateTrayFields: TLateTrayFields); Interfaced -
LateTrayOrder - procedure LateTrayOrder(LateTrayFields: TLateTrayFields; IsInpatient: boolean); Interfaced -
SetAvailTimes - procedure SetAvailTimes(ATime: Extended; var ACount: Integer; var TimeList: string); Local -

Functions

Name Owner Declaration Scope Comments
AMPMToFMTime - function AMPMToFMTime(const x: string): Extended; Local -
FMTimeToAMPM - function FMTimeToAMPM(x: Extended): string; Local -

Constants

Name Declaration Scope Comments
TC_MEAL_REQ 'No Meal Time Selected' Global -
TX_MEAL_REQ 'A meal time must be selected.' Global -


Module Source

1     unit fODDietLT;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fAutoSz, ExtCtrls, StdCtrls, ORFn, fODBase, rODBase, VA508AccessibilityManager;
8     
9     type
10      TfrmODDietLT = class(TfrmAutoSz)
11        lblMealCutoff: TStaticText;
12        Label2: TStaticText;
13        GroupBox1: TGroupBox;
14        cmdYes: TButton;
15        cmdNo: TButton;
16        radLT1: TRadioButton;
17        radLT2: TRadioButton;
18        radLT3: TRadioButton;
19        chkBagged: TCheckBox;
20        Bevel1: TBevel;
21        procedure cmdYesClick(Sender: TObject);
22        procedure cmdNoClick(Sender: TObject);
23        procedure FormCreate(Sender: TObject);
24      private
25        FOutpatient: boolean;
26        YesPressed: Boolean;
27      public
28        { Public declarations }
29      end;
30    
31      TLateTrayFields = record
32        LateMeal: Char;
33        LateTime: string;
34        IsBagged: Boolean;
35      end;
36    
37    procedure CheckLateTray(const StartTime: string; var LateTrayFields: TLateTrayFields; IsOutpatient: boolean; AMeal: char = #0);
38    procedure LateTrayCheck(SomeResponses: TResponses; EventId: integer; IsOutpatient: boolean; var LateTrayFields: TLateTrayFields);
39    procedure LateTrayOrder(LateTrayFields: TLateTrayFields; IsInpatient: boolean);
40    
41    implementation
42    
43    {$R *.DFM}
44    
45    uses rCore, uCore, rODDiet, uConst, rOrders;
46    
47    const
48      TX_MEAL_REQ = 'A meal time must be selected.';
49      TC_MEAL_REQ = 'No Meal Time Selected';
50    
51    procedure CheckLateTray(const StartTime: string; var LateTrayFields: TLateTrayFields; IsOutpatient: boolean; AMeal: char = #0);
52    var
53      frmODDietLT: TfrmODDietLT;
54      DietParams: TDietParams;
55      FMTime: TFMDateTime;
56      TimePart: Extended;
57      Meal: Char;
58      AvailTimes,ALocation: string;
59      TimeCount: Integer;
60    
61      function AMPMToFMTime(const x: string): Extended;
62      var
63        IntTime: Integer;
64      begin
65        Result := 0;
66        if Pos(':', x) = 0 then Exit;
67        IntTime := StrToIntDef(Piece(x, ':', 1) + Copy(Piece(x, ':', 2), 1, 2), 0);
68        if (Pos('P', x) > 0) and (IntTime < 1200) then IntTime := IntTime + 1200;
69        if (Pos('A', x) > 0) and (IntTime > 1200) then IntTime := IntTime - 1200;
70        Result := IntTime / 10000;
71      end;
72    
73      function FMTimeToAMPM(x: Extended): string;
74      var
75        TimePart: extended;
76        AMPMTime, Suffix: string;
77      begin
78        TimePart := Frac(x);
79        if TimePart > 0.1159 then
80        begin
81          if TimePart > 0.1259 then x := x - 0.12;
82          Suffix := 'P'
83        end
84        else Suffix := 'A';
85        AMPMTime := FormatFMDateTime('hh:nn', x);
86        Result := AMPMTime + Suffix;
87      end;
88    
89      procedure SetAvailTimes(ATime: Extended; var ACount: Integer; var TimeList: string);
90      var
91        i: Integer;
92        ReturnList: string;
93      begin
94        ACount := 0;
95        ReturnList := '';
96        for i := 1 to 3 do
97          if AMPMToFMTime(Piece(TimeList, U, i)) > ATime then
98          begin
99            if Length(ReturnList) > 0 then ReturnList := ReturnList + U;
100           ReturnList := ReturnList + Piece(TimeList, U, i);
101           Inc(ACount);
102         end;
103       TimeList := ReturnList;
104     end;
105   
106   begin
107     // initialize LateTrayFields
108     LateTrayFields.LateMeal := #0;
109     LateTrayFields.LateTime := '';
110     LateTrayFields.IsBagged := False;
111     // make sure the start time is today and not in the future
112     FMTime := StrToFMDateTime(StartTime);
113     if FMTime < 0 then Exit;
114     if Int(FMTime) <> FMToday then Exit;
115     TimePart := Frac(FMTime);
116     if TimePart = 0 then TimePart := Frac(FMNow);
117     if TimePart > Frac(FMNow) then Exit;
118     Meal := #0;
119     ALocation := IntToStr(Encounter.Location);
120     LoadDietParams(DietParams,ALocation);
121     // check to see if falling within the alarm range of a meal
122     if not IsOutpatient then
123     begin
124       if (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 1), 0) / 10000)) and
125          (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 2), 0) / 10000)) then Meal := 'B';
126       if (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 3), 0) / 10000)) and
127          (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 4), 0) / 10000)) then Meal := 'N';
128       if (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 5), 0) / 10000)) and
129          (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 6), 0) / 10000)) then Meal := 'E';
130       if Meal = #0 then Exit;
131     end
132     else  // for outpatients
133     begin
134   (*  From Rich Knoepfle, NFS developer
135   If they order a breakfast and it is after the LATE BREAKFAST ALARM END, I don't allow them to do it.  (For special meals I don't allow them to order something for the following day).
136   If it's before the LATE BREAKFAST ALARM BEGIN than I accept the order.
137   If it's between the LATE BREAKFAST ALARM BEGIN and ALARM END then I ask if they want to order a Late breakfast tray.
138   *)
139       Meal := AMeal;
140       case AMeal of
141         'B':  if (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 1), 0) / 10000)) or
142                  (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 2), 0) / 10000)) then Meal := #0;
143         'N':  if (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 3), 0) / 10000)) or
144                  (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 4), 0) / 10000)) then Meal := #0;
145         'E':  if (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 5), 0) / 10000)) or
146                  (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 6), 0) / 10000)) then Meal := #0;
147       end;
148       if Meal = #0 then exit;
149     end;
150   
151     // get the available late times for this meal
152     case Meal of
153     'B': AvailTimes := Pieces(DietParams.BTimes, U, 4, 6);
154     'E': AvailTimes := Pieces(DietParams.ETimes, U, 4, 6);
155     'N': AvailTimes := Pieces(DietParams.NTimes, U, 4, 6);
156     end;
157     SetAvailTimes(TimePart, TimeCount, AvailTimes);
158     if TimeCount = 0 then Exit;
159   
160     // setup form to get the selected late tray
161     frmODDietLT := TfrmODDietLT.Create(Application);
162     try
163       ResizeFormToFont(TForm(frmODDietLT));
164       with frmODDietLT do
165       begin
166         FOutpatient := IsOutpatient;
167         if Length(Piece(AvailTimes, U, 1)) > 0 then radLT1.Caption := Piece(AvailTimes, U, 1);
168         if Length(Piece(AvailTimes, U, 2)) > 0 then radLT2.Caption := Piece(AvailTimes, U, 2);
169         if Length(Piece(AvailTimes, U, 3)) > 0 then radLT3.Caption := Piece(AvailTimes, U, 3);
170         radLT1.Visible := Length(radLT1.Caption) > 0;
171         radLT2.Visible := Length(radLT2.Caption) > 0;
172         radLT3.Visible := Length(radLT3.Caption) > 0;
173         radLT1.Checked := TimeCount = 1;
174         chkBagged.Visible := DietParams.Bagged;
175         with lblMealCutOff do case Meal of
176         'B': Caption := 'You have missed the breakfast cut-off.';
177         'E': Caption := 'You have missed the evening cut-off.';
178         'N': Caption := 'You have missed the noon cut-off.';
179         end;
180         // display the form
181         ShowModal;
182         if YesPressed then
183         begin
184           with radLT1 do if Checked then LateTrayFields.LateTime := Caption;
185           with radLT2 do if Checked then LateTrayFields.LateTime := Caption;
186           with radLT3 do if Checked then LateTrayFields.LateTime := Caption;
187           LateTrayFields.LateMeal := Meal;
188           LateTrayFields.IsBagged := chkBagged.Checked;
189         end;
190       end; {with frmODDietLT}
191     finally
192       frmODDietLT.Release;
193     end;
194   end;
195   
196   procedure LateTrayCheck(SomeResponses: TResponses; EventId: integer; IsOutpatient: boolean; var LateTrayFields: TLateTrayFields);
197   var
198     AResponse, AnotherResponse: TResponse;
199   begin
200     if IsOutpatient then
201     begin
202       AResponse := SomeResponses.FindResponseByName('ORDERABLE', 1);
203       if (EventID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
204       begin
205         AResponse := SomeResponses.FindResponseByName('START', 1);
206         AnotherResponse := SomeResponses.FindResponseByName('MEAL', 1);
207         if (AResponse <> nil) and (AnotherResponse <> nil) then
208           CheckLateTray(AResponse.IValue, LateTrayFields, True, CharAt(AnotherResponse.IValue, 1));
209       end;
210     end
211     else
212     begin
213       AResponse := SomeResponses.FindResponseByName('ORDERABLE', 1);
214       if (EventID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
215       begin
216         AResponse := SomeResponses.FindResponseByName('START', 1);
217         if AResponse <> nil then CheckLateTray(AResponse.IValue, LateTrayFields, False);
218       end;
219     end;
220   end;
221   
222   procedure LateTrayOrder(LateTrayFields: TLateTrayFields; IsInpatient: boolean);
223   const
224     TX_EL_SAVE_ERR    = 'An error occurred while saving this late tray order.';
225     TC_EL_SAVE_ERR    = 'Error Saving Late Tray Order';
226   var
227     NewOrder: TOrder;
228     CanSign: integer;
229   begin
230     NewOrder := TOrder.Create;
231     try
232       with LateTrayFields do OrderLateTray(NewOrder, LateMeal, LateTime, IsBagged);
233       if NewOrder.ID <> '' then
234       begin
235         if IsInpatient then
236           begin
237             if (Encounter.Provider = User.DUZ) and User.CanSignOrders
238               then CanSign := CH_SIGN_YES
239               else CanSign := CH_SIGN_NA;
240           end
241         else
242           begin
243             CanSign := CH_SIGN_NA;
244           end;
245         Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, '', CanSign);
246         SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_NEW, Integer(NewOrder))
247       end
248       else InfoBox(TX_EL_SAVE_ERR, TC_EL_SAVE_ERR, MB_OK);
249     finally
250       NewOrder.Free;
251     end;
252   end;
253   
254   // ---------- frmODDietLT procedures ---------------
255   procedure TfrmODDietLT.FormCreate(Sender: TObject);
256   begin
257     inherited;
258     YesPressed := False;
259   end;
260   
261   procedure TfrmODDietLT.cmdYesClick(Sender: TObject);
262   begin
263     inherited;
264     if not FOutpatient then
265       if (radLT1.Checked = False) and (radLT2.Checked = False) and (radLT3.Checked = False) then
266       begin
267         InfoBox(TX_MEAL_REQ, TC_MEAL_REQ, MB_OK);
268         Exit;
269       end;
270     YesPressed := True;
271     Close;
272   end;
273   
274   procedure TfrmODDietLT.cmdNoClick(Sender: TObject);
275   begin
276     inherited;
277     Close;
278   end;
279   
280   end.

Module Calls (2 levels)


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

Module Called-By (2 levels)


          fODDietLT
          fODBase┤ 
        uOrders┤ │ 
        rODBase┤ │ 
        fOrders┤ │ 
          fMeds┤ │ 
     uSignItems┤ │ 
   fODDietLT...┤ │ 
        fODDiet┤ │ 
        fODMisc┤ │ 
         fODGen┤ │ 
       fODMedIn┤ │ 
      fODMedOut┤ │ 
  fODMedComplex┤ │ 
        fODText┤ │ 
     fODConsult┤ │ 
        fODProc┤ │ 
         fODRad┤ │ 
         fODLab┤ │ 
       fODBBank┤ │ 
        fODMeds┤ │ 
       fODMedIV┤ │ 
      fODVitals┤ │ 
        fODAuto┤ │ 
        fOMNavA┤ │ 
fOrderSaveQuick┤ │ 
         fOMSet┤ │ 
      fODMedNVA┤ │ 
    fOrdersCopy┤ │ 
       fMedCopy┤ │ 
       fODAllgy┘ │ 
       fODDiet...┘