source: cprs/trunk/CPRS-Chart/mEvntDelay.pas@ 796

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

Initial Upload of Official WV CPRS 1.0.26.76
File size: 9.6 KB
Line 
1unit mEvntDelay;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ORCtrls, ORDtTm, uCore, ORFn, ExtCtrls,UConst;
8
9type
10 TfraEvntDelayList = class(TFrame)
11 pnlDate: TPanel;
12 pnlList: TPanel;
13 mlstEvents: TORListBox;
14 edtSearch: TCaptionEdit;
15 lblEffective: TLabel;
16 orDateBox: TORDateBox;
17 lblEvntDelayList: TLabel;
18 procedure edtSearchChange(Sender: TObject);
19 procedure mlstEventsChange(Sender: TObject);
20 procedure mlstEventsClick(Sender: TObject);
21 procedure mlstEventsKeyUp(Sender: TObject; var Key: Word;
22 Shift: TShiftState);
23 procedure edtSearchKeyDown(Sender: TObject; var Key: Word;
24 Shift: TShiftState);
25 private
26 FEvntLimit: Char;
27 FUserDefaultEvent:integer;
28 FDefaultEvent: integer;
29 FMatchedCancel: Boolean;
30 FDisableWarning: Boolean;
31 FIsForCpXfer: Boolean;
32 public
33 constructor Create(AOwner: TComponent); override;
34 procedure ResetProperty;
35 procedure DisplayEvntDelayList;
36 procedure CheckMatch;
37 property EvntLimit: Char read FEvntLimit write FEvntLimit;
38 property UserDefaultEvent: integer read FUserDefaultEvent write FUserDefaultEvent;
39 property DefaultEvent : integer read FDefaultEvent write FDefaultEvent;
40 property MatchedCancel : Boolean read FMatchedCancel write FMatchedCancel;
41 property DisableWarning : Boolean read FDisableWarning write FDisableWarning;
42 property IsForCpXfer : Boolean read FIsForCpXfer write FIsForCpXfer;
43 end;
44
45implementation
46
47{$R *.DFM}
48
49uses
50 rOrders, fOrders, fOrdersTS, fMedCopy, fOrdersCopy;
51
52{ TfraEvntDelayList }
53const
54 TX_MCHEVT1 = ' is already assigned to ';
55 TX_MCHEVT2 = #13 + 'Do you still want to write delayed orders?';
56 TX_MCHEVT3 = #13#13 + 'If you continue to write delayed orders to this event,'
57 + 'they will not release until the patient moves away from and returns to this ward and treating specialty.'
58 + #13#13 + 'If you want these orders to be activated at signature, '
59 + 'then please write them under the ACTIVE view (and not as delayed orders).';
60 TX_XISTEVT1 = 'Delayed orders already exist for event Delayed ';
61 TX_XISTEVT2 = #13 + 'Do you want to view those orders?';
62
63constructor TfraEvntDelayList.Create(AOwner: TComponent);
64begin
65 inherited;
66 FDisableWarning := False;
67 FMatchedCancel := False;
68 FIsForCpXfer := False;
69 FEvntLimit := #0;
70 FUserDefaultEvent := 0;
71 FDefaultEvent := 0;
72end;
73
74procedure TfraEvntDelayList.DisplayEvntDelayList;
75var
76 i: integer;
77 tempStr: string;
78 defaultEvtType: Char;
79 NoUserDefault: boolean;
80const
81 LINE = '^^^^^^^^________________________________________________________________________________________';
82
83begin
84 inherited;
85 mlstEvents.Items.Clear;
86 mlstEvents.InitLongList('');
87 NoUserDefault := False;
88 defaultEvtType := #0;
89
90 if Patient.Inpatient then
91 ListSpecialtiesED(EvntLimit,mlstEvents.Items)
92 else
93 ListSpecialtiesED('A',mlstEvents.Items);
94 if mlstEvents.Items.Count < 1 then
95 Exit;
96 mlstEvents.ItemIndex := -1;
97 if not Patient.Inpatient then
98 begin
99 if UserDefaultEvent > 0 then
100 defaultEvtType := CharAt(EventInfo1(IntToStr(UserDefaultEvent)),1);
101 if defaultEvtType in ['T','D'] then
102 NoUserDefault := True;
103 end;
104 if (UserDefaultEvent > 0) and (not NoUserDefault) then
105 begin
106 for i := 0 to mlstEvents.Items.Count - 1 do
107 begin
108 if Piece(mlstEvents.Items[i],'^',1)=IntToStr(UserDefaultEvent) then
109 begin
110 tempStr := mlstEvents.Items[i];
111 Break;
112 end;
113 end;
114 end;
115 if Length(tempStr)>0 then
116 begin
117 DisableWarning := True;
118 mlstEvents.Items.Insert(0,tempStr);
119 mlstEvents.Items.Insert(1,LINE);
120 mlstEvents.Items.Insert(2,LLS_SPACE);
121 mlstEvents.ItemIndex := 0;
122 edtSearch.Text := mlstEvents.DisplayText[0];
123 tempStr := '';
124 DisableWarning := False;
125 end;
126
127 if (DefaultEvent > 0) and (mlstEvents.ItemIndex<0) then
128 begin
129 for i := 0 to mlstEvents.items.Count - 1 do
130 begin
131 if Piece(mlstEvents.items[i],'^',1)=IntToStr(DefaultEvent) then
132 begin
133 tempStr := mlstEvents.Items[i];
134 Break;
135 end;
136 end;
137 end;
138 if Length(tempStr)>0 then
139 begin
140 mlstEvents.Items.Insert(0,tempStr);
141 mlstEvents.Items.Insert(1,LINE);
142 mlstEvents.Items.Insert(2,LLS_SPACE);
143 mlstEvents.ItemIndex := 0;
144 edtSearch.Text := mlstEvents.DisplayText[0];
145 tempStr := '';
146 end;
147end;
148
149procedure TfraEvntDelayList.ResetProperty;
150begin
151 FEvntLimit := #0;
152 FUserDefaultEvent := 0;
153 FDefaultEvent := 0;
154 FMatchedCancel := False;
155 FDisableWarning := False;
156 FIsForCpXfer := False;
157end;
158
159procedure TfraEvntDelayList.CheckMatch;
160var
161 AnEvtID, ATsName: string;
162begin
163 if mlstEvents.ItemIndex < 0 then Exit;
164 FMatchedCancel := False;
165 AnEvtID := Piece(mlstEvents.Items[mlstEvents.ItemIndex],'^',1);
166 if isMatchedEvent(Patient.DFN,AnEvtID,ATsName) and (not DisableWarning) then
167 begin
168 if InfoBox(Patient.Name + TX_MCHEVT1 + ATsName + ' on ' + Encounter.LocationName + TX_MCHEVT2,
169 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then
170 begin
171 FMatchedCancel := True;
172 frmOrders.lstSheets.ItemIndex := 0;
173 frmOrders.lstSheetsClick(Self);
174 end;
175 end;
176end;
177
178procedure TfraEvntDelayList.edtSearchChange(Sender: TObject);
179var
180 i: integer;
181 needle,hay: String;
182begin
183 if Length(edtSearch.Text)<1 then Exit;
184 if (edtSearch.Modified) then
185 begin
186 needle := UpperCase(edtSearch.text);
187 if length(needle)=0 then exit;
188 for i := 0 to mlstEvents.Items.Count - 1 do
189 begin
190 hay := UpperCase(mlstEvents.DisplayText[i]);
191 hay := Copy(hay,0,length(needle));
192 if Pos(needle, hay) > 0 then
193 begin
194 mlstEvents.ItemIndex := i;
195 mlstEvents.TopIndex := i;
196 edtSearch.Text := mlstEvents.DisplayText[mlstEvents.itemindex];
197 edtSearch.SelStart := length(needle);
198 edtSearch.SelLength := length(edtSearch.Text);
199 exit;
200 end;
201 end;
202 end;
203end;
204
205procedure TfraEvntDelayList.mlstEventsChange(Sender: TObject);
206var
207 i,idx : integer;
208 AnEvtID, AnEvtType, APtEvtID: string;
209 AnEvtName,ATsName: string;
210begin
211 inherited;
212 if mlstEvents.ItemIndex >= 0 then
213 begin
214 AnEvtID := Piece(mlstEvents.Items[mlstEvents.ItemIndex],'^',1);
215 AnEvtType := Piece(mlstEvents.Items[mlstEvents.ItemIndex],'^',3);
216 idx := mlstEvents.ItemIndex;
217 end else
218 begin
219 AnEvtID := '';
220 AnEvtType := '';
221 idx := -1;
222 end;
223 if AnEvtType = 'D' then
224 begin
225 pnlDate.Visible := True;
226 lblEffective.Left := 1;
227 orDateBox.Left := 1;
228 orDateBox.Hint := orDateBox.Text;
229 end else
230 pnlDate.Visible := False;
231 if mlstEvents.ItemIndex >= 0 then
232 AnEvtName := Piece(mlstEvents.Items[mlstEvents.ItemIndex],'^',9)
233 else
234 AnEvtName := '';
235 if isExistedEvent(Patient.DFN, AnEvtID, APtEvtID) then
236 begin
237 if IsForCpXfer then
238 DisableWarning := True;
239 for i := 0 to frmOrders.lstSheets.Items.Count - 1 do
240 begin
241 if Piece(frmOrders.lstSheets.Items[i],'^',1)=APtEvtID then
242 begin
243 frmOrders.lstSheets.ItemIndex := i;
244 frmOrders.ClickLstSheet;
245 end;
246 end;
247 IsForCpXfer := False;
248 end;
249 if (StrToIntDef(AnEvtID,0)>0) and (isMatchedEvent(Patient.DFN,AnEvtID,ATsName))
250 and (not DisableWarning) then
251 begin
252 if InfoBox(Patient.Name + TX_MCHEVT1 + ATsName + ' on ' + Encounter.LocationName + TX_MCHEVT2 + TX_MCHEVT3,
253 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then
254 begin
255 FMatchedCancel := True;
256 frmOrders.lstSheets.ItemIndex := 0;
257 frmOrders.lstSheetsClick(Self);
258 end else
259 begin
260 if Screen.ActiveForm.Name = 'frmOrdersTS' then
261 SendMessage(frmOrdersTS.Handle, UM_STILLDELAY, 0, 0);
262 if Screen.ActiveForm.Name = 'frmMedCopy' then
263 SendMessage(frmMedCopy.Handle, UM_STILLDELAY, 0, 0);
264 if Screen.ActiveForm.Name = 'frmCopyOrders' then
265 SendMessage(frmCopyOrders.Handle, UM_STILLDELAY, 0, 0);
266 end;
267 end;
268 mlstEvents.ItemIndex := idx;
269end;
270
271procedure TfraEvntDelayList.mlstEventsClick(Sender: TObject);
272begin
273 edtSearch.Text := mlstEvents.DisplayText[mlstEvents.ItemIndex];
274end;
275
276procedure TfraEvntDelayList.mlstEventsKeyUp(Sender: TObject; var Key: Word;
277 Shift: TShiftState);
278begin
279 if (mlstEvents.ItemIndex <> mlstEvents.FocusIndex) and (mlstEvents.FocusIndex > -1) then
280 begin
281 if (Key = VK_UP) and ( ( mlstEvents.ItemIndex - mlstEvents.FocusIndex) > 1) and (mlstEvents.ItemIndex > 0) then
282 mlstEvents.ItemIndex := mlstEvents.ItemIndex - 1;
283 if (Key = VK_DOWN) and (mlstEvents.FocusIndex < mlstEvents.ItemIndex) then
284 mlstEvents.ItemIndex := mlstEvents.ItemIndex + 1
285 else
286 mlstEvents.ItemIndex := mlstEvents.FocusIndex;
287 edtSearch.text := mlstEvents.DisplayText[mlstEvents.ItemIndex];
288 mlstEvents.TopIndex := mlstEvents.ItemIndex;
289 end;
290end;
291
292procedure TfraEvntDelayList.edtSearchKeyDown(Sender: TObject;
293 var Key: Word; Shift: TShiftState);
294var
295 x : string;
296 i : integer;
297begin
298 if Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN] then
299 begin
300 edtSearch.SelectAll;
301 Key := 0;
302 end
303 else if Key = VK_BACK then
304 begin
305 x := edtSearch.Text;
306 i := edtSearch.SelStart;
307 if i > 1 then Delete(x, i + 1, Length(x)) else x := '';
308 edtSearch.Text := x;
309 if i > 1 then edtSearch.SelStart := i;
310 end
311end;
312
313end.
Note: See TracBrowser for help on using the repository browser.