Module

fVitals

Path

C:\CPRS\CPRS30\fVitals.pas

Last Modified

7/15/2014 3:26:40 PM

Comments

Modifications
Date: 4/1/98 RAB/ISL
Description: Added procedure SelectVital(FontSize:integer; idx: integer)
    To be able to pass the row index into the form.  This will enable the vital
    entry form to open the apropriate line on this form (If this screen is opened
    by the vital entry screen)

Date: 4/9/98 RAB/ISL
Descriotion:  Added button and click event to call vital entry screen.

Date: 4/9/98 RAB/ISL
Descriotion:  if Idx passed into procedure SelectVital is '99' then the botton to
  call the vital entry screen will be disabled.

Date: 4/23/98
By: Robert Bott
Description: Set position of form to poScreenCenter.
Date: 4/23/98
By: Robert Bott
Description: Forced an update after returning from vital entry form.

//Modifed: 6/23/98
//By: Robert Bott
//Location: ISL
//Description of Mod:
//  Moved code that verifies valid provider and visit from fvit into fVitals.
//   now found in procedure TfrmVitals.btnEnterVitalsClick(Sender: TObject);
//   formerly in procedure TfrmVit.FormActivate(Sender: TObject);

Units Used in Interface

Name Comments
fBase508Form -
uConst -
uVitals -

Units Used in Implementation

Name Comments
fCover -
fEncnt -
fFrame -
fRptBox -
fVisit -
fvit -
rCore -
rReports -
uCore -
uInit -

Classes

Name Comments
TfrmVitals -

Procedures

