Module

fODActive

Path

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

Last Modified

7/15/2014 3:26:40 PM

Units Used in Interface

Name Comments
fAutoSz -
fFrame -
fOrders -
rOrders -
uCore -
uOrders -

Classes

Name Comments
TfrmODActive -

Procedures

Name Owner Declaration Scope Comments
btnCancelClick TfrmODActive procedure btnCancelClick(Sender: TObject); Public/Published -
btnOKClick TfrmODActive procedure btnOKClick(Sender: TObject); Public/Published -
CopyActiveOrdersToEvent - procedure CopyActiveOrdersToEvent(AnOrderView: TOrderView; AnEvent: TOrderDelayEvent); Interfaced -
FormCreate TfrmODActive procedure FormCreate(Sender: TObject); Public/Published -
FormDestroy TfrmODActive procedure FormDestroy(Sender: TObject); Public/Published -
hdControlSectionResize TfrmODActive procedure hdControlSectionResize(HeaderControl: THeaderControl; Section: THeaderSection); Public/Published -
LoadActiveOrders TfrmODActive procedure LoadActiveOrders; Private -
lstActiveOrdersDrawItem TfrmODActive procedure lstActiveOrdersDrawItem(Control: TWinControl; Index: Integer; TheeRect: TRect; State: TOwnerDrawState); Public/Published -
lstActiveOrdersMeasureItem TfrmODActive procedure lstActiveOrdersMeasureItem(Control: TWinControl; Index: Integer; var AaHeight: Integer); Public/Published -
RedrawActiveList TfrmODActive procedure RedrawActiveList; Private -
RetrieveVisibleOrders TfrmODActive procedure RetrieveVisibleOrders(AnIndex: Integer); Private -

Functions

Name Owner Declaration Scope Comments
MeasureColumnHeight TfrmODActive function MeasureColumnHeight(TheOrderText: string; Index: Integer; Column: integer):integer; Private -

Constants

Name Declaration Scope Comments
FM_DATE_ONLY 7 Global -


Module Source

