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

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

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