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

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

Initial Upload of Official WV CPRS 1.0.26.76

File size: 7.1 KB
RevLine 
[456]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;
39
40function ExecuteDCOrders(SelectedList: TList; var DelEvt: boolean): Boolean;
41const
42 DCT_NEWORDER = 1;
43 DCT_DELETION = 2;
44 DCT_NEWSTATUS = 3;
45var
46 frmDCOrders: TfrmDCOrders;
47 AnOrder: TOrder;
48 i,CanSign, DCType: Integer;
49 NeedReason,NeedRefresh,OnCurrent: Boolean;
50 OriginalID,APtEvtID,APtEvtName,AnEvtInfo,tmpPtEvt: string;
51 PtEvtList: TStringList;
52begin
53 Result := False;
54 DelEvt := False;
55 OnCurrent := False;
56 NeedRefresh := False;
57 PtEvtList := TStringList.Create;
58 if SelectedList.Count = 0 then Exit;
59 frmDCOrders := TfrmDCOrders.Create(Application);
60 try
61 ResizeFormToFont(TForm(frmDCOrders));
62 NeedReason := False;
63 with SelectedList do for i := 0 to Count - 1 do
64 begin
65 AnOrder := TOrder(Items[i]);
66 frmDCOrders.lstOrders.Items.Add(AnOrder.Text);
67 if not ((AnOrder.Status = 11) and (AnOrder.Signature = 2)) then NeedReason := True;
68 end;
69 if NeedReason then
70 begin
71 frmDCOrders.lblReason.Visible := True;
72 frmDCOrders.lstReason.Visible := True;
73 end else
74 begin
75 frmDCOrders.lblReason.Visible := False;
76 frmDCOrders.lstReason.Visible := False;
77 end;
78 frmDCOrders.ShowModal;
79 if frmDCOrders.OKPressed then
80 begin
81 if (Encounter.Provider = User.DUZ) and User.CanSignOrders
82 then CanSign := CH_SIGN_YES
83 else CanSign := CH_SIGN_NA;
84 with SelectedList do for i := 0 to Count - 1 do
85 begin
86 AnOrder := TOrder(Items[i]);
87 OriginalID := AnOrder.ID;
88 PtEvtList.Add(AnOrder.EventPtr + '^' + AnOrder.EventName);
89 DCOrder(AnOrder, frmDCOrders.DCReason, DCType);
90 case DCType of
91 DCT_NEWORDER: begin
92 Changes.Add(CH_ORD, AnOrder.ID, AnOrder.Text, '', CanSign, AnOrder.ParentID);
93 AnOrder.ActionOn := OriginalID + '=DC';
94 end;
95 DCT_DELETION: begin
96 Changes.Remove(CH_ORD, OriginalID);
97 if (AnOrder.ID = '0') or (AnOrder.ID = '')
98 then AnOrder.ActionOn := OriginalID + '=DL' // delete order
99 else AnOrder.ActionOn := OriginalID + '=CA'; // cancel action
100 {else AnOrder.ActionOn := AnOrder.ID + '=CA'; - caused cancel from meds to not update orders}
101 UnlockOrder(OriginalID); // for deletion of unsigned DC
102 end;
103 DCT_NEWSTATUS: begin
104 AnOrder.ActionOn := OriginalID + '=DC';
105 UnlockOrder(OriginalID);
106 end;
107 else UnlockOrder(OriginalID);
108 end;
109 SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_ACT, Integer(AnOrder));
110 end;
111 if frmOrders.lstSheets.ItemIndex > -1 then
112 if CharAt(frmOrders.lstSheets.Items[frmOrders.lstSheets.ItemIndex],1)='C' then
113 OnCurrent := True;
114 if not OnCurrent then
115 begin
116 for i := 0 to PtEvtList.Count - 1 do
117 begin
118 if Length(PtEvtList[i])>1 then
119 begin
120 APtEvtID := Piece(PtEvtList[i],'^',1);
121 APtEvtName := Piece(PtEvtList[i],'^',2);
122 AnEvtInfo := EventInfo(APtEvtID);
123 if isExistedEvent(Patient.DFN,Piece(AnEvtInfo,'^',2),tmpPtEvt) and (DeleteEmptyEvt(APtEvtID,APtEvtName,False)) then
124 begin
125 NeedRefresh := True;
126 frmOrders.ChangesUpdate(APtEvtID);
127 end;
128 end;
129 end;
130 if NeedRefresh then
131 begin
132 frmOrders.InitOrderSheetsForEvtDelay;
133 frmOrders.lstSheets.ItemIndex := 0;
134 frmOrders.lstSheetsClick(nil);
135 DelEvt := True;
136 end;
137 end;
138 Result := True;
139 end
140 else with SelectedList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
141 finally
142 frmDCOrders.Release;
143 end;
144end;
145
146procedure TfrmDCOrders.FormCreate(Sender: TObject);
147var
148 DefaultIEN: Integer;
149begin
150 inherited;
151 OKPressed := False;
152 ListDCReasons(lstReason.Items, DefaultIEN);
153 lstReason.SelectByIEN(DefaultIEN);
154 { the following commented out so that providers can enter DC reasons }
155// if Encounter.Provider = User.DUZ then
156// begin
157// lblReason.Visible := False;
158// lstReason.Visible := False;
159// end;
160end;
161
162procedure TfrmDCOrders.cmdOKClick(Sender: TObject);
163const
164 TX_REASON_REQ = 'A reason for discontinue must be selected.';
165 TC_REASON_REQ = 'Missing Discontinue Reason';
166begin
167 inherited;
168 if (lstReason.Visible) and (not (lstReason.ItemIEN > 0)) then
169 begin
170 InfoBox(TX_REASON_REQ, TC_REASON_REQ, MB_OK);
171 Exit;
172 end;
173 OKPressed := True;
174 DCReason := lstReason.ItemIEN;
175 Close;
176end;
177
178procedure TfrmDCOrders.cmdCancelClick(Sender: TObject);
179begin
180 inherited;
181 Close;
182end;
183
184procedure TfrmDCOrders.lstOrdersDrawItem(Control: TWinControl;
185 Index: Integer; Rect: TRect; State: TOwnerDrawState);
186var
187 x: string;
188 ARect: TRect;
189begin
190 inherited;
191 x := '';
192 ARect := Rect;
193 with lstOrders do
194 begin
195 Canvas.FillRect(ARect);
196 Canvas.Pen.Color := clSilver;
197 Canvas.MoveTo(0, ARect.Bottom - 1);
198 Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
199 if Index < Items.Count then
200 begin
201 x := Items[Index];
202 DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
203 end;
204 end;
205end;
206
207procedure TfrmDCOrders.lstOrdersMeasureItem(Control: TWinControl;
208 Index: Integer; var AHeight: Integer);
209var
210 x:string;
211begin
212 inherited;
213 with lstOrders do if Index < Items.Count then
214 begin
215 x := Items[index];
216 AHeight := MeasureColumnHeight(x, Index);
217 end;
218end;
219
220function TfrmDCOrders.MeasureColumnHeight(TheOrderText: string;
221 Index: Integer): integer;
222var
223 ARect: TRect;
224begin
225 ARect.Left := 0;
226 ARect.Top := 0;
227 ARect.Bottom := 0;
228 ARect.Right := lstOrders.Width - 6;
229 Result := WrappedTextHeightByFont(lstOrders.Canvas,lstOrders.Font,TheOrderText,ARect);
230end;
231
232end.
Note: See TracBrowser for help on using the repository browser.