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

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

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