Module

fOrdersRenew

Path

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

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fAutoSz -
fOCAccept -
rODMeds -
uConst -
uODBase -
uOrders -

Units Used in Implementation

Name Comments
fDateRange -
fFrame -
fRenewOutMed -
rCore -
rMisc -
rOrders -
UBAGlobals -
uCore -

Classes

Name Comments
TfrmRenewOrders -

Procedures

Name Owner Declaration Scope Comments
cmdCancelClick TfrmRenewOrders procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdChangeClick TfrmRenewOrders procedure cmdChangeClick(Sender: TObject); Public/Published -
cmdOKClick TfrmRenewOrders procedure cmdOKClick(Sender: TObject); Public/Published -
FormClose TfrmRenewOrders procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmRenewOrders procedure FormCreate(Sender: TObject); Public/Published -
FormResize TfrmRenewOrders procedure FormResize(Sender: TObject); Public/Published -
hdrOrdersSectionResize TfrmRenewOrders procedure hdrOrdersSectionResize(HeaderControl: THeaderControl; Section: THeaderSection); Public/Published -
lstOrdersClick TfrmRenewOrders procedure lstOrdersClick(Sender: TObject); Public/Published -
lstOrdersDrawItem TfrmRenewOrders procedure lstOrdersDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); Public/Published -
lstOrdersMeasureItem TfrmRenewOrders procedure lstOrdersMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer); Public/Published -

Functions

Name Owner Declaration Scope Comments
AcceptOrderCheckOnRenew TfrmRenewOrders function AcceptOrderCheckOnRenew(const AnOrderID: string; var OCList: TStringList): boolean; Private -
ExecuteRenewOrders - function ExecuteRenewOrders(var SelectedList: TList): Boolean; Interfaced M: integer; //BAPHII 1.3.2
MeasureColumnHeight TfrmRenewOrders function MeasureColumnHeight(TheOrderText: string; Index: Integer; Column: integer):integer; Private -
OrderForInpatient - function OrderForInpatient: Boolean; Local -
PickupText - function PickupText(const x: string): string; Global -

Constants

Name Declaration Scope Comments
DATE_COLUMN 1 Global -
TC_DEAFAIL 'Order not renewed' Global -
TC_ORDERCHECKS 'Order Checks' Global -
TC_START_STOP 'Change Start/Stop Dates' Global -
TEXT_COLUMN 0 Global -
TX_DEAFAIL1 'Order for controlled substance,' + CRLF Global -
TX_DEAFAIL2 CRLF + 'could not be renewed. Provider does not have a' + CRLF + Global -
TX_EXP_DEA1 CRLF + 'could not be renewed. Provider''s DEA# expired on ' Global -
TX_EXP_DEA2 CRLF + 'and no VA# is assigned. Provider is ineligible to sign the order.' Global -
TX_EXP_DETOX1 CRLF + 'could not be renewed. Provider''s Detoxification/Maintenance' + CRLF + Global -
TX_EXP_DETOX2 '.' + CRLF + 'Provider is ineligible to sign the order.' Global -
TX_INSTRUCT CRLF + CRLF + 'Click RETRY to select another provider.' + CRLF + 'Click CANCEL to cancel the current renewal.' Global -
TX_LBL_START 'Start Date/Time' Global -
TX_LBL_STOP 'Stop Date/Time' Global -
TX_NO_DETOX CRLF + 'could not be renewed. Provider does not have a' + CRLF + Global -
TX_SCHFAIL CRLF + 'could not be renewed. Provider is not authorized' + CRLF + Global -
TX_START_STOP 'Enter the start and stop times for this order. Stop time is optional.' Global -
WORD_WRAPPED True Global -


Module Source

