source: cprs/trunk/CPRS-Chart/Orders/fODReleaseEvent.pas@ 832

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

Upgrade to version 27

File size: 9.1 KB
Line 
1unit fODReleaseEvent;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ExtCtrls, ORFn, CheckLst, ORCtrls, fAutoSz, fBase508Form,
8 VA508AccessibilityManager;
9
10type
11 TfrmOrdersReleaseEvent = class(TfrmBase508Form)
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, rODLab, fRptBox,
48 VAUtils;
49
50const
51 TX_SAVERR1 = 'The error, ';
52 TX_SAVERR2 = ', occurred while trying to release:' + CRLF + CRLF;
53 TC_SAVERR = 'Error Saving Order';
54
55//procedure ExecuteReleaseEventOrders(AnOrderList: TList);
56function ExecuteReleaseEventOrders(AnOrderList: TList): boolean;
57const
58 TXT_RELEASE = #13 + #13 + ' The following orders will be released to service:';
59var
60 i,j,idx: integer;
61 AOrder: TOrder;
62 OrdersLst: TStringlist;
63 OrderText, LastCheckedPtEvt, SpeCap: string;
64 frmOrdersReleaseEvent: TfrmOrdersReleaseEvent;
65 AList: TStringList;
66
67 function FindOrderText(const AnID: string): string;
68 var
69 i: Integer;
70 begin
71 Result := '';
72 with AnOrderList do for i := 0 to Count - 1 do
73 with TOrder(Items[i]) do if ID = AnID then
74 begin
75 Result := Text;
76 Break;
77 end;
78 end;
79
80begin
81 frmOrdersReleaseEvent := TfrmOrdersReleaseEvent.Create(Application);
82 try
83 frmOrdersReleaseEvent.CurrTS := Piece(GetCurrentSpec(Patient.DFN),'^',1);
84 if Length(frmOrdersReleaseEvent.CurrTS)>0 then
85 SpeCap := #13 + ' The current treating specialty is ' + frmOrdersReleaseEvent.CurrTS
86 else
87 SpeCap := #13 + ' No treating specialty is available.';
88 ResizeFormToFont(TForm(frmOrdersReleaseEvent));
89 if Patient.Inpatient then
90 frmOrdersReleaseEvent.lblRelease.Caption := ' ' + Patient.Name + ' is currently admitted to '
91 + Encounter.LocationName + SpeCap + TXT_RELEASE
92 else
93 begin
94 if Encounter.Location > 0 then
95 frmOrdersReleaseEvent.lblRelease.Caption := ' ' + Patient.Name + ' is currently at '
96 + Encounter.LocationName + SpeCap + TXT_RELEASE
97 else
98 frmOrdersReleaseEvent.lblRelease.Caption := ' ' + Patient.Name + ' is currently an outpatient.' + SpeCap + TXT_RELEASE;
99 end;
100 with frmOrdersReleaseEvent do
101 cklstOrders.Caption := lblRelease.Caption;
102 with AnOrderList do for i := 0 to Count - 1 do
103 begin
104 AOrder := TOrder(Items[i]);
105 idx := frmOrdersReleaseEvent.cklstOrders.Items.AddObject(AOrder.Text,AOrder);
106 frmOrdersReleaseEvent.cklstOrders.Checked[idx] := True;
107 end;
108 frmOrdersReleaseEvent.ShowModal;
109 if frmOrdersReleaseEvent.OKPressed then
110 begin
111 OrdersLst := TStringList.Create;
112 for j := 0 to frmOrdersReleaseEvent.cklstOrders.Items.Count - 1 do
113 begin
114 if frmOrdersReleaseEvent.cklstOrders.Checked[j] then
115 OrdersLst.Add(TOrder(frmOrdersReleaseEvent.cklstOrders.Items.Objects[j]).ID);
116 end;
117 StatusText('Releasing Orders to Service...');
118 SendReleaseOrders(OrdersLst);
119 LastCheckedPtEvt := '';
120 with OrdersLst do if Count > 0 then for i := 0 to Count - 1 do
121 begin
122 if Pos('E', Piece(OrdersLst[i], U, 2)) > 0 then
123 begin
124 OrderText := FindOrderText(Piece(OrdersLst[i], U, 1));
125 if Piece(OrdersLst[i],U,4) = 'Invalid Pharmacy order number' then
126 InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
127 'The changes to this order have not been saved. You must contact Pharmacy to complete any action on this order.',
128 TC_SAVERR, MB_OK)
129 else
130 InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText,
131 TC_SAVERR, MB_OK);
132 end;
133 end;
134 // CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders
135 AList := TStringList.Create;
136 try
137 CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, OrdersLst);
138 if AList.Text <> '' then
139 ReportBox(AList, 'Changed Orders', TRUE);
140 finally
141 AList.Free;
142 end;
143 PrintOrdersOnSignRelease(OrdersLst, NO_PROVIDER);
144
145 with AnOrderList do for i := 0 to Count - 1 do with TOrder(Items[i]) do
146 begin
147 if EventPtr <> LastCheckedPtEvt then
148 begin
149 LastCheckedPtEvt := EventPtr;
150 if CompleteEvt(EventPtr,EventName,False) then
151 frmOrdersReleaseEvent.FComplete := True;
152 end;
153 end;
154 StatusText('');
155 ordersLst.Free;
156 with AnOrderList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
157 if frmOrdersReleaseEvent.FComplete then
158 begin
159 frmOrders.InitOrderSheetsForEvtDelay;
160 frmOrders.ClickLstSheet;
161 end;
162 frmOrdersReleaseEvent.FComplete := False;
163 Result := True;
164 end else
165 Result := False;
166 Except
167 on E: exception do
168 Result := false;
169 end;
170 {finally
171 with AnOrderList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
172 if frmOrdersReleaseEvent.FComplete then
173 begin
174 frmOrders.InitOrderSheetsForEvtDelay;
175 frmOrders.ClickLstSheet;
176 end;
177 frmOrdersReleaseEvent.FComplete := False;
178 end;}
179end;
180
181procedure TfrmOrdersReleaseEvent.btnCancelClick(Sender: TObject);
182begin
183 Close;
184end;
185
186procedure TfrmOrdersReleaseEvent.FormCreate(Sender: TObject);
187begin
188 inherited;
189 OKPressed := False;
190 FLastHintItem := -1;
191 FComplete := False;
192 FOldHintPause := Application.HintPause;
193 FCurrTS := '';
194 Application.HintPause := 250;
195 FOldHintHidePause := Application.HintHidePause;
196 Application.HintHidePause := 30000;
197end;
198
199procedure TfrmOrdersReleaseEvent.btnOKClick(Sender: TObject);
200var
201 i: integer;
202 beSelected: boolean;
203begin
204 beSelected := False;
205 for i := 0 to cklstOrders.Items.Count - 1 do
206 begin
207 if cklstOrders.Checked[i] then
208 begin
209 beSelected := True;
210 Break;
211 end;
212 end;
213 if not beSelected then
214 begin
215 ShowMsg('You have to select at least one order!');
216 Exit;
217 end;
218 OKPressed := True;
219 Close;
220end;
221
222procedure TfrmOrdersReleaseEvent.FormDestroy(Sender: TObject);
223begin
224 inherited;
225 Application.HintPause := FOldHintPause;
226 Application.HintHidePause := FOldHintHidePause;
227end;
228
229procedure TfrmOrdersReleaseEvent.cklstOrdersMeasureItem(
230 Control: TWinControl; Index: Integer; var AHeight: Integer);
231var
232 x:string;
233 ARect: TRect;
234begin
235 inherited;
236 AHeight := MainFontHeight + 2;
237 with cklstOrders do if Index < Items.Count then
238 begin
239 x := FilteredString(Items[Index]);
240 ARect := ItemRect(Index);
241 AHeight := WrappedTextHeightByFont( cklstOrders.Canvas, Font, x, ARect);
242 if AHeight > 255 then AHeight := 255;
243 if AHeight < 13 then AHeight := 13;
244 end;
245end;
246
247procedure TfrmOrdersReleaseEvent.cklstOrdersDrawItem(Control: TWinControl;
248 Index: Integer; Rect: TRect; State: TOwnerDrawState);
249var
250 x: string;
251 ARect: TRect;
252begin
253 inherited;
254 x := '';
255 ARect := Rect;
256 with cklstOrders do
257 begin
258 Canvas.FillRect(ARect);
259 Canvas.Pen.Color := Get508CompliantColor(clSilver);
260 Canvas.MoveTo(0, ARect.Bottom - 1);
261 Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
262 if Index < Items.Count then
263 begin
264 X := FilteredString(Items[Index]);
265 DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
266 end;
267 end;
268end;
269
270procedure TfrmOrdersReleaseEvent.cklstOrdersMouseMove(Sender: TObject;
271 Shift: TShiftState; X, Y: Integer);
272var
273 Itm: integer;
274begin
275 inherited;
276 Itm := cklstOrders.ItemAtPos(Point(X, Y), TRUE);
277 if (Itm >= 0) then
278 begin
279 if (Itm <> FLastHintItem) then
280 begin
281 Application.CancelHint;
282 cklstOrders.Hint := TrimRight(cklstOrders.Items[Itm]);
283 FLastHintItem := Itm;
284 Application.ActivateHint(Point(X, Y));
285 end;
286 end else
287 begin
288 cklstOrders.Hint := '';
289 FLastHintItem := -1;
290 Application.CancelHint;
291 end;
292end;
293
294end.
Note: See TracBrowser for help on using the repository browser.