source: cprs/trunk/CPRS-Chart/Orders/fOrdersEvntRelease.pas@ 829

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

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