1 | unit fOrdersDC;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
7 | fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls;
|
---|
8 |
|
---|
9 | type
|
---|
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 |
|
---|
32 | function ExecuteDCOrders(SelectedList: TList; var DelEvt: boolean): Boolean;
|
---|
33 |
|
---|
34 | implementation
|
---|
35 |
|
---|
36 | {$R *.DFM}
|
---|
37 |
|
---|
38 | uses rOrders, uCore, uConst, fOrders, UBAGlobals;
|
---|
39 | { TODO -oRich V. -cOutpatient Meals : Uncomment for processing of child orders treeview. }
|
---|
40 | //, fOrderChildren;
|
---|
41 |
|
---|
42 | function ExecuteDCOrders(SelectedList: TList; var DelEvt: boolean): Boolean;
|
---|
43 | const
|
---|
44 | DCT_NEWORDER = 1;
|
---|
45 | DCT_DELETION = 2;
|
---|
46 | DCT_NEWSTATUS = 3;
|
---|
47 | var
|
---|
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;*)
|
---|
58 | begin
|
---|
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;
|
---|
180 | end;
|
---|
181 |
|
---|
182 | procedure TfrmDCOrders.FormCreate(Sender: TObject);
|
---|
183 | var
|
---|
184 | DefaultIEN: Integer;
|
---|
185 | begin
|
---|
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;
|
---|
196 | end;
|
---|
197 |
|
---|
198 | procedure TfrmDCOrders.cmdOKClick(Sender: TObject);
|
---|
199 | const
|
---|
200 | TX_REASON_REQ = 'A reason for discontinue must be selected.';
|
---|
201 | TC_REASON_REQ = 'Missing Discontinue Reason';
|
---|
202 | begin
|
---|
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;
|
---|
212 | end;
|
---|
213 |
|
---|
214 | procedure TfrmDCOrders.cmdCancelClick(Sender: TObject);
|
---|
215 | begin
|
---|
216 | inherited;
|
---|
217 | Close;
|
---|
218 | end;
|
---|
219 |
|
---|
220 | procedure TfrmDCOrders.lstOrdersDrawItem(Control: TWinControl;
|
---|
221 | Index: Integer; Rect: TRect; State: TOwnerDrawState);
|
---|
222 | var
|
---|
223 | x: string;
|
---|
224 | ARect: TRect;
|
---|
225 | begin
|
---|
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;
|
---|
241 | end;
|
---|
242 |
|
---|
243 | procedure TfrmDCOrders.lstOrdersMeasureItem(Control: TWinControl;
|
---|
244 | Index: Integer; var AHeight: Integer);
|
---|
245 | var
|
---|
246 | x:string;
|
---|
247 | begin
|
---|
248 | inherited;
|
---|
249 | with lstOrders do if Index < Items.Count then
|
---|
250 | begin
|
---|
251 | x := Items[index];
|
---|
252 | AHeight := MeasureColumnHeight(x, Index);
|
---|
253 | end;
|
---|
254 | end;
|
---|
255 |
|
---|
256 | function TfrmDCOrders.MeasureColumnHeight(TheOrderText: string;
|
---|
257 | Index: Integer): integer;
|
---|
258 | var
|
---|
259 | ARect: TRect;
|
---|
260 | begin
|
---|
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);
|
---|
266 | end;
|
---|
267 |
|
---|
268 | end.
|
---|