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

Last change on this file since 1066 was 830, checked in by Kevin Toppenberg, 14 years ago

Upgrading to version 27
File size: 9.7 KB
RevLine 
[456]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
[830]50 rOrders, fOrders, fOrdersTS, fMedCopy, fOrdersCopy, VA508AccessibilityRouter;
[456]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
[830]65 inherited Create(AOwner);
66 TabStop := FALSE;
[456]67 FDisableWarning := False;
68 FMatchedCancel := False;
69 FIsForCpXfer := False;
70 FEvntLimit := #0;
71 FUserDefaultEvent := 0;
72 FDefaultEvent := 0;
73end;
74
75procedure TfraEvntDelayList.DisplayEvntDelayList;
76var
77 i: integer;
78 tempStr: string;
79 defaultEvtType: Char;
80 NoUserDefault: boolean;
81const
82 LINE = '^^^^^^^^________________________________________________________________________________________';
83
84begin
85 inherited;
86 mlstEvents.Items.Clear;
87 mlstEvents.InitLongList('');
88 NoUserDefault := False;
89 defaultEvtType := #0;
90
91 if Patient.Inpatient then
92 ListSpecialtiesED(EvntLimit,mlstEvents.Items)
93 else
94 ListSpecialtiesED('A',mlstEvents.Items);
95 if mlstEvents.Items.Count < 1 then
96 Exit;
97 mlstEvents.ItemIndex := -1;
98 if not Patient.Inpatient then
99 begin
100 if UserDefaultEvent > 0 then
101 defaultEvtType := CharAt(EventInfo1(IntToStr(UserDefaultEvent)),1);
102 if defaultEvtType in ['T','D'] then
103 NoUserDefault := True;
104 end;
105 if (UserDefaultEvent > 0) and (not NoUserDefault) then
106 begin
107 for i := 0 to mlstEvents.Items.Count - 1 do
108 begin
109 if Piece(mlstEvents.Items[i],'^',1)=IntToStr(UserDefaultEvent) then
110 begin
111 tempStr := mlstEvents.Items[i];
112 Break;
113 end;
114 end;
115 end;
116 if Length(tempStr)>0 then
117 begin
118 DisableWarning := True;
119 mlstEvents.Items.Insert(0,tempStr);
120 mlstEvents.Items.Insert(1,LINE);
121 mlstEvents.Items.Insert(2,LLS_SPACE);
122 mlstEvents.ItemIndex := 0;
123 edtSearch.Text := mlstEvents.DisplayText[0];
124 tempStr := '';
125 DisableWarning := False;
126 end;
127
128 if (DefaultEvent > 0) and (mlstEvents.ItemIndex<0) then
129 begin
130 for i := 0 to mlstEvents.items.Count - 1 do
131 begin
132 if Piece(mlstEvents.items[i],'^',1)=IntToStr(DefaultEvent) then
133 begin
134 tempStr := mlstEvents.Items[i];
135 Break;
136 end;
137 end;
138 end;
139 if Length(tempStr)>0 then
140 begin
141 mlstEvents.Items.Insert(0,tempStr);
142 mlstEvents.Items.Insert(1,LINE);
143 mlstEvents.Items.Insert(2,LLS_SPACE);
144 mlstEvents.ItemIndex := 0;
145 edtSearch.Text := mlstEvents.DisplayText[0];
146 tempStr := '';
147 end;
148end;
149
150procedure TfraEvntDelayList.ResetProperty;
151begin
152 FEvntLimit := #0;
153 FUserDefaultEvent := 0;
154 FDefaultEvent := 0;
155 FMatchedCancel := False;
156 FDisableWarning := False;
157 FIsForCpXfer := False;
158end;
159
160procedure TfraEvntDelayList.CheckMatch;
161var
162 AnEvtID, ATsName: string;
163begin
164 if mlstEvents.ItemIndex < 0 then Exit;
165 FMatchedCancel := False;
166 AnEvtID := Piece(mlstEvents.Items[mlstEvents.ItemIndex],'^',1);
167 if isMatchedEvent(Patient.DFN,AnEvtID,ATsName) and (not DisableWarning) then
168 begin
169 if InfoBox(Patient.Name + TX_MCHEVT1 + ATsName + ' on ' + Encounter.LocationName + TX_MCHEVT2,
170 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then
171 begin
172 FMatchedCancel := True;
173 frmOrders.lstSheets.ItemIndex := 0;
174 frmOrders.lstSheetsClick(Self);
175 end;
176 end;
177end;
178
179procedure TfraEvntDelayList.edtSearchChange(Sender: TObject);
180var
181 i: integer;
182 needle,hay: String;
183begin
184 if Length(edtSearch.Text)<1 then Exit;
185 if (edtSearch.Modified) then
186 begin
187 needle := UpperCase(edtSearch.text);
188 if length(needle)=0 then exit;
189 for i := 0 to mlstEvents.Items.Count - 1 do
190 begin
191 hay := UpperCase(mlstEvents.DisplayText[i]);
192 hay := Copy(hay,0,length(needle));
193 if Pos(needle, hay) > 0 then
194 begin
195 mlstEvents.ItemIndex := i;
196 mlstEvents.TopIndex := i;
197 edtSearch.Text := mlstEvents.DisplayText[mlstEvents.itemindex];
198 edtSearch.SelStart := length(needle);
199 edtSearch.SelLength := length(edtSearch.Text);
200 exit;
201 end;
202 end;
203 end;
204end;
205
206procedure TfraEvntDelayList.mlstEventsChange(Sender: TObject);
207var
208 i,idx : integer;
209 AnEvtID, AnEvtType, APtEvtID: string;
210 AnEvtName,ATsName: string;
211begin
212 inherited;
213 if mlstEvents.ItemIndex >= 0 then
214 begin
215 AnEvtID := Piece(mlstEvents.Items[mlstEvents.ItemIndex],'^',1);
216 AnEvtType := Piece(mlstEvents.Items[mlstEvents.ItemIndex],'^',3);
217 idx := mlstEvents.ItemIndex;
218 end else
219 begin
220 AnEvtID := '';
221 AnEvtType := '';
222 idx := -1;
223 end;
224 if AnEvtType = 'D' then
225 begin
226 pnlDate.Visible := True;
227 lblEffective.Left := 1;
228 orDateBox.Left := 1;
229 orDateBox.Hint := orDateBox.Text;
230 end else
231 pnlDate.Visible := False;
232 if mlstEvents.ItemIndex >= 0 then
233 AnEvtName := Piece(mlstEvents.Items[mlstEvents.ItemIndex],'^',9)
234 else
235 AnEvtName := '';
236 if isExistedEvent(Patient.DFN, AnEvtID, APtEvtID) then
237 begin
238 if IsForCpXfer then
239 DisableWarning := True;
240 for i := 0 to frmOrders.lstSheets.Items.Count - 1 do
241 begin
242 if Piece(frmOrders.lstSheets.Items[i],'^',1)=APtEvtID then
243 begin
244 frmOrders.lstSheets.ItemIndex := i;
245 frmOrders.ClickLstSheet;
246 end;
247 end;
248 IsForCpXfer := False;
249 end;
250 if (StrToIntDef(AnEvtID,0)>0) and (isMatchedEvent(Patient.DFN,AnEvtID,ATsName))
251 and (not DisableWarning) then
252 begin
253 if InfoBox(Patient.Name + TX_MCHEVT1 + ATsName + ' on ' + Encounter.LocationName + TX_MCHEVT2 + TX_MCHEVT3,
254 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then
255 begin
256 FMatchedCancel := True;
257 frmOrders.lstSheets.ItemIndex := 0;
258 frmOrders.lstSheetsClick(Self);
259 end else
260 begin
261 if Screen.ActiveForm.Name = 'frmOrdersTS' then
262 SendMessage(frmOrdersTS.Handle, UM_STILLDELAY, 0, 0);
263 if Screen.ActiveForm.Name = 'frmMedCopy' then
264 SendMessage(frmMedCopy.Handle, UM_STILLDELAY, 0, 0);
265 if Screen.ActiveForm.Name = 'frmCopyOrders' then
266 SendMessage(frmCopyOrders.Handle, UM_STILLDELAY, 0, 0);
267 end;
268 end;
269 mlstEvents.ItemIndex := idx;
270end;
271
272procedure TfraEvntDelayList.mlstEventsClick(Sender: TObject);
273begin
274 edtSearch.Text := mlstEvents.DisplayText[mlstEvents.ItemIndex];
275end;
276
277procedure TfraEvntDelayList.mlstEventsKeyUp(Sender: TObject; var Key: Word;
278 Shift: TShiftState);
279begin
280 if (mlstEvents.ItemIndex <> mlstEvents.FocusIndex) and (mlstEvents.FocusIndex > -1) then
281 begin
282 if (Key = VK_UP) and ( ( mlstEvents.ItemIndex - mlstEvents.FocusIndex) > 1) and (mlstEvents.ItemIndex > 0) then
283 mlstEvents.ItemIndex := mlstEvents.ItemIndex - 1;
284 if (Key = VK_DOWN) and (mlstEvents.FocusIndex < mlstEvents.ItemIndex) then
285 mlstEvents.ItemIndex := mlstEvents.ItemIndex + 1
286 else
287 mlstEvents.ItemIndex := mlstEvents.FocusIndex;
288 edtSearch.text := mlstEvents.DisplayText[mlstEvents.ItemIndex];
289 mlstEvents.TopIndex := mlstEvents.ItemIndex;
290 end;
291end;
292
293procedure TfraEvntDelayList.edtSearchKeyDown(Sender: TObject;
294 var Key: Word; Shift: TShiftState);
295var
296 x : string;
297 i : integer;
298begin
299 if Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN] then
300 begin
301 edtSearch.SelectAll;
302 Key := 0;
303 end
304 else if Key = VK_BACK then
305 begin
306 x := edtSearch.Text;
307 i := edtSearch.SelStart;
308 if i > 1 then Delete(x, i + 1, Length(x)) else x := '';
309 edtSearch.Text := x;
310 if i > 1 then edtSearch.SelStart := i;
311 end
312end;
313
[830]314initialization
315 SpecifyFormIsNotADialog(TfraEvntDelayList);
316
[456]317end.
Note: See TracBrowser for help on using the repository browser.