source: cprs/trunk/CPRS-Chart/Orders/fODActive.pas@ 1707

Last change on this file since 1707 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

File size: 10.3 KB
Line 
1unit fODActive;
2
3interface
4
5uses
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
10type
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
46procedure CopyActiveOrdersToEvent(AnOrderView: TOrderView; AnEvent: TOrderDelayEvent);
47
48implementation
49
50uses
51 VA2006Utils;
52
53{$R *.DFM}
54
55const
56 FM_DATE_ONLY = 7;
57
58procedure CopyActiveOrdersToEvent(AnOrderView: TOrderView; AnEvent: TOrderDelayEvent);
59var
60 frmODActive: TfrmODActive;
61begin
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;
75end;
76
77procedure TfrmODActive.btnOKClick(Sender: TObject);
78const
79 TX_NOSEL = 'No orders are highlighted. Select the orders' + CRLF +
80 'you wish to take action on.';
81 TC_NOSEL = 'No Orders Selected';
82var
83 i : integer;
84 SelectedList: TStringList;
85 TheVerify : boolean;
86 DoesDestEvtOccur:boolean;
87begin
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;
115end;
116
117procedure TfrmODActive.btnCancelClick(Sender: TObject);
118begin
119 Close;
120end;
121
122procedure TfrmODActive.FormCreate(Sender: TObject);
123begin
124 FixHeaderControlDelphi2006Bug(hdControl);
125 ActiveOrderList := TList.Create;
126 FOrderView := TOrderView.Create;
127 FDefaultEventOrder := '';
128end;
129
130procedure TfrmODActive.LoadActiveOrders;
131var
132 AnOrder: TOrder;
133 i: integer;
134 AnOrderPtEvtId,AnOrderEvtId: string;
135begin
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;
162end;
163
164procedure TfrmODActive.FormDestroy(Sender: TObject);
165begin
166 ClearOrders(ActiveOrderList);
167 ActiveOrderList.Free;
168 lstActiveOrders.Clear;
169 if FOrderView <> nil then FOrderView := nil ;
170end;
171
172procedure TfrmODActive.lstActiveOrdersMeasureItem(Control: TWinControl;
173 Index: Integer; var AaHeight: Integer);
174var
175 x,y: string;
176 TextHeight, NewHeight, DateHeight: Integer;
177 TheOrder: TOrder;
178begin
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;
203end;
204
205procedure TfrmODActive.lstActiveOrdersDrawItem(Control: TWinControl;
206 Index: Integer; TheeRect: TRect; State: TOwnerDrawState);
207var
208 x, y: string;
209 ARect: TRect;
210 AnOrder: TOrder;
211 i,RightSide: integer;
212 SaveColor: TColor;
213begin
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;
262end;
263
264procedure TfrmODActive.RetrieveVisibleOrders(AnIndex: Integer);
265var
266 i: Integer;
267 tmplst: TList;
268 AnOrder: TOrder;
269begin
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;
279end;
280
281procedure TfrmODActive.hdControlSectionResize(
282 HeaderControl: THeaderControl; Section: THeaderSection);
283begin
284 inherited;
285 RedrawSuspend(Self.Handle);
286 RedrawActiveList;
287 RedrawActivate(Self.Handle);
288 lstActiveOrders.Invalidate;
289end;
290
291procedure TfrmODActive.RedrawActiveList;
292var
293 i, SaveTop: Integer;
294 AnOrder: TOrder;
295begin
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;
311end;
312
313function TfrmODActive.MeasureColumnHeight(TheOrderText: string; Index,
314 Column: integer): integer;
315var
316 ARect: TRect;
317begin
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);
323end;
324
325end.
Note: See TracBrowser for help on using the repository browser.