source: cprs/trunk/CPRS-Chart/Vitals/uVitals.pas@ 819

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

Initial Upload of Official WV CPRS 1.0.26.76
File size: 21.2 KB
Line 
1unit uVitals;
2{ Old class TVital currently not used - commented out at bottom of unit }
3
4interface
5
6uses
7 SysUtils, Dialogs, Controls, Windows, Classes, ORClasses, ORCtrls, ORFn, Forms
8 , TRPCB
9 ;
10
11const
12 NoVitalOverrideValue = '^None^';
13
14type
15 TVitalType = (vtUnknown, vtTemp, vtPulse, vtResp, vtBP, vtHeight, vtWeight, vtPain,
16 vtPO2, vtCVP, vtCircum);
17 TValidVitalTypes = vtTemp..vtCircum;
18
19procedure InitPainCombo(cboPain: TORComboBox);
20procedure ConvertVital(VType: TVitalType; var VValue, VUnit: string);
21function GetVitalStr(VType: TVitalType; rte, unt, UserStr, DateStr: string): string;
22function GetVitalUser: string;
23procedure AssignVitals2List(List: TStrings; ADateTime: TFMDateTime;
24 ALocation, ABP, ATemp, ATempUnits,
25 AResp, APulse, AHeight, AHeightUnits,
26 AWeight, AWeightUnits, APain: string);
27function VitalInvalid(VitalControl: TControl; UnitsControl: TControl = nil;
28 OverrideValue: string = NoVitalOverrideValue): boolean;
29function VitalControlTag(VType: TVitalType; UnitControl: boolean = FALSE): integer;
30function ConvertHeight2Inches(Ht: string): string;
31function FormatVitalForNote(VitalStr: string):String;
32function ConvertVitalData(const Value: string; VitalType: TVitalType; UnitType: string = ''): string;
33procedure VitalsFrameCreated(Frame: TFrame);
34procedure SetVitalsMetric(const Value: boolean);
35procedure SetVitCVPmmHg(const Value: boolean);
36function ValidVitalsDate(var ADate: TFMDateTime; SkipFirst: boolean = FALSE; Show: boolean = true): boolean;
37function IsNumericWeight(const x: string): Boolean;
38procedure CloseVitalsDLL;
39
40const
41 VitalPCECodes: array[TValidVitalTypes] of string =
42 { vtTemp } ('TMP',
43 { vtPulse } 'PU',
44 { vtResp } 'RS',
45 { vtBP } 'BP',
46 { vtHeight } 'HT',
47 { vtWeight } 'WT',
48 { vtPain } 'PN',
49 { vtPO2 } 'PO2',
50 { vtCVP } 'CVP',
51 { vtCircum } 'CG');
52
53
54 VitalCodes: array[TValidVitalTypes] of string =
55 { vtTemp } ('T',
56 { vtPulse } 'P',
57 { vtResp } 'R',
58 { vtBP } 'BP',
59 { vtHeight } 'HT',
60 { vtWeight } 'WT',
61 { vtPain } 'PN',
62 { vtPO2 } 'PO2',
63 { vtCVP } 'CVP',
64 { vtCircum } 'CG');
65
66 TAG_VITTEMP = 2;
67 TAG_VITPULSE = 4;
68 TAG_VITRESP = 3;
69 TAG_VITBP = 1;
70 TAG_VITHEIGHT = 5;
71 TAG_VITWEIGHT = 6;
72 TAG_VITTEMPUNIT= 7;
73 TAG_VITHTUNIT = 8;
74 TAG_VITWTUNIT = 9;
75 TAG_VITPAIN = 10;
76 TAG_VITDATE = 11;
77
78 VitalDateStr = 'VST^DT^';
79 VitalPatientStr = 'VST^PT^';
80 VitalLocationStr = 'VST^HL^';
81
82 SHARE_DIR = '\VISTA\Common Files\';
83 GMV_CONTEXT = 'OR CPRS GUI CHART';
84 GMV_APP_SIGNATURE = 'CPRS';
85 GMV_DEFAULT_TEMPLATE = '';
86
87type
88 VitalTags = TAG_VITBP..TAG_VITPAIN;
89
90 TGMV_VitalsEnterForm = function(
91 aBroker:TRPCBroker;
92 aPatient, aLocation, aTemplate,aSignature:String;
93 aDateTime:TDateTime): TCustomForm; stdcall;
94
95 TGMV_VitalsEnterDLG = function(
96 aBroker:TRPCBroker;
97 aDFN, aLocation, aTemplate,aSignature:String;
98 aDateTime:TDateTime;
99 aName,anInfo:String): Integer; stdcall;
100
101 TGFM_VitalsViewDLG = function(
102 aBroker:TRPCBroker;
103 aDFN, aLocation,
104 DateStart, DateStop,
105 aSignature,
106 aContextIn,aContextOut,
107 aName,anInfo,aHospitalName:String): Integer; stdcall;
108
109 TGMV_VitalsViewForm = function(
110 aBroker:TRPCBroker;
111 aDFN, aLocation,
112 DateStart, DateStop,
113 aSignature,
114 aContextIn,aContextOut,
115 aName,anInfo,
116 aDynamicParameter {HospitolName^Vital Type Abbreviation} :String): TCustomForm; stdcall;
117
118 TGMV_LatestVitalsList = function (
119 aBroker:TRPCBroker;
120 aDFN,
121 aDelim:String;
122 bSilent:Boolean
123 ): TStringList; stdcall;
124
125 TGMV_VitalsExit = Procedure;
126
127var
128 VitalsDLLHandle : THandle;
129 DLLForceClose : Boolean = False;
130
131
132const
133 VitalTagSet = [TAG_VITBP..TAG_VITPAIN];
134 VitalDateTagSet = [TAG_VITBP..TAG_VITDATE];
135
136 VitalTagCodes: array[VitalTags] of TVitalType =
137 { TAG_VITBP } (vtBP,
138 { TAG_VITTEMP } vtTemp,
139 { TAG_VITRESP } vtResp,
140 { TAG_VITPULSE } vtPulse,
141 { TAG_VITHEIGHT } vtHeight,
142 { TAG_VITWEIGHT } vtWeight,
143 { TAG_VITTEMPUNIT } vtTemp,
144 { TAG_VITHTUNIT } vtHeight,
145 { TAG_VITWTUNIT } vtWeight,
146 { TAG_VITPAIN } vtPain);
147
148 VitalDesc: array[TVitalType] of string =
149 { vtUnknown } ('Unknown',
150 { vtTemp } 'Temperature',
151 { vtPulse } 'Pulse',
152 { vtResp } 'Respiration',
153 { vtBP } 'Blood Pressure',
154 { vtHeight } 'Height',
155 { vtWeight } 'Weight',
156 { vtPain } 'Pain Score',
157 { vtPO2 } 'Pulse Oximetry',
158 { vtCVP } 'Central Venous Pressure',
159 { vtCircum } 'Circumference/Girth');
160
161 VitalFormatedDesc: array[TValidVitalTypes] of string =
162 { vtTemp } ('Temperature ',
163 { vtPulse } 'Pulse ',
164 { vtResp } 'Resp ',
165 { vtBP } 'Blood Press. ',
166 { vtHeight } 'Height ',
167 { vtWeight } 'Weight ',
168 { vtPain } 'Pain Scale. ',
169 { vtPO2 } 'Pulse Ox. ',
170 { vtCVP } 'Cnt Vns Pres ',
171 { vtCircum } 'Circum/Girth ');
172 vnumType = 2;
173 vnumValue = 3;
174 vnumDate = 4;
175
176implementation
177
178uses
179 uCore, rCore, rVitals, Contnrs, mVitBase, mVitMetric, fVitalsDate;
180
181var
182 uVitalFrames: TComponentList = nil;
183
184procedure CloseVitalsDLL;
185var
186 VitalsExit : TGMV_VitalsExit;
187begin
188 if VitalsDLLHandle <> 0 then
189 begin
190 @VitalsExit := GetProcAddress(VitalsDLLHandle,PChar('GMV_VitalsExit'));
191 if assigned(VitalsExit) then
192 VitalsExit();
193 DLLForceClose := True;
194 end;
195end;
196
197function VitalErrorText(VType: TVitalType): string;
198begin
199 case VType of
200 vtTemp, vtHeight, vtWeight:
201 Result := '- check rate and unit.';
202 else
203 Result := 'reading entered.';
204 end;
205 Result := 'Invalid ' + VitalDesc[VType] + ' ' + Result;
206end;
207
208procedure InitPainCombo(cboPain: TORComboBox);
209begin
210 cboPain.Items.Clear;
211 cboPain.Items.Add('0^ - no pain');
212 cboPain.Items.Add('1^ - slightly uncomfortable');
213 cboPain.Items.Add('2^');
214 cboPain.Items.Add('3^');
215 cboPain.Items.Add('4^');
216 cboPain.Items.Add('5^');
217 cboPain.Items.Add('6^');
218 cboPain.Items.Add('7^');
219 cboPain.Items.Add('8^');
220 cboPain.Items.Add('9^');
221 cboPain.Items.Add('10^ - worst imaginable');
222 cboPain.Items.Add('99^ - unable to respond');
223end;
224
225procedure ConvertVital(VType: TVitalType; var VValue, VUnit: string);
226begin
227 case VType of
228 vtTemp: if(VUnit = 'C') then //if metric, convert to standard
229 begin
230 if StrToFloat(VValue) > 0 then
231 //VValue := FloatToStr(StrToFloat(VValue) * 9.0 / 5.0 +32.0);
232 VValue := FloatToStr(Round((StrToFloat(VValue) * 9.0 / 5.0 +32.0)*100)/100);
233 VUnit := 'F';
234 end;
235
236 vtHeight: if VUnit = 'CM' then
237 begin
238 if StrToFloat(VValue) > 0 then
239 //VValue := FloatToStr(StrtoFloat(VValue) / 2.54);
240 VValue := FloatToStr(Round((StrtoFloat(VValue) / 2.54)*1000)/1000);
241 VUnit := 'IN';
242 end;
243
244 vtWeight: if VUnit = 'KG' then
245 begin
246 if StrToFloat(VValue) > 0 then
247 //VValue := FloatToStr(StrtoFloat(VValue) * 2.2046);
248 //
249 // the vitals package uses 2.2 (not 2.2046), so the GUI needs to use the
250 // same so conversions back & forth don't lead to errors
251 // this probably shouldn't even be done here - it should be done by the
252 // vitals package - KCM
253 //
254 VValue := FloatToStr(Round(StrtoFloat(VValue) * 2.2{046} *1000)/1000);
255 VUnit := 'LB';
256 end;
257 end;
258end;
259
260function GetVitalStr(VType: TVitalType; rte, unt, UserStr, DateStr: string): string;
261begin
262 Result := '';
263 ConvertVital(VType, rte, unt);
264 if rte <> '' then
265 begin
266 if(VType = vtPain) then unt := U;
267 Result := 'VIT'+U+VitalPCECodes[VType]+U+U+U+rte+U+UserStr+U+unt+U+DateStr;
268 end;
269end;
270
271function GetVitalUser: string;
272var
273 UserID: Int64;
274
275begin
276 UserID := Encounter.Provider;
277 if UserID <= 0 then
278 UserID := User.DUZ;
279 Result := IntToStr(UserID);
280end;
281
282procedure AssignVitals2List(List: TStrings; ADateTime: TFMDateTime;
283 ALocation, ABP, ATemp, ATempUnits,
284 AResp, APulse, AHeight, AHeightUnits,
285 AWeight, AWeightUnits, APain: string);
286var
287 UserStr, DateStr: string;
288
289 procedure AddVital(VType: TVitalType; ARte: string; AUnit: string = '');
290 var
291 VStr: string;
292
293 begin
294 VStr := GetVitalStr(VType, ARte, AUnit, UserStr, DateStr);
295 if(VStr <> '') then
296 List.Add(VStr);
297 end;
298
299begin
300 with List do
301 begin
302 UserStr := GetVitalUser;
303 DateStr := FloatToStr(ADateTime);
304 clear;
305
306 Add(VitalDateStr + DateStr);
307 Add(VitalPatientStr + Patient.DFN); // encounter Patient //*DFN*
308 Add(VitalLocationStr + ALocation);
309 AddVital(vtBP, ABP); // Blood Pressure
310 AddVital(vtTemp, ATemp, ATempUnits); // Temperature
311 AddVital(vtResp, AResp); // Resp
312 AddVital(vtPulse, APulse); // Pulse
313 AddVital(vtHeight, AHeight, AHeightUnits); // Height
314 AddVital(vtWeight, AWeight, AWeightUnits); // Weight
315 AddVital(vtPain, APain); // Pain
316 end;
317end;
318
319function VitalInvalid(VitalControl: TControl; UnitsControl: TControl = nil;
320 OverrideValue: string = NoVitalOverrideValue): boolean;
321var
322 rte, unt: string;
323 Tag: integer;
324 VType: TVitalType;
325
326begin
327 Tag := -1;
328
329 if(OverrideValue = NoVitalOverrideValue) then
330 begin
331 if(assigned(VitalControl)) then
332 begin
333 rte := TORExposedControl(VitalControl).Text;
334 Tag := VitalControl.Tag;
335 end
336 else
337 rte := '';
338 end
339 else
340 begin
341 rte := OverrideValue;
342 if(assigned(VitalControl)) then
343 Tag := VitalControl.Tag;
344 end;
345
346 if(assigned(UnitsControl)) then
347 begin
348 unt := TORExposedControl(UnitsControl).Text;
349 if(Tag < 0) then
350 Tag := UnitsControl.Tag;
351 end
352 else
353 unt := '';
354
355 if(Tag >= low(VitalTags)) and (Tag <= high(VitalTags)) then
356 VType := VitalTagCodes[Tag]
357 else
358 VType := vtUnknown;
359 //pain does not need to be validated because the combo box limits the selection.
360 if(VType = vtPain) then
361 Result := FALSE
362 else
363 begin
364 Result := TRUE;
365 if(VType <> vtUnknown) then
366 begin
367 if (rte = '') then
368 Result := FALSE
369 else
370 if (VerifyVital(VitalPCECodes[VType],rte,unt) = True) then
371 Result := FALSE;
372 end;
373 end;
374 // GRE 2/12/03 added to disallow user entering "lb" with weight NOIS MWV-0103-22037
375 if VType = vtWeight then
376 begin
377 if (IsNumericWeight(rte) = FALSE) then
378 Result := True;
379 end;
380 if(Result) then
381 ShowMessage(VitalErrorText(VType));
382end;
383
384function VitalControlTag(VType: TVitalType; UnitControl: boolean = FALSE): integer;
385var
386 i,cnt: integer;
387
388begin
389 if UnitControl then
390 cnt := 0
391 else
392 cnt := 1;
393 Result := -1;
394 for i := low(VitalTags) to high(VitalTags) do
395 begin
396 if(VitalTagCodes[i] = VType) then
397 begin
398 inc(cnt);
399 if(cnt = 2) then
400 begin
401 Result := i;
402 break;
403 end;
404 end;
405 end;
406end;
407
408function ConvertHeight2Inches(Ht: string): string;
409var
410 c: char;
411 i: integer; //counter
412 inchstr,feetstr : string;
413 feet: boolean;
414 v: double;
415
416begin
417 feet := False;
418 result := '';
419 feetstr := '';
420 inchstr := '';
421
422 // check for feet
423 for i := 1 to (length(Ht)) do
424 begin
425 c := Ht[i];
426 if (c = '''') then feet := True;
427 end;
428
429 if (feet = True) then
430 begin
431 i := 1;
432 while (Ht[i] <> '''') do
433 begin
434 if (Ht[i] in ['0'..'9']) or (Ht[i] = '.') then
435 feetstr := feetstr + Ht[i];
436 inc(i);
437 end;
438 while (i <= length(Ht)) and (Ht[i] <> '"') and
439 (Ht[i] <> '') do
440 begin
441 if (Ht[i] in ['0'..'9']) or (Ht[i] = '.') then
442 inchstr := inchstr + Ht[i];
443 inc(i);
444 end;
445 v := 0;
446 if (feetstr <> '') then
447 v := v + (StrTofloat(feetstr)*12);
448 if(inchstr <> '') then
449 v := v + StrToFloat(inchstr);
450 result := floatToStr(v);
451 //add here to convert to CM if CM is the unit
452
453 end
454 else //no feet
455 begin
456 for i := 1 to (length(Ht)) do
457 begin
458 c := Ht[i]; //first character
459 if (c in ['0'..'9']) or (c = '.') then
460 result := result + c;
461 if (c = '"') then break;
462 end;
463 end;
464end;
465
466{
4671215^T^98.6^2991108.11^98.6 F^(37.0 C)
4681217^P^70^2991108.11^70
4691216^R^18^2991108.11^18
4701214^BP^120/70^2991108.11^120/70
4711218^HT^70^2991108.11^70 in^(177.8 cm)
4721219^WT^200^2991108.11^200 lb^(90.0 kg)
4731220^PN^1^2991108.11^1
474}
475 //format string as it should appear on the PCE panel.
476function FormatVitalForNote(VitalStr: string):String;
477var
478 Code, Value: string;
479 v: TVitalType;
480
481begin
482 Code := UpperCase(Piece(VitalStr, U, vnumType));
483 for v := low(TValidVitalTypes) to high(TValidVitalTypes) do
484 begin
485 if(Code = VitalCodes[v]) then
486 begin
487 Value := ConvertVitalData(Piece(VitalStr, U, vnumValue), v);
488 if(v = vtPain) and (Value = '99') then
489 Value := 'Unable to respond.';
490 Result := VitalFormatedDesc[v] + Value + ' ' +
491 FormatFmDateTime('mmm dd,yyyy hh:nn',(StrToFloat(Piece(VitalStr, U, vnumDate))));
492 end
493 end;
494end;
495
496function ConvertVitalData(const Value: string; VitalType: TVitalType; UnitType: string = ''): string;
497var
498 dbl: Double;
499
500begin
501 Result := Value;
502 if(VitalType in [vtTemp, vtHeight, vtWeight]) then
503 begin
504 try
505 dbl := StrToFloat(Value);
506 except
507 on EConvertError do
508 dbl := 0
509 else
510 raise;
511 end;
512 if(dbl <> 0) then
513 begin
514 UnitType := UpperCase(UnitType);
515 case VitalType of
516 vtTemp:
517 begin
518 if(UnitType = 'C') then
519 begin
520 dbl := dbl * (9/5);
521 dbl := dbl + 32;
522 dbl := round(dbl * 10) / 10;
523 Result := FloatToStr(dbl) + ' F (' + Result + ' C)';
524 end
525 else
526 begin
527 dbl := dbl - 32;
528 dbl := dbl * (5/9);
529 dbl := round(dbl * 10) / 10;
530 Result := Result + ' F (' + FloatToStr(dbl) + ' C)';
531 end;
532 end;
533
534 vtHeight:
535 begin
536 if(UnitType = 'CM') then
537 begin
538 dbl := dbl / 2.54;
539 dbl := round(dbl * 10) / 10;
540 Result := FloatToStr(dbl) + ' in [' + Result + ' cm)';
541 end
542 else
543 begin
544 dbl := dbl * 2.54;
545 dbl := round(dbl * 10) / 10;
546 Result := Result + ' in [' + FloatToStr(dbl) + ' cm)';
547 end;
548 end;
549
550 vtWeight:
551 begin
552 if(UnitType = 'KG') then
553 begin
554 dbl := dbl * 2.2;
555 dbl := round(dbl * 10) / 10;
556 Result := FloatToStr(dbl) + ' lb (' + Result + ' kg)';
557 end
558 else
559 begin
560 dbl := dbl / 2.2;
561 dbl := round(dbl * 10) / 10;
562 Result := Result + ' lb (' + FloatToStr(dbl) + ' kg)';
563 end;
564 end;
565 end;
566 end;
567 end;
568end;
569
570procedure VitalsFrameCreated(Frame: TFrame);
571begin
572 if not assigned(uVitalFrames) then
573 uVitalFrames := TComponentList.Create(FALSE);
574 uVitalFrames.Add(Frame);
575end;
576
577procedure SetVitalsMetric(const Value: boolean);
578var
579 i: integer;
580
581begin
582 if(uVitalsMetric <> Value) then
583 begin
584 uVitalsMetric := Value;
585 for i := 0 to uVitalFrames.Count-1 do
586 begin
587 if uVitalFrames[i] is TfraVitBase then
588 TfraVitBase(uVitalFrames[i]).VitalsMetricChanged
589 else
590 if uVitalFrames[i] is TfraVitMetric then
591 TfraVitMetric(uVitalFrames[i]).VitalsMetricChanged
592 end;
593 end;
594end;
595
596procedure SetVitCVPmmHg(const Value: boolean);
597var
598 i: integer;
599
600begin
601 if(uVitCVPmmHg <> Value) then
602 begin
603 uVitCVPmmHg := Value;
604 for i := 0 to uVitalFrames.Count-1 do
605 if uVitalFrames[i] is TfraVitBase then
606 TfraVitBase(uVitalFrames[i]).VitalsCVPUnitsChanged;
607 end;
608end;
609
610
611function ValidVitalsDate(var ADate: TFMDateTime; SkipFirst: boolean = FALSE; Show: boolean = true): boolean; //AGP Change 26.1
612var
613 frmVitalsDate: TfrmVitalsDate;
614 ok: boolean;
615
616begin
617 Result := TRUE;
618 while (Result and (SkipFirst or (ADate > FMNow))) do
619 begin
620 if(SkipFirst) then
621 begin
622 ok := TRUE;
623 SkipFirst := FALSE;
624 end
625 else
626 ok := (InfoBox('Vital sign Date/Time entered (' + FormatFMDateTime('mmm dd yyyy hh:nn', ADate) +
627 ') cannot be in the future.' + CRLF +
628 'If you do not change the entered date/time vitals information will be lost.' + CRLF +
629 'Do you want to enter a new Date/Time?',
630 'Invalid Vital Entry Date/Time',
631 MB_YESNO + MB_ICONWARNING) = ID_YES);
632 if ok then
633 begin
634 frmVitalsDate := TfrmVitalsDate.Create(Application);
635 try
636 frmVitalsDate.dteVitals.FMDateTime := ADate;
637 frmVitalsDate.btnNow.Visible := Show; //AGP Change 26.1
638 if frmVitalsDate.ShowModal = mrOK then
639 ADate := frmVitalsDate.dteVitals.FMDateTime;
640 finally
641 frmVitalsDate.Free;
642 end;
643 end
644 else
645 Result := FALSE;
646 end;
647end;
648
649function IsNumericWeight(const x: string): Boolean;
650var
651 i: Integer;
652begin
653 Result := True;
654 for i := 1 to Length(x) do if not (x[i] in ['0'..'9','.']) then Result := False;
655end;
656(* Old class currently not used
657{$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED
658
659interface
660
661uses SysUtils, Classes;
662
663type
664 TVital = class(TObject)
665 {class for vital}
666 Private
667 Fsend: Boolean; //do we need this?
668 public
669 Typ: String; //type
670 Value: Single;
671 Unt: String; //unit
672 Provider: Integer;
673 procedure Assign(Src: TVital); //will we need assign?
674 procedure Clear;
675 procedure SetFromString(const x: string);
676 function DelimitedStr: string;
677 end;
678
679
680implementation
681
682uses ORFn, fPCEEdit, uPCE;
683
684Procedure TVital.Assign(Src: TVital);
685{assigns the values from one vital to another}
686begin
687 Fsend := Src.Fsend;
688 Typ := Src.Typ;
689 Value := Src.Value;
690 Unt := Src.Unt;
691 provider := Src.Provider;
692end;
693
694procedure Tvital.Clear;
695{clear all fields}
696begin
697 Fsend := False;
698 Typ := '';
699 Value := 0.0;
700 Unt := ''; //will default to Inches/LBs/Farenheit on M side,
701 //depending on the Type
702 //Provider := UProvider;
703end;
704
705Procedure TVital.SetFromString(const X: string);
706begin
707 Typ := Piece(x, U, 2);
708 Value := StrToFloat(Piece(x, U, 5));
709 Provider := StrToInt(Piece(x, U, 6));
710 Unt := Piece(x, U, 7);
711end;
712
713function TVital.DelimitedStr: string;
714begin
715 Result := 'VIT' + U + Typ + U + U + U + FloatToStr(Value) + U +
716 IntToStr(Provider) + U + Unt;
717end;
718*)
719
720initialization
721
722finalization
723 KillObj(@uVitalFrames);
724
725end.
Note: See TracBrowser for help on using the repository browser.