source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fOrdersEvntRelease.pas@ 820

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

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