source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrdersEvntRelease.pas@ 1099

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

Adding foia-cprs branch
File size: 10.8 KB
RevLine 
[459]1unit fOrdersEvntRelease;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs
7 ,ORFn, uCore, rOrders, fOrders, StdCtrls, ORCtrls, ExtCtrls, Grids,fAutoSz,
8 Spin, ComCtrls;
9
10type
11 TfrmOrdersEvntRelease = class(TfrmAutoSz)
12 pnlTop: TPanel;
13 lblPtInfo: TStaticText;
14 pnlBottom: TPanel;
15 Label1: TLabel;
16 btnOK: TButton;
17 btnCancel: TButton;
18 grdEvtList: TCaptionStringGrid;
19 Panel1: TPanel;
20 Panel2: TPanel;
21 btnApply: TButton;
22 updown1: TUpDown;
23 edtNumber: TEdit;
24 Panel3: TPanel;
25 Label2: TLabel;
26 Label3: TLabel;
27 procedure FormCreate(Sender: TObject);
28 procedure btnCancelClick(Sender: TObject);
29 procedure FormShow(Sender: TObject);
30 procedure grdEvtListDrawCell(Sender: TObject; ACol, ARow: Integer;
31 Rect: TRect; State: TGridDrawState);
32 procedure grdEvtListMouseDown(Sender: TObject; Button: TMouseButton;
33 Shift: TShiftState; X, Y: Integer);
34 procedure btnOKClick(Sender: TObject);
35 procedure grdEvtListKeyPress(Sender: TObject; var Key: Char);
36 procedure grdEvtListDblClick(Sender: TObject);
37 procedure pnlBottomResize(Sender: TObject);
38 procedure edtNumberChange(Sender: TObject);
39 procedure edtNumberKeyDown(Sender: TObject; var Key: Word;
40 Shift: TShiftState);
41 procedure btnApplyClick(Sender: TObject);
42 procedure btnApplyKeyDown(Sender: TObject; var Key: Word;
43 Shift: TShiftState);
44 procedure edtNumberClick(Sender: TObject);
45 procedure updown1Click(Sender: TObject; Button: TUDBtnType);
46 procedure FormClose(Sender: TObject; var Action: TCloseAction);
47 procedure FormDestroy(Sender: TObject);
48 private
49 { Private declarations }
50 FEvtList: TStringList;
51 FTotal: Integer;
52 FDGroup: Integer;
53 FViewName: string;
54 FPtEvt: string;
55 FEvent: TOrderDelayEvent;
56 fPreTxt: string;
57 FOkPressed: Boolean;
58 procedure ShowEvents(NumOfEvts: integer);
59 public
60 { Public declarations }
61 end;
62
63 procedure SelectEvtReleasedOrders(var OrderView: TOrderView);
64
65implementation
66
67uses rMisc, Accessibility_TLB, uAccessibleStringGrid;
68
69{$R *.DFM}
70
71const
72 TAB = #9;
73
74procedure SelectEvtReleasedOrders(var OrderView: TOrderView);
75const
76 FROM_SERVER = TRUE;
77var
78 frmOrdersEvntRelease: TfrmOrdersEvntRelease;
79begin
80 frmOrdersEvntRelease := TfrmOrdersEvntRelease.Create(Application);
81 SetFormPosition(frmOrdersEvntRelease);
82 try
83 with frmOrdersEvntRelease do
84 begin
85 FDGroup := OrderView.DGroup;
86 ShowModal;
87 if FOkPressed then
88 begin
89 frmOrders.FromDCRelease := True;
90 OrderView.Changed := FOkPressed;
91 OrderView.DGroup := FDGroup;
92 OrderView.CtxtTime := 0;
93 OrderView.TextView := 0;
94 OrderView.ViewName := FViewName;
95 OrderView.EventDelay.PtEventIFN := StrToIntDef(FPtEvt,0);
96 if FEvent.PtEventIFN > 0 then OrderView.EventDelay := FEvent
97 else
98 begin
99 OrderView.EventDelay.EventType := 'C';
100 OrderView.EventDelay.Specialty := 0;
101 OrderView.EventDelay.Effective := 0;
102 OrderView.EventDelay.PtEventIFN := 0;
103 end;
104 end else
105 OrderView.Changed := False;
106 end;
107 finally
108 frmOrdersEvntRelease.FEvtList.Clear;
109 frmOrdersEvntRelease.Release;
110 frmOrdersEvntRelease.FOkPressed := False;
111 end;
112end;
113
114procedure TfrmOrdersEvntRelease.FormCreate(Sender: TObject);
115var
116 CurrTS: string;
117 SpeCap: string;
118 ATotal: integer;
119begin
120 CurrTS := Piece(GetCurrentSpec(Patient.DFN),'^',1);
121 if Length(CurrTS)>0 then
122 SpeCap := #13 + ' The current treating specialty is ' + CurrTS
123 else
124 SpeCap := #13 + ' No treating specialty is available.';
125 FPtEvt := '';
126 FEvent.EventType := #0;
127 FEvent.EventIFN := 0;
128 FEvent.EventName := '';
129 FEvent.PtEventIFN := 0;
130 FEvent.Specialty := 0;
131 FEvent.Effective := 0;
132 FOkPressed := False;
133 FEvtList := TStringList.Create;
134 FTotal := 5;
135 edtNumber.Text := '5';
136 fPreTxt := edtNumber.Text;
137 if Patient.Inpatient then
138 lblPtInfo.Caption := ' ' + Patient.Name + ' is currently admitted to ' + Encounter.LocationName + SpeCap
139 else
140 begin
141 if Encounter.Location > 0 then
142 lblPtInfo.Caption := ' ' + Patient.Name + ' is currently at ' + Encounter.LocationName + SpeCap
143 else
144 lblPtInfo.Caption := ' ' + Patient.Name + ' currently is an outpatient. ' + SpeCap;
145 end;
146 lblPtInfo.Top := (pnlTop.Height - lblPtInfo.Height) div 2;
147 grdEvtList.Cells[0,0] := 'Event Name';
148 grdEvtList.Cells[1,0] := 'Date/Time Occured';
149 SetPtEvtList(TStrings(fevtList),Patient.DFN, ATotal);
150 TAccessibleStringGrid.WrapControl(grdEvtList);
151end;
152
153procedure TfrmOrdersEvntRelease.btnCancelClick(Sender: TObject);
154begin
155 Close;
156end;
157
158procedure TfrmOrdersEvntRelease.FormShow(Sender: TObject);
159begin
160 ShowEvents(fTotal);
161end;
162
163procedure TfrmOrdersEvntRelease.grdEvtListDrawCell(Sender: TObject; ACol,
164 ARow: Integer; Rect: TRect; State: TGridDrawState);
165begin
166 inherited;
167 grdEvtList.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2,
168 Piece(grdEvtList.Cells[ACol, ARow], TAB, 1));
169end;
170
171procedure TfrmOrdersEvntRelease.grdEvtListMouseDown(Sender: TObject;
172 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
173var
174 ACol, ARow: integer;
175 EvtInfo: string;
176begin
177 grdEvtList.MouseToCell(X,Y,ACol,ARow);
178 if ARow>0 then
179 begin
180 FPtEvt := Piece(grdEvtList.Cells[0,grdEvtList.Row],TAB,2);
181 if StrToIntDef(FPtEvt,0)>0 then
182 FEvent.PtEventIFN := StrToInt(FPtEvt);
183 EvtInfo := EventInfo(FPtEvt);
184 FEvent.EventIFN := StrToIntDef( Piece(EvtInfo,'^',2),0);
185 if FEvent.EventIFN > 0 then
186 begin
187 FEvent.EventType := CharAt(Piece(EvtInfo,'^',1),1);
188 FEvent.EventName := Piece(EvtInfo,'^',3);
189 end;
190 FDGroup := DGroupAll;
191 FViewName := 'Patient event -- ' + Piece(grdEvtList.Cells[0,grdEvtList.Row],TAB,1)
192 + ' on ' + grdEvtList.Cells[1,grdEvtList.Row];
193 end;
194end;
195
196procedure TfrmOrdersEvntRelease.btnOKClick(Sender: TObject);
197var
198 EvtInfo: string;
199begin
200 if grdEvtList.Row < 1 then
201 begin
202 ShowMessage('You need to select an event first.');
203 FOkPressed := False;
204 Exit;
205 end
206 else
207 begin
208 if AnsiCompareText(grdEvtList.Cells[0,1],'No event order found') = 0 then
209 begin
210 FOKPressed := False;
211 Exit;
212 end;
213 if FPtEvt = '' then
214 begin
215 FPtEvt := Piece(grdEvtList.Cells[0,grdEvtList.Row],TAB,2);
216 if StrToIntDef(FPtEvt,0)>0 then
217 FEvent.PtEventIFN := StrToInt(FPtEvt);
218 EvtInfo := EventInfo(FPtEvt);
219 FEvent.EventIFN := StrToIntDef( Piece(EvtInfo,'^',2),0);
220 if FEvent.EventIFN > 0 then
221 begin
222 FEvent.EventType := CharAt(Piece(EvtInfo,'^',1),1);
223 FEvent.EventName := Piece(EvtInfo,'^',3);
224 end;
225 FDGroup := DGroupAll;
226 FViewName := 'Patient event -- ' + Piece(grdEvtList.Cells[0,grdEvtList.Row],TAB,1)
227 + ' on ' + grdEvtList.Cells[1,grdEvtList.Row];
228 FOkPressed := True;
229 Close;
230 end else
231 begin
232 FOkPressed := True;
233 Close;
234 end;
235 end;
236end;
237
238procedure TfrmOrdersEvntRelease.grdEvtListKeyPress(Sender: TObject;
239 var Key: Char);
240var
241 EvtInfo: string;
242begin
243 if grdEvtList.Row > 0 then
244 begin
245 FPtEvt := Piece(grdEvtList.Cells[0,grdEvtList.Row],TAB,2);
246 if StrToIntDef(FPtEvt,0)>0 then
247 FEvent.PtEventIFN := StrToInt(FPtEvt);
248 EvtInfo := EventInfo(FPtEvt);
249 FEvent.EventIFN := StrToIntDef( Piece(EvtInfo,'^',2),0);
250 if FEvent.EventIFN > 0 then
251 begin
252 FEvent.EventType := CharAt(Piece(EvtInfo,'^',1),1);
253 FEvent.EventName := Piece(EvtInfo,'^',3);
254 end;
255 FDGroup := DGroupAll;
256 FViewName := 'Released orders for event--Delayed ' + Piece(grdEvtList.Cells[0,grdEvtList.Row],TAB,1)
257 + ' on ' + grdEvtList.Cells[1,grdEvtList.Row];
258 if Key = #13 then btnOKClick(Self);
259 end;
260end;
261
262procedure TfrmOrdersEvntRelease.grdEvtListDblClick(Sender: TObject);
263begin
264 if grdEvtList.Row > 0 then
265 btnOKClick(Self);
266end;
267
268procedure TfrmOrdersEvntRelease.pnlBottomResize(Sender: TObject);
269begin
270 grdEvtList.ColWidths[0] := ( grdEvtList.Width div 3 ) * 2;
271 grdEvtList.ColWidths[1] := grdEvtList.Width - grdEvtList.ColWidths[0] - 4;
272end;
273
274procedure TfrmOrdersEvntRelease.ShowEvents(NumOfEvts: integer);
275var
276 temptot,idx,jdx: integer;
277begin
278 with grdEvtList do
279 for idx := 0 to ColCount - 1 do
280 for jdx:= 1 to RowCount - 1 do
281 begin
282 Cells[idx,jdx] := '';
283 end;
284 if NumOfEvts = 0 then temptot := fevtList.Count
285 else temptot := NumOfEvts;
286 if temptot > fevtList.Count then
287 temptot := fevtList.Count;
288 grdEvtList.RowCount := temptot + 1;
289 if temptot = 0 then
290 begin
291 grdEvtList.RowCount := 2;
292 grdEvtList.Cells[0,1] := 'No event order found';
293 btnOK.Enabled := False;
294 end else
295 begin
296 for idx := 1 to grdEvtList.RowCount-1 do
297 begin
298 grdEvtList.Cells[0,idx] := Piece(fevtList[idx-1],'^',2)+ TAB + Piece(fevtList[idx-1],'^',1);
299 grdEvtList.Cells[1,idx] := FormatFMDateTime('mm/dd/yy hh:nn',StrToFloat(Piece(fevtList[idx-1],'^',3)));
300 end;
301 end;
302end;
303
304procedure TfrmOrdersEvntRelease.edtNumberChange(Sender: TObject);
305begin
306 inherited;
307 if (CharAt(edtNumber.Text,1)='A') or (CharAt(edtNumber.Text,1)='a') then
308 begin
309 edtNumber.Text := 'ALL';
310 edtNumber.SelectAll;
311 fTotal := 0;
312 end
313 else if (StrToIntDef(edtNumber.Text,0)=0) and (AnsiCompareText(edtNumber.Text,'all')<>0) then
314 edtNumber.Text := fPreTxt
315 else if StrToIntDef(edtNumber.Text,0)>0 then
316 fTotal := StrtoInt(edtNumber.Text);
317end;
318
319procedure TfrmOrdersEvntRelease.edtNumberKeyDown(Sender: TObject;
320 var Key: Word; Shift: TShiftState);
321begin
322 inherited;
323 if Key=VK_RETURN then
324 btnApplyClick(Self);
325end;
326
327procedure TfrmOrdersEvntRelease.btnApplyClick(Sender: TObject);
328begin
329 inherited;
330 fPreTxt := edtNumber.Text;
331 ShowEvents(fTotal);
332end;
333
334procedure TfrmOrdersEvntRelease.btnApplyKeyDown(Sender: TObject;
335 var Key: Word; Shift: TShiftState);
336begin
337 inherited;
338 if Key = VK_RETURN then
339 btnApplyClick(Self);
340end;
341
342procedure TfrmOrdersEvntRelease.edtNumberClick(Sender: TObject);
343begin
344 inherited;
345 edtNumber.SelectAll;
346end;
347
348procedure TfrmOrdersEvntRelease.updown1Click(Sender: TObject;
349 Button: TUDBtnType);
350begin
351 inherited;
352 fTotal := updown1.Position;
353 edtNumber.Text := IntToStr(updown1.Position);
354 btnApplyClick(Self);
355end;
356
357procedure TfrmOrdersEvntRelease.FormClose(Sender: TObject;
358 var Action: TCloseAction);
359begin
360 inherited;
361 SaveUserBounds(Self);
362 Action := caFree;
363end;
364
365procedure TfrmOrdersEvntRelease.FormDestroy(Sender: TObject);
366begin
367 TAccessibleStringGrid.UnwrapControl(grdEvtList);
368 inherited;
369end;
370
371end.
Note: See TracBrowser for help on using the repository browser.