source: cprs/trunk/CPRS-Chart/Orders/fOrdersDC.pas

Last change on this file was 1679, checked in by healthsevak, 9 years ago

Updating the working copy to CPRS version 28

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