source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrdersDC.pas@ 459

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

Adding foia-cprs branch
File size: 8.7 KB
Line 
1unit fOrdersDC;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls;
8
9type
10 TfrmDCOrders = class(TfrmAutoSz)
11 Label1: TLabel;
12 Panel1: TPanel;
13 lstOrders: TCaptionListBox;
14 Panel2: TPanel;
15 lblReason: TLabel;
16 lstReason: TORListBox;
17 cmdOK: TButton;
18 cmdCancel: TButton;
19 procedure FormCreate(Sender: TObject);
20 procedure cmdOKClick(Sender: TObject);
21 procedure cmdCancelClick(Sender: TObject);
22 procedure lstOrdersDrawItem(Control: TWinControl; Index: Integer;
23 Rect: TRect; State: TOwnerDrawState);
24 procedure lstOrdersMeasureItem(Control: TWinControl; Index: Integer;
25 var AHeight: Integer);
26 private
27 OKPressed: Boolean;
28 DCReason: Integer;
29 function MeasureColumnHeight(TheOrderText: string; Index: Integer):integer;
30 end;
31
32function ExecuteDCOrders(SelectedList: TList; var DelEvt: boolean): Boolean;
33
34implementation
35
36{$R *.DFM}
37
38uses rOrders, uCore, uConst, fOrders, UBAGlobals;
39{ TODO -oRich V. -cOutpatient Meals : Uncomment for processing of child orders treeview. }
40//, fOrderChildren;
41
42function ExecuteDCOrders(SelectedList: TList; var DelEvt: boolean): Boolean;
43const
44 DCT_NEWORDER = 1;
45 DCT_DELETION = 2;
46 DCT_NEWSTATUS = 3;
47var
48 frmDCOrders: TfrmDCOrders;
49 AnOrder: TOrder;
50 i,CanSign, DCType: Integer;
51 NeedReason,NeedRefresh,OnCurrent: Boolean;
52 OriginalID,APtEvtID,APtEvtName,AnEvtInfo,tmpPtEvt: string;
53 PtEvtList: TStringList;
54{ TODO -oRich V. -cOutpatient Meals : Uncomment for processing of child orders treeview. }
55(* tmpList: TList;
56 j: integer;
57 AChildOrder: TOrder;*)
58begin
59 Result := False;
60 DelEvt := False;
61 OnCurrent := False;
62 NeedRefresh := False;
63 PtEvtList := TStringList.Create;
64 if SelectedList.Count = 0 then Exit;
65{ TODO -oRich V. -cOutpatient Meals : Uncomment for processing of child orders treeview. }
66// tmpList := TList.Create;
67 frmDCOrders := TfrmDCOrders.Create(Application);
68 try
69 ResizeFormToFont(TForm(frmDCOrders));
70 NeedReason := False;
71 with SelectedList do for i := 0 to Count - 1 do
72 begin
73 AnOrder := TOrder(Items[i]);
74
75 if BILLING_AWARE then //CQ4589
76 UBAGlobals.RemoveOrderFromDxList(AnOrder.ID);
77
78{ TODO -oRich V. -cOutpatient Meals : Comment next 3 lines for processing of child orders treeview. }
79 frmDCOrders.lstOrders.Items.Add(AnOrder.Text);
80 if not ((AnOrder.Status = 11) and (AnOrder.Signature = 2)) then NeedReason := True;
81 end;
82{ TODO -oRich V. -cOutpatient Meals : Uncomment for processing of child orders treeview. }
83//*********** begin OP meals changes **************
84(* if Copy(AnOrder.Text, 1, 1) = '+' then
85 begin
86 ActOnChildOrders(tmpList, AnOrder.ID);
87{ TODO -oRich V. -cOutpatient Meals : How/when to get selected items into SelectedList? }
88 for j := tmpList.Count - 1 downto 0 do
89 begin
90 AChildOrder := TOrder(tmpList.Items[j]);
91 frmDCOrders.lstOrders.Items.Add(AChildOrder.Text);
92 if not ((AChildOrder.Status = 11) and (AChildOrder.Signature = 2)) then NeedReason := True;
93 end;
94 end else
95 begin
96 frmDCOrders.lstOrders.Items.Add(AnOrder.Text);
97 if not ((AnOrder.Status = 11) and (AnOrder.Signature = 2)) then NeedReason := True;
98 end;
99 end;*)
100//************* End OP meals changes ****************
101 if NeedReason then
102 begin
103 frmDCOrders.lblReason.Visible := True;
104 frmDCOrders.lstReason.Visible := True;
105 end else
106 begin
107 frmDCOrders.lblReason.Visible := False;
108 frmDCOrders.lstReason.Visible := False;
109 end;
110 frmDCOrders.ShowModal;
111 if frmDCOrders.OKPressed then
112 begin
113 if (Encounter.Provider = User.DUZ) and User.CanSignOrders
114 then CanSign := CH_SIGN_YES
115 else CanSign := CH_SIGN_NA;
116 with SelectedList do for i := 0 to Count - 1 do
117 begin
118 AnOrder := TOrder(Items[i]);
119 OriginalID := AnOrder.ID;
120 PtEvtList.Add(AnOrder.EventPtr + '^' + AnOrder.EventName);
121 DCOrder(AnOrder, frmDCOrders.DCReason, DCType);
122 case DCType of
123 DCT_NEWORDER: begin
124 Changes.Add(CH_ORD, AnOrder.ID, AnOrder.Text, '', CanSign, AnOrder.ParentID);
125 AnOrder.ActionOn := OriginalID + '=DC';
126 end;
127 DCT_DELETION: begin
128 if BILLING_AWARE then
129 UBAGlobals.BADeltedOrders.Add(OriginalID);
130 Changes.Remove(CH_ORD, OriginalID);
131 if (AnOrder.ID = '0') or (AnOrder.ID = '')
132 then AnOrder.ActionOn := OriginalID + '=DL' // delete order
133 else AnOrder.ActionOn := OriginalID + '=CA'; // cancel action
134 {else AnOrder.ActionOn := AnOrder.ID + '=CA'; - caused cancel from meds to not update orders}
135 UnlockOrder(OriginalID); // for deletion of unsigned DC
136 end;
137 DCT_NEWSTATUS: begin
138 AnOrder.ActionOn := OriginalID + '=DC';
139 UnlockOrder(OriginalID);
140 end;
141 else UnlockOrder(OriginalID);
142 end;
143 SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_ACT, Integer(AnOrder));
144 end;
145 if frmOrders.lstSheets.ItemIndex > -1 then
146 if CharAt(frmOrders.lstSheets.Items[frmOrders.lstSheets.ItemIndex],1)='C' then
147 OnCurrent := True;
148 if not OnCurrent then
149 begin
150 for i := 0 to PtEvtList.Count - 1 do
151 begin
152 if Length(PtEvtList[i])>1 then
153 begin
154 APtEvtID := Piece(PtEvtList[i],'^',1);
155 APtEvtName := Piece(PtEvtList[i],'^',2);
156 AnEvtInfo := EventInfo(APtEvtID);
157 if isExistedEvent(Patient.DFN,Piece(AnEvtInfo,'^',2),tmpPtEvt) and (DeleteEmptyEvt(APtEvtID,APtEvtName,False)) then
158 begin
159 NeedRefresh := True;
160 frmOrders.ChangesUpdate(APtEvtID);
161 end;
162 end;
163 end;
164 if NeedRefresh then
165 begin
166 frmOrders.InitOrderSheetsForEvtDelay;
167 frmOrders.lstSheets.ItemIndex := 0;
168 frmOrders.lstSheetsClick(nil);
169 DelEvt := True;
170 end;
171 end;
172 Result := True;
173 end
174 else with SelectedList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
175 finally
176{ TODO -oRich V. -cOutpatient Meals : Uncomment for processing of child orders treeview. }
177 //tmpList.Free;
178 frmDCOrders.Release;
179 end;
180end;
181
182procedure TfrmDCOrders.FormCreate(Sender: TObject);
183var
184 DefaultIEN: Integer;
185begin
186 inherited;
187 OKPressed := False;
188 ListDCReasons(lstReason.Items, DefaultIEN);
189 lstReason.SelectByIEN(DefaultIEN);
190 { the following commented out so that providers can enter DC reasons }
191// if Encounter.Provider = User.DUZ then
192// begin
193// lblReason.Visible := False;
194// lstReason.Visible := False;
195// end;
196end;
197
198procedure TfrmDCOrders.cmdOKClick(Sender: TObject);
199const
200 TX_REASON_REQ = 'A reason for discontinue must be selected.';
201 TC_REASON_REQ = 'Missing Discontinue Reason';
202begin
203 inherited;
204 if not (lstReason.ItemIEN > 0) then
205 begin
206 InfoBox(TX_REASON_REQ, TC_REASON_REQ, MB_OK);
207 Exit;
208 end;
209 OKPressed := True;
210 DCReason := lstReason.ItemIEN;
211 Close;
212end;
213
214procedure TfrmDCOrders.cmdCancelClick(Sender: TObject);
215begin
216 inherited;
217 Close;
218end;
219
220procedure TfrmDCOrders.lstOrdersDrawItem(Control: TWinControl;
221 Index: Integer; Rect: TRect; State: TOwnerDrawState);
222var
223 x: string;
224 ARect: TRect;
225begin
226 inherited;
227 x := '';
228 ARect := Rect;
229 with lstOrders do
230 begin
231 Canvas.FillRect(ARect);
232 Canvas.Pen.Color := clSilver;
233 Canvas.MoveTo(0, ARect.Bottom - 1);
234 Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
235 if Index < Items.Count then
236 begin
237 x := Items[Index];
238 DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
239 end;
240 end;
241end;
242
243procedure TfrmDCOrders.lstOrdersMeasureItem(Control: TWinControl;
244 Index: Integer; var AHeight: Integer);
245var
246 x:string;
247begin
248 inherited;
249 with lstOrders do if Index < Items.Count then
250 begin
251 x := Items[index];
252 AHeight := MeasureColumnHeight(x, Index);
253 end;
254end;
255
256function TfrmDCOrders.MeasureColumnHeight(TheOrderText: string;
257 Index: Integer): integer;
258var
259 ARect: TRect;
260begin
261 ARect.Left := 0;
262 ARect.Top := 0;
263 ARect.Bottom := 0;
264 ARect.Right := lstOrders.Width - 6;
265 Result := WrappedTextHeightByFont(lstOrders.Canvas,lstOrders.Font,TheOrderText,ARect);
266end;
267
268end.
Note: See TracBrowser for help on using the repository browser.