source: cprs/branches/foia-cprs/CPRS-Chart/Encounter/fEncVitals.pas@ 459

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

Adding foia-cprs branch
File size: 14.4 KB
Line 
1unit fEncVitals;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fPCEBase, ORDtTm, StdCtrls, ORCtrls, ExtCtrls, Buttons, fAutoSz, ORFn,
8 rvitals, ComCtrls;
9
10type
11 TfrmEncVitals = class(TfrmPCEBase)
12 pnlmain: TPanel;
13 lblDate: TStaticText;
14 lblDateBP: TStaticText;
15 lblDateTemp: TStaticText;
16 lblDateResp: TStaticText;
17 lblDatePulse: TStaticText;
18 lblDateHeight: TStaticText;
19 lblDateWeight: TStaticText;
20 lblLstMeas: TStaticText;
21 lbllastBP: TStaticText;
22 lblLastTemp: TStaticText;
23 lblLastResp: TStaticText;
24 lblLastPulse: TStaticText;
25 lblLastHeight: TStaticText;
26 lblLastWeight: TStaticText;
27 lblVitPointer: TOROffsetLabel;
28 lblVital: TStaticText;
29 lblVitBP: TStaticText;
30 lnlVitTemp: TStaticText;
31 lblVitResp: TStaticText;
32 lblVitPulse: TStaticText;
33 lblVitHeight: TStaticText;
34 lblVitWeight: TStaticText;
35 txtMeasBP: TCaptionEdit;
36 cboTemp: TCaptionComboBox;
37 txtMeasTemp: TCaptionEdit;
38 txtMeasResp: TCaptionEdit;
39 cboHeight: TCaptionComboBox;
40 txtMeasWt: TCaptionEdit;
41 cboWeight: TCaptionComboBox;
42 txtMeasDate: TORDateBox;
43 lblVitPain: TStaticText;
44 lblLastPain: TStaticText;
45 lblDatePain: TStaticText;
46 cboPain: TORComboBox;
47 txtMeasPulse: TCaptionEdit;
48 txtMeasHt: TCaptionEdit;
49 procedure SetVitPointer(Sender: TObject);
50 procedure txtMeasBPExit(Sender: TObject);
51 procedure cboTempChange(Sender: TObject);
52 procedure cboTempExit(Sender: TObject);
53 procedure txtMeasRespExit(Sender: TObject);
54 procedure txtMeasPulseExit(Sender: TObject);
55 procedure cboHeightChange(Sender: TObject);
56 procedure cboHeightExit(Sender: TObject);
57 procedure cboWeightChange(Sender: TObject);
58 procedure cboWeightExit(Sender: TObject);
59 procedure FormCreate(Sender: TObject);
60 procedure FormDestroy(Sender: TObject);
61 procedure lbllastClick(Sender: TObject);
62 procedure FormShow(Sender: TObject);
63 procedure FormActivate(Sender: TObject);
64 function HasData: Boolean;
65 function AssignVitals: boolean;
66 procedure cboPainChange(Sender: TObject);
67 procedure FormResize(Sender: TObject);
68 procedure txtMeasTempExit(Sender: TObject);
69 procedure txtMeasHtExit(Sender: TObject);
70 procedure txtMeasWtExit(Sender: TObject);
71 procedure FormKeyDown(Sender: TObject; var Key: Word;
72 Shift: TShiftState);
73 private
74 FDataLoaded: boolean;
75 FChangingFocus: boolean;
76 UvitalNew: TStringList;
77 uVitalOld: TSTringList;
78 procedure InitVitalPanel;
79 procedure PopulateLastVital;
80 function GetVitHTRate: String;
81 procedure CheckVitalUnit;
82 procedure ChangeFocus(Control: TWinControl);
83 procedure ClearData;
84 public
85 function OK2SaveVitals: boolean;
86 property VitalNew: TStringList read uVitalNew;
87 property VitalOld: TStringList read uVitalOld;
88 end;
89
90var
91 frmEncVitals: TfrmEncVitals;
92// uVitalLocation: Real;
93
94implementation
95
96{$R *.DFM}
97
98uses UCore, rCore, rPCE, fPCELex, fPCEOther, fVitals,fVisit, fFrame, fEncnt,
99 uVitals, fEncounterFrame;
100
101const
102 TX_VDATE_REQ1 = 'Entered vitals information can not be saved without a Date.' + CRLF +
103 'Do you wish to use the encounter date of ';
104 TX_VDATE_REQ2 = '?';
105 TC_VDATE_REQ = 'Missing Vitals Entry Date';
106
107 TX_KILLDATA = 'Discard entered vitals information?';
108
109var
110 UcboVitChanging: Boolean = False;
111
112function TfrmEncVitals.HasData: Boolean;
113begin
114 result := False;
115 if ((txtMeasBP.text <> '') or (txtMeasTemp.text <> '') or (txtMeasResp.text <> '') or
116 (txtMeasPulse.text <> '') or (txtMeasHt.text <> '') or (txtMeasWt.text <> '')) or
117 (cboPain.text <>'') then
118 result := True;
119end;
120
121procedure TfrmEncVitals.InitVitalPanel;
122begin
123 lblDate.font.Style := [fsBold];
124 lblDateBP.font.Style := [fsBold];
125 lblDateTemp.font.Style := [fsBold];
126 lblDateResp.font.Style := [fsBold];
127 lblDatePulse.font.Style := [fsBold];
128 lblDateHeight.font.Style := [fsBold];
129 lblDateWeight.font.Style := [fsBold];
130 lblDatePain.font.style := [fsBold];
131 lblLstMeas.font.Style := [fsBold];
132 lblLastBP.font.Style := [fsBold];
133 lblLastTemp.font.Style := [fsBold];
134 lblLastResp.font.Style := [fsBold];
135 lblLastPulse.font.Style := [fsBold];
136 lblLastHeight.font.Style := [fsBold];
137 lblLastWeight.font.Style := [fsBold];
138 lblLastPain.font.style := [fsBold];
139 lblVital.font.Style := [fsbold];
140
141 {Use this area to read parameter for units and set apropriately
142 after parameter is defined. in next version
143 }
144 UcboVitchanging := true; //prevents entering code in CheckVitalUnit
145
146 try
147 InitPainCombo(cboPain);
148 cboTemp.Text := cboTemp.Items[0];
149 cboHeight.Text := cboHeight.Items[0];
150 cboWeight.Text := cboWeight.Items[0];
151 finally
152 UcboVitchanging := False; //prevents entering code in CheckVitalUnit
153 end;
154
155 if txtMeasDate.Text = '' then
156 txtMeasDate.Text := FormatFMDateTime('mmm dd,yy@hh:nn', uEncPCEData.VisitDateTime);
157 if (UvitalOld.text = '') then
158 PopulateLastVital;
159end;
160
161
162procedure TfrmEncVitals.PopulateLastVital;
163var
164 i: integer;
165begin
166 GetLastVital(uVitalOld,Patient.DFN);
167 //populate labels from UVitalOld;
168 with UVitalOld do
169 for i := 0 to count-1 do
170 begin
171 if piece(strings[i],U,2) = 'T' then
172 begin
173 lblLastTemp.Caption := ConvertVitalData(piece(strings[i],U,3), vtTemp);
174 lblDateTemp.Caption := FormatFMDateTime('mmm dd,yy',
175 StrToFloat(piece(strings[i],U,4)));
176 end;
177 if piece(strings[i],U,2) = 'P' then
178 begin
179 lblLastPulse.Caption := piece(strings[i],U,3);
180 lblDatePulse.Caption := FormatFMDateTime('mmm dd,yy',
181 StrToFloat(piece(strings[i],U,4)));
182 end;
183 if piece(strings[i],U,2) = 'R' then
184 begin
185 lblLastResp.Caption := piece(strings[i],U,3);
186 lblDateResp.Caption := FormatFMDateTime('mmm dd,yy',
187 StrToFloat(piece(strings[i],U,4)));
188 end;
189 if piece(strings[i],U,2) = 'BP' then
190 begin
191 lblLastBP.Caption := piece(strings[i],U,3);
192 lblDateBP.Caption := FormatFMDateTime('mmm dd,yy',
193 StrToFloat(piece(strings[i],U,4)));
194 end;
195 if piece(strings[i],U,2) = 'HT' then
196 begin
197 lblLastHeight.Caption := ConvertVitalData(piece(strings[i],U,3), vtHeight);
198 lblDateHeight.Caption := FormatFMDateTime('mmm dd,yy',
199 StrToFloat(piece(strings[i],U,4)));
200 end;
201 if piece(strings[i],U,2) = 'WT' then
202 begin
203 lblLastWeight.Caption := ConvertVitalData(piece(strings[i],U,3), vtWeight);
204 lblDateWeight.Caption := FormatFMDateTime('mmm dd,yy',
205 StrToFloat(piece(strings[i],U,4)));
206
207 end;
208 if piece(strings[i],U,2) = 'PN' then
209 begin
210 lblLastPain.Caption := piece(strings[i],U,3);
211 lblDatePain.Caption := FormatFMDateTime('mmm dd,yy',
212 StrToFloat(piece(strings[i],U,4)));
213 end;
214 end;
215end;
216
217
218procedure TfrmEncVitals.SetVitPointer(Sender: TObject);
219begin
220 if ActiveCtrl.tag in VitalTagSet then
221 begin
222 // move pointer to some height and five pixels to right of edit box.
223 lblVitPointer.Top := ActiveCtrl.Top+((ActiveCtrl.height ) div
224 (lblVitPointer.height ));
225
226 if ActiveCtrl = txtMeasTemp then
227 lblVitPointer.left := (cboTemp.left + cboTemp.Width)
228 else if ActiveCtrl = txtMeasHT then
229 lblVitPointer.left := (cboHeight.left + cboHeight.Width)
230 else if ActiveCtrl = txtMeasWT then
231 lblVitPointer.left := (cboWeight.left + cboWeight.Width)
232 else
233 lblVitPointer.left := (ActiveCtrl.left + ActiveCtrl.Width);
234
235 end;
236end;
237
238
239function TfrmEncVitals.GetVitHTRate: String;
240begin
241 Result := ConvertHeight2Inches(txtMeasHT.Text);
242 txtMeasHT.text := result;
243end;
244
245function TfrmEncVitals.AssignVitals: boolean;
246var
247 TmpDate: TFMDateTime;
248
249begin
250 TmpDate := txtMeasDate.FMDateTime;
251 Result := ValidVitalsDate(TmpDate);
252 if Result then
253 AssignVitals2List(uVitalNew, TmpDate, FloatToStr(PCERPCEncLocation),
254 txtMeasBP.text, txtMeasTemp.text, cboTemp.text,
255 txtMeasResp.text, txtMeasPulse.text, GetVitHTRate, cboHeight.text,
256 txtMeasWT.text, cboWeight.text, cboPain.ItemID);
257end;
258
259procedure TfrmEncVitals.cboTempChange(Sender: TObject);
260begin
261 inherited;
262 if not (cbotemp.droppeddown) then
263 CheckVitalUnit;
264end;
265
266
267procedure TfrmEncVitals.CheckVitalUnit;
268var
269 len,i: integer;
270 found: boolean;
271 comp: string; //substring for comparing
272 temp: string;
273begin
274 if (UcboVitchanging = true) then exit;
275
276 UcboVitChanging := true;
277 try
278 with ActiveCtrl as TComboBox do
279 begin
280 found := False;
281 temp := text;
282 while (found = false) and (Length(temp) > 0) do
283 begin
284 i := 0;
285 while (found = false) and (length(items[i]) > 0) do
286 begin
287 len := length(temp);
288 //match text to string
289 comp := copy(items[i],0,len);
290 if (CompareText(comp,temp) = 0) then
291 begin
292 found := true;
293 Text := '';
294 text := items[i];
295
296 end;
297 inc(i);
298 end;
299 if (found = false) then Delete(temp,1,1);
300 end;
301 if (found = False) then
302 begin
303 Text := '';
304 end;
305 end;
306 finally
307 UcboVitChanging := false;
308 end;
309end;
310
311
312procedure TfrmEncVitals.cboHeightChange(Sender: TObject);
313begin
314 inherited;
315 CheckVitalUnit;
316end;
317
318procedure TfrmEncVitals.cboWeightChange(Sender: TObject);
319begin
320 inherited;
321 CheckVitalUnit;
322end;
323
324procedure TfrmEncVitals.txtMeasBPExit(Sender: TObject);
325begin
326 inherited;
327 if VitalInvalid(txtMeasBP) then
328 ChangeFocus(txtMeasBP);
329end;
330
331procedure TfrmEncVitals.cboTempExit(Sender: TObject);
332begin
333 inherited;
334 if(ActiveCtrl <> txtMeasTemp) then
335 begin
336 if VitalInvalid(txtMeasTemp, cboTemp) then
337 ChangeFocus(txtMeasTemp);
338 end;
339end;
340
341procedure TfrmEncVitals.txtMeasRespExit(Sender: TObject);
342begin
343 inherited;
344 if VitalInvalid(txtMeasResp) then
345 ChangeFocus(txtMeasResp);
346end;
347
348procedure TfrmEncVitals.txtMeasPulseExit(Sender: TObject);
349begin
350 inherited;
351 if VitalInvalid(txtMeasPulse) then
352 ChangeFocus(txtMeasPulse);
353end;
354
355procedure TfrmEncVitals.cboHeightExit(Sender: TObject);
356begin
357 inherited;
358 if(ActiveCtrl <> txtMeasHt) then
359 begin
360 if VitalInvalid(txtMeasHt, cboHeight, GetVitHTRate) then
361 ChangeFocus(txtMeasHt);
362 end;
363end;
364
365procedure TfrmEncVitals.cboWeightExit(Sender: TObject);
366begin
367 inherited;
368 if(ActiveCtrl <> txtMeasWt) then
369 begin
370 if VitalInvalid(txtMeasWt, cboWeight) then
371 ChangeFocus(txtMeasWt);
372 end;
373end;
374
375procedure TfrmEncVitals.FormCreate(Sender: TObject);
376
377begin
378 inherited;
379 FTabName := CT_VitNm;
380 //uVisitType := TPCEProc.create;
381 uVitalOld := TStringList.create;
382 uVitalNew := TStringList.create;
383
384end;
385
386
387
388procedure TfrmEncVitals.FormDestroy(Sender: TObject);
389
390begin
391 inherited;
392 //uVisitType.Free;
393 uVitalOld.Free;
394 uVitalNew.free;
395end;
396
397
398
399
400procedure TfrmEncVitals.lbllastClick(Sender: TObject);
401begin
402 inherited;
403 //
404 try
405 frmEncVitals.Show;
406 except
407 with sender as TStaticText do
408 SelectVital(self.Font.Size, tag);
409 end; //end of try
410end;
411
412
413procedure TfrmEncVitals.FormShow(Sender: TObject);
414begin
415 inherited;
416// frmEncVitals.caption := 'Vital entry for - '+ patient.name; {RAB 6/15/98}
417 FormActivate(Sender);
418end;
419
420procedure TfrmEncVitals.FormActivate(Sender: TObject);
421begin
422 inherited;
423 if(not FChangingFocus) and (not FDataLoaded) then
424 begin
425 FDataLoaded := TRUE;
426 InitVitalPanel;
427// txtMeasTemp.setfocus; //added 3/30/99 after changing tab order.
428 //The date is now first in tab order, but it shouldn't default there.
429 end;
430end;
431
432
433
434procedure TfrmEncVitals.cboPainChange(Sender: TObject);
435begin
436 inherited;
437 CheckVitalUnit;
438end;
439
440procedure TfrmEncVitals.FormResize(Sender: TObject);
441begin
442 inherited;
443 //added to make things austo size that do not heave the property.
444 cboTemp.height := txtmeastemp.height;
445 cboPain.height := txtmeastemp.height;
446 cboheight.height := txtmeastemp.height;
447 cboweight.height := txtmeastemp.height;
448end;
449
450procedure TfrmEncVitals.txtMeasTempExit(Sender: TObject);
451begin
452 inherited;
453 if(ActiveCtrl <> cboTemp) then
454 begin
455 if VitalInvalid(txtMeasTemp, cboTemp) then
456 ChangeFocus(txtMeasTemp);
457 end;
458end;
459
460procedure TfrmEncVitals.txtMeasHtExit(Sender: TObject);
461begin
462 inherited;
463 if(ActiveCtrl <> cboHeight) then
464 begin
465 if VitalInvalid(txtMeasHt, cboHeight, GetVitHTRate) then
466 ChangeFocus(txtMeasHt);
467 end;
468end;
469
470procedure TfrmEncVitals.txtMeasWtExit(Sender: TObject);
471begin
472 inherited;
473 if(ActiveCtrl <> cboWeight) then
474 begin
475 if VitalInvalid(txtMeasWt, cboWeight) then
476 ChangeFocus(txtMeasWt);
477 end;
478end;
479
480procedure TfrmEncVitals.ChangeFocus(Control: TWinControl);
481begin
482 FChangingFocus := TRUE;
483 try
484 Control.SetFocus;
485 finally
486 FChangingFocus := FALSE;
487 end;
488end;
489
490function TfrmEncVitals.OK2SaveVitals: boolean;
491begin
492 Result := TRUE;
493 if(HasData and (abs(txtMeasDate.FMDateTime) <= 0.0000000000001)) then
494 begin
495 Result := (InfoBox(TX_VDATE_REQ1 + FormatFMDateTime('mmm dd,yy@hh:nn', uEncPCEData.DateTime) +
496 TX_VDATE_REQ2, TC_VDATE_REQ, MB_YESNO or MB_ICONWARNING) = IDYES);
497 if Result then
498 txtMeasDate.FMDateTime := uEncPCEData.DateTime
499 else
500 begin
501 Result := (InfoBox(TX_KILLDATA, TC_VDATE_REQ, MB_YESNO or MB_ICONWARNING) = IDYES);
502 if(Result) then
503 ClearData;
504 end;
505 end;
506end;
507
508procedure TfrmEncVitals.ClearData;
509begin
510 txtMeasBP.text := '';
511 txtMeasTemp.text := '';
512 txtMeasResp.text := '';
513 txtMeasPulse.text := '';
514 txtMeasHt.text := '';
515 txtMeasWt.text := '';
516 cboPain.text := '';
517end;
518
519procedure TfrmEncVitals.FormKeyDown(Sender: TObject; var Key: Word;
520 Shift: TShiftState);
521begin
522 {capture return key press if on the vital screen}
523 begin
524 inherited;
525 if (ActiveCtrl.tag in VitalDateTagSet)then
526 begin
527 if Key = VK_RETURN then
528 begin
529 Key := 0;
530 if (ActiveCtrl.Tag = TAG_VITPAIN) then
531 ChangeFocus(btnOK)
532 else
533 begin
534 GetParentForm(Self).Perform(WM_NEXTDLGCTL,0,0);
535 SetVitPointer(Sender);
536 end;
537 end;
538 end;
539 end;
540end;
541
542end.
Note: See TracBrowser for help on using the repository browser.