source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fODActive.pas@ 973

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

Initial upload of TMG-CPRS 1.0.26.69

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