source: cprs/branches/tmg-cprs/CPRS-Chart/fvit.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: 16.3 KB
Line 
1//kt -- Modified with SourceScanner on 8/7/2007
2{///////////////////////////////////////////////////////
3//Description: This form has been copied form the vital entry tab in fPCEEdit
4// It is intended to be used for vital entry off of the cover sheet in CPRS and
5// posibly being ported to a separate application from CPRS that only does Vital entry.
6//
7//Created: April 1998
8//Author: Robert Bott
9//Location: ISL
10//
11//To Do List:
12// needs to be modified to use the application font settings.
13
14////////////////////////////////////////////////////////
15//Modifed: 4/21/98
16//By: Robert Bott
17//Location: ISL
18//Description of Mod: Modified this unit to use only the Date/time entered
19// rather than the encounter.datetime.
20//
21//Modifed: 5/06/98
22//By: Robert Bott
23//Location: ISL
24//Description of Mod: removed DateStrToFMDateTimeStr function and added
25// TOTDateBox to allow the date/time to be edited.
26//
27//Modifed: 6/15/98
28//By: Robert Bott
29//Location: ISL
30//Description of Mod: moved line of code to change caption from formCreate event
31// to formShow event. This prevents an error occuring at that line if there is
32// not a broker connection.
33
34//Modifed: 6/23/98
35//By: Robert Bott
36//Location: ISL
37//Description of Mod:
38// Moved code that verifies valid provider and visit from fvit into fVitals.
39// now found in procedure TfrmVitals.btnEnterVitalsClick(Sender: TObject);
40// formerly in procedure TfrmVit.FormActivate(Sender: TObject);
41
42//Modifed: 9/18/98
43//By: Robert Bott
44//Location: ISL
45//Description of Mod:
46// changed procedure TfrmVit.cmdOKClick to display the error message returned
47// from ValAndStoreVitals.
48
49//Modifed: 12/10/98
50//By: Robert Bott
51//Location: ISL
52//Description of Mod:
53// Changed oredr of display and entry to Temp, Pulse, Resp, B/P, HT, WT
54
55//Modifed: 6/29/99
56//By: Robert Bott
57//Location: ISL
58//Description of Mod:
59// Changed AssignVitals finction to round conversions before storing them.
60
61///////////////////////////////////////////////////////////////////////////////}
62
63unit fvit;
64
65interface
66
67uses
68 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
69 ExtCtrls, fAutoSz,StdCtrls, ORFn, ORCtrls, rvitals, ORDtTm, DKLang;
70
71
72type
73 TfrmVit = class(TfrmAutoSz)
74 pnlmain: TPanel;
75 lblDate: TStaticText;
76 lblDateBP: TStaticText;
77 lblDateTemp: TStaticText;
78 lblDateResp: TStaticText;
79 lblDatePulse: TStaticText;
80 lblDateHeight: TStaticText;
81 lblDateWeight: TStaticText;
82 lblLstMeas: TStaticText;
83 lbllastBP: TStaticText;
84 lblLastTemp: TStaticText;
85 lblLastResp: TStaticText;
86 lblLastPulse: TStaticText;
87 lblLastHeight: TStaticText;
88 lblLastWeight: TStaticText;
89 txtMeasBP: TCaptionEdit;
90 cboTemp: TCaptionComboBox;
91 txtMeasTemp: TCaptionEdit;
92 txtMeasResp: TCaptionEdit;
93 txtMeasPulse: TCaptionEdit;
94 txtMeasHt: TCaptionEdit;
95 cboHeight: TCaptionComboBox;
96 txtMeasWt: TCaptionEdit;
97 cboWeight: TCaptionComboBox;
98 lblVitPointer: TOROffsetLabel;
99 cmdOK: TButton;
100 cmdCancel: TButton;
101 lblVital: TStaticText;
102 lblVitBP: TStaticText;
103 lnlVitTemp: TStaticText;
104 lblVitResp: TStaticText;
105 lblVitPulse: TStaticText;
106 lblVitHeight: TStaticText;
107 lblVitWeight: TStaticText;
108 txtMeasDate: TORDateBox;
109 lblDatePain: TStaticText;
110 lblLastPain: TStaticText;
111 lblVitPain: TStaticText;
112 cboPain: TORComboBox;
113 DKLanguageController1: TDKLanguageController;
114 procedure FormKeyPress(Sender: TObject; var Key: Char);
115 procedure txtMeasBPExit(Sender: TObject);
116 procedure cboTempChange(Sender: TObject);
117 procedure cboTempExit(Sender: TObject);
118 procedure txtMeasRespExit(Sender: TObject);
119 procedure txtMeasPulseExit(Sender: TObject);
120 procedure cboHeightChange(Sender: TObject);
121 procedure cboHeightExit(Sender: TObject);
122 procedure cboWeightChange(Sender: TObject);
123 procedure cboWeightExit(Sender: TObject);
124 procedure FormCreate(Sender: TObject);
125 procedure FormDestroy(Sender: TObject);
126 procedure cmdCancelClick(Sender: TObject);
127 procedure cmdOKClick(Sender: TObject);
128 procedure lbllastClick(Sender: TObject);
129 procedure FormShow(Sender: TObject);
130 procedure FormActivate(Sender: TObject);
131 procedure cboPainChange(Sender: TObject);
132 procedure SetVitPointer(Sender: TObject);
133 procedure txtMeasTempExit(Sender: TObject);
134 procedure txtMeasHtExit(Sender: TObject);
135 procedure txtMeasWtExit(Sender: TObject);
136
137 private
138 { Private declarations }
139 procedure InitVitalPanel;
140 procedure PopulateLastVital;
141 function GetVitHTRate: String;
142 procedure AssignVitals;
143 procedure CheckVitalUnit(AWinControl: TWinControl);
144 public
145 { Public declarations }
146 end;
147
148//const
149//TX_NEED_VISIT = 'A visit or location is required before entering vital signs.'; <-- original line. //kt 8/7/2007
150//TX_NO_VISIT = 'Insufficient Visit Information'; <-- original line. //kt 8/7/2007
151//TX_NEED_PROVIDER = 'A valid provider must be selected before entering vital signs.'; <-- original line. //kt 8/7/2007
152//TX_NO_PROVIDER = 'Undefined Provider'; <-- original line. //kt 8/7/2007
153
154function TX_NEED_VISIT : string; //kt replaced const with Fn. 8-25-07
155function TX_NO_VISIT : string; //kt replaced const with Fn. 8-25-07
156function TX_NEED_PROVIDER : string; //kt replaced const with Fn. 8-25-07
157function TX_NO_PROVIDER : string; //kt replaced const with Fn. 8-25-07
158
159var
160 frmVit: TfrmVit;
161 uVitalLocation: Real;
162 //uVitalNew: TStringlist;
163
164implementation
165
166{$R *.DFM}
167
168uses UCore, rCore, rPCE, fPCELex, fPCEOther, fVitals,fVisit, fFrame, fEncnt,
169 uVitals;
170
171var
172 uVitalOld: TStringlist;
173 uVitalNew: TStringlist;
174 UcboVitChanging: Boolean = False;
175
176function TX_NEED_VISIT : string; //kt 8-25-07 replaced const with Fn.
177begin Result := DKLangConstW('fvit_A_visit_or_location_is_required_before_entering_vital_signsx');
178end;
179
180function TX_NO_VISIT : string; //kt 8-25-07 replaced const with Fn.
181begin Result := DKLangConstW('fvit_Insufficient_Visit_Information');
182end;
183
184function TX_NEED_PROVIDER : string; //kt 8-25-07 replaced const with Fn.
185begin Result := DKLangConstW('fvit_A_valid_provider_must_be_selected_before_entering_vital_signsx');
186end;
187
188function TX_NO_PROVIDER : string; //kt 8-25-07 replaced const with Fn.
189begin Result := DKLangConstW('fvit_Undefined_Provider');
190end;
191
192
193
194{Start of code for Vital Page--------------------------------------------------}
195procedure TfrmVit.FormKeyPress(Sender: TObject; var Key: Char);
196{capture return key press if on the vital screen}
197begin
198 inherited;
199 if (ActiveControl.tag IN ([TAG_VITTEMP,TAG_VITPULSE,TAG_VITRESP,
200 TAG_VITBP,TAG_VITHEIGHT,TAG_VITWEIGHT,TAG_VITTEMPUNIT,TAG_VITHTUNIT,TAG_VITWTUNIT,TAG_VITPAIN,TAG_VITDATE]))then
201 begin
202 if Key = #13 then
203 begin
204 Key := #0;
205
206 if (activeControl.Tag = TAG_VITPAIN) then cmdOK.setfocus
207 else
208 begin
209 Perform(WM_NEXTDLGCTL,0,0);
210 SetVitPointer(Sender);
211 end;
212 end;
213 end;
214
215end;
216
217procedure TfrmVit.InitVitalPanel;
218begin
219 lblDate.font.Style := [fsBold];
220 lblDateBP.font.Style := [fsBold];
221 lblDateTemp.font.Style := [fsBold];
222 lblDateResp.font.Style := [fsBold];
223 lblDatePulse.font.Style := [fsBold];
224 lblDateHeight.font.Style := [fsBold];
225 lblDateWeight.font.Style := [fsBold];
226 lblDatePain.font.style := [fsBold]; {*RAB*}
227 lblLstMeas.font.Style := [fsBold];
228 lblLastBP.font.Style := [fsBold];
229 lblLastTemp.font.Style := [fsBold];
230 lblLastResp.font.Style := [fsBold];
231 lblLastPulse.font.Style := [fsBold];
232 lblLastHeight.font.Style := [fsBold];
233 lblLastWeight.font.Style := [fsBold];
234 lblLastPain.font.style := [fsBold]; {*RAB*}
235 lblVital.font.Style := [fsbold];
236
237
238 UcboVitChanging := true; //prevents entering code in CheckVitalUnit
239 try
240 InitPainCombo(cboPain);
241 cboTemp.Text := cboTemp.Items[0];
242 cboHeight.Text := cboHeight.Items[0];
243 cboWeight.Text := cboWeight.Items[0];
244 finally
245 UcboVitchanging := False; //prevents entering code in CheckVitalUnit
246 end;
247
248 txtMeasDate.Text := FormatFMDateTime('mmm dd,yy@hh:nn', FMNOW);
249
250 if (UvitalOld.text = '') then
251 PopulateLastVital;
252end;
253
254
255
256procedure TfrmVit.PopulateLastVital;
257var
258 i: integer;
259begin
260 GetLastVital(uVitalOld,Patient.DFN);
261 //populate labels from UVitalOld;
262 with UVitalOld do
263 for i := 0 to count-1 do
264 begin
265 if piece(strings[i],U,2) = 'T' then
266 begin
267 lblLastTemp.Caption := piece(strings[i],U,3);
268 lblDateTemp.Caption := FormatFMDateTime('mmm dd,yy',
269 StrToFloat(piece(strings[i],U,4)));
270 end;
271 if piece(strings[i],U,2) = 'P' then
272 begin
273 lblLastPulse.Caption := piece(strings[i],U,3);
274 lblDatePulse.Caption := FormatFMDateTime('mmm dd,yy',
275 StrToFloat(piece(strings[i],U,4)));
276 end;
277 if piece(strings[i],U,2) = 'R' then
278 begin
279 lblLastResp.Caption := piece(strings[i],U,3);
280 lblDateResp.Caption := FormatFMDateTime('mmm dd,yy',
281 StrToFloat(piece(strings[i],U,4)));
282 end;
283 if piece(strings[i],U,2) = 'BP' then
284 begin
285 lblLastBP.Caption := piece(strings[i],U,3);
286 lblDateBP.Caption := FormatFMDateTime('mmm dd,yy',
287 StrToFloat(piece(strings[i],U,4)));
288 end;
289 if piece(strings[i],U,2) = 'HT' then
290 begin
291 lblLastHeight.Caption := piece(strings[i],U,3);
292 lblDateHeight.Caption := FormatFMDateTime('mmm dd,yy',
293 StrToFloat(piece(strings[i],U,4)));
294 end;
295 if piece(strings[i],U,2) = 'WT' then
296 begin
297 lblLastWeight.Caption := piece(strings[i],U,3);
298 lblDateWeight.Caption := FormatFMDateTime('mmm dd,yy',
299 StrToFloat(piece(strings[i],U,4)));
300 end;
301 if piece(strings[i],U,2) = 'PN' then {*RAB*}
302 begin
303 lblLastPain.Caption := piece(strings[i],U,3); {*RAB*}
304 lblDatePain.Caption := FormatFMDateTime('mmm dd,yy', {*RAB*}
305 StrToFloat(piece(strings[i],U,4))); {*RAB*}
306
307 end;
308 end;
309
310end;
311
312
313
314function TfrmVit.GetVitHTRate: String;
315begin
316 Result := ConvertHeight2Inches(txtMeasHT.Text);
317 txtMeasHT.text := Result;
318end;
319
320//procedure: procedure TFrmVit.AssignVitals;
321//Modifed: 10/02/98
322//By: Robert Bott
323//Location: ISL
324//Description of Mod:
325// If encounter.provider is not defined (=0) then use User.DUZ to store vitals.
326procedure TFrmVit.AssignVitals;
327begin
328 AssignVitals2List(uVitalNew, txtMeasDate.FMDateTime, FloatToStr(uVitalLocation),
329 txtMeasBP.text, txtMeasTemp.text, cboTemp.text,
330 txtMeasResp.text, txtMeasPulse.text, GetVitHTRate, cboHeight.text,
331 txtMeasWT.text, cboWeight.text, cboPain.ItemID);
332end;
333
334procedure TfrmVit.cboTempChange(Sender: TObject);
335begin
336 inherited;
337 if not (cbotemp.droppeddown) then
338 CheckVitalUnit(cboTemp);
339end;
340
341
342procedure TFrmVit.CheckVitalUnit(AWinControl: TWinControl);
343var
344 len,i: integer;
345 found: boolean;
346 comp: string; //substring for comparing
347 temp: string;
348begin
349 if (UcboVitchanging = true) then exit;
350
351 UcboVitChanging := true;
352 try
353 with AWinControl as TComboBox do
354 begin
355 found := False;
356 temp := (AWinControl as TComboBox).text;
357 while (found = false) and (Length(temp) > 0) do
358 begin
359 i := 0;
360 while (found = false) and (length(items[i]) > 0) do
361 begin
362 len := length(temp);
363 //match text to string
364 comp := copy(items[i],0,len);
365 if (CompareText(comp,temp) = 0) then
366 begin
367 found := true;
368 (AWinControl as TComboBox).Text := '';
369 (AWinControl as TComboBox).text := items[i];
370
371 end;
372 inc(i);
373 end;
374 if (found = false) then Delete(temp,1,1);
375 end;
376 if (found = False) then
377 begin
378 (AWinControl as TComboBox).Text := '';
379 end;
380 end;
381 finally
382 UcboVitChanging := false;
383 end;
384end;
385
386
387procedure TfrmVit.cboHeightChange(Sender: TObject);
388begin
389 inherited;
390 CheckVitalUnit(cboHeight);
391end;
392
393procedure TfrmVit.cboWeightChange(Sender: TObject);
394begin
395 inherited;
396 CheckVitalUnit(cboWeight);
397end;
398
399procedure TfrmVit.txtMeasBPExit(Sender: TObject);
400begin
401 inherited;
402 if VitalInvalid(txtMeasBP) then
403 txtMeasBP.SetFocus;
404end;
405
406procedure TfrmVit.cboTempExit(Sender: TObject);
407begin
408 inherited;
409 if(ActiveControl <> txtMeasTemp) then
410 begin
411 if VitalInvalid(txtMeasTemp, cboTemp) then
412 txtMeasTemp.SetFocus;
413 end;
414end;
415
416procedure TfrmVit.txtMeasRespExit(Sender: TObject);
417begin
418 inherited;
419 if VitalInvalid(txtMeasResp) then
420 txtMeasResp.SetFocus;
421end;
422
423procedure TfrmVit.txtMeasPulseExit(Sender: TObject);
424begin
425 inherited;
426 if VitalInvalid(txtMeasPulse) then
427 txtMeasPulse.SetFocus;
428end;
429
430procedure TfrmVit.cboHeightExit(Sender: TObject);
431begin
432 inherited;
433 if(ActiveControl <> txtMeasHt) then
434 begin
435 if VitalInvalid(txtMeasHt, cboHeight, GetVitHTRate) then
436 txtMeasHt.SetFocus;
437 end;
438end;
439
440procedure TfrmVit.cboWeightExit(Sender: TObject);
441begin
442 inherited;
443 if(ActiveControl <> txtMeasWt) then
444 begin
445 if VitalInvalid(txtMeasWt, cboWeight) then
446 txtMeasWt.SetFocus;
447 end;
448end;
449
450procedure TfrmVit.FormCreate(Sender: TObject);
451
452begin
453 inherited;
454 //uVisitType := TPCEProc.create;
455 uVitalOld := TStringList.create;
456 uVitalNew := TStringList.create;
457 ResizeAnchoredFormToFont(self);
458end;
459
460
461
462procedure TfrmVit.FormDestroy(Sender: TObject);
463
464begin
465 inherited;
466 //uVisitType.Free;
467 uVitalOld.Free;
468 uVitalNew.free;
469end;
470
471
472
473procedure TfrmVit.cmdCancelClick(Sender: TObject);
474begin
475 inherited;
476 close();
477end;
478
479procedure TfrmVit.cmdOKClick(Sender: TObject);
480var
481 StoreMessage: string;
482begin
483 inherited;
484 // do validation for vitals & anything else here
485 AssignVitals;
486
487 //store vitals
488 StoreMessage := ValAndStoreVitals(UVitalNew);
489 if (Storemessage <> 'True') then
490 begin
491 showmessage(storemessage);
492 exit;
493 end;
494 close();
495end;
496
497procedure TfrmVit.lbllastClick(Sender: TObject);
498begin
499 inherited;
500 //
501 try
502 frmVitals.Show;
503 except
504 with sender as tLabel do
505 SelectVital(self.Font.Size, tag);
506 end; //end of try
507end;
508
509
510procedure TfrmVit.FormShow(Sender: TObject);
511begin
512 inherited;
513//frmVit.caption := 'Vital entry for - '+ patient.name; {RAB 6/15/98} <-- original line. //kt 8/7/2007
514 frmVit.caption := DKLangConstW('fvit_Vital_entry_for_x')+ patient.name; {RAB 6/15/98} //kt added 8/7/2007
515end;
516
517procedure TfrmVit.FormActivate(Sender: TObject);
518begin
519 inherited;
520 InitVitalPanel;
521 txtMeasTemp.setfocus; //added 3/30/99 after changing tab order.
522 //The date is now first in tab order, but it shouldn't default there.
523
524end;
525
526
527procedure TfrmVit.cboPainChange(Sender: TObject);
528begin
529 inherited;
530 CheckVitalUnit(cboPain);
531end;
532
533procedure TfrmVit.SetVitPointer(Sender: TObject);
534begin
535 if ActiveControl.tag in ([TAG_VITTEMP, TAG_VITPULSE, TAG_VITRESP, TAG_VITBP, TAG_VITHEIGHT,
536 TAG_VITWEIGHT]) then
537 begin
538 // move pointer to some height and five pixels to right of edit box.
539 lblVitPointer.Top := ActiveControl.Top+((ActiveControl.height ) div
540 (lblVitPointer.height ));
541
542 if ActiveControl = txtMeasTemp then
543 lblVitPointer.left := (cboTemp.left + cboTemp.Width)
544 else if ActiveControl = txtMeasHT then
545 lblVitPointer.left := (cboHeight.left + cboHeight.Width)
546 else if ActiveControl = txtMeasWT then
547 lblVitPointer.left := (cboWeight.left + cboWeight.Width)
548 else
549 lblVitPointer.left := (ActiveControl.left + ActiveControl.Width);
550
551 end;
552end;
553
554procedure TfrmVit.txtMeasTempExit(Sender: TObject);
555begin
556 if(ActiveControl <> cboTemp) then
557 begin
558 if VitalInvalid(txtMeasTemp, cboTemp) then
559 txtMeasTemp.SetFocus;
560 end;
561end;
562
563procedure TfrmVit.txtMeasHtExit(Sender: TObject);
564begin
565 if(ActiveControl <> cboHeight) then
566 begin
567 if VitalInvalid(txtMeasHt, cboHeight, GetVitHTRate) then
568 txtMeasHt.SetFocus;
569 end;
570end;
571
572procedure TfrmVit.txtMeasWtExit(Sender: TObject);
573begin
574 if(ActiveControl <> cboWeight) then
575 begin
576 if VitalInvalid(txtMeasWt, cboWeight) then
577 txtMeasWt.SetFocus;
578 end;
579end;
580
581end.
Note: See TracBrowser for help on using the repository browser.