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

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

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