source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fODActive.pas@ 1643

Last change on this file since 1643 was 459, checked in by Kevin Toppenberg, 16 years ago

Adding foia-cprs branch

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