Name Owner Declaration Scope Comments
BeginEndDates TfrmVitals procedure BeginEndDates(var ADate1, ADate2: TFMDateTime; var ADaysBack: integer); Public/Published -
btnEnterVitalsClick TfrmVitals procedure btnEnterVitalsClick(Sender: TObject); Public/Published -
chk3DClick TfrmVitals procedure chk3DClick(Sender: TObject); Public/Published -
chkValuesClick TfrmVitals procedure chkValuesClick(Sender: TObject); Public/Published -
chkZoomClick TfrmVitals procedure chkZoomClick(Sender: TObject); Public/Published -
chtChartClickLegend TfrmVitals procedure chtChartClickLegend(Sender: TCustomChart; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
chtChartClickSeries TfrmVitals procedure chtChartClickSeries(Sender: TCustomChart; Series: TChartSeries; ValueIndex: Integer; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
chtChartMouseDown TfrmVitals procedure chtChartMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
chtChartUndoZoom TfrmVitals procedure chtChartUndoZoom(Sender: TObject); Public/Published -
FormCreate TfrmVitals procedure FormCreate(Sender: TObject); Public/Published -
FormDestroy TfrmVitals procedure FormDestroy(Sender: TObject); Public/Published -
FormKeyUp TfrmVitals procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
FormShow TfrmVitals procedure FormShow(Sender: TObject); Public/Published -
GetStartStop TfrmVitals procedure GetStartStop(var start, stop: string; aitems: TStrings); Private -
grdVitalsSelectCell TfrmVitals procedure grdVitalsSelectCell(Sender: TObject; Col, Row: Integer; var CanSelect: Boolean); Public/Published -
lstDatesClick TfrmVitals procedure lstDatesClick(Sender: TObject); Public/Published -
lstVitalsClick TfrmVitals procedure lstVitalsClick(Sender: TObject); Public/Published -
pnlEnterVitalsResize TfrmVitals procedure pnlEnterVitalsResize(Sender: TObject); Public/Published -
pop3DClick TfrmVitals procedure pop3DClick(Sender: TObject); Public/Published -
popChartPopup TfrmVitals procedure popChartPopup(Sender: TObject); Public/Published -
popCopyClick TfrmVitals procedure popCopyClick(Sender: TObject); Public/Published -
popDetailsClick TfrmVitals procedure popDetailsClick(Sender: TObject); Public/Published -
popPrintClick TfrmVitals procedure popPrintClick(Sender: TObject); Public/Published -
popValuesClick TfrmVitals procedure popValuesClick(Sender: TObject); Public/Published -
popZoomBackClick TfrmVitals procedure popZoomBackClick(Sender: TObject); Public/Published -
popZoomClick TfrmVitals procedure popZoomClick(Sender: TObject); Public/Published -
SelectVital - procedure SelectVital(FontSize:integer; idx: integer); Interfaced -
SelectVitals - procedure SelectVitals(VitalType: String); Interfaced -
VGrid TfrmVitals procedure VGrid(griddata: TStrings); Private
Private declarations
procedure SelectVitals(FontSize: Integer);
var
  frmVitals: TfrmVitals;
  firstchar: string;
  i: integer;
begin
  frmVitals := TfrmVitals.Create(Application);
  try
    ResizeAnchoredFormToFont(frmVitals);
    with frmVitals do
    begin
      with frmCover do
        for i := ComponentCount - 1 downto 0 do
          begin
            if Components[i] is TORListBox then
              begin
                case Components[i].Tag of
                  70:
                  if (Components[i] as TORListBox).ItemIndex > -1 then
                    begin
                      // changed to look at 2 chars so pain & pulse not confused {*KCM*}
                      firstchar := UpperCase(Copy(Piece((Components[i] as TORListBox).Items[(Components[i] as TORListBox).ItemIndex], '^', 2), 1, 2));
                      if firstchar = 'T' then
                        lstVitals.ItemIndex := 0
                      else if firstchar = 'P' then
                        lstVitals.ItemIndex := 1
                      else if firstchar = 'R' then
                        lstVitals.ItemIndex := 2
                      else if firstchar = 'BP' then
                        lstVitals.ItemIndex := 3
                      else if firstchar = 'HT' then
                        lstVitals.ItemIndex := 4
                      else if firstchar = 'WT' then
                        lstVitals.ItemIndex := 5
                      else if firstchar = 'PN' then
                        lstVitals.ItemIndex := 6;
                    end
                    else
                    begin
                      firstchar := '';
                      lstVitals.ItemIndex := 0;
                    end;
                end;
              end;
          end;
      ShowModal;
    end;
  finally
    frmVitals.Release;
  end;
end;
WorksheetChart TfrmVitals procedure WorksheetChart(test: string; aitems: TStrings); Private -

Functions

Name Owner Declaration Scope Comments
FMToDateTime TfrmVitals function FMToDateTime(FMDateTime: string): TDateTime; Public Public declarations
getVitalsStartDate - function getVitalsStartDate : String; Global -
OkFloatValue - function OkFloatValue(value: string): boolean; Local -
VitalsGrid - function VitalsGrid(const patient: string; date1, date2: TFMDateTime; restrictdates: integer; tests: TStrings): TStrings; Interfaced
DFN*
DFN*
VitalsMemo - function VitalsMemo(const patient: string; date1, date2: TFMDateTime; tests: TStrings): TStrings; Interfaced
DFN*
DFN*

Global Variables

Name Type Declaration Comments
frmVitals TfrmVitals frmVitals: TfrmVitals; -
tmpGrid TStringList tmpGrid: TStringList; -
uDate1 TDateTime uDate1, uDate2: Tdatetime; -
uDate2 TDateTime uDate1, uDate2: Tdatetime; -

Constants

Name Declaration Scope Comments
ZOOM_PERCENT 99 Global Padding for inflating margins


Module Source

1     {Modifications
2     Date: 4/1/98 RAB/ISL
3     Description: Added procedure SelectVital(FontSize:integer; idx: integer)
4         To be able to pass the row index into the form.  This will enable the vital
5         entry form to open the apropriate line on this form (If this screen is opened
6         by the vital entry screen)
7     
8     Date: 4/9/98 RAB/ISL
9     Descriotion:  Added button and click event to call vital entry screen.
10    
11    Date: 4/9/98 RAB/ISL
12    Descriotion:  if Idx passed into procedure SelectVital is '99' then the botton to
13      call the vital entry screen will be disabled.
14    
15    Date: 4/23/98
16    By: Robert Bott
17    Description: Set position of form to poScreenCenter.
18    Date: 4/23/98
19    By: Robert Bott
20    Description: Forced an update after returning from vital entry form.
21    
22    //Modifed: 6/23/98
23    //By: Robert Bott
24    //Location: ISL
25    //Description of Mod:
26    //  Moved code that verifies valid provider and visit from fvit into fVitals.
27    //   now found in procedure TfrmVitals.btnEnterVitalsClick(Sender: TObject);
28    //   formerly in procedure TfrmVit.FormActivate(Sender: TObject);
29    
30    }
31    
32    unit fVitals;
33    
34    interface
35    
36    uses
37      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
38      StdCtrls, ORCtrls, TeEngine, Series, TeeProcs, Chart, ExtCtrls, Grids,Buttons,
39      ORNet, ORFn, uConst, Menus, ORDtTmRng, fBase508Form, ComCtrls, uVitals, VAUtils,
40      VA508AccessibilityManager;
41    
42    type
43      TfrmVitals = class(TfrmBase508Form)
44        pnlTop: TPanel;
45        chtChart: TChart;
46        serTest: TLineSeries;
47        pnlLeft: TORAutoPanel;
48        lstDates: TORListBox;
49        pnlBottom: TPanel;
50        grdVitals: TCaptionStringGrid;
51        pnlButtons: TPanel;
52        lstVitals: TCaptionListBox;
53        serTestX: TLineSeries;
54        serTime: TPointSeries;
55        lblNoResults: TStaticText;
56        serTestY: TLineSeries;
57        pnlLeftClient: TORAutoPanel;
58        chkValues: TCheckBox;
59        chk3D: TCheckBox;
60        chkZoom: TCheckBox;
61        pnlEnterVitals: TPanel;
62        btnEnterVitals: TButton;
63        popChart: TPopupMenu;
64        popValues: TMenuItem;
65        pop3D: TMenuItem;
66        popZoom: TMenuItem;
67        popZoomBack: TMenuItem;
68        N1: TMenuItem;
69        popCopy: TMenuItem;
70        N2: TMenuItem;
71        popDetails: TMenuItem;
72        calVitalsRange: TORDateRangeDlg;
73        N3: TMenuItem;
74        popPrint: TMenuItem;
75        dlgWinPrint: TPrintDialog;
76        procedure lstDatesClick(Sender: TObject);
77        procedure FormCreate(Sender: TObject);
78        procedure FormDestroy(Sender: TObject);
79        procedure lstVitalsClick(Sender: TObject);
80        procedure grdVitalsSelectCell(Sender: TObject; Col, Row: Integer;
81          var CanSelect: Boolean);
82        procedure chkZoomClick(Sender: TObject);
83        procedure chk3DClick(Sender: TObject);
84        procedure chkValuesClick(Sender: TObject);
85        procedure FormShow(Sender: TObject);
86        procedure pnlEnterVitalsResize(Sender: TObject);
87        procedure btnEnterVitalsClick(Sender: TObject);
88        procedure chtChartUndoZoom(Sender: TObject);
89        procedure popValuesClick(Sender: TObject);
90        procedure pop3DClick(Sender: TObject);
91        procedure popZoomClick(Sender: TObject);
92        procedure popZoomBackClick(Sender: TObject);
93        procedure popCopyClick(Sender: TObject);
94        procedure popDetailsClick(Sender: TObject);
95        procedure chtChartClickSeries(Sender: TCustomChart;
96          Series: TChartSeries; ValueIndex: Integer; Button: TMouseButton;
97          Shift: TShiftState; X, Y: Integer);
98        procedure chtChartMouseDown(Sender: TObject; Button: TMouseButton;
99          Shift: TShiftState; X, Y: Integer);
100       procedure chtChartClickLegend(Sender: TCustomChart;
101         Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
102       procedure popChartPopup(Sender: TObject);
103       procedure popPrintClick(Sender: TObject);
104       procedure BeginEndDates(var ADate1, ADate2: TFMDateTime; var ADaysBack: integer);
105       procedure FormKeyUp(Sender: TObject; var Key: Word;
106         Shift: TShiftState);
107     private
108       { Private declarations }
109       procedure VGrid(griddata: TStrings);
110       procedure WorksheetChart(test: string; aitems: TStrings);
111       procedure GetStartStop(var start, stop: string; aitems: TStrings);
112     public
113       { Public declarations }
114       function FMToDateTime(FMDateTime: string): TDateTime;
115     end;
116   
117   
118   var
119     frmVitals: TfrmVitals;
120     tmpGrid: TStringList;
121     uDate1, uDate2: Tdatetime;
122   
123   procedure SelectVital(FontSize:integer; idx: integer);
124   procedure SelectVitals(VitalType: String);
125   function VitalsGrid(const patient: string; date1, date2: TFMDateTime; restrictdates: integer; tests: TStrings): TStrings;  //*DFN*
126   function VitalsMemo(const patient: string; date1, date2: TFMDateTime; tests: TStrings): TStrings;  //*DFN*
127   
128   implementation
129   
130   uses fCover, uCore, rCore, fvit, fFrame, fEncnt, fVisit, fRptBox, rReports, uInit;
131   
132   const
133     ZOOM_PERCENT = 99;        // padding for inflating margins
134   
135   {$R *.DFM}
136   
137   
138   procedure SelectVital(FontSize:integer; idx: integer);
139   var
140     frmVitals: TfrmVitals;
141   begin
142     frmVitals := TfrmVitals.Create(Application);
143     try
144       ResizeAnchoredFormToFont(frmVitals);
145       with frmVitals do
146       begin
147         if idx <= lstvitals.items.count then lstVitals.ItemIndex := idx
148         else lstVitals.ItemIndex := 0;
149   
150         if idx = 99 then
151           btnEnterVitals.enabled := False;
152         ShowModal;
153       end;
154   
155     finally
156       frmVitals.Release;
157     end;
158   end;
159   
160   function getVitalsStartDate : String;
161   begin
162     result := '';
163     if Patient.Inpatient then
164       result := FormatDateTime('mm/dd/yy',Now - 7)
165     else
166       result := FormatDateTime('mm/dd/yy',IncMonth(Now,-6));
167   end;
168   
169   procedure SelectVitals(VitalType: String);
170   var
171     VLPtVitals : TGMV_VitalsViewForm;
172     GMV_FName: String;
173     
174   begin
175    { Availble Forms:
176     GMV_FName :='GMV_VitalsEnterDLG';
177     GMV_FName :='GMV_VitalsEnterForm';
178     GMV_FName :='GMV_VitalsViewForm';
179     GMV_FName :='GMV_VitalsViewDLG';
180     }
181     GMV_FName :='GMV_VitalsViewDLG';
182     LoadVitalsDLL;
183    // UpdateTimeOutInterval(5000);
184     if VitalsDLLHandle <> 0 then
185       begin
186        @VLPtVitals := GetProcAddress(VitalsDLLHandle,PChar(GMV_FName));
187        if assigned(VLPtVitals) then
188          VLPtVitals(RPCBrokerV,Patient.DFN,FloatToStr(Encounter.Location),
189                     getVitalsStartDate(),FormatDateTime('mm/dd/yy',Now),
190                     GMV_APP_SIGNATURE,
191                     GMV_CONTEXT,GMV_CONTEXT,
192                     Patient.Name,
193                     frmFrame.lblPtSSN.Caption + '    ' + frmFrame.lblPtAge.Caption,
194                     Encounter.LocationName +U+ VitalType)
195        else
196          MessageDLG('Can''t find function "'+GMV_FName+'".',mtError,[mbok],0);
197       end
198     else
199       MessageDLG('Can''t find library '+VitalsDLLName+'.',mtError,[mbok],0);
200     @VLPtVitals := nil;
201     UnloadVitalsDLL;
202   end;
203   
204   (*
205   procedure SelectVitals(FontSize: Integer);
206   var
207     frmVitals: TfrmVitals;
208     firstchar: string;
209     i: integer;
210   begin
211     frmVitals := TfrmVitals.Create(Application);
212     try
213       ResizeAnchoredFormToFont(frmVitals);
214       with frmVitals do
215       begin
216         with frmCover do
217           for i := ComponentCount - 1 downto 0 do
218             begin
219               if Components[i] is TORListBox then
220                 begin
221                   case Components[i].Tag of
222                     70:
223                     if (Components[i] as TORListBox).ItemIndex > -1 then
224                       begin
225                         // changed to look at 2 chars so pain & pulse not confused {*KCM*}
226                         firstchar := UpperCase(Copy(Piece((Components[i] as TORListBox).Items[(Components[i] as TORListBox).ItemIndex], '^', 2), 1, 2));
227                         if firstchar = 'T' then
228                           lstVitals.ItemIndex := 0
229                         else if firstchar = 'P' then
230                           lstVitals.ItemIndex := 1
231                         else if firstchar = 'R' then
232                           lstVitals.ItemIndex := 2
233                         else if firstchar = 'BP' then
234                           lstVitals.ItemIndex := 3
235                         else if firstchar = 'HT' then
236                           lstVitals.ItemIndex := 4
237                         else if firstchar = 'WT' then
238                           lstVitals.ItemIndex := 5
239                         else if firstchar = 'PN' then
240                           lstVitals.ItemIndex := 6;
241                       end
242                       else
243                       begin
244                         firstchar := '';
245                         lstVitals.ItemIndex := 0;
246                       end;
247                   end;
248                 end;
249             end;
250         ShowModal;
251       end;
252     finally
253       frmVitals.Release;
254     end;
255   end;
256     *)
257   procedure TfrmVitals.VGrid(griddata: TStrings);
258   var
259     testcnt, datecnt, datacnt, linecnt, x, y, i: integer;
260   begin
261     testcnt := strtoint(Piece(griddata[0], '^', 1));
262     datecnt := strtoint(Piece(griddata[0], '^', 2));
263     datacnt := strtoint(Piece(griddata[0], '^', 3));
264     linecnt := testcnt + datecnt + datacnt;
265     with grdVitals do
266     begin
267       if datecnt = 0 then ColCount := 1 else ColCount := datecnt;
268       if testcnt = 0 then RowCount := 2 else RowCount := testcnt + 1;
269       DefaultColWidth := 80;
270       FixedCols := 0;
271       FixedRows := 1;
272       for y := 0 to RowCount - 1 do
273         for x := 0 to ColCount - 1 do
274           Cells[x, y] := '';
275       if datecnt = 0 then
276       begin
277         Cells[1, 0] := 'no results';
278         for x := 1 to RowCount - 1 do
279           Cells[x, 1] := '';
280       end;
281       for i := testcnt + 1 to testcnt + datecnt do
282       begin
283         Cells[i - testcnt - 1, 0] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(Piece(griddata[i], '^', 2)));
284       end;
285       for i := testcnt + datecnt + 1 to linecnt do
286       begin
287         x := strtoint(Piece(griddata[i], '^', 1));
288         y := strtoint(Piece(griddata[i], '^', 2));
289         Cells[x - 1, y]  := Piece(griddata[i], '^', 3);
290       end;
291     end;
292   end;
293   
294   function VitalsGrid(const patient: string; date1, date2: TFMDateTime; restrictdates: integer; tests: TStrings): TStrings;  //*DFN*
295   begin
296     CallV('GMV ORQQVI1 GRID', [patient, date1, date2, restrictdates, tests]);
297     Result := RPCBrokerV.Results;
298   end;
299   
300   function VitalsMemo(const patient: string; date1, date2: TFMDateTime; tests: TStrings): TStrings;  //*DFN*
301   begin
302     CallV('GMV ORQQVI1 DETAIL', [patient, date1, date2, 0, tests]);
303     Result := RPCBrokerV.Results;
304   end;
305   
306   procedure TfrmVitals.lstDatesClick(Sender: TObject);
307   var
308     daysback, vindex: integer;
309     date1, date2: TFMDateTime;
310     today: TDateTime;
311   begin
312     if (lstDates.ItemID = 'S') then
313     begin
314       with calVitalsRange do
315       begin
316         if Execute then
317         begin
318           lstDates.ItemIndex := lstDates.Items.Add(RelativeStart + ';' +
319             RelativeStop + U + TextOfStart + ' to ' + TextOfStop);
320         end
321         else
322           lstDates.ItemIndex := -1;
323       end;
324     end;
325     today := FMToDateTime(floattostr(FMToday));
326     if lstDates.ItemIEN > 0 then
327     begin
328       daysback := lstDates.ItemIEN;
329       date1 := FMToday + 0.2359;
330       If daysback = 1 then
331         date2 := DateTimeToFMDateTime(today)
332       Else
333         date2 := DateTimeToFMDateTime(today - daysback);
334     end
335     else
336       BeginEndDates(date1,date2,daysback);
337     //date1 := date1 + 0.2359;
338     FastAssign(VitalsGrid(Patient.DFN, date1, date2, 0, lstVitals.Items), tmpGrid);
339     vindex := lstVitals.ItemIndex;
340     VGrid(tmpGrid);
341     lstVitals.ItemIndex := vindex;
342     lstVitalsClick(self);
343     chtChart.BottomAxis.Automatic := true;    //***********
344     chkZoom.Checked := false;
345     chtChart.UndoZoom;
346     if lstVitals.ItemIndex > -1 then
347     begin
348       WorksheetChart(inttostr(lstVitals.ItemIndex + 1), tmpGrid);
349       if (serTest.Count > 1) and not chkZoom.Checked then
350       begin
351         chtChart.UndoZoom;
352         chtChart.ZoomPercent(ZOOM_PERCENT);
353       end;
354     end;
355   end;
356   
357   procedure TfrmVitals.FormCreate(Sender: TObject);
358   begin
359     tmpGrid := TStringList.Create;
360     if Patient.Inpatient then lstDates.ItemIndex := 1 else lstDates.ItemIndex := 4;
361     SerTest.GetHorizAxis.ExactDateTime := true;
362     SerTest.GetHorizAxis.Increment := DateTimeStep[dtOneMinute];
363   end;
364   
365   procedure TfrmVitals.FormDestroy(Sender: TObject);
366   begin
367     tmpGrid.free;
368   end;
369   
370   function TfrmVitals.FMToDateTime(FMDateTime: string): TDateTime;
371   var
372     x, Year: string;
373   begin
374     { Note: TDateTime cannot store month only or year only dates }
375     x := FMDateTime + '0000000';
376     if Length(x) > 12 then x := Copy(x, 1, 12);
377     if StrToInt(Copy(x, 9, 4)) > 2359 then x := Copy(x,1,7) + '.2359';
378     Year := IntToStr(17 + StrToInt(Copy(x,1,1))) + Copy(x,2,2);
379     x := Copy(x,4,2) + '/' + Copy(x,6,2) + '/' + Year + ' ' + Copy(x,9,2) + ':' + Copy(x,11,2);
380     Result := StrToDateTime(x);
381   end;
382   
383   procedure TfrmVitals.lstVitalsClick(Sender: TObject);
384   begin
385     with grdVitals do
386     begin
387       Row := lstVitals.ItemIndex + 1;
388       Col := grdVitals.ColCount - 1;
389     end;
390   end;
391   
392   procedure TfrmVitals.WorksheetChart(test: string; aitems: TStrings);
393   
394   function OkFloatValue(value: string): boolean;
395   var
396     i, j: integer;
397     first, second: string;
398   begin
399     Result := false;
400     i := strtointdef(value, -99999);
401     if i <> -99999 then Result := true
402     else if pos(Pieces(value, '.', 2, 3), '.') > 0 then Result := false
403     else
404     begin
405       first := Piece(value, '.', 1);
406       second := Piece(value, '.', 2);
407       if length(second) > 0 then
408       begin
409         i := strtointdef(first, -99999);
410         j := strtointdef(second, -99999);
411         if (i <> -99999) and (j <> -99999) then Result := true;
412       end
413       else
414       begin
415         i :=strtointdef(first, -99999);
416         if i <> -99999 then Result := true;
417       end;
418     end;
419   end;
420   
421   var
422     datevalue, oldstart, oldend: TDateTime;
423     labvalue, labvalue1, labvalue2, labvalue3: double;
424     i, numtest, numcol, numvalues, valuecount: integer;
425     high, start, stop, value, value1, value2, value3, testcheck, units, testname, testnum, testorder: string;
426   begin
427   
428   
429     valuecount := 0;
430     testnum := Piece(test, '^', 1);
431     testname := lstVitals.Items[strtoint(testnum) - 1];
432     numtest := strtoint(Piece(aitems[0], '^', 1));
433     numcol := strtoint(Piece(aitems[0], '^', 2));
434     numvalues := strtoint(Piece(aitems[0], '^', 3));
435     if numvalues = 0 then
436       chtChart.Visible := false
437     else
438     begin
439       chtChart.Visible := true;
440       serTest.Clear;  serTestX.Clear;  serTime.Clear;
441       if numtest > 0 then
442       begin
443         for i := 1 to numtest do
444           if testnum = Piece(aitems[i], '^', 1) then
445           begin
446             testorder := inttostr(i);
447             break;
448           end;
449         GetStartStop(start, stop, aitems);
450         chtChart.Legend.Color := grdVitals.Color;
451         chtChart.Title.Font.Size := MainFontSize;
452         chtChart.LeftAxis.Title.Caption := units;
453         serTest.Title := Piece(test, '^', 2);
454         testcheck := testorder;
455         high := '0';
456         if testname = 'Blood Pressure' then
457         begin
458           serTestY.Active := false;
459           for i := numtest + numcol + 1 to numtest + numcol + numvalues do
460             if Piece(aitems[i], '^', 2) = testcheck then
461             begin
462               serTestX.Active := true;
463               serTestX.Marks.Visible := chkValues.Checked;
464               serTestY.Marks.Visible := chkValues.Checked;
465               value := Piece(aitems[i], '^', 3);
466               value1 := Piece(value, '/', 1);
467               value2 := Piece(value, '/', 2);
468               value3 := Piece(value, '/', 3);
469               if OkFloatValue(value1) and OKFloatValue(value2) then
470               begin
471                 high := value1;
472                 labvalue1 := strtofloat(value1);
473                 labvalue2 := strtofloat(value2);
474                 datevalue := FMToDateTime(Piece(aitems[numtest + strtoint(Piece(aitems[i], '^', 1))], '^', 2));
475                 serTest.AddXY(datevalue, labvalue1, '', clTeeColor);
476                 serTestX.AddXY(datevalue, labvalue2, '', clTeeColor);
477                 inc(valuecount);
478                 if OKFloatValue(value3) then
479                 begin
480                   labvalue3 := strtofloat(value3);
481                   serTestY.AddXY(datevalue, labvalue3, '', clTeeColor);
482                   serTestY.Active := true;
483                 end;
484               end;
485             end;
486           serTest.Title := 'Systolic';
487           serTestX.Title := 'Diastolic';
488         end    // blood pressure
489         else
490         begin
491           for i := numtest + numcol + 1 to numtest + numcol + numvalues do
492             if Piece(aitems[i], '^', 2) = testcheck then
493             begin
494               serTestX.Active := false;
495               serTestY.Active := false;
496               value := Piece(aitems[i], '^', 3);
497               if OkFloatValue(value) then
498               begin
499                 high := value;
500                 labvalue := strtofloat(value);
501                 datevalue := FMToDateTime(Piece(aitems[numtest + strtoint(Piece(aitems[i], '^', 1))], '^', 2));
502                 serTest.AddXY(datevalue, labvalue, '', clTeeColor);
503                 inc(valuecount);
504               end;
505             end;
506           serTest.Title := lstVitals.Items[lstVitals.ItemIndex];
507         end;   // not blood pressure
508         serTime.AddXY(FMToDateTime(start), strtofloat(high), '',clTeeColor);
509         serTime.AddXY(FMToDateTime(stop), strtofloat(high), '',clTeeColor);
510       end;   // numtest > 0
511       if chkZoom.Checked and chtChart.Visible then
512       begin
513         oldstart := chtChart.BottomAxis.Minimum;
514         oldend := chtChart.BottomAxis.Maximum;
515         chtChart.UndoZoom;
516         chtChart.BottomAxis.Automatic := false;
517         chtChart.BottomAxis.Minimum := oldstart;
518         chtChart.BottomAxis.Maximum := oldend;
519       end
520       else
521       begin
522         chtChart.BottomAxis.Automatic := true;
523       end;
524       if valuecount = 0 then chtChart.Visible := false;
525     end;  // numvalues not 0
526   end;
527   
528   procedure TfrmVitals.GetStartStop(var start, stop: string; aitems: TStrings);
529   var
530     numtest, numcol: integer;
531   begin
532     numtest := strtoint(Piece(aitems[0], '^', 1));
533     numcol := strtoint(Piece(aitems[0], '^', 2));
534     start := Piece(aitems[numtest + 1], '^', 2);
535     stop := Piece(aitems[numtest + numcol], '^', 2);
536   end;
537   
538   procedure TfrmVitals.grdVitalsSelectCell(Sender: TObject; Col,
539     Row: Integer; var CanSelect: Boolean);
540   begin
541     lstVitals.ItemIndex := Row - 1;
542     if lstVitals.ItemIndex > -1 then
543     begin
544       WorksheetChart(inttostr(lstVitals.ItemIndex + 1), tmpGrid);
545       if (serTest.Count > 1) and not chkZoom.Checked then
546       begin
547         chtChart.UndoZoom;
548         chtChart.ZoomPercent(ZOOM_PERCENT);
549       end;
550     end;
551   end;
552   
553   procedure TfrmVitals.chkZoomClick(Sender: TObject);
554   begin
555     chtChart.AllowZoom := chkZoom.Checked;
556     chtChart.AnimatedZoom := chkZoom.Checked;
557     if not chkZoom.Checked then
558     begin
559       chtChart.UndoZoom;
560       if serTest.Count > 1 then chtChart.ZoomPercent(ZOOM_PERCENT);
561     end;
562   end;
563   
564   procedure TfrmVitals.chk3DClick(Sender: TObject);
565   begin
566     chtChart.View3D := chk3D.Checked;
567   end;
568   
569   procedure TfrmVitals.chkValuesClick(Sender: TObject);
570   begin
571     serTest.Marks.Visible := chkValues.Checked;
572     if serTestX.Active then serTestX.Marks.Visible := chkValues.Checked;
573     if serTestY.Active then serTestY.Marks.Visible := chkValues.Checked;
574   end;
575   
576   procedure TfrmVitals.FormShow(Sender: TObject);
577   begin
578     lstDatesClick(self);
579   end;
580   
581   
582   
583   
584   procedure TfrmVitals.pnlEnterVitalsResize(Sender: TObject);
585   begin
586     btnEnterVitals.top := pnlEnterVitals.top;
587     btnEnterVitals.left := pnlEnterVitals.left;
588     btnEnterVitals.height := pnlEnterVitals.height;
589     btnEnterVitals.width := pnlEnterVitals.width;
590   end;
591   
592   procedure TfrmVitals.btnEnterVitalsClick(Sender: TObject);
593   begin
594     If Encounter.location > 0.0 then //if it has been assigned.
595       uVitalLocation := Encounter.Location
596     else
597       begin
598         //assign location
599         if Encounter.NeedVisit then
600         begin
601           UpdateVisit(Font.Size);
602           frmFrame.DisplayEncounterText;
603         end;
604         if Encounter.NeedVisit and (not frmFrame.CCOWDrivedChange) then 
605         begin
606           InfoBox(TX_NEED_VISIT, TX_NO_VISIT, MB_OK or MB_ICONWARNING);
607           exit;                                  {RAB 6/23/98}
608         end
609         else
610           uVitalLocation := Encounter.Location;
611       end;
612   
613     if (not encounter.NeedVisit) then
614       try
615         Application.CreateForm(TfrmVit, frmVit);
616         frmvit.showmodal;
617         //refresh vital info
618         lstDatesClick(self);
619       finally
620         frmvit.release;
621       end;
622   end;
623   
624   procedure TfrmVitals.chtChartUndoZoom(Sender: TObject);
625   begin
626     chtChart.BottomAxis.Automatic := true;
627   end;
628   
629   procedure TfrmVitals.popValuesClick(Sender: TObject);
630   begin
631     chkValues.Checked := not chkValues.Checked;
632     chkValuesClick(self);
633   end;
634   
635   procedure TfrmVitals.pop3DClick(Sender: TObject);
636   begin
637     chk3D.Checked := not chk3D.Checked;
638     chk3DClick(self);
639   end;
640   
641   procedure TfrmVitals.popZoomClick(Sender: TObject);
642   begin
643     chkZoom.Checked := not chkZoom.Checked;
644     chkZoomClick(self);
645   end;
646   
647   procedure TfrmVitals.popZoomBackClick(Sender: TObject);
648   begin
649     chtChart.UndoZoom;
650   end;
651   
652   procedure TfrmVitals.popCopyClick(Sender: TObject);
653   begin
654     chtChart.CopyToClipboardBitmap;
655   end;
656   
657   procedure TfrmVitals.popDetailsClick(Sender: TObject);
658   var
659     tmpList: TStringList;
660     date1, date2: TFMDateTime;
661     strdate1, strdate2: string;
662   begin
663     inherited;
664     Screen.Cursor := crHourGlass;
665     if chtChart.Tag > 0 then
666     begin
667       strdate1 := FormatDateTime('mm/dd/yyyy', uDate1);
668       strdate2 := FormatDateTime('mm/dd/yyyy', uDate2);
669       uDate1 := StrToDateTime(strdate1);
670       uDate2 := StrToDateTime(strdate2);
671       date1 := DateTimeToFMDateTime(uDate1 + 1);
672       date2 := DateTimeToFMDateTime(uDate2);
673       StatusText('Retrieving data for ' + FormatDateTime('dddd, mmmm d, yyyy', uDate2) + '...');
674       ReportBox(VitalsMemo(Patient.DFN, date1, date2, lstVitals.Items), 'Vitals on ' + Patient.Name + ' for ' + FormatDateTime('dddd, mmmm d, yyyy', uDate2), True);
675     end
676     else
677     begin
678       date1 := DateTimeToFMDateTime(chtChart.BottomAxis.Maximum);
679       date2 := DateTimeToFMDateTime(chtChart.BottomAxis.Minimum);
680       tmpList := TStringList.Create;
681       try
682         tmpList.Add(lstVitals.Items[lstVitals.ItemIndex]);
683         if serTest.Title = 'Systolic' then
684           StatusText('Retrieving data for Blood Pressure...')
685         else
686           StatusText('Retrieving data for ' + serTest.Title + '...');
687         ReportBox(VitalsMemo(Patient.DFN, date1, date2, tmpList), serTest.Title + ' results on ' + Patient.Name, True);
688       finally
689         tmpList.Free;
690       end;
691     end;
692     Screen.Cursor := crDefault;
693     StatusText('');
694   end;
695   
696   procedure TfrmVitals.chtChartClickSeries(Sender: TCustomChart;
697     Series: TChartSeries; ValueIndex: Integer; Button: TMouseButton;
698     Shift: TShiftState; X, Y: Integer);
699   begin
700       uDate1 := Series.XValue[ValueIndex];
701       uDate2 := uDate1;
702       chtChart.Hint := 'Details - Vitals for ' + FormatDateTime('dddd, mmmm d, yyyy', Series.XValue[ValueIndex]) + '...';
703       chtChart.Tag := ValueIndex + 1;
704     if Button <> mbRight then  popDetailsClick(self);
705   end;
706   
707   procedure TfrmVitals.chtChartMouseDown(Sender: TObject;
708     Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
709   begin
710     chtChart.Hint := '';
711     chtChart.Tag := 0;
712   end;
713   
714   procedure TfrmVitals.chtChartClickLegend(Sender: TCustomChart;
715     Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
716   begin
717     if serTest.Title = 'Systolic' then
718       chtChart.Hint := 'Details - for Blood Pressure...'
719     else
720       chtChart.Hint := 'Details - for ' + serTest.Title + '...';
721     chtChart.Tag := 0;
722     if Button <> mbRight then  popDetailsClick(self);
723   end;
724   
725   procedure TfrmVitals.popChartPopup(Sender: TObject);
726   begin
727     popValues.Checked := chkValues.Checked;
728     pop3D.Checked := chk3D.Checked;
729     popZoom.Checked := chkZoom.Checked;
730     popZoomBack.Enabled := popZoom.Checked and not chtChart.BottomAxis.Automatic;;
731     if chtChart.Hint <> '' then
732     begin
733       popDetails.Caption := chtChart.Hint;
734       popDetails.Enabled := true;
735     end
736     else
737     begin
738       popDetails.Caption := 'Details...';
739       popDetails.Enabled := false;
740     end;
741   end;
742   
743   procedure TfrmVitals.popPrintClick(Sender: TObject);
744   var
745     GraphTitle: string;
746   begin
747     GraphTitle := lstVitals.Items[lstVitals.ItemIndex] +
748                   ' - ' +
749                   lstDates.DisplayText[lstDates.ItemIndex];
750     if dlgWinPrint.Execute then PrintGraph(chtChart, GraphTitle);
751   end;
752   
753   procedure TfrmVitals.BeginEndDates(var ADate1, ADate2: TFMDateTime; var ADaysBack: integer);
754   var
755     datetemp: TFMDateTime;
756     today, datetime1, datetime2: TDateTime;
757     relativedate: string;
758   begin
759     today := FMToDateTime(floattostr(FMToday));
760     relativedate := Piece(lstDates.ItemID, ';', 1);
761     relativedate := Piece(relativedate, '-', 2);
762     ADaysBack := strtointdef(relativedate, 0);
763     ADate1 := DateTimeToFMDateTime(today - ADaysBack);
764     relativedate := Piece(lstDates.ItemID, ';', 2);
765     if StrToIntDef(Piece(relativedate, '+', 2), 0) > 0 then
766       begin
767         relativedate := Piece(relativedate, '+', 2);
768         ADaysBack := strtointdef(relativedate, 0);
769         ADate2 := DateTimeToFMDateTime(today + ADaysBack + 1);
770       end
771     else
772       begin
773         relativedate := Piece(relativedate, '-', 2);
774         ADaysBack := strtointdef(relativedate, 0);
775         ADate2 := DateTimeToFMDateTime(today - ADaysBack);
776       end;
777     datetime1 := FMDateTimeToDateTime(ADate1);
778     datetime2 := FMDateTimeToDateTime(ADate2);
779     if datetime1 < datetime2 then                 // reorder dates, if needed
780       begin
781         datetemp := ADate1;
782         ADate1 := ADate2;
783         ADate2 := datetemp
784       end;
785     ADate1 := ADate1 + 0.2359;
786   end;
787   
788   procedure TfrmVitals.FormKeyUp(Sender: TObject; var Key: Word;
789     Shift: TShiftState);
790   begin
791     if Key = VK_ESCAPE then
792     begin
793       Key := 0;
794       Close;
795     end;  
796   end;
797   
798   end.

Module Calls (2 levels)


fVitals
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├uVitals
 │ ├uCore
 │ ├rCore
 │ ├rVitals
 │ └fVitalsDate
 ├uCore...
 ├rCore...
 ├fvit
 │ ├fAutoSz
 │ ├rVitals
 │ ├uCore...
 │ ├rCore...
 │ ├fVitals...
 │ └uVitals...
 ├fFrame
 │ ├fPage
 │ ├uConst
 │ ├VERGENCECONTEXTORLib_TLB
 │ ├fBase508Form...
 │ ├XuDsigS
 │ ├rCore...
 │ ├fPtSelMsg
 │ ├fPtSel
 │ ├fCover
 │ ├fProbs
 │ ├fMeds
 │ ├fOrders
 │ ├rOrders
 │ ├fNotes
 │ ├fConsults
 │ ├fDCSumm
 │ ├rMisc
 │ ├fLabs
 │ ├fReports
 │ ├rReports
 │ ├fPtDemo
 │ ├fEncnt
 │ ├fPtCWAD
 │ ├uCore...
 │ ├fAbout
 │ ├fReview
 │ ├fxBroker
 │ ├fxLists
 │ ├fxServer
 │ ├fRptBox
 │ ├rODAllergy
 │ ├uInit
 │ ├fLabInfo
 │ ├uReminders
 │ ├fReminderTree
 │ ├fDeviceSelect
 │ ├fDrawers
 │ ├fReminderDialog
 │ ├fOptions
 │ ├fGraphs
 │ ├fGraphData
 │ ├rTemplates
 │ ├fSurgery
 │ ├rSurgery
 │ ├uEventHooks
 │ ├uSignItems
 │ ├rECS
 │ ├fIconLegend
 │ ├uOrders
 │ ├uSpell
 │ ├uOrPtf
 │ ├fPatientFlagMulti
 │ ├fAlertForward
 │ ├UBAGlobals
 │ ├UBACore
 │ ├fOrdersSign
 │ ├uVitals...
 │ ├fMHTest
 │ ├uFormMonitor
 │ ├fOtherSchedule
 │ ├uVA508CPRSCompatibility
 │ ├fIVRoutes
 │ ├fPrintLocation
 │ ├fTemplateEditor
 │ └fCombatVet
 ├fEncnt...
 ├fRptBox...
 └rReports...

Module Called-By (2 levels)


            fVitals
       fEncVitals┤ 
fEncounterFrame┘ │ 
           fCover┤ 
         fFrame┤ │ 
      fARTAllgy┘ │ 
             fvit┘ 
     fVitals...┘