source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fODReleaseEvent.pas@ 1742

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

Adding foia-cprs branch

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