source: cprs/trunk/CPRS-Chart/Encounter/fEncVitals.pas@ 1243

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

Upgrade to version 27
File size: 17.6 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, ORNet, uVitals, VAUtils, TRPCB, VA508AccessibilityManager;
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 pnlBottom: TPanel;
50 lvVitals: TCaptionListView;
51 btnEnterVitals: TButton;
52 btnOKkludge: TButton;
53 btnCancelkludge: TButton;
54 procedure SetVitPointer(Sender: TObject);
55 procedure txtMeasBPExit(Sender: TObject);
56 procedure cboTempChange(Sender: TObject);
57 procedure cboTempExit(Sender: TObject);
58 procedure txtMeasRespExit(Sender: TObject);
59 procedure txtMeasPulseExit(Sender: TObject);
60 procedure cboHeightChange(Sender: TObject);
61 procedure cboHeightExit(Sender: TObject);
62 procedure cboWeightChange(Sender: TObject);
63 procedure cboWeightExit(Sender: TObject);
64 procedure FormCreate(Sender: TObject);
65 procedure FormDestroy(Sender: TObject);
66 procedure lbllastClick(Sender: TObject);
67 procedure FormShow(Sender: TObject);
68 procedure FormActivate(Sender: TObject);
69 function HasData: Boolean;
70 function AssignVitals: boolean;
71 procedure cboPainChange(Sender: TObject);
72 procedure FormResize(Sender: TObject);
73 procedure txtMeasTempExit(Sender: TObject);
74 procedure txtMeasHtExit(Sender: TObject);
75 procedure txtMeasWtExit(Sender: TObject);
76 procedure btnEnterVitalsClick(Sender: TObject); //vitals lite
77 private
78 FDataLoaded: boolean;
79 FChangingFocus: boolean;
80 UvitalNew: TStringList;
81 uVitalOld: TSTringList;
82 procedure InitVitalPanel;
83 procedure PopulateLastVital;
84 function GetVitHTRate: String;
85 procedure CheckVitalUnit;
86 procedure ChangeFocus(Control: TWinControl);
87 procedure ClearData;
88 procedure LoadVitalView(VitalsList : TStringList); //Vitals Lite
89 procedure LoadVitalsList;
90 public
91 function OK2SaveVitals: boolean;
92 property VitalNew: TStringList read uVitalNew;
93 property VitalOld: TStringList read uVitalOld;
94 end;
95
96var
97 frmEncVitals: TfrmEncVitals;
98// uVitalLocation: Real;
99
100implementation
101
102{$R *.DFM}
103
104uses UCore, rCore, rPCE, fPCELex, fPCEOther, fVitals,fVisit, fFrame, fEncnt,
105 fEncounterFrame, uInit
106 // , fGMV_InputTemp // Vitals Lite 2004-05-21
107 , VA508AccessibilityRouter;
108
109const
110 TX_VDATE_REQ1 = 'Entered vitals information can not be saved without a Date.' + CRLF +
111 'Do you wish to use the encounter date of ';
112 TX_VDATE_REQ2 = '?';
113 TC_VDATE_REQ = 'Missing Vitals Entry Date';
114
115 TX_KILLDATA = 'Discard entered vitals information?';
116
117var
118 UcboVitChanging: Boolean = False;
119
120function TfrmEncVitals.HasData: Boolean;
121begin
122 result := False;
123 if ((txtMeasBP.text <> '') or (txtMeasTemp.text <> '') or (txtMeasResp.text <> '') or
124 (txtMeasPulse.text <> '') or (txtMeasHt.text <> '') or (txtMeasWt.text <> '')) or
125 (cboPain.text <>'') then
126 result := True;
127end;
128
129procedure TfrmEncVitals.InitVitalPanel;
130begin
131 lblDate.font.Style := [fsBold];
132 lblDateBP.font.Style := [fsBold];
133 lblDateTemp.font.Style := [fsBold];
134 lblDateResp.font.Style := [fsBold];
135 lblDatePulse.font.Style := [fsBold];
136 lblDateHeight.font.Style := [fsBold];
137 lblDateWeight.font.Style := [fsBold];
138 lblDatePain.font.style := [fsBold];
139 lblLstMeas.font.Style := [fsBold];
140 lblLastBP.font.Style := [fsBold];
141 lblLastTemp.font.Style := [fsBold];
142 lblLastResp.font.Style := [fsBold];
143 lblLastPulse.font.Style := [fsBold];
144 lblLastHeight.font.Style := [fsBold];
145 lblLastWeight.font.Style := [fsBold];
146 lblLastPain.font.style := [fsBold];
147 lblVital.font.Style := [fsbold];
148
149 {Use this area to read parameter for units and set apropriately
150 after parameter is defined. in next version
151 }
152 UcboVitchanging := true; //prevents entering code in CheckVitalUnit
153
154 try
155 InitPainCombo(cboPain);
156 cboTemp.Text := cboTemp.Items[0];
157 cboHeight.Text := cboHeight.Items[0];
158 cboWeight.Text := cboWeight.Items[0];
159 finally
160 UcboVitchanging := False; //prevents entering code in CheckVitalUnit
161 end;
162
163 if txtMeasDate.Text = '' then
164 txtMeasDate.Text := FormatFMDateTime('mmm dd,yy@hh:nn', uEncPCEData.VisitDateTime);
165 if (UvitalOld.text = '') then
166 PopulateLastVital;
167end;
168
169
170procedure TfrmEncVitals.PopulateLastVital;
171var
172 i: integer;
173begin
174 GetLastVital(uVitalOld,Patient.DFN);
175 //populate labels from UVitalOld;
176 with UVitalOld do
177 for i := 0 to count-1 do
178 begin
179 if piece(strings[i],U,2) = 'T' then
180 begin
181 lblLastTemp.Caption := ConvertVitalData(piece(strings[i],U,3), vtTemp);
182 lblDateTemp.Caption := FormatFMDateTime('mmm dd,yy',
183 StrToFloat(piece(strings[i],U,4)));
184 end;
185 if piece(strings[i],U,2) = 'P' then
186 begin
187 lblLastPulse.Caption := piece(strings[i],U,3);
188 lblDatePulse.Caption := FormatFMDateTime('mmm dd,yy',
189 StrToFloat(piece(strings[i],U,4)));
190 end;
191 if piece(strings[i],U,2) = 'R' then
192 begin
193 lblLastResp.Caption := piece(strings[i],U,3);
194 lblDateResp.Caption := FormatFMDateTime('mmm dd,yy',
195 StrToFloat(piece(strings[i],U,4)));
196 end;
197 if piece(strings[i],U,2) = 'BP' then
198 begin
199 lblLastBP.Caption := piece(strings[i],U,3);
200 lblDateBP.Caption := FormatFMDateTime('mmm dd,yy',
201 StrToFloat(piece(strings[i],U,4)));
202 end;
203 if piece(strings[i],U,2) = 'HT' then
204 begin
205 lblLastHeight.Caption := ConvertVitalData(piece(strings[i],U,3), vtHeight);
206 lblDateHeight.Caption := FormatFMDateTime('mmm dd,yy',
207 StrToFloat(piece(strings[i],U,4)));
208 end;
209 if piece(strings[i],U,2) = 'WT' then
210 begin
211 lblLastWeight.Caption := ConvertVitalData(piece(strings[i],U,3), vtWeight);
212 lblDateWeight.Caption := FormatFMDateTime('mmm dd,yy',
213 StrToFloat(piece(strings[i],U,4)));
214
215 end;
216 if piece(strings[i],U,2) = 'PN' then
217 begin
218 lblLastPain.Caption := piece(strings[i],U,3);
219 lblDatePain.Caption := FormatFMDateTime('mmm dd,yy',
220 StrToFloat(piece(strings[i],U,4)));
221 end;
222 end;
223end;
224
225
226procedure TfrmEncVitals.SetVitPointer(Sender: TObject);
227begin
228 if ActiveCtrl.tag in VitalTagSet then
229 begin
230 // move pointer to some height and five pixels to right of edit box.
231 lblVitPointer.Top := ActiveCtrl.Top+((ActiveCtrl.height ) div
232 (lblVitPointer.height ));
233
234 if ActiveCtrl = txtMeasTemp then
235 lblVitPointer.left := (cboTemp.left + cboTemp.Width)
236 else if ActiveCtrl = txtMeasHT then
237 lblVitPointer.left := (cboHeight.left + cboHeight.Width)
238 else if ActiveCtrl = txtMeasWT then
239 lblVitPointer.left := (cboWeight.left + cboWeight.Width)
240 else
241 lblVitPointer.left := (ActiveCtrl.left + ActiveCtrl.Width);
242
243 end;
244end;
245
246
247function TfrmEncVitals.GetVitHTRate: String;
248begin
249 Result := ConvertHeight2Inches(txtMeasHT.Text);
250 txtMeasHT.text := result;
251end;
252
253function TfrmEncVitals.AssignVitals: boolean;
254var
255 TmpDate: TFMDateTime;
256
257begin
258 TmpDate := txtMeasDate.FMDateTime;
259 Result := ValidVitalsDate(TmpDate);
260 if Result then
261 AssignVitals2List(uVitalNew, TmpDate, FloatToStr(PCERPCEncLocation),
262 txtMeasBP.text, txtMeasTemp.text, cboTemp.text,
263 txtMeasResp.text, txtMeasPulse.text, GetVitHTRate, cboHeight.text,
264 txtMeasWT.text, cboWeight.text, cboPain.ItemID);
265end;
266
267procedure TfrmEncVitals.cboTempChange(Sender: TObject);
268begin
269 inherited;
270 if not (cbotemp.droppeddown) then
271 CheckVitalUnit;
272end;
273
274
275procedure TfrmEncVitals.CheckVitalUnit;
276var
277 len,i: integer;
278 found: boolean;
279 comp: string; //substring for comparing
280 temp: string;
281begin
282 if (UcboVitchanging = true) then exit;
283
284 UcboVitChanging := true;
285 try
286 with ActiveCtrl as TComboBox do
287 begin
288 found := False;
289 temp := text;
290 while (found = false) and (Length(temp) > 0) do
291 begin
292 i := 0;
293 while (found = false) and (length(items[i]) > 0) do
294 begin
295 len := length(temp);
296 //match text to string
297 comp := copy(items[i],0,len);
298 if (CompareText(comp,temp) = 0) then
299 begin
300 found := true;
301 Text := '';
302 text := items[i];
303
304 end;
305 inc(i);
306 end;
307 if (found = false) then Delete(temp,1,1);
308 end;
309 if (found = False) then
310 begin
311 Text := '';
312 end;
313 end;
314 finally
315 UcboVitChanging := false;
316 end;
317end;
318
319
320procedure TfrmEncVitals.cboHeightChange(Sender: TObject);
321begin
322 inherited;
323 CheckVitalUnit;
324end;
325
326procedure TfrmEncVitals.cboWeightChange(Sender: TObject);
327begin
328 inherited;
329 CheckVitalUnit;
330end;
331
332procedure TfrmEncVitals.txtMeasBPExit(Sender: TObject);
333begin
334 inherited;
335 if VitalInvalid(txtMeasBP) then
336 ChangeFocus(txtMeasBP);
337end;
338
339procedure TfrmEncVitals.cboTempExit(Sender: TObject);
340begin
341 inherited;
342 if(ActiveCtrl <> txtMeasTemp) then
343 begin
344 if VitalInvalid(txtMeasTemp, cboTemp) then
345 ChangeFocus(txtMeasTemp);
346 end;
347end;
348
349procedure TfrmEncVitals.txtMeasRespExit(Sender: TObject);
350begin
351 inherited;
352 if VitalInvalid(txtMeasResp) then
353 ChangeFocus(txtMeasResp);
354end;
355
356procedure TfrmEncVitals.txtMeasPulseExit(Sender: TObject);
357begin
358 inherited;
359 if VitalInvalid(txtMeasPulse) then
360 ChangeFocus(txtMeasPulse);
361end;
362
363procedure TfrmEncVitals.cboHeightExit(Sender: TObject);
364begin
365 inherited;
366 if(ActiveCtrl <> txtMeasHt) then
367 begin
368 if VitalInvalid(txtMeasHt, cboHeight, GetVitHTRate) then
369 ChangeFocus(txtMeasHt);
370 end;
371end;
372
373procedure TfrmEncVitals.cboWeightExit(Sender: TObject);
374begin
375 inherited;
376 if(ActiveCtrl <> txtMeasWt) then
377 begin
378 if VitalInvalid(txtMeasWt, cboWeight) then
379 ChangeFocus(txtMeasWt);
380 end;
381end;
382
383
384procedure TfrmEncVitals.FormCreate(Sender: TObject);
385begin
386
387 inherited;
388 FTabName := CT_VitNm;
389 //uVisitType := TPCEProc.create;
390 uVitalOld := TStringList.create;
391 uVitalNew := TStringList.create;
392
393end;
394
395
396
397procedure TfrmEncVitals.FormDestroy(Sender: TObject);
398
399begin
400 //uVisitType.Free;
401 uVitalOld.Free;
402 uVitalNew.free;
403
404{== Vitals Lite 2004-05-21 ===================================================}
405 if VitalsDLLHandle <> 0 then
406 begin
407 FreeLibrary(VitalsDLLHandle);
408 VitalsDLLHandle := 0;
409 end;
410{== Vitals Lite 2004-05-21 ===================================================}
411 inherited;
412end;
413
414
415
416
417procedure TfrmEncVitals.lbllastClick(Sender: TObject);
418begin
419 inherited;
420 //
421 try
422 frmEncVitals.Show;
423 except
424 with sender as TStaticText do
425 SelectVital(self.Font.Size, tag);
426 end; //end of try
427end;
428
429
430procedure TfrmEncVitals.FormShow(Sender: TObject);
431var
432 GMV_LibName: String;
433begin
434 inherited;
435 //Begin Vitals Lite
436 {Visit is Assumed to Be selected when Opening Encounter Dialog}
437 GMV_LibName :='GMV_VitalsViewEnter.dll';
438 GMV_LibName := GetProgramFilesPath + SHARE_DIR + GMV_LibName;
439 if VitalsDLLHandle = 0 then
440 VitalsDLLHandle := LoadLibrary(PChar(GMV_LibName));
441 if VitalsDLLHandle = 0 then // No Handle found
442 MessageDLG('Can''t find library "'+GMV_LibName+'".',mtError,[mbok],0)
443 else
444 LoadVitalsList;
445 //End Vitals Lite
446// frmEncVitals.caption := 'Vital entry for - '+ patient.name; {RAB 6/15/98}
447 FormActivate(Sender);
448end;
449
450procedure TfrmEncVitals.FormActivate(Sender: TObject);
451begin
452 inherited;
453 if(not FChangingFocus) and (not FDataLoaded) then
454 begin
455 FDataLoaded := TRUE;
456 InitVitalPanel;
457// txtMeasTemp.setfocus; //added 3/30/99 after changing tab order.
458 //The date is now first in tab order, but it shouldn't default there.
459 end;
460end;
461
462
463
464procedure TfrmEncVitals.cboPainChange(Sender: TObject);
465begin
466 inherited;
467 CheckVitalUnit;
468end;
469
470procedure TfrmEncVitals.FormResize(Sender: TObject);
471begin
472 inherited;
473 //added to make things austo size that do not heave the property.
474 cboTemp.height := txtmeastemp.height;
475 cboPain.height := txtmeastemp.height;
476 cboheight.height := txtmeastemp.height;
477 cboweight.height := txtmeastemp.height;
478end;
479
480procedure TfrmEncVitals.txtMeasTempExit(Sender: TObject);
481begin
482 inherited;
483 if(ActiveCtrl <> cboTemp) then
484 begin
485 if VitalInvalid(txtMeasTemp, cboTemp) then
486 ChangeFocus(txtMeasTemp);
487 end;
488end;
489
490procedure TfrmEncVitals.txtMeasHtExit(Sender: TObject);
491begin
492 inherited;
493 if(ActiveCtrl <> cboHeight) then
494 begin
495 if VitalInvalid(txtMeasHt, cboHeight, GetVitHTRate) then
496 ChangeFocus(txtMeasHt);
497 end;
498end;
499
500procedure TfrmEncVitals.txtMeasWtExit(Sender: TObject);
501begin
502 inherited;
503 if(ActiveCtrl <> cboWeight) then
504 begin
505 if VitalInvalid(txtMeasWt, cboWeight) then
506 ChangeFocus(txtMeasWt);
507 end;
508end;
509
510procedure TfrmEncVitals.ChangeFocus(Control: TWinControl);
511begin
512 FChangingFocus := TRUE;
513 try
514 Control.SetFocus;
515 finally
516 FChangingFocus := FALSE;
517 end;
518end;
519
520function TfrmEncVitals.OK2SaveVitals: boolean;
521begin
522 Result := TRUE;
523 if(HasData and (abs(txtMeasDate.FMDateTime) <= 0.0000000000001)) then
524 begin
525 Result := (InfoBox(TX_VDATE_REQ1 + FormatFMDateTime('mmm dd,yy@hh:nn', uEncPCEData.DateTime) +
526 TX_VDATE_REQ2, TC_VDATE_REQ, MB_YESNO or MB_ICONWARNING) = IDYES);
527 if Result then
528 txtMeasDate.FMDateTime := uEncPCEData.DateTime
529 else
530 begin
531 Result := (InfoBox(TX_KILLDATA, TC_VDATE_REQ, MB_YESNO or MB_ICONWARNING) = IDYES);
532 if(Result) then
533 ClearData;
534 end;
535 end;
536end;
537
538procedure TfrmEncVitals.ClearData;
539begin
540 txtMeasBP.text := '';
541 txtMeasTemp.text := '';
542 txtMeasResp.text := '';
543 txtMeasPulse.text := '';
544 txtMeasHt.text := '';
545 txtMeasWt.text := '';
546 cboPain.text := '';
547end;
548
549//Begin Vitals Lite
550procedure TfrmEncVitals.LoadVitalView(VitalsList: TStringList);
551var
552 i : integer;
553 curCol : TListColumn;
554 curItem : TListItem;
555 HeadingList,tmpList : TStringList;
556begin
557 HeadingList := TStringList.Create;
558 tmpList := TStringList.Create;
559 lvVitals.ShowColumnHeaders := false; //CQ: 10069 - the column display becomes squished.
560 lvVitals.Items.Clear;
561 lvVitals.Columns.Clear;
562 PiecesToList(VitalsList[0],U,HeadingList);
563 for i := 0 to HeadingList.Count-1 do
564 begin
565 curCol := lvVitals.Columns.Add;
566 curCol.Caption := HeadingList[i];
567 curCol.AutoSize := true;
568 end;
569 for i := 1 to VitalsList.Count-1 do
570 begin
571 curItem := lvVitals.Items.Add;
572 PiecesToList(VitalsList[i],U,tmpList);
573 curItem.Caption := tmpList[0];
574 tmpList.Delete(0);
575 curItem.SubItems.Assign(tmpList);
576 end;
577 lvVitals.ShowColumnHeaders := true; //CQ: 10069 - the column display becomes squished.
578 HeadingList.Free;
579 tmpList.Free;
580end;
581
582procedure TfrmEncVitals.btnEnterVitalsClick(Sender: TObject);
583var
584 VLPtVitals : TGMV_VitalsEnterDLG;
585 GMV_FName : String;
586begin
587 inherited;
588 if VitalsDLLHandle = 0 then Exit;//The DLL was initialized on Create, but just in case....
589 GMV_FName := 'GMV_VitalsEnterDLG';
590 @VLPtVitals := GetProcAddress(VitalsDLLHandle,PChar(GMV_FName));
591 if assigned(VLPtVitals) then
592 begin
593 VLPtVitals(
594 RPCBrokerV,
595 Patient.DFN,
596 FloatToStr(uEncPCEData.Location),
597 GMV_DEFAULT_TEMPLATE,
598 GMV_APP_SIGNATURE,
599 FMDateTimeToDateTime(uEncPCEData.DateTime),
600 Patient.Name,
601 frmFrame.lblPtSSN.Caption + ' ' + frmFrame.lblPtAge.Caption
602 );
603 end
604 else
605 MessageDLG('Unable to find function "'+GMV_FName+'".',mtError,[mbok],0);
606 @VLPtVitals := nil;
607 LoadVitalsList;
608end;
609
610procedure TfrmEncVitals.LoadVitalsList;
611var
612 VitalsList : TStringList;
613 VLPtVitals : TGMV_LatestVitalsList;
614 GMV_FName : String;
615begin
616 if VitalsDLLHandle = 0 then Exit;//The DLL was initialized on Create, but just in case....
617 GMV_FName := 'GMV_LatestVitalsList';
618 @VLPtVitals := GetProcAddress(VitalsDLLHandle,PChar(GMV_FName));
619 if assigned(VLPtVitals) then
620 begin
621// frmFrame.DLLActive := True; // need this flag for CCOW (RV)
622 VitalsList := VLPtVitals(RPCBrokerV,Patient.DFN,U,false);
623 if assigned(VitalsList) then
624 LoadVitalView(VitalsList);
625 end
626 else
627 MessageDLG('Can''t find function "'+GMV_FName+'".',mtError,[mbok],0);
628 @VLPtVitals := nil;
629// frmFrame.DLLActive := False; // need this flag for CCOW (RV)
630end;
631//End Vitals Lite
632
633initialization
634 SpecifyFormIsNotADialog(TfrmEncVitals);
635
636end.
Note: See TracBrowser for help on using the repository browser.