1     unit fODActive;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       ORFn, uCore, StdCtrls, CheckLst, ComCtrls,ExtCtrls,rOrders,fOrders,uOrders,
8       fFrame,ORCtrls,fAutoSz, VA508AccessibilityManager;
9     
10    type
11      TfrmODActive = class(TfrmAutoSz)
12        lblCaption: TLabel;
13        pnlClient: TPanel;
14        btnOK: TButton;
15        btnCancel: TButton;
16        hdControl: THeaderControl;
17        lstActiveOrders: TCaptionListBox;
18        procedure btnOKClick(Sender: TObject);
19        procedure btnCancelClick(Sender: TObject);
20        procedure FormCreate(Sender: TObject);
21        procedure FormDestroy(Sender: TObject);
22        procedure lstActiveOrdersMeasureItem(Control: TWinControl;
23          Index: Integer; var AaHeight: Integer);
24        procedure lstActiveOrdersDrawItem(Control: TWinControl;
25          Index: Integer; TheeRect: TRect; State: TOwnerDrawState);
26        procedure hdControlSectionResize(HeaderControl: THeaderControl;
27          Section: THeaderSection);
28      private
29        { Private declarations }
30        FOrderView: TOrderView;
31        FEvent: TOrderDelayEvent;
32        FAutoAc: boolean;
33        ActiveOrderList: TList;
34        FDefaultEventOrder: string;
35        function MeasureColumnHeight(TheOrderText: string; Index: Integer; Column: integer):integer;
36        procedure LoadActiveOrders;
37        procedure RetrieveVisibleOrders(AnIndex: Integer);
38        procedure RedrawActiveList;
39      public
40        { Public declarations }
41        property Event: TOrderDelayEvent   read FEvent         write FEvent;
42        property OrderView: TOrderView     read FOrderView     write FOrderView;
43        property AutoAc: boolean           read FAutoAc;
44      end;
45    
46    procedure CopyActiveOrdersToEvent(AnOrderView: TOrderView; AnEvent: TOrderDelayEvent);
47    
48    implementation
49    
50    uses
51      VA2006Utils;
52    
53    {$R *.DFM}
54    
55    const
56     FM_DATE_ONLY = 7;
57    
58    procedure CopyActiveOrdersToEvent(AnOrderView: TOrderView; AnEvent: TOrderDelayEvent);
59    var
60      frmODActive: TfrmODActive;
61    begin
62      frmODActive := TfrmODActive.Create(Application);
63      ResizeFormToFont(TForm(frmODActive));
64      frmODActive.Event     := AnEvent;
65      frmODActive.FOrderView := AnOrderView;
66      frmODActive.FOrderView.Filter := 2;
67      if Length(frmOrders.EventDefaultOrder)>0 then
68        frmODActive.FDefaultEventOrder := frmOrders.EventDefaultOrder;
69      frmODActive.lblCaption.Caption := frmODActive.lblCaption.Caption + ' Delayed ' + AnEvent.EventName + ':';
70      frmODActive.LoadActiveOrders;
71      if frmODActive.lstActiveOrders.Items.Count < 1 then
72        frmODActive.Close
73      else
74        frmODActive.ShowModal;
75    end;
76    
77    procedure TfrmODActive.btnOKClick(Sender: TObject);
78    const
79      TX_NOSEL      = 'No orders are highlighted.  Select the orders' + CRLF +
80                      'you wish to take action on.';
81      TC_NOSEL      = 'No Orders Selected';
82    var
83      i : integer;
84      SelectedList: TStringList;
85      TheVerify : boolean;
86      DoesDestEvtOccur:boolean;
87    begin
88      try
89      self.btnOK.Enabled := false;
90      DoesDestEvtOccur := False;
91      uAutoAC := True;
92      frmFrame.UpdatePtInfoOnRefresh;
93      SelectedList := TStringList.Create;
94      try
95        TheVerify := False;
96        with lstActiveOrders do for i := 0 to Items.Count - 1 do
97          if Selected[i] then SelectedList.Add(TOrder(Items.Objects[i]).ID);
98        if ShowMsgOn(SelectedList.Count = 0, TX_NOSEL, TC_NOSEL) then Exit;
99        if (Event.EventType = 'D') or ((not Patient.InPatient) and (Event.EventType = 'T')) then
100         TransferOrders(SelectedList, Event, DoesDestEvtOccur, TheVerify)
101       else if (not Patient.Inpatient) and (Event.EventType = 'A') then
102         TransferOrders(SelectedList, Event, DoesDestEvtOccur, TheVerify)
103       else
104         CopyOrders(SelectedList, Event, DoesDestEvtOccur, TheVerify);
105       if ( frmOrders <> nil ) and DoesDestEvtOccur then
106         frmOrders.PtEvtCompleted(Event.PtEventIFN,Event.EventName);
107      finally
108       SelectedList.Free;
109       uAutoAC := False;
110     end;
111     finally
112       self.btnOK.Enabled := True;
113     end;
114     Close;
115   end;
116   
117   procedure TfrmODActive.btnCancelClick(Sender: TObject);
118   begin
119     Close;
120   end;
121   
122   procedure TfrmODActive.FormCreate(Sender: TObject);
123   begin
124     FixHeaderControlDelphi2006Bug(hdControl);
125     ActiveOrderList := TList.Create;
126     FOrderView      := TOrderView.Create;
127     FDefaultEventOrder := '';
128   end;
129   
130   procedure TfrmODActive.LoadActiveOrders;
131   var
132     AnOrder: TOrder;
133     i: integer;
134     AnOrderPtEvtId,AnOrderEvtId: string;
135   begin
136     LoadOrdersAbbr(ActiveOrderList,FOrderView,'');
137     with ActiveOrderList do for i := Count - 1 downto 0 do
138     begin
139       AnOrder := TOrder(Items[i]);
140       AnOrderPtEvtID := GetOrderPtEvtID(AnOrder.ID);
141       if StrToIntDef(AnOrderPtEvtID,0)>0 then
142       begin
143         AnOrderEvtId := Piece(EventInfo(AnOrderPtEvtID),'^',2);
144         if AnsiCompareText(AnOrderEvtID,IntToStr(FEvent.TheParent.ParentIFN))=0 then
145         begin
146            ActiveOrderList.Delete(i);
147            continue;
148         end;
149       end;
150       if (AnOrder.ID = FDefaultEventOrder) or (isDCedOrder(AnOrder.ID)) then
151       begin
152         ActiveOrderList.Delete(i);
153       end;
154     end;
155     SortOrders(ActiveOrderList, FOrderView.ByService, FOrderView.InvChrono);
156     lstActiveOrders.Items.Clear;
157     with ActiveOrderList do for i := 0 to Count - 1 do
158     begin
159       AnOrder := TOrder(Items[i]);
160       lstActiveOrders.Items.AddObject(AnOrder.ID,AnOrder);
161     end;
162   end;
163   
164   procedure TfrmODActive.FormDestroy(Sender: TObject);
165   begin
166     ClearOrders(ActiveOrderList);
167     ActiveOrderList.Free;
168     lstActiveOrders.Clear;
169     if FOrderView <> nil then FOrderView := nil ;
170   end;
171   
172   procedure TfrmODActive.lstActiveOrdersMeasureItem(Control: TWinControl;
173     Index: Integer; var AaHeight: Integer);
174   var
175     x,y: string;
176     TextHeight, NewHeight, DateHeight: Integer;
177     TheOrder: TOrder;
178   begin
179     inherited;
180     NewHeight := AaHeight;
181     with lstActiveOrders do if Index < Items.Count then
182     begin
183       TheOrder := TOrder(ActiveOrderList.Items[index]);
184       if TheOrder <> nil then with TheOrder do
185       begin
186         if not TheOrder.Retrieved then RetrieveVisibleOrders(Index);
187         {measure the height of order text}
188         x := Text;
189         TextHeight := MeasureColumnHeight(x,Index,1);
190   
191         {measure the height of Start/Stop date time}
192         x := FormatFMDateTimeStr('mm/dd/yy hh:nn', StartTime);
193         if IsFMDateTime(StartTime) and (Length(StartTime) = FM_DATE_ONLY) then x := Piece(x, #32, 1);
194         if Length(x) > 0 then x := 'Start: ' + x;
195         y := FormatFMDateTimeStr('mm/dd/yy hh:nn', StopTime);
196         if IsFMDateTime(StopTime)  and (Length(StopTime) = FM_DATE_ONLY)  then y := Piece(y, #32, 1);
197         if Length(y) > 0 then x := x + CRLF + 'Stop: ' + y;
198         DateHeight := MeasureColumnHeight(x,Index,2);
199         NewHeight := HigherOf(TextHeight, DateHeight);
200       end;
201     end;
202     AaHeight := NewHeight;
203   end;
204   
205   procedure TfrmODActive.lstActiveOrdersDrawItem(Control: TWinControl;
206     Index: Integer; TheeRect: TRect; State: TOwnerDrawState);
207   var
208     x, y: string;
209     ARect: TRect;
210     AnOrder: TOrder;
211     i,RightSide: integer;
212     SaveColor: TColor;
213   begin
214     inherited;
215     with lstActiveOrders do
216     begin
217       ARect := TheeRect;
218       Canvas.FillRect(ARect);
219       Canvas.Pen.Color := Get508CompliantColor(clSilver);
220       Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
221       Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
222       RightSide := -2;
223       for i := 0 to 2 do
224       begin
225         RightSide := RightSide + hdControl.Sections[i].Width;
226         Canvas.MoveTo(RightSide, ARect.Bottom - 1);
227         Canvas.LineTo(RightSide, ARect.Top);
228       end;
229       if Index < Items.Count then
230       begin
231         AnOrder := TOrder(Items.Objects[Index]);
232         if AnOrder <> nil then with AnOrder do for i := 0 to 3 do
233         begin
234           if i > 0 then ARect.Left := ARect.Right + 2 else ARect.Left := 2;
235           ARect.Right := ARect.Left + hdControl.Sections[i].Width - 6;
236           SaveColor := Canvas.Brush.Color;
237           if i = 0 then
238           begin
239             x := DGroupName;
240             if (Index > 0) and (x = TOrder(Items.Objects[Index - 1]).DGroupName) then x := '';
241           end;
242           if i = 1 then x := Text;
243           if i = 2 then
244           begin
245             x := FormatFMDateTimeStr('mm/dd/yy hh:nn', StartTime);
246             if IsFMDateTime(StartTime) and (Length(StartTime) = FM_DATE_ONLY) then x := Piece(x, #32, 1);
247             if Length(x) > 0 then x := 'Start: ' + x;
248             y := FormatFMDateTimeStr('mm/dd/yy hh:nn', StopTime);
249             if IsFMDateTime(StopTime)  and (Length(StopTime) = FM_DATE_ONLY)  then y := Piece(y, #32, 1);
250             if Length(y) > 0 then x := x + CRLF + 'Stop: ' + y;
251           end;
252           if i = 3 then x := NameOfStatus(Status);
253           if (i = 1) or (i = 2) then
254             DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK)
255           else
256             DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX );
257           Canvas.Brush.Color := SaveColor;
258           ARect.Right := ARect.Right + 4;
259         end;
260       end;
261     end;
262   end;
263   
264   procedure TfrmODActive.RetrieveVisibleOrders(AnIndex: Integer);
265   var
266     i: Integer;
267     tmplst: TList;
268     AnOrder: TOrder;
269   begin
270     tmplst := TList.Create;
271     for i := AnIndex to AnIndex + 100 do
272     begin
273       if i >= ActiveOrderList.Count then break;
274       AnOrder := TOrder(ActiveOrderList.Items[i]);
275       if not AnOrder.Retrieved then tmplst.Add(AnOrder);
276     end;
277     RetrieveOrderFields(tmplst, 2, -1);
278     tmplst.Free;
279   end;
280   
281   procedure TfrmODActive.hdControlSectionResize(
282     HeaderControl: THeaderControl; Section: THeaderSection);
283   begin
284     inherited;
285     RedrawSuspend(Self.Handle);
286     RedrawActiveList;
287     RedrawActivate(Self.Handle);
288     lstActiveOrders.Invalidate;
289   end;
290   
291   procedure TfrmODActive.RedrawActiveList;
292   var
293     i, SaveTop: Integer;
294     AnOrder: TOrder;
295   begin
296     with lstActiveOrders do
297     begin
298       RedrawSuspend(Handle);
299       SaveTop := TopIndex;
300       Clear;
301       for i := 0 to ActiveOrderList.Count - 1 do
302       begin
303         AnOrder := TOrder(ActiveOrderList.Items[i]);
304         if (AnOrder.ID = FDefaultEventOrder) or (isDCedOrder(AnOrder.ID)) then
305           Continue;
306         Items.AddObject(AnOrder.ID, AnOrder);
307       end;
308       TopIndex := SaveTop;
309       RedrawActivate(Handle);
310     end;
311   end;
312   
313   function TfrmODActive.MeasureColumnHeight(TheOrderText: string; Index,
314     Column: integer): integer;
315   var
316     ARect: TRect;
317   begin
318     ARect.Left := 0;
319     ARect.Top := 0;
320     ARect.Bottom := 0;
321     ARect.Right := hdControl.Sections[Column].Width -6;
322     Result := WrappedTextHeightByFont(lstActiveOrders.Canvas,lstActiveOrders.Font,TheOrderText,ARect);
323   end;
324   
325   end.

Module Calls (2 levels)


fODActive
 ├uCore
 │ ├rCore
 │ ├uConst
 │ ├uCombatVet
 │ ├rTIU
 │ ├rOrders
 │ ├rConsults
 │ └uOrders
 ├rOrders...
 ├fOrders
 │ ├fHSplit
 │ ├rOrders...
 │ ├fODBase
 │ ├uConst
 │ ├uCore...
 │ ├uOrders...
 │ ├UBACore
 │ ├UBAGlobals
 │ ├fFrame
 │ ├fOrderVw
 │ ├fRptBox
 │ ├fLkUpLocation
 │ ├fOrdersDC
 │ ├fOrdersCV
 │ ├fOrdersHold
 │ ├fOrdersUnhold
 │ ├fOrdersAlert
 │ ├fOrderFlag
 │ ├fOrderUnflag
 │ ├fOrdersSign
 │ ├fOrdersRelease
 │ ├fOrdersOnChart
 │ ├fOrdersEvntRelease
 │ ├fOrdersComplete
 │ ├fOrdersVerify
 │ ├fOrderComment
 │ ├fOrdersRenew
 │ ├fODReleaseEvent
 │ ├rCore...
 │ ├fOCSession
 │ ├fOrdersPrint
 │ ├fOrdersTS
 │ ├fEffectDate
 │ ├fODActive...
 │ ├fOrdersCopy
 │ ├uODBase
 │ ├rMeds
 │ ├fODValidateAction
 │ ├fMeds
 │ ├uInit
 │ ├fODConsult
 │ ├fClinicWardMeds
 │ ├fActivateDeactivate
 │ └rODMeds
 ├uOrders...
 ├fFrame...
 └fAutoSz
   └fBase508Form

Module Called-By (2 levels)


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