source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fODReleaseEvent.pas@ 463

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

Initial upload of TMG-CPRS 1.0.26.69
File size: 10.2 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit fODReleaseEvent;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 StdCtrls, ExtCtrls, ORFn, CheckLst, ORCtrls, fAutoSz;
9
10type
11 TfrmOrdersReleaseEvent = class(TForm)
12 pnlMiddle: TPanel;
13 pnlBottom: TPanel;
14 btnOK: TButton;
15 btnCancel: TButton;
16 cklstOrders: TCaptionCheckListBox;
17 lblRelease: TLabel;
18 procedure btnCancelClick(Sender: TObject);
19 procedure FormCreate(Sender: TObject);
20 procedure btnOKClick(Sender: TObject);
21 procedure FormDestroy(Sender: TObject);
22 procedure cklstOrdersMeasureItem(Control: TWinControl; Index: Integer;
23 var AHeight: Integer);
24 procedure cklstOrdersDrawItem(Control: TWinControl; Index: Integer;
25 Rect: TRect; State: TOwnerDrawState);
26 procedure cklstOrdersMouseMove(Sender: TObject; Shift: TShiftState; X,
27 Y: Integer);
28 private
29 { Private declarations }
30 OKPressed: boolean;
31 FLastHintItem: integer;
32 FOldHintPause: integer;
33 FOldHintHidePause: integer;
34 FComplete: boolean;
35 FCurrTS: string;
36 public
37 { Public declarations }
38 property CurrTS: string read FCurrTS write FCurrTS;
39 end;
40
41//procedure ExecuteReleaseEventOrders(AnOrderList: TList);
42function ExecuteReleaseEventOrders(AnOrderList: TList): boolean;
43
44implementation
45{$R *.DFM}
46
47uses rCore, rOrders, uConst, fOrdersPrint, uCore, uOrders, fOrders
48 , DKLang //kt
49 ;
50
51//const
52//TX_SAVERR1 = 'The error, '; <-- original line. //kt 8/8/2007
53//TX_SAVERR2 = ', occurred while trying to release:' + CRLF + CRLF; <-- original line. //kt 8/8/2007
54//TC_SAVERR = 'Error Saving Order'; <-- original line. //kt 8/8/2007
55
56//procedure ExecuteReleaseEventOrders(AnOrderList: TList);
57
58var
59 TX_SAVERR1 : string; //kt
60 TX_SAVERR2 : string; //kt
61 TC_SAVERR : string; //kt
62
63procedure SetupVars;
64//kt Added entire function to replace constant declarations 8/8/2007
65begin
66 TX_SAVERR1 := DKLangConstW('fODReleaseEvent_The_errorx');
67 TX_SAVERR2 := DKLangConstW('fODReleaseEvent_x_occurred_while_trying_to_releasex') + CRLF + CRLF;
68 TC_SAVERR := DKLangConstW('fODReleaseEvent_Error_Saving_Order');
69end;
70
71function ExecuteReleaseEventOrders(AnOrderList: TList): boolean;
72//const
73//TXT_RELEASE = #13 + #13 + ' The following orders will be released to service:'; <-- original line. //kt 8/8/2007
74var
75 i,j,idx: integer;
76 AOrder: TOrder;
77 OrdersLst: TStringlist;
78 OrderText, LastCheckedPtEvt, SpeCap: string;
79 frmOrdersReleaseEvent: TfrmOrdersReleaseEvent;
80 TXT_RELEASE : string; //kt
81
82 function FindOrderText(const AnID: string): string;
83 var
84 i: Integer;
85 begin
86 Result := '';
87 with AnOrderList do for i := 0 to Count - 1 do
88 with TOrder(Items[i]) do if ID = AnID then
89 begin
90 Result := Text;
91 Break;
92 end;
93 end;
94
95begin
96 SetupVars; //kt added 8/8/2007 to replace constants with vars.
97 TXT_RELEASE := #13 + #13 + DKLangConstW('fODReleaseEvent_The_following_orders_will_be_released_to_servicex'); //kt added 8/8/2007
98 frmOrdersReleaseEvent := TfrmOrdersReleaseEvent.Create(Application);
99 try
100 frmOrdersReleaseEvent.CurrTS := Piece(GetCurrentSpec(Patient.DFN),'^',1);
101 if Length(frmOrdersReleaseEvent.CurrTS)>0 then
102// SpeCap := #13 + ' The current treating specialty is ' + frmOrdersReleaseEvent.CurrTS <-- original line. //kt 8/8/2007
103 SpeCap := #13 + DKLangConstW('fODReleaseEvent_The_current_treating_specialty_is') + frmOrdersReleaseEvent.CurrTS //kt added 8/8/2007
104 else
105// SpeCap := #13 + ' No treating specialty is available.'; <-- original line. //kt 8/8/2007
106 SpeCap := #13 + DKLangConstW('fODReleaseEvent_No_treating_specialty_is_availablex'); //kt added 8/8/2007
107 ResizeFormToFont(TForm(frmOrdersReleaseEvent));
108 if Patient.Inpatient then
109// frmOrdersReleaseEvent.lblRelease.Caption := ' ' + Patient.Name + ' is currently admitted to ' <-- original line. //kt 8/8/2007
110 frmOrdersReleaseEvent.lblRelease.Caption := ' ' + Patient.Name + DKLangConstW('fODReleaseEvent_is_currently_admitted_to') //kt added 8/8/2007
111 + Encounter.LocationName + SpeCap + TXT_RELEASE
112 else
113 begin
114 if Encounter.Location > 0 then
115// frmOrdersReleaseEvent.lblRelease.Caption := ' ' + Patient.Name + ' is currently at ' <-- original line. //kt 8/8/2007
116 frmOrdersReleaseEvent.lblRelease.Caption := ' ' + Patient.Name + DKLangConstW('fODReleaseEvent_is_currently_at') //kt added 8/8/2007
117 + Encounter.LocationName + SpeCap + TXT_RELEASE
118 else
119// frmOrdersReleaseEvent.lblRelease.Caption := ' ' + Patient.Name + ' is currently an outpatient.' + SpeCap + TXT_RELEASE; <-- original line. //kt 8/8/2007
120 frmOrdersReleaseEvent.lblRelease.Caption := ' ' + Patient.Name + DKLangConstW('fODReleaseEvent_is_currently_an_outpatientx') + SpeCap + TXT_RELEASE; //kt added 8/8/2007
121 end;
122 with frmOrdersReleaseEvent do
123 cklstOrders.Caption := lblRelease.Caption;
124 with AnOrderList do for i := 0 to Count - 1 do
125 begin
126 AOrder := TOrder(Items[i]);
127 idx := frmOrdersReleaseEvent.cklstOrders.Items.AddObject(AOrder.Text,AOrder);
128 frmOrdersReleaseEvent.cklstOrders.Checked[idx] := True;
129 end;
130 frmOrdersReleaseEvent.ShowModal;
131 if frmOrdersReleaseEvent.OKPressed then
132 begin
133 OrdersLst := TStringList.Create;
134 for j := 0 to frmOrdersReleaseEvent.cklstOrders.Items.Count - 1 do
135 begin
136 if frmOrdersReleaseEvent.cklstOrders.Checked[j] then
137 OrdersLst.Add(TOrder(frmOrdersReleaseEvent.cklstOrders.Items.Objects[j]).ID);
138 end;
139// StatusText('Releasing Orders to Service...'); <-- original line. //kt 8/8/2007
140 StatusText(DKLangConstW('fODReleaseEvent_Releasing_Orders_to_Servicexxx')); //kt added 8/8/2007
141 SendReleaseOrders(OrdersLst);
142 LastCheckedPtEvt := '';
143 with OrdersLst do if Count > 0 then for i := 0 to Count - 1 do
144 begin
145 if Pos('E', Piece(OrdersLst[i], U, 2)) > 0 then
146 begin
147 OrderText := FindOrderText(Piece(OrdersLst[i], U, 1));
148 InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText,TC_SAVERR, MB_OK);
149 end;
150 end;
151 PrintOrdersOnSignRelease(OrdersLst, NO_PROVIDER);
152
153 with AnOrderList do for i := 0 to Count - 1 do with TOrder(Items[i]) do
154 begin
155 if EventPtr <> LastCheckedPtEvt then
156 begin
157 LastCheckedPtEvt := EventPtr;
158 if CompleteEvt(EventPtr,EventName,False) then
159 frmOrdersReleaseEvent.FComplete := True;
160 end;
161 end;
162 StatusText('');
163 ordersLst.Free;
164 with AnOrderList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
165 if frmOrdersReleaseEvent.FComplete then
166 begin
167 frmOrders.InitOrderSheetsForEvtDelay;
168 frmOrders.ClickLstSheet;
169 end;
170 frmOrdersReleaseEvent.FComplete := False;
171 Result := True;
172 end else
173 Result := False;
174 Except
175 on E: exception do
176 Result := false;
177 end;
178 {finally
179 with AnOrderList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
180 if frmOrdersReleaseEvent.FComplete then
181 begin
182 frmOrders.InitOrderSheetsForEvtDelay;
183 frmOrders.ClickLstSheet;
184 end;
185 frmOrdersReleaseEvent.FComplete := False;
186 end;}
187end;
188
189procedure TfrmOrdersReleaseEvent.btnCancelClick(Sender: TObject);
190begin
191 Close;
192end;
193
194procedure TfrmOrdersReleaseEvent.FormCreate(Sender: TObject);
195begin
196 inherited;
197 OKPressed := False;
198 FLastHintItem := -1;
199 FComplete := False;
200 FOldHintPause := Application.HintPause;
201 FCurrTS := '';
202 Application.HintPause := 250;
203 FOldHintHidePause := Application.HintHidePause;
204 Application.HintHidePause := 30000;
205end;
206
207procedure TfrmOrdersReleaseEvent.btnOKClick(Sender: TObject);
208var
209 i: integer;
210 beSelected: boolean;
211begin
212 beSelected := False;
213 for i := 0 to cklstOrders.Items.Count - 1 do
214 begin
215 if cklstOrders.Checked[i] then
216 begin
217 beSelected := True;
218 Break;
219 end;
220 end;
221 if not beSelected then
222 begin
223// ShowMessage('You have to select at least one order!'); <-- original line. //kt 8/8/2007
224 ShowMessage(DKLangConstW('fODReleaseEvent_You_have_to_select_at_least_one_orderx')); //kt added 8/8/2007
225 Exit;
226 end;
227 OKPressed := True;
228 Close;
229end;
230
231procedure TfrmOrdersReleaseEvent.FormDestroy(Sender: TObject);
232begin
233 inherited;
234 Application.HintPause := FOldHintPause;
235 Application.HintHidePause := FOldHintHidePause;
236end;
237
238procedure TfrmOrdersReleaseEvent.cklstOrdersMeasureItem(
239 Control: TWinControl; Index: Integer; var AHeight: Integer);
240var
241 x:string;
242 ARect: TRect;
243begin
244 inherited;
245 AHeight := MainFontHeight + 2;
246 with cklstOrders do if Index < Items.Count then
247 begin
248 x := FilteredString(Items[Index]);
249 ARect := ItemRect(Index);
250 AHeight := WrappedTextHeightByFont( cklstOrders.Canvas, Font, x, ARect);
251 if AHeight > 255 then AHeight := 255;
252 if AHeight < 13 then AHeight := 13;
253 end;
254end;
255
256procedure TfrmOrdersReleaseEvent.cklstOrdersDrawItem(Control: TWinControl;
257 Index: Integer; Rect: TRect; State: TOwnerDrawState);
258var
259 x: string;
260 ARect: TRect;
261begin
262 inherited;
263 x := '';
264 ARect := Rect;
265 with cklstOrders do
266 begin
267 Canvas.FillRect(ARect);
268 Canvas.Pen.Color := clSilver;
269 Canvas.MoveTo(0, ARect.Bottom - 1);
270 Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
271 if Index < Items.Count then
272 begin
273 X := FilteredString(Items[Index]);
274 DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
275 end;
276 end;
277end;
278
279procedure TfrmOrdersReleaseEvent.cklstOrdersMouseMove(Sender: TObject;
280 Shift: TShiftState; X, Y: Integer);
281var
282 Itm: integer;
283begin
284 inherited;
285 Itm := cklstOrders.ItemAtPos(Point(X, Y), TRUE);
286 if (Itm >= 0) then
287 begin
288 if (Itm <> FLastHintItem) then
289 begin
290 Application.CancelHint;
291 cklstOrders.Hint := TrimRight(cklstOrders.Items[Itm]);
292 FLastHintItem := Itm;
293 Application.ActivateHint(Point(X, Y));
294 end;
295 end else
296 begin
297 cklstOrders.Hint := '';
298 FLastHintItem := -1;
299 Application.CancelHint;
300 end;
301end;
302
303end.
Note: See TracBrowser for help on using the repository browser.