1     unit fOrdersRenew;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fAutoSz, StdCtrls, ORFn, ComCtrls, uConst, rODMeds, uOrders, fOCAccept,
8       ExtCtrls, uODBase, ORCtrls, VA508AccessibilityManager;
9     
10    type
11      TfrmRenewOrders = class(TfrmAutoSz)
12        hdrOrders: THeaderControl;
13        pnlBottom: TPanel;
14        cmdCancel: TButton;
15        cmdOK: TButton;
16        cmdChange: TButton;
17        lstOrders: TCaptionListBox;
18        procedure FormCreate(Sender: TObject);
19        procedure cmdOKClick(Sender: TObject);
20        procedure cmdCancelClick(Sender: TObject);
21        procedure lstOrdersMeasureItem(Control: TWinControl; Index: Integer;
22          var Height: Integer);
23        procedure lstOrdersDrawItem(Control: TWinControl; Index: Integer;
24          Rect: TRect; State: TOwnerDrawState);
25        procedure lstOrdersClick(Sender: TObject);
26        procedure cmdChangeClick(Sender: TObject);
27        procedure FormClose(Sender: TObject; var Action: TCloseAction);
28        procedure hdrOrdersSectionResize(HeaderControl: THeaderControl;
29          Section: THeaderSection);
30        procedure FormResize(Sender: TObject);
31      private
32        OKPressed: Boolean;
33        OrderList: TList;
34        function MeasureColumnHeight(TheOrderText: string; Index: Integer; Column: integer):integer;
35        function AcceptOrderCheckOnRenew(const AnOrderID: string; var OCList: TStringList): boolean;
36      end;
37    
38    function ExecuteRenewOrders(var SelectedList: TList): Boolean;
39    
40    implementation
41    
42    {$R *.DFM}
43    
44    uses rOrders, fDateRange, fRenewOutMed, uCore, rCore, rMisc, UBAGlobals, 
45      VA2006Utils, fFrame;
46    
47    const
48      TEXT_COLUMN = 0;
49      DATE_COLUMN = 1;
50      WORD_WRAPPED = True;
51    
52      TC_START_STOP = 'Change Start/Stop Dates';
53      TX_START_STOP = 'Enter the start and stop times for this order.  Stop time is optional.';
54      TX_LBL_START  = 'Start Date/Time';
55      TX_LBL_STOP   = 'Stop Date/Time';
56      TX_DEAFAIL1   = 'Order for controlled substance,' + CRLF;
57      TX_DEAFAIL2   = CRLF + 'could not be renewed. Provider does not have a' + CRLF +
58                      'current, valid DEA# on record and is ineligible' + CRLF + 'to sign the order.';
59      TX_SCHFAIL    = CRLF + 'could not be renewed. Provider is not authorized' + CRLF +
60                      'to prescribe medications in Federal Schedule ';
61      TX_NO_DETOX   = CRLF + 'could not be renewed. Provider does not have a' + CRLF +
62                      'valid Detoxification/Maintenance ID number on' + CRLF +
63                      'record and is ineligible to sign the order.';
64      TX_EXP_DETOX1 = CRLF + 'could not be renewed. Provider''s Detoxification/Maintenance' + CRLF +
65                      'ID number expired due to an expired DEA# on ';
66      TX_EXP_DETOX2 = '.' + CRLF + 'Provider is ineligible to sign the order.';
67      TX_EXP_DEA1   = CRLF + 'could not be renewed. Provider''s DEA# expired on ';
68      TX_EXP_DEA2   = CRLF + 'and no VA# is assigned. Provider is ineligible to sign the order.';
69      TX_INSTRUCT   = CRLF + CRLF + 'Click RETRY to select another provider.' + CRLF + 'Click CANCEL to cancel the current renewal.';
70      TC_DEAFAIL    = 'Order not renewed';
71      TC_ORDERCHECKS = 'Order Checks';
72    
73    function PickupText(const x: string): string;
74    begin
75      case CharAt(x, 1) of
76      'C': Result := ' (administered in Clinic)';
77      'M': Result := ' (deliver by Mail)';
78      'W': Result := ' (pick up at Window)';
79      else Result := '';
80      end;
81    end;
82    
83    function ExecuteRenewOrders(var SelectedList: TList): Boolean;
84    const
85      TC_IMO_ERROR  = 'Inpatient medication order on outpatient authorization required';
86    var
87      frmRenewOrders: TfrmRenewOrders;
88      RenewFields: TOrderRenewFields;
89      AnOrder, TheOrder: TOrder;
90      OriginalID, RNFillerID,x: string;
91      OrderableItemIen: integer;
92      TreatAsIMOOrder, IsAnIMOOrder: boolean;
93      PassDeaList: TList;
94      InptDlg: boolean;
95      i,j: Integer;
96      //m: integer; //BAPHII 1.3.2
97      PkgInfo:string;
98      PlainText,RnErrMsg: string;
99      TD: TFMDateTime;
100     OrchkList: TStringList;
101     DEAFailStr, TX_INFO: string;
102   
103     function OrderForInpatient: Boolean;
104     begin
105       Result := Patient.Inpatient;
106     end;
107   begin
108     Result := False;
109     IsAnIMOOrder := False;
110     RnErrMsg := '';
111     InptDlg := False;
112   
113     if SelectedList.Count = 0 then Exit;
114   
115     PassDeaList := TList.Create;
116     OrchkList := TStringList.Create;
117     frmRenewOrders := TfrmRenewOrders.Create(Application);
118   
119     try
120       frmRenewOrders.OrderList := SelectedList;
121       //IsInpt := OrderForInpatient;
122   
123       with frmRenewOrders.OrderList do
124       for j := 0 to Count - 1 do
125          begin
126            TheOrder := TOrder(Items[j]);
127            PkgInfo := GetPackageByOrderID(TheOrder.ID);
128   
129            if Pos('PS',PkgInfo)=1 then
130               begin
131                 if PkgInfo = 'PSO' then InptDlg := False
132                 else if PkgInfo = 'PSJ' then InptDlg := True;
133                 OrderableItemIen := GetOrderableIen(TheOrder.ID);
134                 DEAFailStr := '';
135                 DEAFailStr := DEACheckFailed(OrderableItemIen, InptDlg);
136                 while StrToIntDef(Piece(DEAFailStr,U,1),0) in [1..5] do
137                    begin
138                      case StrToIntDef(Piece(DEAFailStr,U,1),0) of
139                        1:  TX_INFO := TX_DEAFAIL1 + #13 + TheOrder.Text + #13 + TX_DEAFAIL2;  //prescriber has an invalid or no DEA#
140                        2:  TX_INFO := TX_DEAFAIL1 + #13 + TheOrder.Text + #13 + TX_SCHFAIL + Piece(DEAFailStr,U,2) + '.';  //prescriber has no schedule privileges in 2,2N,3,3N,4, or 5
141                        3:  TX_INFO := TX_DEAFAIL1 + #13 + TheOrder.Text + #13 + TX_NO_DETOX;  //prescriber has an invalid or no Detox#
142                        4:  TX_INFO := TX_DEAFAIL1 + #13 + TheOrder.Text + #13 + TX_EXP_DEA1 + Piece(DEAFailStr,U,2) + TX_EXP_DEA2;  //prescriber's DEA# expired and no VA# is assigned
143                        5:  TX_INFO := TX_DEAFAIL1 + #13 + TheOrder.Text + #13 + TX_EXP_DETOX1 + Piece(DEAFailStr,U,2) + TX_EXP_DETOX2;  //valid detox#, but expired DEA#
144                      end;
145                      if InfoBox(TX_INFO + TX_INSTRUCT, TC_DEAFAIL, MB_RETRYCANCEL) = IDRETRY then
146                      begin
147                        DEAContext := True;
148                        fFrame.frmFrame.mnuFileEncounterClick(frmRenewOrders);
149                        DEAFailStr := '';
150                        DEAFailStr := DEACheckFailed(OrderableItemIen, InptDlg);
151                      end
152                      else begin
153                        UnlockOrder(TheOrder.ID);
154                        Exit;
155                      end;
156                    end;
157                 PassDeaList.Add(frmRenewOrders.OrderList.Items[j]);
158               end
159            else
160              PassDeaList.Add(frmRenewOrders.OrderList.Items[j]);
161          end;
162   
163       frmRenewOrders.OrderList.Clear;
164       frmRenewOrders.OrderList := PassDeaList;
165   
166       for i := frmRenewOrders.OrderList.Count - 1 downto 0 do
167          begin
168            AnOrder := TOrder(frmRenewOrders.OrderList.Items[i]);
169            if not IMOActionValidation('RENEW^'+ AnOrder.ID,IsAnIMOOrder,RnErrMsg,'C') then
170               begin
171                 frmRenewOrders.OrderList.Delete(i);
172                 ShowMsgOn(Length(RnErrMsg) > 0, RnErrMsg, TC_IMO_ERROR);
173               end;
174            RnErrMsg := '';
175          end;
176   
177       with frmRenewOrders.OrderList do
178        for i := 0 to Count - 1 do
179          begin
180            AnOrder := TOrder(Items[i]);
181            RenewFields := TOrderRenewFields.Create;
182            LoadRenewFields(RenewFields, AnOrder.ID);
183            RenewFields.NewText := AnOrder.Text + PickupText(RenewFields.Pickup);
184            AnOrder.LinkObject := RenewFields;
185            PlainText := '';
186   
187            if RenewFields.NewText <> '' then
188              PlainText := PlainText + frmRenewOrders.hdrOrders.Sections[TEXT_COLUMN].Text + ': ' + RenewFields.NewText + CRLF;
189   
190            if RenewFields.BaseType = OD_TEXTONLY then
191              with RenewFields do
192                 PlainText := PlainText + 'Start: ' + StartTime + CRLF + 'Stop: ' + StopTime;
193   
194            frmRenewOrders.lstOrders.Items.AddObject(PlainText, AnOrder);
195          end;
196   
197       if frmRenewOrders.OrderList.Count < 1 then
198         frmRenewOrders.Close
199       else
200         frmRenewOrders.ShowModal;
201   
202       if frmRenewOrders.OKPressed then
203          begin
204            with frmRenewOrders.OrderList do
205              for i := Count - 1 downto 0 do
206               begin
207                 OrchkList.Clear;
208                 AnOrder := TOrder(Items[i]);
209                 OriginalID := AnOrder.ID;
210   
211                 //BAPHII 1.3.2 - Pick up source-order ID here
212                UBAGlobals.SourceOrderID := OriginalID; //BAPHII 1.3.2
213                UBAGlobals.CopyTreatmentFactorsDxsToRenewedOrder; //BAPHII 1.3.2
214   
215                 if CheckOrderGroup(OriginalID) = 1 then
216                   RNFillerID := 'PSI'
217                 else if CheckOrderGroup(OriginalID) = 2 then
218                   RNFillerID := 'PSO';
219   
220                 if AddFillerAppID(RNFillerID) and OrderChecksEnabled then
221                    begin
222                      StatusText('Order Checking...');
223                      x := OrderChecksOnDisplay(RNFillerID);
224                      StatusText('');
225                      if Length(x) > 0 then InfoBox(x, TC_ORDERCHECKS, MB_OK);
226                    end;
227   
228                 TreatAsIMOOrder := False;
229   
230                 if not frmRenewOrders.AcceptOrderCheckOnRenew(AnOrder.ID,OrchkList) then
231                 begin
232                   frmRenewOrders.OrderList.Delete(i);
233                   Continue;
234                 end;
235   
236                 if IsIMOOrder(OriginalID) then               //IMO
237                    begin
238                      TD := FMToday;
239                      if IsValidIMOLoc(Encounter.Location, Patient.DFN) and (Encounter.DateTime > TD) then
240                        TreatAsIMOOrder := True;
241                      if Patient.Inpatient then TreatAsIMOOrder := True;
242                    end;
243   
244                 RenewFields := TOrderRenewFields(AnOrder.LinkObject);
245   
246                 //PSI-COMPLEX Start
247                 if IsComplexOrder(OriginalID) then
248                    begin
249                      if TreatAsIMOOrder then
250                        RenewOrder(AnOrder, RenewFields,1,Encounter.DateTime,OrchkList)
251                      else
252                        RenewOrder(AnOrder, RenewFields,1,0,OrchkList);
253   
254                      AnOrder.ActionOn := OriginalID + '=RN';
255                      SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_CPLXRN, Integer(AnOrder));
256                    end
257                 //PSI-COMPLEX End
258                 else
259                    begin
260                      if TreatAsIMOOrder then
261                        RenewOrder(AnOrder, RenewFields,0,Encounter.DateTime,OrchkList)
262                      else
263                        RenewOrder(AnOrder, RenewFields,0,0,OrchkList);
264   
265                      AnOrder.ActionOn := OriginalID + '=RN';
266                      SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_ACT, Integer(AnOrder));
267                    end;
268               end;
269   
270            Result := True;
271   
272          end
273   
274       else
275        with frmRenewOrders.OrderList do
276           for i := 0 to Count - 1 do
277              UnlockOrder(TOrder(Items[i]).ID);
278     finally
279       // free all the TOrderRenewFields that were created
280       SelectedList := frmRenewOrders.OrderList;
281   
282       with frmRenewOrders.OrderList do for i := 0 to Count - 1 do
283          begin
284            AnOrder := TOrder(Items[i]);
285            RenewFields := TOrderRenewFields(AnOrder.LinkObject);
286            RenewFields.Free;
287            AnOrder.LinkObject := nil;
288          end;
289       frmRenewOrders.Release;
290     end;
291   end;
292   
293   procedure TfrmRenewOrders.FormCreate(Sender: TObject);
294   begin
295     inherited;
296     FixHeaderControlDelphi2006Bug(hdrOrders);
297     OKPressed := False;
298     hdrOrders.Sections[0].Width := Round(self.width * 0.75);
299     hdrOrders.Sections[1].Width := Round(self.width * 0.25);
300     ResizeFormToFont(Self);
301     SetFormPosition(Self);
302   end;
303   
304   procedure TfrmRenewOrders.FormResize(Sender: TObject);
305   var
306   i: integer;
307   Height: integer;
308   begin
309     inherited;
310     if lstorders.Count = 0 then exit;
311     for I := 0 to lstOrders.Count - 1 do
312       begin
313          Height := lstOrders.ItemRect(i).Bottom - lstOrders.ItemRect(i).Top;
314          lstOrdersMeasureItem(lstOrders,i,Height);
315          //ListGridDrawCell(lstOrders, hdrOrders, i, TEXT_COLUMN, x, WORD_WRAPPED);
316       end;
317   end;
318   
319   procedure TfrmRenewOrders.lstOrdersMeasureItem(Control: TWinControl;
320     Index: Integer; var Height: Integer);
321   var
322     x, tmp: string;
323     DateHeight, TextHeight: Integer;
324     AnOrder: TOrder;
325     RenewFields: TOrderRenewFields;
326   begin
327     inherited;
328         AnOrder := TOrder(OrderList.Items[Index]);
329         if (AnOrder <> nil) then
330           begin
331             RenewFields := TOrderRenewFields(AnOrder.LinkObject);
332             with RenewFields do x := 'Start: ' + StartTime + CRLF + 'Stop: ' + StopTime;
333             //tmp := RenewFields.NewText;
334             tmp := LstOrders.Items.Strings[index];
335             TextHeight := MeasureColumnHeight(tmp,Index,TEXT_COLUMN);
336             DateHeight := MeasureColumnHeight(x, Index, DATE_COLUMN);
337             Height := HigherOf(TextHeight, DateHeight);
338             if Height > 255 then Height := 255;  //This is maximum allowed by a windows listbox item.
339           end
340   end;
341   
342   procedure TfrmRenewOrders.lstOrdersDrawItem(Control: TWinControl;
343     Index: Integer; Rect: TRect; State: TOwnerDrawState);
344   var
345     x: string;
346     AnOrder: TOrder;
347     RenewFields: TOrderRenewFields;
348   begin
349     inherited;
350     AnOrder := TOrder(lstOrders.Items.Objects[Index]);
351     if AnOrder <> nil then with AnOrder do
352     begin
353       RenewFields := TOrderRenewFields(AnOrder.LinkObject);
354       if RenewFields.BaseType = OD_TEXTONLY
355         then with RenewFields do x := 'Start: ' + StartTime + CRLF + 'Stop: ' + StopTime
356         else x := '';
357       ListGridDrawLines(lstOrders, hdrOrders, Index, State);
358       ListGridDrawCell(lstOrders, hdrOrders, Index, TEXT_COLUMN, RenewFields.NewText, WORD_WRAPPED);
359       ListGridDrawCell(lstOrders, hdrOrders, Index, DATE_COLUMN, x, WORD_WRAPPED);
360     end;
361   end;
362   
363   procedure TfrmRenewOrders.lstOrdersClick(Sender: TObject);
364   var
365     RenewFields: TOrderRenewFields;
366   begin
367     inherited;
368     with lstOrders do
369     begin
370       if ItemIndex < 0 then Exit;
371       RenewFields := TOrderRenewFields(TOrder(Items.Objects[ItemIndex]).LinkObject);
372       case RenewFields.BaseType of
373       OD_MEDOUTPT: cmdChange.Caption := 'Change Refills/Pick Up...';
374       OD_TEXTONLY: cmdChange.Caption := 'Change Start/Stop...';
375       else         cmdChange.Caption := 'Change...';
376       end;
377       with RenewFields do if (BaseType = OD_MEDOUTPT) or (BaseType = OD_TEXTONLY)
378         then cmdChange.Enabled := True
379         else cmdChange.Enabled := False;
380     end;
381   end;
382   
383   procedure TfrmRenewOrders.cmdChangeClick(Sender: TObject);
384   var
385     StartPos: Integer;
386     x, NewComment, OldComment, OldRefills, OldPickup: string;
387     AnOrder: TOrder;
388     RenewFields: TOrderRenewFields;
389   begin
390     inherited;
391     with lstOrders do
392     begin
393       if ItemIndex < 0 then Exit;
394       AnOrder := TOrder(Items.Objects[ItemIndex]);
395       RenewFields := TOrderRenewFields(AnOrder.LinkObject);
396       case RenewFields.BaseType of
397       OD_MEDOUTPT: with RenewFields do begin
398                      OldRefills := IntToStr(Refills) + ' refills';
399                      { reverse string to make sure getting last matching comment }
400                      OldComment := UpperCase(ReverseStr(Comments));
401                      OldPickup  := PickupText(Pickup);
402                      ExecuteRenewOutMed(Refills, Comments, Pickup, AnOrder);
403                      NewComment := UpperCase(ReverseStr(Comments));
404                      x := ReverseStr(NewText);
405                      StartPos := Pos(OldComment, UpperCase(x));
406                      if StartPos > 0
407                        then x := Copy(x, 1, StartPos - 1) + NewComment +
408                                  Copy(x, StartPos + Length(OldComment), Length(x))
409                        else x := NewComment + x;
410                      NewText := ReverseStr(x);
411                      x := NewText;
412                      StartPos := Pos(OldRefills, x);
413                      if StartPos > 0
414                        then x := Copy(x, 1, StartPos - 1) + IntToStr(Refills) + ' refills' +
415                                  Copy(x, StartPos + Length(OldRefills), Length(x))
416                        else x := x + ' ' + IntToStr(Refills) + ' refills';
417                      StartPos := Pos(OldPickup, x);
418                      if StartPos > 0
419                        then x := Copy(x, 1, StartPos - 1) + PickupText(Pickup) +
420                                  Copy(x, StartPos + Length(OldPickup), Length(x))
421                        else x := x + PickupText(Pickup);
422                      NewText := x;
423                    end;
424       OD_TEXTONLY: with RenewFields do ExecuteDateRange(StartTime, StopTime, DT_FUTURE+DT_TIMEOPT,
425                      TC_START_STOP, TX_START_STOP, TX_LBL_START, TX_LBL_STOP);
426       end;
427     end;
428     lstOrders.Invalidate;
429   end;
430   
431   procedure TfrmRenewOrders.cmdOKClick(Sender: TObject);
432   begin
433     inherited;
434     OKPressed := True;
435     Close;
436   end;
437   
438   procedure TfrmRenewOrders.cmdCancelClick(Sender: TObject);
439   begin
440     inherited;
441     Close;
442   end;
443   
444   function TfrmRenewOrders.MeasureColumnHeight(TheOrderText: string; Index,
445     Column: integer): integer;
446   var
447     ARect: TRect;
448     cnt: integer;
449     x: string;
450   begin
451     cnt := 0;
452     ARect.Left := 0;
453     ARect.Top := 0;
454     ARect.Bottom := 0;
455     ARect.Right := hdrOrders.Sections[Column].Width -6;
456     Result := WrappedTextHeightByFont(lstOrders.Canvas,lstOrders.Font,TheOrderText,ARect);
457     //AGP 28.0 this fix address the issue of WrappedTextHeightByFont appearing to not take in account CRLF
458     if Pos(CRLF, TheOrderText) > 0 then
459       begin
460         repeat
461           x := Copy(TheOrderText, 1, Pos(CRLF, TheOrderText) - 1);
462           if Length(x) = 0 then x := TheOrderText;
463           Delete(TheOrderText, 1, Length(x) + 2);  {delete text + CRLF}
464           cnt := cnt + 1;
465         until TheOrderText = '';
466         if cnt > 0 then Result := Result + (cnt * Abs(self.Font.Height));
467         if Result > 255 then Result := 255;
468       end;
469     
470   end;
471   
472   function TfrmRenewOrders.AcceptOrderCheckOnRenew(const AnOrderID: string;
473     var OCList: TStringList): boolean;
474   var
475     OIInfo,FillerID: string;
476     AnOIList: TStringList;
477     subI: integer;
478   begin
479     AnOIList := TStringList.Create;
480     OIInfo := DataForOrderCheck(AnOrderID);
481     FillerID := Piece(OIInfo,'^',2);
482     subI := 1;
483     while Length(Piece(OIInfo,'|',subI))>1 do
484     begin
485       AnOIList.Add(Piece(OIInfo,'|',subI));
486       subI := subI + 1;
487     end;
488     OrderChecksOnAccept(OCList, FillerID, '', AnOIList, AnOrderID,'1');
489     Result :=  AcceptOrderWithChecks(OCList);
490   end;
491   
492   procedure TfrmRenewOrders.FormClose(Sender: TObject;
493     var Action: TCloseAction);
494   begin
495     inherited;
496     SaveUserBounds(Self);
497   end;
498   
499   procedure TfrmRenewOrders.hdrOrdersSectionResize(HeaderControl: THeaderControl; Section: THeaderSection);
500   begin
501     inherited;
502     lstOrders.Repaint; //CQ6367
503   end;
504   
505   
506   end.

