source: cprs/branches/tmg-cprs/CPRS-Chart/mEvntDelay.pas@ 1681

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

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