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

Last change on this file since 1780 was 1679, checked in by healthsevak, 10 years ago

Updating the working copy to CPRS version 28
File size: 17.2 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 UnloadVitalsDLL;
406{== Vitals Lite 2004-05-21 ===================================================}
407 inherited;
408end;
409
410
411
412
413procedure TfrmEncVitals.lbllastClick(Sender: TObject);
414begin
415 inherited;
416 //
417 try
418 frmEncVitals.Show;
419 except
420 with sender as TStaticText do
421 SelectVital(self.Font.Size, tag);
422 end; //end of try
423end;
424
425
426procedure TfrmEncVitals.FormShow(Sender: TObject);
427begin
428 inherited;
429 //Begin Vitals Lite
430 {Visit is Assumed to Be selected when Opening Encounter Dialog}
431 LoadVitalsDLL;
432 if VitalsDLLHandle = 0 then // No Handle found
433 MessageDLG('Can''t find library '+VitalsDLLName+'.',mtError,[mbok],0)
434 else
435 LoadVitalsList;
436 //End Vitals Lite
437// frmEncVitals.caption := 'Vital entry for - '+ patient.name; {RAB 6/15/98}
438 FormActivate(Sender);
439end;
440
441procedure TfrmEncVitals.FormActivate(Sender: TObject);
442begin
443 inherited;
444 if(not FChangingFocus) and (not FDataLoaded) then
445 begin
446 FDataLoaded := TRUE;
447 InitVitalPanel;
448// txtMeasTemp.setfocus; //added 3/30/99 after changing tab order.
449 //The date is now first in tab order, but it shouldn't default there.
450 end;
451end;
452
453
454
455procedure TfrmEncVitals.cboPainChange(Sender: TObject);
456begin
457 inherited;
458 CheckVitalUnit;
459end;
460
461procedure TfrmEncVitals.FormResize(Sender: TObject);
462begin
463 inherited;
464 //added to make things austo size that do not heave the property.
465 cboTemp.height := txtmeastemp.height;
466 cboPain.height := txtmeastemp.height;
467 cboheight.height := txtmeastemp.height;
468 cboweight.height := txtmeastemp.height;
469end;
470
471procedure TfrmEncVitals.txtMeasTempExit(Sender: TObject);
472begin
473 inherited;
474 if(ActiveCtrl <> cboTemp) then
475 begin
476 if VitalInvalid(txtMeasTemp, cboTemp) then
477 ChangeFocus(txtMeasTemp);
478 end;
479end;
480
481procedure TfrmEncVitals.txtMeasHtExit(Sender: TObject);
482begin
483 inherited;
484 if(ActiveCtrl <> cboHeight) then
485 begin
486 if VitalInvalid(txtMeasHt, cboHeight, GetVitHTRate) then
487 ChangeFocus(txtMeasHt);
488 end;
489end;
490
491procedure TfrmEncVitals.txtMeasWtExit(Sender: TObject);
492begin
493 inherited;
494 if(ActiveCtrl <> cboWeight) then
495 begin
496 if VitalInvalid(txtMeasWt, cboWeight) then
497 ChangeFocus(txtMeasWt);
498 end;
499end;
500
501procedure TfrmEncVitals.ChangeFocus(Control: TWinControl);
502begin
503 FChangingFocus := TRUE;
504 try
505 Control.SetFocus;
506 finally
507 FChangingFocus := FALSE;
508 end;
509end;
510
511function TfrmEncVitals.OK2SaveVitals: boolean;
512begin
513 Result := TRUE;
514 if(HasData and (abs(txtMeasDate.FMDateTime) <= 0.0000000000001)) then
515 begin
516 Result := (InfoBox(TX_VDATE_REQ1 + FormatFMDateTime('mmm dd,yy@hh:nn', uEncPCEData.DateTime) +
517 TX_VDATE_REQ2, TC_VDATE_REQ, MB_YESNO or MB_ICONWARNING) = IDYES);
518 if Result then
519 txtMeasDate.FMDateTime := uEncPCEData.DateTime
520 else
521 begin
522 Result := (InfoBox(TX_KILLDATA, TC_VDATE_REQ, MB_YESNO or MB_ICONWARNING) = IDYES);
523 if(Result) then
524 ClearData;
525 end;
526 end;
527end;
528
529procedure TfrmEncVitals.ClearData;
530begin
531 txtMeasBP.text := '';
532 txtMeasTemp.text := '';
533 txtMeasResp.text := '';
534 txtMeasPulse.text := '';
535 txtMeasHt.text := '';
536 txtMeasWt.text := '';
537 cboPain.text := '';
538end;
539
540//Begin Vitals Lite
541procedure TfrmEncVitals.LoadVitalView(VitalsList: TStringList);
542var
543 i : integer;
544 curCol : TListColumn;
545 curItem : TListItem;
546 HeadingList,tmpList : TStringList;
547begin
548 HeadingList := TStringList.Create;
549 tmpList := TStringList.Create;
550 lvVitals.ShowColumnHeaders := false; //CQ: 10069 - the column display becomes squished.
551 lvVitals.Items.Clear;
552 lvVitals.Columns.Clear;
553 PiecesToList(VitalsList[0],U,HeadingList);
554 for i := 0 to HeadingList.Count-1 do
555 begin
556 curCol := lvVitals.Columns.Add;
557 curCol.Caption := HeadingList[i];
558 curCol.AutoSize := true;
559 end;
560 for i := 1 to VitalsList.Count-1 do
561 begin
562 curItem := lvVitals.Items.Add;
563 PiecesToList(VitalsList[i],U,tmpList);
564 curItem.Caption := tmpList[0];
565 tmpList.Delete(0);
566 curItem.SubItems.Assign(tmpList);
567 end;
568 lvVitals.ShowColumnHeaders := true; //CQ: 10069 - the column display becomes squished.
569 HeadingList.Free;
570 tmpList.Free;
571end;
572
573procedure TfrmEncVitals.btnEnterVitalsClick(Sender: TObject);
574var
575 VLPtVitals : TGMV_VitalsEnterDLG;
576 GMV_FName : String;
577begin
578 inherited;
579 if VitalsDLLHandle = 0 then Exit;//The DLL was initialized on Create, but just in case....
580 GMV_FName := 'GMV_VitalsEnterDLG';
581 @VLPtVitals := GetProcAddress(VitalsDLLHandle,PChar(GMV_FName));
582 if assigned(VLPtVitals) then
583 begin
584 VLPtVitals(
585 RPCBrokerV,
586 Patient.DFN,
587 FloatToStr(uEncPCEData.Location),
588 GMV_DEFAULT_TEMPLATE,
589 GMV_APP_SIGNATURE,
590 FMDateTimeToDateTime(uEncPCEData.DateTime),
591 Patient.Name,
592 frmFrame.lblPtSSN.Caption + ' ' + frmFrame.lblPtAge.Caption
593 );
594 end
595 else
596 MessageDLG('Unable to find function "'+GMV_FName+'".',mtError,[mbok],0);
597 @VLPtVitals := nil;
598 LoadVitalsList;
599end;
600
601procedure TfrmEncVitals.LoadVitalsList;
602var
603 VitalsList : TStringList;
604 VLPtVitals : TGMV_LatestVitalsList;
605 GMV_FName : String;
606begin
607 if VitalsDLLHandle = 0 then Exit;//The DLL was initialized on Create, but just in case....
608 GMV_FName := 'GMV_LatestVitalsList';
609 @VLPtVitals := GetProcAddress(VitalsDLLHandle,PChar(GMV_FName));
610 if assigned(VLPtVitals) then
611 begin
612 VitalsList := VLPtVitals(RPCBrokerV,Patient.DFN,U,false);
613 if assigned(VitalsList) then
614 LoadVitalView(VitalsList);
615 end
616 else
617 MessageDLG('Can''t find function "'+GMV_FName+'".',mtError,[mbok],0);
618 @VLPtVitals := nil;
619end;
620//End Vitals Lite
621
622initialization
623 SpecifyFormIsNotADialog(TfrmEncVitals);
624
625end.
Note: See TracBrowser for help on using the repository browser.