Module Calls (2 levels)


fOrdersRenew
 ├fAutoSz
 │ └fBase508Form
 ├uConst
 ├rODMeds
 │ ├uCore
 │ └uConst
 ├uOrders
 │ ├uConst
 │ ├rConsults
 │ ├rOrders
 │ ├fODBase
 │ ├XuDsigS
 │ ├fODDiet
 │ ├fODMisc
 │ ├fODGen
 │ ├fODMedIn
 │ ├fODMedOut
 │ ├fODText
 │ ├fODConsult
 │ ├fODProc
 │ ├fODRad
 │ ├fODLab
 │ ├fODBBank
 │ ├fODMeds
 │ ├fODMedIV
 │ ├fODVitals
 │ ├fODAuto
 │ ├fOMNavA
 │ ├rCore
 │ ├uCore...
 │ ├fFrame
 │ ├fEncnt
 │ ├fOMVerify
 │ ├fOrderSaveQuick
 │ ├fOMSet
 │ ├rMisc
 │ ├uODBase
 │ ├rODMeds...
 │ ├fLkUpLocation
 │ ├fOrdersPrint
 │ ├fOMAction
 │ ├fARTAllgy
 │ ├fOMHTML
 │ ├fOrders
 │ ├rODBase
 │ ├fODChild
 │ ├fMeds
 │ ├rMeds
 │ ├rPCE
 │ ├fRptBox
 │ ├fODMedNVA
 │ ├fODChangeUnreleasedRenew
 │ ├rODAllergy
 │ ├UBAGlobals
 │ └uTemplateFields
 ├fOCAccept
 │ ├fAutoSz...
 │ ├rOrders...
 │ └fOCMonograph
 ├uODBase...
 ├rOrders...
 ├fDateRange
 │ └fAutoSz...
 ├fRenewOutMed
 │ ├rOrders...
 │ ├fBase508Form...
 │ ├rODBase...
 │ └rODMeds...
 ├uCore...
 ├rCore...
 ├rMisc...
 ├UBAGlobals...
 └fFrame...

Module Called-By (2 levels)


           fOrdersRenew
              fOrders┤ 
            uOrders┤ │ 
            fODBase┤ │ 
             fFrame┤ │ 
              rMisc┤ │ 
            uODBase┤ │ 
              fMeds┤ │ 
          fOrdersDC┤ │ 
          fOrdersCV┤ │ 
            fOMNavA┤ │ 
             fOMSet┤ │ 
 fOrdersEvntRelease┤ │ 
    fODReleaseEvent┤ │ 
         mEvntDelay┤ │ 
          fODActive┤ │ 
        fOrdersCopy┤ │ 
           fMedCopy┤ │ 
fActivateDeactivate┘ │ 
             fMeds...┘