source: cprs/trunk/CPRS-Chart/fLabs.pas@ 1071

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

Upgrading to version 27
File size: 185.3 KB
Line 
1unit fLabs;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fHSplit, StdCtrls, ExtCtrls, ORCtrls, ComCtrls, Grids, Buttons, fLabTest,
8 fLabTests, fLabTestGroups, ORFn, TeeProcs, TeEngine, Chart, Series, Menus,
9 uConst, ORDtTmRng, OleCtrls, SHDocVw, Variants, StrUtils, fBase508Form,
10 VA508AccessibilityManager;
11
12type
13 TGrdLab508Manager = class(TVA508ComponentManager)
14 private
15 function GetTextToSpeak(sg: TCaptionStringGrid): String;
16 function ToBlankIfEmpty(aString : String) : String;
17 public
18 constructor Create; override;
19 function GetValue(Component: TWinControl): string; override;
20 function GetItem(Component: TWinControl): TObject; override;
21 end;
22
23 TfrmLabs = class(TfrmHSplit)
24 PopupMenu1: TPopupMenu;
25 GotoTop1: TMenuItem;
26 GotoBottom1: TMenuItem;
27 FreezeText1: TMenuItem;
28 UnfreezeText1: TMenuItem;
29 popChart: TPopupMenu;
30 popValues: TMenuItem;
31 pop3D: TMenuItem;
32 popZoom: TMenuItem;
33 N1: TMenuItem;
34 popCopy: TMenuItem;
35 popZoomBack: TMenuItem;
36 popDetails: TMenuItem;
37 N2: TMenuItem;
38 calLabRange: TORDateRangeDlg;
39 dlgWinPrint: TPrintDialog;
40 N3: TMenuItem;
41 popPrint: TMenuItem;
42 Timer1: TTimer;
43 pnlRightBottom: TPanel;
44 Memo1: TMemo;
45 memLab: TRichEdit;
46 pnlRightTop: TPanel;
47 bvlHeader: TBevel;
48 pnlHeader: TORAutoPanel;
49 lblDateFloat: TLabel;
50 pnlWorksheet: TORAutoPanel;
51 chkValues: TCheckBox;
52 chk3D: TCheckBox;
53 ragHorV: TRadioGroup;
54 chkAbnormals: TCheckBox;
55 ragCorG: TRadioGroup;
56 chkZoom: TCheckBox;
57 pnlGraph: TORAutoPanel;
58 lblGraphInfo: TLabel;
59 chkGraph3D: TCheckBox;
60 chkGraphValues: TCheckBox;
61 chkGraphZoom: TCheckBox;
62 pnlButtons: TORAutoPanel;
63 lblOld: TOROffsetLabel;
64 lblPrev: TOROffsetLabel;
65 lblNext: TOROffsetLabel;
66 lblRecent: TOROffsetLabel;
67 lblMostRecent: TLabel;
68 lblCollection: TLabel;
69 lblDate: TVA508StaticText;
70 cmdNext: TButton;
71 cmdPrev: TButton;
72 cmdRecent: TButton;
73 cmdOld: TButton;
74 TabControl1: TTabControl;
75 grdLab: TCaptionStringGrid;
76 pnlChart: TPanel;
77 lblGraph: TLabel;
78 lstTestGraph: TORListBox;
79 chtChart: TChart;
80 serHigh: TLineSeries;
81 serLow: TLineSeries;
82 serTest: TLineSeries;
83 pnlRightTopHeader: TPanel;
84 lblHeading: TOROffsetLabel;
85 lblTitle: TOROffsetLabel;
86 PopupMenu2: TPopupMenu;
87 Print1: TMenuItem;
88 Copy1: TMenuItem;
89 SelectAll1: TMenuItem;
90 PopupMenu3: TPopupMenu;
91 Print2: TMenuItem;
92 Copy2: TMenuItem;
93 SelectAll2: TMenuItem;
94 MenuItem1: TMenuItem;
95 MenuItem2: TMenuItem;
96 MenuItem3: TMenuItem;
97 MenuItem4: TMenuItem;
98 sptHorzRight: TSplitter;
99 pnlFooter: TORAutoPanel;
100 lblSpecimen: TLabel;
101 lblSingleTest: TLabel;
102 lblFooter: TOROffsetLabel;
103 lstTests: TORListBox;
104 lvReports: TCaptionListView;
105 pnlLefTop: TPanel;
106 lblReports: TOROffsetLabel;
107 tvReports: TORTreeView;
108 pnlLeftBottom: TPanel;
109 lstQualifier: TORListBox;
110 lblQualifier: TOROffsetLabel;
111 lblHeaders: TOROffsetLabel;
112 lstHeaders: TORListBox;
113 lblDates: TOROffsetLabel;
114 lstDates: TORListBox;
115 Splitter1: TSplitter;
116 pnlOtherTests: TORAutoPanel;
117 bvlOtherTests: TBevel;
118 cmdOtherTests: TButton;
119 chkMaxFreq: TCheckBox;
120 procedure FormCreate(Sender: TObject);
121 procedure DisplayHeading(aRanges: string);
122 //procedure lstReportsClick(Sender: TObject);
123 procedure lstHeadersClick(Sender: TObject);
124 procedure lstDatesClick(Sender: TObject);
125 procedure cmdOtherTestsClick(Sender: TObject);
126 procedure FormDestroy(Sender: TObject);
127 procedure cmdNextClick(Sender: TObject);
128 procedure cmdPrevClick(Sender: TObject);
129 procedure cmdRecentClick(Sender: TObject);
130 procedure cmdOldClick(Sender: TObject);
131 procedure FormResize(Sender: TObject);
132 procedure pnlRightResize(Sender: TObject);
133 procedure chkValuesClick(Sender: TObject);
134 procedure chk3DClick(Sender: TObject);
135 procedure ragHorVClick(Sender: TObject);
136 procedure ragCorGClick(Sender: TObject);
137 procedure lstTestGraphClick(Sender: TObject);
138 procedure chkGraphValuesClick(Sender: TObject);
139 procedure chkGraph3DClick(Sender: TObject);
140 procedure chkGraphZoomClick(Sender: TObject);
141 procedure GotoTop1Click(Sender: TObject);
142 procedure GotoBottom1Click(Sender: TObject);
143 procedure FreezeText1Click(Sender: TObject);
144 procedure UnfreezeText1Click(Sender: TObject);
145 procedure PopupMenu1Popup(Sender: TObject);
146 procedure chkZoomClick(Sender: TObject);
147 procedure chtChartUndoZoom(Sender: TObject);
148 procedure popCopyClick(Sender: TObject);
149 procedure popChartPopup(Sender: TObject);
150 procedure popValuesClick(Sender: TObject);
151 procedure pop3DClick(Sender: TObject);
152 procedure popZoomClick(Sender: TObject);
153 procedure popZoomBackClick(Sender: TObject);
154 procedure chtChartMouseDown(Sender: TObject; Button: TMouseButton;
155 Shift: TShiftState; X, Y: Integer);
156 procedure chtChartClickSeries(Sender: TCustomChart;
157 Series: TChartSeries; ValueIndex: Integer; Button: TMouseButton;
158 Shift: TShiftState; X, Y: Integer);
159 procedure chtChartClickLegend(Sender: TCustomChart;
160 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
161 procedure popDetailsClick(Sender: TObject);
162 procedure popPrintClick(Sender: TObject);
163 procedure BeginEndDates(var ADate1, ADate2: TFMDateTime; var ADaysBack: integer);
164 procedure Timer1Timer(Sender: TObject);
165 procedure TabControl1Change(Sender: TObject);
166 procedure WebBrowser1DocumentComplete(Sender: TObject;
167 const pDisp: IDispatch; var URL: OleVariant);
168 procedure Memo1KeyUp(Sender: TObject; var Key: Word;
169 Shift: TShiftState);
170 procedure UpdateRemoteStatus(aSiteID, aStatus: string);
171 procedure lblDateEnter(Sender: TObject);
172 procedure LoadTreeView;
173 procedure LoadListView(aReportData: TStringList);
174 procedure tvReportsClick(Sender: TObject);
175 procedure lstQualifierClick(Sender: TObject);
176 procedure tvReportsKeyDown(Sender: TObject; var Key: Word;
177 Shift: TShiftState);
178 procedure tvReportsCollapsing(Sender: TObject; Node: TTreeNode;
179 var AllowCollapse: Boolean);
180 procedure tvReportsExpanding(Sender: TObject; Node: TTreeNode;
181 var AllowExpansion: Boolean);
182 procedure lvReportsKeyUp(Sender: TObject; var Key: Word;
183 Shift: TShiftState);
184 procedure SelectAll1Click(Sender: TObject);
185 procedure Print1Click(Sender: TObject);
186 procedure Copy1Click(Sender: TObject);
187 procedure Copy2Click(Sender: TObject);
188 procedure Print2Click(Sender: TObject);
189 procedure lvReportsCompare(Sender: TObject; Item1, Item2: TListItem;
190 Data: Integer; var Compare: Integer);
191 procedure lvReportsColumnClick(Sender: TObject; Column: TListColumn);
192 procedure lvReportsSelectItem(Sender: TObject; Item: TListItem;
193 Selected: Boolean);
194 procedure sptHorzRightCanResize(Sender: TObject; var NewSize: Integer;
195 var Accept: Boolean);
196 procedure Splitter1CanResize(Sender: TObject; var NewSize: Integer;
197 var Accept: Boolean);
198 procedure SelectAll2Click(Sender: TObject);
199 procedure chkMaxFreqClick(Sender: TObject);
200 procedure sptHorzRightMoved(Sender: TObject);
201 private
202 { Private declarations }
203 SortIdx1, SortIdx2, SortIdx3: Integer;
204 grdLab508Manager : TGrdLab508Manager;
205 procedure AlignList;
206 procedure HGrid(griddata: TStrings);
207 procedure VGrid(griddata: TStrings);
208 procedure FillGrid(agrid: TStringGrid; aitems: TStrings);
209 procedure GridComments(aitems: TStrings);
210 procedure FillComments(amemo: TRichEdit; aitems:TStrings);
211 procedure GetInterimGrid(adatetime: TFMDateTime; direction: integer);
212 procedure WorksheetChart(test: string; aitems: TStrings);
213 procedure GetStartStop(var start, stop: string; aitems: TStrings);
214 procedure GraphChart(test: string; aitems: TStrings);
215 procedure GraphList(griddata: TStrings);
216 procedure ProcessNotifications;
217 procedure PrintLabGraph;
218 procedure GoRemoteOld(Dest: TStringList; AItem, AReportID: Int64; AQualifier, ARpc, AHSType, ADaysBack, ASection: string; ADate1, ADate2: TFMDateTime);
219 procedure GoRemote(Dest: TStringList; AItem: string; AQualifier, ARpc: string; AHSTag: string; AHDR: string; aFHIE: string);
220 procedure ShowTabControl;
221 procedure ChkBrowser;
222 procedure CommonComponentVisible(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12: Boolean);
223 public
224 procedure ClearPtData; override;
225 function AllowContextChange(var WhyNot: string): Boolean; override;
226 procedure DisplayPage; override;
227 procedure SetFontSize(NewFontSize: Integer); override;
228 function FMToDateTime(FMDateTime: string): TDateTime;
229 procedure RequestPrint; override;
230 //procedure ExtlstReportsClick(Sender: TObject; Ext: boolean);
231
232end;
233
234var
235 frmLabs: TfrmLabs;
236 uFormat: integer;
237 uPrevReportNode: TTreeNode;
238 uDate1, uDate2: Tdatetime;
239 tmpGrid: TStringList;
240 uLabLocalReportData: TStringList; //Storage for Local report data
241 uLabRemoteReportData: TStringList; //Storage for Remote lab query
242 uUpdateStat: boolean; //flag turned on when remote status is being updated
243 uScreenSplitMoved: boolean; //set if user moves the sptHorzRight Bar
244 uScreenSplitLoc: Integer; //location of user changed split - sptHorzRight Bar
245 uTreeStrings: TStrings;
246 uReportInstruction: String; //User Instructions
247 uColChange: string; //determines when column widths have changed
248 uQualifier: string;
249 uReportType: string;
250 uSortOrder: string;
251 uMaxOcc: string;
252 UpdatingLvReports: Boolean; //Currently updating lvReports
253 uColumns: TStringList;
254 uNewColumn: TListColumn;
255 uLocalReportData: TStringList; //Storage for Local report data
256 uRemoteReportData: TStringList; //Storage for status of Remote data
257 uQualifierType: Integer;
258 uHState: string;
259 uFirstSort: Integer;
260 uSecondSort: Integer;
261 uThirdSort: Integer;
262 ulvSelectOn: boolean; //flag turned on when multiple items in lvReports control have been selected
263
264implementation
265
266uses uCore, rLabs, rCore, rCover, rOrders, fLabPrint, fFrame, fRptBox, Printers, fReportsPrint,
267 clipbrd, rReports, rGraphs, activex, mshtml, VA508AccessibilityRouter, uReports,
268 VAUtils
269 { TODO -oRV -cWVEHR Long Age : Changed to use long age }
270 , rWVEHR;
271
272
273const
274 QT_OTHER = 0;
275 QT_MOSTRECENT = 1;
276 QT_DATERANGE = 2;
277 QT_IMAGING = 3;
278 QT_NUTR = 4;
279 QT_PROCEDURES = 19;
280 QT_SURGERY = 28;
281 QT_HSCOMPONENT = 5;
282 QT_HSWPCOMPONENT = 6;
283 CT_LABS = 9; // ID for Labs tab used by frmFrame
284 TX_NOREPORT = 'No report is currently selected.';
285 TX_NOREPORT_CAP = 'No Report Selected';
286 ZOOM_PERCENT = 99; // padding for inflating margins
287 HTML_PRE = '<html><head><style>' + CRLF +
288 'PRE {font-size:8pt;font-family: "Courier New", "monospace"}' + CRLF +
289 '</style></head><body><pre>';
290 HTML_POST = CRLF + '</pre></body></html>';
291
292{$R *.DFM}
293
294var
295 uFrozen: Boolean;
296 uGraphingActivated: Boolean;
297 uRemoteCount: Integer;
298 uHTMLDoc: string;
299 uReportRPC: string;
300 uHTMLPatient: ANSIstring;
301 uEmptyImageList: TImageList;
302 uRptID: String;
303 uDirect: String;
304 ColumnToSort: Integer;
305 ColumnSortForward: Boolean;
306
307procedure TfrmLabs.RequestPrint;
308var
309 aID : integer;
310begin
311 aID := 0;
312 if CharAt(uRPTID,2) =':' then
313 aID := strToInt(piece(uRPTID,':',1));
314 if (aID = 0) and (CharAt(uRPTID,3) =':') then
315 aID := StrToInt(piece(uRptID,':',1));
316 if uReportType = 'M' then
317 begin
318 InfoBox(TX_NOREPORT, TX_NOREPORT_CAP, MB_OK);
319 Exit;
320 end;
321 if (uReportType = 'V') and (length(piece(uHState,';',2)) > 0) then
322 begin
323 if lvReports.Items.Count < 1 then
324 begin
325 InfoBox('There are no items to be printed.', 'No Items to Print', MB_OK);
326 Exit;
327 end;
328 if lvReports.SelCount < 1 then
329 begin
330 InfoBox('Please select one or more items from the list to be printed.', 'No Items Selected', MB_OK);
331 Exit;
332 end;
333 end;
334 {if (uReportType = 'G') and GraphFormActive then
335 with GraphForm do
336 begin
337 if (lvwItemsTop.SelCount < 1) and (lvwItemsBottom.SelCount < 1) then
338 begin
339 InfoBox('There are no items graphed.', 'No Items to Print', MB_OK);
340 Exit;
341 end
342 else
343 begin
344 mnuPopGraphPrintClick(mnuPopGraphPrint);
345 Exit;
346 end;
347 end; }
348 if uQualifierType = QT_DATERANGE then
349 begin // = 2
350 if lstQualifier.ItemIndex < 0 then
351 begin
352 InfoBox('Please select from one of the Date Range items before printing', 'Incomplete Information', MB_OK);
353 end
354 else
355 PrintReports(uRptID, piece(uRemoteType,'^',4));
356 end
357 else
358 if uQualifierType = 0 then
359 begin
360 if aID = 0 then InfoBox(TX_NOREPORT, TX_NOREPORT_CAP, MB_OK);
361 case aID of
362 1: begin
363 InfoBox('Unable to print ''Most Recent'' report.', 'No Print Available', MB_OK);
364 end;
365 2: begin
366 PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN);
367 end;
368 3: begin
369 PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN);
370 end;
371 4: begin
372 PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN);
373 end;
374 5: begin
375 InfoBox('Unable to print ''Worksheet'' report.', 'No Print Available', MB_OK);
376 end;
377 6: begin
378 if chtChart.Visible then PrintLabGraph;
379 end;
380 8: begin
381 PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN);
382 end;
383 9: begin
384 PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN);
385 end;
386 10: begin
387 PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN);
388 end;
389 20: begin
390 PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN);
391 end;
392 21: begin
393 PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN);
394 end;
395 end;
396 end
397 else
398 PrintLabs(uRptID, piece(uRemoteType,'^',4), lstDates.ItemIEN);
399end;
400
401
402procedure TfrmLabs.FormCreate(Sender: TObject);
403var
404 aList: TStrings;
405begin
406 inherited;
407 PageID := CT_LABS;
408 uFrozen := False;
409 uScreenSplitMoved := False;
410 aList := TStringList.Create;
411 FastAssign(rpcGetGraphSettings, aList);
412 uGraphingActivated := aList.Count > 0;
413 aList.Free;
414 uRemoteCount := 0;
415 tmpGrid := TStringList.Create;
416 uLabLocalReportData := TStringList.Create;
417 uLabRemoteReportData := TStringList.Create;
418 uColumns := TStringList.Create;
419 uTreeStrings := TStringList.Create;
420 uEmptyImageList := TImageList.Create(Self);
421 uEmptyImageList.Width := 0;
422 uLocalReportData := TStringList.Create;
423 uRemoteReportData := TStringList.Create;
424 uPrevReportNode := tvReports.Items.GetFirstNode;
425 tvReports.Selected := uPrevReportNode;
426 if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 5;
427 lblSingleTest.Caption := '';
428 lblSpecimen.Caption := '';
429 SerTest.GetHorizAxis.ExactDateTime := true;
430 SerTest.GetHorizAxis.Increment := DateTimeStep[dtOneMinute];
431 grdLab508Manager := TGrdLab508Manager.Create;
432 amgrMain.ComponentManager[grdLab] := grdLab508Manager;
433 memo1.Visible := false;
434end;
435
436procedure TfrmLabs.UpdateRemoteStatus(aSiteID, aStatus: string);
437var
438 j: integer;
439 s: string;
440 c: boolean;
441begin
442 if uUpdateStat = true then exit; //uUpdateStat also looked at in fFrame
443 uUpdateStat := true;
444 for j := 0 to frmFrame.lstCIRNLocations.Items.Count - 1 do
445 begin
446 s := frmFrame.lstCIRNLocations.Items[j];
447 c := frmFrame.lstCIRNLocations.checked[j];
448 if piece(s, '^', 1) = aSiteID then
449 begin
450 frmFrame.lstCIRNLocations.Items[j] := pieces(s, '^', 1, 3) + '^' + aStatus;
451 frmFrame.lstCIRNLocations.checked[j] := c;
452 end;
453 end;
454 uUpdateStat := false;
455end;
456
457function TfrmLabs.AllowContextChange(var WhyNot: string): Boolean;
458var
459 i: integer;
460begin
461 Result := inherited AllowContextChange(WhyNot); // sets result = true
462 if Timer1.Enabled = true then
463 case BOOLCHAR[frmFrame.CCOWContextChanging] of
464 '1': begin
465 WhyNot := 'A remote data query in progress will be aborted.';
466 Result := False;
467 end;
468 '0': if WhyNot = 'COMMIT' then
469 begin
470 with RemoteSites.SiteList do for i := 0 to Count - 1 do
471 if TRemoteSite(Items[i]).Selected then
472 if Length(TRemoteSite(Items[i]).LabRemoteHandle) > 0 then
473 begin
474 TRemoteSite(Items[i]).ReportClear;
475 TRemoteSite(Items[i]).LabQueryStatus := '-1^Aborted';
476 TabControl1.OnChange(nil);
477 end;
478 Timer1.Enabled := false;
479 Result := True;
480 end;
481 end;
482end;
483
484procedure TfrmLabs.ClearPtData;
485begin
486 inherited ClearPtData;
487 Timer1.Enabled := False;
488 memLab.Lines.Clear;
489 uLabLocalReportData.Clear;
490 uLabRemoteReportData.Clear;
491 TabControl1.Tabs.Clear;
492 TabControl1.Visible := false;
493 tmpGrid.Clear;
494 lvReports.SmallImages := uEmptyImageList;
495 uLocalReportData.Clear;
496 uRemoteReportData.Clear;
497 with grdLab do
498 begin
499 RowCount := 1;
500 ColCount := 1;
501 Cells[0, 0] := '';
502 end;
503end;
504
505procedure TfrmLabs.DisplayPage;
506var
507 i: integer;
508begin
509 inherited DisplayPage;
510 frmFrame.mnuFilePrint.Tag := CT_LABS;
511 frmFrame.mnuFilePrint.Enabled := True;
512 frmFrame.mnuFilePrintSetup.Enabled := True;
513 memLab.SelStart := 0;
514 uHTMLPatient := '<DIV align left>'
515 + '<TABLE width="75%" border="0" cellspacing="0" cellpadding="1">'
516 + '<TR valign="bottom" align="left">'
517 + '<TD nowrap><B>Patient: ' + Patient.Name + '</B></TD>'
518 + '<TD nowrap><B>' + Patient.SSN + '</B></TD>'
519{ TODO -oRV -cWVEHR Long Age : Changed to use long age }
520 //+ '<TD nowrap><B>Age: ' + IntToStr(Patient.Age) + '</B></TD>'
521 + '<TD nowrap><B>Age: ' + GetPatientBriefAge(Patient.DFN) + '</B></TD>'
522{}
523 + '</TR></TABLE></DIV><HR>';
524 //the preferred method would be to use headers and footers
525 //so this is just an interim solution.
526 if InitPage then
527 begin
528 Splitter1.Visible := false;
529 pnlLeftBottom.Visible := false;
530 uColChange := '';
531 uMaxOcc := '';
532 LoadTreeView;
533 end;
534 if InitPatient and not (CallingContext = CC_NOTIFICATION) then
535 begin
536 uColChange := '';
537 if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 5;
538 tvReports.Selected := tvReports.Items.GetFirstNode;
539 tvReportsClick(self);
540 end;
541 if InitPatient and not (CallingContext = CC_NOTIFICATION) then
542 begin
543 uColChange := '';
544 lstQualifier.Clear;
545 //tvProcedures.Items.Clear;
546 //lblProcTypeMsg.Visible := FALSE;
547 lvReports.SmallImages := uEmptyImageList;
548 lvReports.Items.Clear;
549 lvReports.Columns.Clear;
550 lblTitle.Caption := '';
551 lvReports.Caption := '';
552 Splitter1.Visible := false;
553 pnlLeftBottom.Visible := false;
554 memLab.Parent := pnlRightBottom;
555 memLab.Align := alClient;
556 memLab.Clear;
557 uReportInstruction := '';
558 uLocalReportData.Clear;
559 for i := 0 to RemoteSites.SiteList.Count - 1 do
560 TRemoteSite(RemoteSites.SiteList.Items[i]).ReportClear;
561 //pnlRightTop.Height := lblTitle.Height + TabControl1.Height;
562 StatusText('');
563 with tvReports do
564 if Items.Count > 0 then
565 begin
566 tvReports.Selected := tvReports.Items.GetFirstNode;
567 tvReportsClick(self);
568 end;
569 end;
570 case CallingContext of
571 CC_INIT_PATIENT: if not InitPatient then
572 begin
573 if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 5;
574 tvReports.Selected := tvReports.Items.GetFirstNode;
575 tvReportsClick(self);
576 lvReports.SmallImages := uEmptyImageList;
577 lstQualifier.Clear;
578 //tvProcedures.Items.Clear;
579 //lblProcTypeMsg.Visible := FALSE;
580 lvReports.SmallImages := uEmptyImageList;
581 lvReports.Items.Clear;
582 Splitter1.Visible := false;
583 pnlLeftBottom.Visible := false;
584 with tvReports do
585 if Items.Count > 0 then
586 begin
587 tvReports.Selected := tvReports.Items.GetFirstNode;
588 tvReportsClick(self);
589 end;
590 end;
591 CC_NOTIFICATION: ProcessNotifications;
592 end;
593end;
594
595procedure TfrmLabs.SetFontSize(NewFontSize: Integer);
596begin
597 inherited SetFontSize(NewFontSize);
598 FormResize(self);
599end;
600
601procedure TfrmLabs.LoadListView(aReportData: TStringList);
602var
603 j,k,aErr: integer;
604 aTmpAray: TStringList;
605 aColCtr, aCurCol, aCurRow, aColID: integer;
606 x,y,z,c,aSite: string;
607 ListItem: TListItem;
608begin
609 aSite := '';
610 aErr := 0;
611 ListItem := nil;
612 case uQualifierType of
613 QT_HSCOMPONENT:
614 begin // = 5
615 if (length(piece(uHState,';',2)) > 0) then
616 begin
617 with lvReports do
618 begin
619 ViewStyle := vsReport;
620 for j := 0 to aReportData.Count - 1 do
621 begin
622 if piece(aReportData[j],'^',1) = '-1' then //error condition, most likely remote call
623 continue;
624 ListItem := Items.Add;
625 aSite := piece(aReportData[j],'^',1);
626 ListItem.Caption := piece(aSite,';',1);
627 for k := 2 to uColumns.Count do
628 begin
629 ListItem.SubItems.Add(piece(aReportData[j],'^',k));
630 end;
631 end;
632 if aReportData.Count = 0 then
633 begin
634 uReportInstruction := '<No Data Available>';
635 memLab.Lines.Clear;
636 memLab.Lines.Add(uReportInstruction);
637 end
638 else
639 memLab.Lines.Clear;
640 end;
641 end;
642 end;
643 QT_HSWPCOMPONENT:
644 begin // = 6
645 if (length(piece(uHState,';',2)) > 0) then //and (chkText.Checked = false) then
646 begin
647 aTmpAray := TStringList.Create;
648 aCurRow := 0;
649 aCurCol := 0;
650 aColCtr := 9;
651 aTmpAray.Clear;
652 with lvReports do
653 begin
654 for j := 0 to aReportData.Count - 1 do
655 begin
656 x := aReportData[j];
657 aColID := StrToIntDef(piece(x,'^',1),-1);
658 if aColID < 0 then //this is an error condition most likely an incompatible remote call
659 continue;
660 if aColID > (uColumns.Count - 1) then
661 begin
662 aErr := 1;
663 continue; //extract is out of sync with columns defined in 101.24
664 end;
665 if aColID < aColCtr then
666 begin
667 if aTmpAray.Count > 0 then
668 begin
669 if aColCtr = 1 then
670 begin
671 ListItem := Items.Add;
672 aSite := piece(aTmpAray[j],'^',1);
673 ListItem.Caption := piece(aSite,';',1);
674 ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol));
675 end
676 else
677 begin
678 c := aTmpAray[0];
679 if piece(uColumns.Strings[aCurCol],'^',4) = '1' then
680 c := c + '...';
681 z := piece(c,'^',1);
682 y := copy(c, (pos('^', c)), 9999);
683 if pos('^',y) > 0 then
684 begin
685 while pos('^',y) > 0 do
686 begin
687 y := copy(y, (pos('^', y)+1), 9999);
688 z := z + '^' + y;
689 end;
690 ListItem.SubItems.Add(z);
691 end
692 else
693 begin
694 ListItem.SubItems.Add(y);
695 end;
696 end;
697 RowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray);
698 aTmpAray.Clear;
699 end;
700 aColCtr := 0;
701 aCurCol := aColID;
702 aCurRow := aCurRow + 1;
703 end
704 else
705 if aColID = aCurCol then
706 begin
707 z := '';
708 y := piece(x,'^',2);
709 if length(y) > 0 then z := y;
710 y := copy(x, (pos('^', x)+1), 9999);
711 if pos('^',y) > 0 then
712 begin
713 while pos('^',y) > 0 do
714 begin
715 y := copy(y, (pos('^', y)+1), 9999);
716 z := z + '^' + y;
717 end;
718 aTmpAray.Add(z);
719 end
720 else
721 begin
722 aTmpAray.Add(y);
723 end;
724 continue;
725 end;
726 if aTmpAray.Count > 0 then
727 begin
728 if aColCtr = 1 then
729 begin
730 ListItem := Items.Add;
731 aSite := piece(aTmpAray[0],'^',1);
732 ListItem.Caption := piece(aSite,';',1);
733 ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol));
734 end
735 else
736 begin
737 c := aTmpAray[0];
738 if piece(uColumns.Strings[aCurCol],'^',4) = '1' then
739 c := c + '...';
740 ListItem.SubItems.Add(c);
741 end;
742 RowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray);
743 aTmpAray.Clear;
744 end;
745 aCurCol := aColID;
746 Inc(aColCtr);
747 y := '';
748 for k := 2 to 10 do
749 if length(piece(x,'^',k)) > 0 then
750 begin
751 if length(y) > 0 then y := y + '^' + piece(x,'^',k)
752 else y := y + piece(x,'^',k);
753 end;
754 aTmpAray.Add(y);
755 if aColCtr > 0 then
756 while aColCtr < aCurCol do
757 begin
758 ListItem.SubItems.Add('');
759 Inc(aColCtr);
760 end;
761 end;
762 if aTmpAray.Count > 0 then
763 begin
764 if aColCtr = 1 then
765 begin
766 ListItem := Items.Add;
767 aSite := piece(aTmpAray[0],'^',1);
768 ListItem.Caption := piece(aSite,';',1);
769 ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol));
770 end
771 else
772 begin
773 c := aTmpAray[0];
774 if piece(uColumns.Strings[aCurCol],'^',4) = '1' then
775 c := c + '...';
776 ListItem.SubItems.Add(c);
777 end;
778 RowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray);
779 aTmpAray.Clear;
780 end;
781 end;
782 aTmpAray.Free;
783 end;
784 end;
785 end;
786 if aErr = 1 then
787 if User.HasKey('XUPROGMODE') then
788 ShowMsg('Programmer message: One or more Column ID''s in file 101.24 do not match ID''s coded in extract routine');
789end;
790
791procedure TfrmLabs.DisplayHeading(aRanges: string);
792var
793 x,x1,x2,y,z,DaysBack: string;
794 d1,d2: TFMDateTime;
795begin
796 with lblTitle do
797 begin
798 x := '';
799 if tvReports.Selected = nil then
800 tvReports.Selected := tvReports.Items.GetFirstNode;
801 if tvReports.Selected.Parent <> nil then
802 x := tvReports.Selected.Parent.Text + ' ' + tvReports.Selected.Text
803 else
804 x := tvReports.Selected.Text;
805 x1 := '';
806 x2 := '';
807 if (uReportType <> 'M') and (not(uRptID = '1:MOST RECENT')) then
808 begin
809 if CharAt(aRanges, 1) = 'd' then
810 begin
811 if length(piece(aRanges,';',2)) > 0 then
812 begin
813 x2 := ' Max/site:' + piece(aRanges,';',2);
814 aRanges := piece(aRanges,';',1);
815 end;
816 DaysBack := Copy(aRanges, 2, Length(aRanges));
817 if DaysBack = '0' then
818 aRanges := 'T' + ';T'
819 else
820 aRanges := 'T-' + DaysBack + ';T';
821 end;
822 if length(piece(aRanges,';',1)) > 0 then
823 begin
824 d1 := ValidDateTimeStr(piece(aRanges,';',1),'');
825 d2 := ValidDateTimeStr(piece(aRanges,';',2),'');
826 y := FormatFMDateTime('mmm dd,yyyy',d1);
827 if Copy(y,8,2) = '18' then y := 'EARLIEST RESULT';
828 z := FormatFMDateTime('mmm dd,yyyy',d2);
829 x1 := ' [From: ' + y + ' to ' + z + ']';
830 end;
831 if length(piece(aRanges,';',3)) > 0 then
832 x2 := ' Max/site:' + piece(aRanges,';',3);
833 case uQualifierType of
834 QT_DATERANGE:
835 x := x + x1;
836 QT_HSCOMPONENT:
837 x := x + x1 + x2;
838 QT_HSWPCOMPONENT:
839 x := x + x1 + x2;
840 QT_IMAGING:
841 x := x + x1 + x2;
842 0:
843 x := x + x1;
844 end;
845 end;
846 if piece(uRemoteType, '^', 9) = '1' then x := x + ' <<ONLY REMOTE DOD DATA INCLUDED IN REPORT>>';
847 Caption := x;
848 end;
849 lvReports.Caption := x;
850end;
851
852procedure TfrmLabs.AlignList;
853begin
854 lblReports.Top := 0;
855 lstDates.Height := pnlLeft.Height div 3 - (lblDates.Height div 2);
856 lstDates.Top := pnlLeft.Height - lstDates.Height;
857 lblDates.Top := lstDates.Top - lblDates.Height;
858 lstQualifier.Height := pnlLeft.Height div 3 - (lblQualifier.Height div 2);
859 lstQualifier.Top := pnlLeft.Height - lstQualifier.Height;
860 lblQualifier.Top := lstQualifier.Top - lblQualifier.Height;
861 pnlOtherTests.Top := lblDates.Top - pnlOtherTests.Height;
862 lstHeaders.Height := pnlLeft.Height div 3 - (lblHeaders.Height * 3);
863 lstHeaders.Top := lblDates.Top - lstHeaders.Height;
864 lblHeaders.Top := lstHeaders.Top - lblHeaders.Height;
865 lstDates.Repaint;
866 lstHeaders.Repaint;
867 lstQualifier.Repaint;
868end;
869
870procedure TfrmLabs.LoadTreeView;
871var
872 i: integer;
873 currentNode, parentNode, grandParentNode, gtGrandParentNode: TTreeNode;
874 x: string;
875 addchild, addgrandchild, addgtgrandchild: boolean;
876begin
877 tvReports.Items.Clear;
878 memLab.Clear;
879 uHTMLDoc := '';
880 //WebBrowser1.Navigate('about:blank'); **Browser Remove**
881 //tvProcedures.Items.Clear;
882 //lblProcTypeMsg.Visible := FALSE;
883 lvReports.SmallImages := uEmptyImageList;
884 lvReports.Items.Clear;
885 uTreeStrings.Clear;
886 //lblTitle.Caption := '';
887 lvReports.Caption := '';
888 ListLabReports(uTreeStrings);
889 addchild := false;
890 addgrandchild := false;
891 addgtgrandchild := false;
892 parentNode := nil;
893 grandParentNode := nil;
894 gtGrandParentNode := nil;
895 currentNode := nil;
896 for i := 0 to uTreeStrings.Count - 1 do
897 begin
898 x := uTreeStrings[i];
899 if UpperCase(Piece(x,'^',1))='[PARENT END]' then
900 begin
901 if addgtgrandchild = true then
902 begin
903 currentNode := gtgrandParentNode;
904 addgtgrandchild := false;
905 end
906 else
907 if addgrandchild = true then
908 begin
909 currentNode := grandParentNode;
910 addgrandchild := false;
911 end
912 else
913 begin
914 currentNode := parentNode;
915 addchild := false;
916 end;
917 continue;
918 end;
919 if UpperCase(Piece(x,'^',1))='[PARENT START]' then
920 begin
921 if addgtgrandchild = true then
922 currentNode := tvReports.Items.AddChildObject(gtGrandParentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)))
923 else
924 if addgrandchild = true then
925 begin
926 currentNode := tvReports.Items.AddChildObject(grandParentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)));
927 addgtgrandchild := true;
928 gtgrandParentNode := currentNode;
929 end
930 else
931 if addchild = true then
932 begin
933 currentNode := tvReports.Items.AddChildObject(parentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)));
934 addgrandchild := true;
935 grandParentNode := currentNode;
936 end
937 else
938 begin
939 currentNode := tvReports.Items.AddObject(currentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)));
940 parentNode := currentNode;
941 addchild := true;
942 end;
943 end
944 else
945 if addchild = false then
946 begin
947 currentNode := tvReports.Items.AddObject(currentNode,Piece(x,'^',2),MakeReportTreeObject(x));
948 parentNode := currentNode;
949 end
950 else
951 begin
952 if addgtgrandchild = true then
953 currentNode := tvReports.Items.AddChildObject(gtGrandParentNode,Piece(x,'^',2),MakeReportTreeObject(x))
954 else
955 if addgrandchild = true then
956 currentNode := tvReports.Items.AddChildObject(grandParentNode,Piece(x,'^',2),MakeReportTreeObject(x))
957 else
958 currentNode := tvReports.Items.AddChildObject(parentNode,Piece(x,'^',2),MakeReportTreeObject(x));
959 end;
960 end;
961 if tvReports.Items.Count > 0 then begin
962 tvReports.Selected := tvReports.Items.GetFirstNode;
963 tvReportsClick(self);
964 end;
965end;
966
967{procedure TfrmLabs.lstReportsClick(Sender: TObject);
968begin
969 ExtlstReportsClick(Sender, false);
970end; }
971
972{procedure TfrmLabs.ExtlstReportsClick(Sender: TObject; Ext: boolean);
973var
974 i,iCat: integer;
975 Rpt: string;
976begin
977 inherited;
978 uRemoteCount := 0;
979 Timer1.Enabled := False;
980 Rpt := lstReports.Items[lstReports.ItemIndex];
981 uReportType := Piece(Rpt,'^',4);
982 uReportRPC := UpperCase(Piece(Rpt,'^',6));
983 if length(Piece(Rpt,'^',5)) > 0 then
984 iCat := StrToInt(Piece(Rpt,'^',5))
985 else
986 iCat := 0;
987 if uReportType = '' then uReportType := 'R';
988 StatusText('');
989 uLabLocalReportData.Clear;
990 uLabRemoteReportData.Clear;
991 lstHeaders.Clear;
992 TabControl1.Visible := false;
993 if Piece(Rpt,'^',3) = '1' then
994 if TabControl1.Tabs.Count > 1 then
995 TabControl1.Visible := true;
996 for i := 0 to RemoteSites.SiteList.Count - 1 do
997 TRemoteSite(RemoteSites.SiteList.Items[i]).LabClear;
998 if uFrozen = True then memo1.visible := False;
999 case lstReports.ItemIEN of
1000 1: begin // Most Recent
1001 CommonComponentVisible(false,false,false,false,false,true,true,false,true,false,false,false);
1002 pnlButtons.Visible := true;
1003 pnlWorksheet.Visible := false;
1004 pnlGraph.Visible := false;
1005 memLab.Align := alBottom;
1006 memLab.Height := pnlLeft.Height div 5;
1007 grdLab.Align := alClient;
1008 memLab.Clear;
1009 //if uReportType = 'H' then **Browser Remove**
1010 //begin
1011 //WebBrowser1.Navigate('about:blank');
1012 //WebBrowser1.Align := alBottom;
1013 //WebBrowser1.Height := pnlLeft.Height div 5;
1014 //WebBrowser1.Visible := true;
1015 //WebBrowser1.BringToFront;
1016 //memLab.Visible := false;
1017 //end
1018 //else
1019 //begin
1020 //WebBrowser1.Visible := false;
1021 //WebBrowser1.SendToBack;
1022 //memLab.Visible := true;
1023 //memLab.BringToFront;
1024 //end;
1025 FormResize(self);
1026 cmdRecentClick(self);
1027 uPrevReportIndex := lstReports.ItemIndex;
1028 end;
1029 4: begin // Interim for Selected Tests
1030 if uPrevReportIndex <> lstReports.ItemIndex then
1031 begin
1032 lstTests.Clear;
1033 lblSpecimen.Caption := '';
1034 end;
1035 if not Ext then SelectTests(Font.Size);
1036 if lstTests.Items.Count > 0 then
1037 begin
1038 CommonComponentVisible(false,false,true,true,true,false,false,false,true,false,false,false);
1039 memLab.Clear;
1040 chkBrowser;
1041 FormResize(self);
1042 RedrawActivate(memLab.Handle);
1043 lstDatesClick(self);
1044 //lstQualifierClick(self);
1045 if not Ext then cmdOtherTests.SetFocus;
1046 cmdOtherTests.Default := true;
1047 end
1048 else lstReports.ItemIndex := uPrevReportIndex;
1049 end;
1050 5: begin // Worksheet
1051 if uPrevReportIndex <> lstReports.ItemIndex then
1052 begin
1053 lstTests.Clear;
1054 lblSpecimen.Caption := '';
1055 end;
1056 if not Ext then SelectTestGroups(Font.Size);
1057 if lstTests.Items.Count > 0 then
1058 begin
1059 CommonComponentVisible(false,false,true,true,true,true,true,false,false,false,false,false);
1060 chtChart.Visible := true;
1061 memLab.Visible := false;
1062 pnlButtons.Visible := false;
1063 pnlWorksheet.Visible := true;
1064 pnlGraph.Visible := false;
1065 lstTestGraph.Width := 97;
1066 ragCorG.ItemIndex := 0;
1067 FormResize(self);
1068 lblFooter.Caption := ' KEY: "L" = Abnormal Low, "H" = Abnormal High, "*" = Critical Value, "**" = Comments on Specimen';
1069 //chkZoom.Checked := false;
1070 //chkZoomClick(self);
1071 //lstDatesClick(self);
1072 lstQualifierClick(self);
1073 if not Ext then cmdOtherTests.SetFocus;
1074 cmdOtherTests.Default := true;
1075 end
1076 else lstReports.ItemIndex := uPrevReportIndex;
1077 end;
1078 6: begin // Graph
1079 // do if graphing is activiated
1080 if uGraphingActivated then
1081 begin
1082 memLab.Clear;
1083 chkBrowser;
1084 FormResize(self);
1085 memLab.Align := alClient;
1086 CommonComponentVisible(false,false,false,false,false,false,false,false,false,false,false,false);
1087 RedrawActivate(memLab.Handle);
1088 StatusText('');
1089 memLab.Lines.Insert(0, ' ');
1090 memLab.Lines.Insert(1, 'Graphing activated');
1091 memLab.SelStart := 0;
1092 frmFrame.mnuToolsGraphingClick(self); // make it just lab tests ??
1093 //lstReports.ItemIndex := uPrevReportIndex;
1094 end
1095 else // otherwise, do lab graph
1096 begin
1097 if uPrevReportIndex <> lstReports.ItemIndex then
1098 begin
1099 lblSingleTest.Caption := '';
1100 lblSpecimen.Caption := '';
1101 end;
1102 if not Ext then SelectTest(Font.Size);
1103 if (length(lblSingleTest.Caption) > 2) and (length(lblSpecimen.Caption) > 2) then
1104 begin
1105 CommonComponentVisible(false,false,true,true,true,true,false,false,true,false,false,false);
1106 pnlChart.Visible := true;
1107 chtChart.Visible := true;
1108 pnlButtons.Visible := false;
1109 pnlWorksheet.Visible := false;
1110 pnlGraph.Visible := true;
1111 memLab.Height := pnlRight.Height div 5;
1112 memLab.Clear;
1113 //if uReportType = 'H' then **Browser Remove**
1114 //begin
1115 //WebBrowser1.Visible := true;
1116 //WebBrowser1.Navigate('about:blank');
1117 //WebBrowser1.Height := pnlRight.Height div 5;
1118 //WebBrowser1.BringToFront;
1119 //memLab.Visible := false;
1120 //end
1121 //else
1122 //begin
1123 //WebBrowser1.Visible := false;
1124 //WebBrowser1.SendToBack;
1125 //memLab.Visible := true;
1126 //memLab.BringToFront;
1127 //end;
1128 lstTestGraph.Items.Clear;
1129 lstTestGraph.Width := 0;
1130 FormResize(self);
1131 RedrawActivate(memLab.Handle);
1132 lblFooter.Caption := '';
1133 chkGraphZoom.Checked := false;
1134 chkGraphZoomClick(self);
1135 chkGraph3DClick(self);
1136 chkGraphValuesClick(self);
1137 //lstDatesClick(self);
1138 lstQualifierClick(self);
1139 if not Ext then cmdOtherTests.SetFocus;
1140 cmdOtherTests.Default := true;
1141 end
1142 else
1143 lstReports.ItemIndex := uPrevReportIndex;
1144 end;
1145 end
1146 else // case
1147 begin
1148 //added to deal with other reports from file 101.24
1149 memLab.Clear;
1150 chkBrowser;
1151 FormResize(self);
1152 memLab.Align := alClient;
1153 case iCat of
1154 //Categories of reports:
1155 //0:Fixed
1156 //1:Fixed w/Dates
1157 //2:Fixed w/Headers
1158 //3:Fixed w/Dates & Headers
1159 //4:Specialized
1160 //5:Graphic
1161
1162 0: begin
1163 CommonComponentVisible(false,false,false,false,false,false,false,false,false,false,false,false);
1164 StatusText('Retrieving data...');
1165 GoRemoteOld(uLabRemoteReportData,lstReports.ItemIEN,1,'',uReportRPC,'0','9999','1',0,0);
1166 TabControl1.OnChange(nil);
1167 Reports(uLabLocalReportData,Patient.DFN, Piece(Rpt,'^',1), '0', '9999', '1', 0, 0, uReportRPC);
1168 if TabControl1.TabIndex < 1 then
1169 QuickCopy(uLabLocalReportData,memLab);
1170 RedrawActivate(memLab.Handle);
1171 StatusText('');
1172 memLab.Lines.Insert(0,' ');
1173 memLab.Lines.Delete(0);
1174 memLab.SelStart := 0;
1175 if uReportType = 'R' then
1176 uHTMLDoc := HTML_PRE + uLabLocalReportData.Text + HTML_POST
1177 else
1178 uHTMLDoc := uHTMLPatient + uLabLocalReportData.Text;
1179 //if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank'); **Browser Remove**
1180 end;
1181 1: begin
1182 CommonComponentVisible(false,false,false,true,true,false,false,false,false,false,false,false);
1183 memLab.Repaint;
1184 //lstDatesClick(self);
1185 lstQualifierClick(self);
1186 end;
1187 2: begin
1188 CommonComponentVisible(true,true,false,false,false,false,false,false,false,false,false,false);
1189 lstHeaders.Clear;
1190 StatusText('Retrieving data...');
1191 GoRemoteOld(uLabRemoteReportData,lstReports.ItemIEN,1,'',uReportRPC,'0','9999','1',0,0);
1192 TabControl1.OnChange(nil);
1193 Reports(uLabLocalReportData,Patient.DFN, Piece(Rpt,'^',1), '0', '9999', '1', 0, 0, uReportRPC);
1194 if uLabLocalReportData.Count > 0 then
1195 begin
1196 TabControl1.OnChange(nil);
1197 if lstHeaders.Items.Count > 0 then lstHeaders.ItemIndex := 0;
1198 end;
1199 RedrawActivate(memLab.Handle);
1200 StatusText('');
1201 memLab.Lines.Insert(0,' ');
1202 memLab.Lines.Delete(0);
1203 if uReportType = 'R' then
1204 uHTMLDoc := HTML_PRE + uLabLocalReportData.Text + HTML_POST
1205 else
1206 uHTMLDoc := uHTMLPatient + uLabLocalReportData.Text;
1207 //if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank'); **Browser Remove**
1208 end;
1209 3: begin
1210 CommonComponentVisible(true,true,false,true,true,false,false,false,true,false,false,false);
1211 //lstDatesClick(self);
1212 lstQualifierClick(self);
1213 memLab.Lines.Insert(0,' ');
1214 memLab.Lines.Delete(0);
1215 end;
1216 end;
1217 end;
1218 end;
1219 uPrevReportIndex := lstReports.ItemIndex;
1220 DisplayHeading('');
1221end; }
1222
1223procedure TfrmLabs.lstHeadersClick(Sender: TObject);
1224var
1225 Current, Desired: integer;
1226begin
1227 inherited;
1228 if uFrozen = True then memo1.visible := False;
1229 Current := SendMessage(memLab.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
1230 Desired := lstHeaders.ItemIEN;
1231 SendMessage(memLab.Handle, EM_LINESCROLL, 0, Desired - Current - 1);
1232end;
1233
1234procedure TfrmLabs.lstQualifierClick(Sender: TObject);
1235 var
1236 MoreID: String; //Restores MaxOcc value
1237 aRemote, aHDR, aFHIE: string;
1238 i: integer;
1239 tmpList: TStringList;
1240 daysback: integer;
1241 date1, date2: TFMDateTime;
1242 today: TDateTime;
1243begin
1244 inherited;
1245 if uFrozen = True then
1246 begin
1247 memo1.visible := False;
1248 memo1.TabStop := False;
1249 end;
1250 if (lstDates.ItemID = 'S') then
1251 begin
1252 with calLabRange do
1253 begin
1254 if Execute then
1255 if Length(TextOfStart) > 0 then
1256 if Length(TextOfStop) > 0 then
1257 begin
1258 lstDates.ItemIndex := lstDates.Items.Add(RelativeStart + ';' +
1259 RelativeStop + U + TextOfStart + ' to ' + TextOfStop);
1260 DisplayHeading('');
1261 end
1262 else
1263 lstDates.ItemIndex := -1
1264 else
1265 lstDates.ItemIndex := -1
1266 else
1267 lstDates.ItemIndex := -1;
1268 end;
1269 end;
1270 today := FMToDateTime(floattostr(FMToday));
1271 if lstDates.ItemIEN > 0 then
1272 begin
1273 daysback := lstDates.ItemIEN;
1274 date1 := FMToday;
1275 If daysback = 1 then
1276 date2 := DateTimeToFMDateTime(today)
1277 Else
1278 date2 := DateTimeToFMDateTime(today - daysback);
1279 end
1280 else
1281 BeginEndDates(date1,date2,daysback);
1282 date1 := date1 + 0.2359;
1283 MoreID := ';' + Piece(uQualifier,';',3);
1284 if chkMaxFreq.checked = true then
1285 begin
1286 MoreID := '';
1287 SetPiece(uQualifier,';',3,'');
1288 end;
1289 aRemote := piece(uRemoteType,'^',1);
1290 aHDR := piece(uRemoteType,'^',7);
1291 aFHIE := piece(uRemoteType,'^',8);
1292 SetPiece(uRemoteType,'^',5,lstQualifier.ItemID);
1293 //tvProcedures.Items.Clear;
1294 //lblProcTypeMsg.Visible := FALSE;
1295 uHTMLDoc := '';
1296 {if uReportType = 'H' then **Browser Remove**
1297 begin
1298 WebBrowser1.Visible := true;
1299 WebBrowser1.TabStop := true;
1300 WebBrowser1.Navigate('about:blank');
1301 WebBrowser1.BringToFront;
1302 memLab.Visible := false;
1303 memLab.TabStop := false;
1304 end
1305 else
1306 begin
1307 WebBrowser1.Visible := false;
1308 WebBrowser1.TabStop := false; }
1309 memLab.Visible := true;
1310 memLab.TabStop := true;
1311 memLab.BringToFront;
1312 RedrawActivate(memLab.Handle);
1313 //end; }
1314 uLocalReportData.Clear;
1315 uRemoteReportData.Clear;
1316 for i := 0 to RemoteSites.SiteList.Count - 1 do
1317 TRemoteSite(RemoteSites.SiteList.Items[i]).ReportClear;
1318 uRemoteCount := 0;
1319 if aHDR = '1' then
1320 DisplayHeading(lstQualifier.ItemID)
1321 else
1322 DisplayHeading(lstQualifier.ItemID + MoreID);
1323 if lstQualifier.ItemID = 'ds' then
1324 begin
1325 with calLabRange do
1326 if Not (Execute) then
1327 begin
1328 lstQualifier.ItemIndex := -1;
1329 Exit;
1330 end
1331 else if (Length(TextOfStart) > 0) and (Length(TextOfStop) > 0) then
1332 begin
1333 if (Length(piece(uRemoteType,'^',6)) > 0) and (StrToInt(piece(uRemoteType,'^',6)) > 0) then
1334 if abs(FMDateTimeToDateTime(FMDateStart) - FMDateTimeToDateTime(FMDateStop)) > StrToInt(piece(uRemoteType,'^',6)) then
1335 begin
1336 InfoBox('The Date Range selected is greater than the' + CRLF + 'Maximum Days Allowed of ' + piece(uRemoteType,'^',6)
1337 + ' for this report.', 'No Report Generated',MB_OK);
1338 lstQualifier.ItemIndex := -1;
1339 exit;
1340 end;
1341 lstQualifier.ItemIndex := lstQualifier.Items.Add(RelativeStart +
1342 ';' + RelativeStop + U + TextOfStart + ' to ' + TextOfStop);
1343 DisplayHeading(lstQualifier.ItemID + MoreID);
1344 SetPiece(uRemoteType,'^',5,lstQualifier.ItemID);
1345 end
1346 else
1347 begin
1348 lstQualifier.ItemIndex := -1;
1349 InfoBox('Invalid Date Range entered. Please try again','Invalid Date/time entry',MB_OK);
1350 if (Execute) and (Length(TextOfStart) > 0) and (Length(TextOfStop) > 0) then
1351 begin
1352 lstQualifier.ItemIndex := lstQualifier.Items.Add(RelativeStart +
1353 ';' + RelativeStop + U + TextOfStart + ' to ' + TextOfStop);
1354 DisplayHeading(lstQualifier.ItemID + MoreID);
1355 SetPiece(uRemoteType,'^',5,lstQualifier.ItemID);
1356 end
1357 else
1358 begin
1359 lstQualifier.ItemIndex := -1;
1360 InfoBox('No Report Generated!','Invalid Date/time entry',MB_OK);
1361 exit;
1362 end;
1363 end;
1364 end;
1365 if (CharAt(lstQualifier.ItemID,1) = 'd') and (Length(piece(uRemoteType,'^',6)) > 0) and (StrToInt(piece(uRemoteType,'^',6)) > 0) then
1366 if ExtractInteger(lstQualifier.ItemID) > (StrToInt(piece(uRemoteType,'^',6))) then
1367 begin
1368 InfoBox('The Date Range selected is greater than the' + CRLF + 'Maximum Days Allowed of ' + piece(uRemoteType,'^',6)
1369 + ' for this report.', 'No Report Generated',MB_OK);
1370 lstQualifier.ItemIndex := -1;
1371 exit;
1372 end;
1373 Screen.Cursor := crHourGlass;
1374 uReportInstruction := #13#10 + 'Retrieving data...';
1375 memLab.Lines.Add(uReportInstruction);
1376 {if WebBrowser1.Visible = true then **Browser Remove**
1377 begin
1378 uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST;
1379 WebBrowser1.Navigate('about:blank');
1380 end; }
1381 case uQualifierType of
1382 QT_HSCOMPONENT:
1383 begin // = 5
1384 lvReports.SmallImages := uEmptyImageList;
1385 lvReports.Items.Clear;
1386 memLab.Lines.Clear;
1387 RowObjects.Clear;
1388 if ((aRemote = '1') or (aRemote = '2')) then
1389 GoRemote(uRemoteReportData, 'L:' + uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR, aFHIE);
1390 if not(piece(uRemoteType, '^', 9) = '1') then
1391 if (length(piece(uHState,';',2)) > 0) then
1392 begin
1393 if not(aRemote = '2') then
1394 LoadReportText(uLocalReportData, 'L:' + uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
1395 LoadListView(uLocalReportData);
1396 end
1397 else
1398 begin
1399 if ((aRemote = '1') or (aRemote = '2')) then
1400 ShowTabControl;
1401 LoadReportText(uLocalReportData, 'L:' + uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
1402 if uLocalReportData.Count < 1 then
1403 begin
1404 uReportInstruction := '<No Report Available>';
1405 memLab.Lines.Add(uReportInstruction);
1406 end
1407 else
1408 begin
1409 QuickCopy(uLocalReportData,memLab);
1410 TabControl1.OnChange(nil);
1411 end;
1412 end;
1413 end;
1414 QT_HSWPCOMPONENT:
1415 begin // = 6
1416 lvReports.SmallImages := uEmptyImageList;
1417 lvReports.Items.Clear;
1418 RowObjects.Clear;
1419 memLab.Lines.Clear;
1420 if ((aRemote = '1') or (aRemote = '2')) then
1421 begin
1422 Screen.Cursor := crDefault;
1423 GoRemote(uRemoteReportData, 'L:' + uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR, aFHIE);
1424 end;
1425 if not(piece(uRemoteType, '^', 9) = '1') then
1426 if (length(piece(uHState,';',2)) > 0) then
1427 begin
1428 if not(aRemote = '2') then
1429 LoadReportText(uLocalReportData, 'L:' + uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
1430 LoadListView(uLocalReportData);
1431 end
1432 else
1433 begin
1434 {if ((aRemote = '1') or (aRemote = '2')) then
1435 ShowTabControl;}
1436 if not (aRemote = '2') then
1437 begin
1438 LoadReportText(uLocalReportData, 'L:' + uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
1439 if uLocalReportData.Count < 1 then
1440 begin
1441 uReportInstruction := '<No Report Available>';
1442 memLab.Lines.Add(uReportInstruction);
1443 end
1444 else
1445 QuickCopy(uLocalReportData,memLab);
1446 end;
1447 end;
1448 end
1449 else
1450 begin
1451 Screen.Cursor := crDefault;
1452 //GoRemote(uRemoteReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR, aFHIE);
1453//**************************************************************************
1454case StrToInt(Piece(uRptID,':',1)) of
1455 21: begin // Cumulative
1456 lstHeaders.Clear;
1457 memLab.Clear;
1458 uLabLocalReportData.Clear;
1459 uLabRemoteReportData.Clear;
1460 StatusText('Retrieving data for cumulative report...');
1461 GoRemoteOld(uLabRemoteReportData,0,2,'',uReportRPC,'',IntToStr(daysback),'',date1,date2);
1462 TabControl1.OnChange(nil);
1463 Cumulative(uLabLocalReportData, Patient.DFN, daysback, date1, date2, uReportRPC);
1464 if uLabLocalReportData.Count > 0 then
1465 begin
1466 TabControl1.OnChange(nil);
1467 if lstHeaders.Items.Count > 0 then lstHeaders.ItemIndex := 0;
1468 end;
1469 memLab.Lines.Insert(0,' ');
1470 memLab.Lines.Delete(0);
1471 end;
1472 3: begin // Interim
1473 memLab.Clear;
1474 uLabLocalReportData.Clear;
1475 uLabRemoteReportData.Clear;
1476 StatusText('Retrieving data for interim report...');
1477 GoRemoteOld(uLabRemoteReportData,0,3,'',uReportRPC,'','','',date1,date2);
1478 TabControl1.OnChange(nil);
1479 Interim(uLabLocalReportData, Patient.DFN, date1, date2, uReportRPC);
1480 if uLabLocalReportData.Count < 1 then
1481 uLabLocalReportData.Add('<No results for this date range.>');
1482 if TabControl1.TabIndex < 1 then
1483 QuickCopy(uLabLocalReportData,memLab);
1484 memLab.Lines.Insert(0,' ');
1485 memLab.Lines.Delete(0);
1486 memLab.SelStart := 0;
1487 end;
1488 4: begin // Interim for Selected Tests
1489 memLab.Clear;
1490 uLabLocalReportData.Clear;
1491 uLabRemoteReportData.Clear;
1492 try
1493 StatusText('Retrieving data for selected tests...');
1494 FastAssign(InterimSelect(Patient.DFN, date1, date2, lstTests.Items), uLabLocalReportData);
1495 if uLabLocalReportData.Count > 0 then
1496 QuickCopy(uLabLocalReportData,memLab)
1497 else
1498 memLab.Lines.Add('<No results for selected tests in this date range.>');
1499 memLab.SelStart := 0;
1500 finally
1501 //tmpList.Free;
1502 end;
1503 end;
1504 5: begin // Worksheet
1505 chtChart.BottomAxis.Automatic := true;
1506 chkZoom.Checked := false;
1507 //chkZoomClick(self);
1508 chkAbnormals.Checked := false;
1509 memLab.Clear;
1510 uLabLocalReportData.Clear;
1511 uLabRemoteReportData.Clear;
1512 grdLab.Align := alClient;
1513 StatusText('Retrieving data for worksheet...');
1514 FastAssign(Worksheet(Patient.DFN, date1, date2,
1515 Piece(lblSpecimen.Caption, '^', 1), lstTests.Items), tmpGrid);
1516 if ragHorV.ItemIndex = 0 then
1517 HGrid(tmpGrid)
1518 else
1519 VGrid(tmpGrid);
1520 GraphList(tmpGrid);
1521 GridComments(tmpGrid);
1522 ragCorGClick(self);
1523 end;
1524 6: begin // Graph
1525 if not uGraphingActivated then
1526 begin
1527 chtChart.BottomAxis.Automatic := true;
1528 chkGraphZoom.Checked := false;
1529 chkGraphZoomClick(self);
1530 memLab.Clear;
1531 uLabLocalReportData.Clear;
1532 uLabRemoteReportData.Clear;
1533 tmpList := TStringList.Create;
1534 try
1535 StatusText('Retrieving data for graph...');
1536 FastAssign(GetChart(Patient.DFN, date1, date2,
1537 Piece(lblSpecimen.Caption, '^', 1),
1538 Piece(lblSingleTest.Caption, '^', 1)), tmpList);
1539 if tmpList.Count > 1 then
1540 begin
1541 chtChart.Visible := true;
1542 GraphChart(lblSingleTest.Caption, tmpList);
1543 chtChart.ZoomPercent(ZOOM_PERCENT);
1544 for i := strtoint(Piece(tmpList[0], '^', 1)) + 1 to tmpList.Count - 1
1545 do memLab.Lines.Add(tmpList[i]);
1546 if memLab.Lines.Count < 2 then
1547 memLab.Lines.Add('<No comments on specimens.>');
1548 memLab.SelStart := 0;
1549 lblGraph.Visible := false;
1550 end
1551 else
1552 begin
1553 lblGraph.Left := chtChart.Left + ((chtChart.Width - lblGraph.Width) div 2);
1554 lblGraph.Top := 2;
1555 lblGraph.Visible := true;
1556 if Piece(lblSpecimen.Caption, '^', 1) = '0' then
1557 pnlChart.Caption := '<No results can be graphed for ' +
1558 Piece(lblSingleTest.Caption, '^', 2) + ' in this date range.> '
1559 + 'Results may be available, but cannot be graphed. Please try an alternate view.'
1560 else
1561 pnlChart.Caption := '<No results can be graphed for ' +
1562 Piece(lblSingleTest.Caption, '^', 2)
1563 + ' (' + Piece(lblSpecimen.Caption, '^', 2) +
1564 ') in this date range.> '
1565 + 'Results may be available, but cannot be graphed. Please try an alternate view.';
1566 chtChart.Visible := false;
1567 end;
1568 finally
1569 tmpList.Free;
1570 end;
1571 end;
1572 end;
1573 9: begin // Micro
1574 memLab.Clear;
1575 uLabLocalReportData.Clear;
1576 uLabRemoteReportData.Clear;
1577 StatusText('Retrieving microbiology data...');
1578 GoRemoteOld(uLabRemoteReportData,0,4,'',uReportRPC,'','','',date1,date2);
1579 TabControl1.OnChange(nil);
1580 Micro(uLabLocalReportData, Patient.DFN, date1, date2, uReportRPC);
1581 if uLabLocalReportData.Count < 1 then
1582 uLabLocalReportData.Add('<No microbiology results for this date range.>');
1583 if TabControl1.TabIndex < 1 then
1584 QuickCopy(uLabLocalReportData,memLab);
1585 memLab.Lines.Insert(0,' ');
1586 memLab.Lines.Delete(0);
1587 memLab.SelStart := 0;
1588 end;
1589 10: begin // Lab Status
1590 memLab.Clear;
1591 uLabLocalReportData.Clear;
1592 uLabRemoteReportData.Clear;
1593 StatusText('Retrieving lab status data...');
1594 GoRemoteOld(uLabRemoteReportData,9,1,'',uReportRPC,'',IntToStr(daysback),'',date1,date2);
1595 TabControl1.OnChange(nil);
1596 Reports(uLabLocalReportData,Patient.DFN, 'L:' + '9', '', IntToStr(daysback),'',
1597 date1, date2, uReportRPC);
1598 if uLabLocalReportData.Count < 1 then
1599 uLabLocalReportData.Add('<No laboratory orders for this date range.>');
1600 if TabControl1.TabIndex < 1 then
1601 QuickCopy(uLabLocalReportData,memLab);
1602 memLab.Lines.Insert(0,' ');
1603 memLab.Lines.Delete(0);
1604 memLab.SelStart := 0;
1605 end;
1606 else begin //Anything Else
1607 lstHeaders.Clear;
1608 memLab.Clear;
1609 uLabLocalReportData.Clear;
1610 uLabRemoteReportData.Clear;
1611 StatusText('Retrieving lab data...');
1612 GoRemoteOld(uLabRemoteReportData, 1, 1, '', uReportRPC, '', IntToStr(daysback), '', date1, date2);
1613 //GoRemoteOld(uLabRemoteReportData, StrToInt(Piece(uRptID,'^',1)), 1, '', uReportRPC, '', IntToStr(daysback), '', date1, date2);
1614 TabControl1.OnChange(nil);
1615 Reports(uLabLocalReportData,Patient.DFN, 'L:' + Piece(uRptID,'^',1), '',
1616 IntToStr(daysback), '', date1, date2, uReportRPC);
1617 if uLabLocalReportData.Count < 1 then
1618 uLabLocalReportData.Add('<No data for this date range.>');
1619 if TabControl1.TabIndex < 1 then
1620 QuickCopy(uLabLocalReportData,memLab);
1621 memLab.Lines.Insert(0,' ');
1622 memLab.Lines.Delete(0);
1623 memLab.SelStart := 0;
1624 end;
1625 end;
1626//**************************************************************************
1627 {LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
1628 if TabControl1.TabIndex < 1 then
1629 QuickCopy(uLocalReportData,memLab); }
1630 end;
1631 end;
1632 Screen.Cursor := crDefault;
1633 StatusText('');
1634 memLab.Lines.Insert(0,' ');
1635 memLab.Lines.Delete(0);
1636 {if WebBrowser1.Visible = true then **Browser Remove**
1637 begin
1638 if uReportType = 'R' then
1639 uHTMLDoc := HTML_PRE + uLocalReportData.Text + HTML_POST
1640 else
1641 uHTMLDoc := uHTMLPatient + uLocalReportData.Text;
1642 WebBrowser1.Navigate('about:blank');
1643 end; }
1644end;
1645
1646procedure TfrmLabs.lblDateEnter(Sender: TObject);
1647begin
1648 inherited;
1649 amgrMain.AccessText[lblDate] := 'Date Collected '+lblDate.Caption;
1650end;
1651
1652procedure TfrmLabs.lstDatesClick(Sender: TObject);
1653var
1654 tmpList: TStringList;
1655 daysback: integer;
1656 date1, date2: TFMDateTime;
1657 today: TDateTime;
1658 i: integer;
1659 x,x1,x2,aID: string;
1660begin
1661 inherited;
1662 uRemoteCount := 0;
1663 if uFrozen = True then memo1.visible := False;
1664 Screen.Cursor := crHourGlass;
1665 DisplayHeading('');
1666 uHTMLDoc := '';
1667 //Rpt := lstReports.Items[lstReports.ItemIndex];
1668 //uReportRPC := UpperCase(Piece(Rpt,'^',6));
1669 chkBrowser;
1670 if (lstDates.ItemID = 'S') then
1671 begin
1672 with calLabRange do
1673 begin
1674 if Execute then
1675 if Length(TextOfStart) > 0 then
1676 if Length(TextOfStop) > 0 then
1677 begin
1678 lstDates.ItemIndex := lstDates.Items.Add(RelativeStart + ';' +
1679 RelativeStop + U + TextOfStart + ' to ' + TextOfStop);
1680 DisplayHeading('');
1681 end
1682 else
1683 lstDates.ItemIndex := -1
1684 else
1685 lstDates.ItemIndex := -1
1686 else
1687 lstDates.ItemIndex := -1;
1688 end;
1689 end;
1690 today := FMToDateTime(floattostr(FMToday));
1691 if lstDates.ItemIEN > 0 then
1692 begin
1693 daysback := lstDates.ItemIEN;
1694 date1 := FMToday;
1695 If daysback = 1 then
1696 date2 := DateTimeToFMDateTime(today)
1697 Else
1698 date2 := DateTimeToFMDateTime(today - daysback);
1699 end
1700 else
1701 BeginEndDates(date1,date2,daysback);
1702 date1 := date1 + 0.2359;
1703 uHTMLDoc := '';
1704 //WebBrowser1.Navigate('about:blank'); **Browser Remove**
1705 aID := piece(uRptID,':',1);
1706 if aID = '21' then
1707 begin // Cumulative
1708 lstHeaders.Clear;
1709 memLab.Clear;
1710 uLabLocalReportData.Clear;
1711 uLabRemoteReportData.Clear;
1712 StatusText('Retrieving data for cumulative report...');
1713 GoRemoteOld(uLabRemoteReportData,0,2,'',uReportRPC,'',IntToStr(daysback),'',date1,date2);
1714 TabControl1.OnChange(nil);
1715 Cumulative(uLabLocalReportData, Patient.DFN, daysback, date1, date2, uReportRPC);
1716 if uLabLocalReportData.Count > 0 then
1717 begin
1718 TabControl1.OnChange(nil);
1719 if lstHeaders.Items.Count > 0 then lstHeaders.ItemIndex := 0;
1720 end;
1721 memLab.Lines.Insert(0,' ');
1722 memLab.Lines.Delete(0);
1723 end
1724 else if aID = '3' then
1725 begin // Interim
1726 memLab.Clear;
1727 uLabLocalReportData.Clear;
1728 uLabRemoteReportData.Clear;
1729 StatusText('Retrieving data for interim report...');
1730 GoRemoteOld(uLabRemoteReportData,0,3,'',uReportRPC,'','','',date1,date2);
1731 TabControl1.OnChange(nil);
1732 Interim(uLabLocalReportData, Patient.DFN, date1, date2, uReportRPC);
1733 if uLabLocalReportData.Count < 1 then
1734 uLabLocalReportData.Add('<No results for this date range.>');
1735 if TabControl1.TabIndex < 1 then
1736 QuickCopy(uLabLocalReportData,memLab);
1737 memLab.Lines.Insert(0,' ');
1738 memLab.Lines.Delete(0);
1739 memLab.SelStart := 0;
1740 end
1741 else if aID = '4' then
1742 begin // Interim for Selected Tests
1743 memLab.Clear;
1744 uLabLocalReportData.Clear;
1745 uLabRemoteReportData.Clear;
1746 try
1747 StatusText('Retrieving data for selected tests...');
1748 FastAssign(InterimSelect(Patient.DFN, date1, date2, lstTests.Items), uLabLocalReportData);
1749 if uLabLocalReportData.Count > 0 then
1750 QuickCopy(uLabLocalReportData,memLab)
1751 else
1752 memLab.Lines.Add('<No results for selected tests in this date range.>');
1753 memLab.SelStart := 0;
1754 finally
1755 //tmpList.Free;
1756 end;
1757 end
1758 else if aID = '5' then
1759 begin // Worksheet
1760 chtChart.BottomAxis.Automatic := true;
1761 chkZoom.Checked := false;
1762 //chkZoomClick(self);
1763 chkAbnormals.Checked := false;
1764 memLab.Clear;
1765 uLabLocalReportData.Clear;
1766 uLabRemoteReportData.Clear;
1767 grdLab.Align := alClient;
1768 StatusText('Retrieving data for worksheet...');
1769 FastAssign(Worksheet(Patient.DFN, date1, date2,
1770 Piece(lblSpecimen.Caption, '^', 1), lstTests.Items), tmpGrid);
1771 if ragHorV.ItemIndex = 0 then
1772 HGrid(tmpGrid)
1773 else
1774 VGrid(tmpGrid);
1775 GraphList(tmpGrid);
1776 GridComments(tmpGrid);
1777 ragCorGClick(self);
1778 end
1779 else if aID = '6' then
1780 begin // Graph
1781 if not uGraphingActivated then
1782 begin
1783 chtChart.BottomAxis.Automatic := true;
1784 chkGraphZoom.Checked := false;
1785 chkGraphZoomClick(self);
1786 memLab.Clear;
1787 uLabLocalReportData.Clear;
1788 uLabRemoteReportData.Clear;
1789 tmpList := TStringList.Create;
1790 try
1791 StatusText('Retrieving data for graph...');
1792 FastAssign(GetChart(Patient.DFN, date1, date2,
1793 Piece(lblSpecimen.Caption, '^', 1),
1794 Piece(lblSingleTest.Caption, '^', 1)), tmpList);
1795 if tmpList.Count > 1 then
1796 begin
1797 chtChart.Visible := true;
1798 GraphChart(lblSingleTest.Caption, tmpList);
1799 chtChart.ZoomPercent(ZOOM_PERCENT);
1800 for i := strtoint(Piece(tmpList[0], '^', 1)) + 1 to tmpList.Count - 1
1801 do memLab.Lines.Add(tmpList[i]);
1802 if memLab.Lines.Count < 2 then
1803 memLab.Lines.Add('<No comments on specimens.>');
1804 memLab.SelStart := 0;
1805 lblGraph.Visible := false;
1806 end
1807 else
1808 begin
1809 lblGraph.Left := chtChart.Left + ((chtChart.Width - lblGraph.Width) div 2);
1810 lblGraph.Top := 2;
1811 lblGraph.Visible := true;
1812 if Piece(lblSpecimen.Caption, '^', 1) = '0' then
1813 pnlChart.Caption := '<No results can be graphed for ' +
1814 Piece(lblSingleTest.Caption, '^', 2) + ' in this date range.> '
1815 + 'Results may be available, but cannot be graphed. Please try an alternate view.'
1816 else
1817 pnlChart.Caption := '<No results can be graphed for ' +
1818 Piece(lblSingleTest.Caption, '^', 2)
1819 + ' (' + Piece(lblSpecimen.Caption, '^', 2) +
1820 ') in this date range.> '
1821 + 'Results may be available, but cannot be graphed. Please try an alternate view.';
1822 chtChart.Visible := false;
1823 end;
1824 finally
1825 tmpList.Free;
1826 end;
1827 end;
1828 end
1829 else if aID = '9' then
1830 begin // Micro
1831 memLab.Clear;
1832 uLabLocalReportData.Clear;
1833 uLabRemoteReportData.Clear;
1834 StatusText('Retrieving microbiology data...');
1835 GoRemoteOld(uLabRemoteReportData,0,4,'',uReportRPC,'','','',date1,date2);
1836 TabControl1.OnChange(nil);
1837 Micro(uLabLocalReportData, Patient.DFN, date1, date2, uReportRPC);
1838 if uLabLocalReportData.Count < 1 then
1839 uLabLocalReportData.Add('<No microbiology results for this date range.>');
1840 if TabControl1.TabIndex < 1 then
1841 QuickCopy(uLabLocalReportData,memLab);
1842 memLab.Lines.Insert(0,' ');
1843 memLab.Lines.Delete(0);
1844 memLab.SelStart := 0;
1845 end
1846 else if aID = '10' then
1847 begin // Lab Status
1848 memLab.Clear;
1849 uLabLocalReportData.Clear;
1850 uLabRemoteReportData.Clear;
1851 StatusText('Retrieving lab status data...');
1852 GoRemoteOld(uLabRemoteReportData,10,1,'',uReportRPC,'',IntToStr(daysback),'',date1,date2);
1853 TabControl1.OnChange(nil);
1854 Reports(uLabLocalReportData,Patient.DFN, 'L:10', '', IntToStr(daysback),'',
1855 date1, date2, uReportRPC);
1856 if uLabLocalReportData.Count < 1 then
1857 uLabLocalReportData.Add('<No laboratory orders for this date range.>');
1858 if TabControl1.TabIndex < 1 then
1859 QuickCopy(uLabLocalReportData,memLab);
1860 memLab.Lines.Insert(0,' ');
1861 memLab.Lines.Delete(0);
1862 memLab.SelStart := 0;
1863 end
1864 else begin //Anything Else
1865 lstHeaders.Clear;
1866 memLab.Clear;
1867 uLabLocalReportData.Clear;
1868 uLabRemoteReportData.Clear;
1869 StatusText('Retrieving lab data...');
1870 //GoRemoteOld(uLabRemoteReportData, StrToInt(Piece(uRptID,'^',1)), 1, '', uReportRPC, '', IntToStr(daysback), '', date1, date2);
1871 GoRemoteOld(uLabRemoteReportData, 1, 1, '', uReportRPC, '', IntToStr(daysback), '', date1, date2);
1872 TabControl1.OnChange(nil);
1873 Reports(uLabLocalReportData,Patient.DFN, 'L:' + Piece(uRptID,'^',1), '',
1874 IntToStr(daysback), '', date1, date2, uReportRPC);
1875 if uLabLocalReportData.Count < 1 then
1876 uLabLocalReportData.Add('<No data for this date range.>');
1877 if TabControl1.TabIndex < 1 then
1878 QuickCopy(uLabLocalReportData,memLab);
1879 memLab.Lines.Insert(0,' ');
1880 memLab.Lines.Delete(0);
1881 memLab.SelStart := 0;
1882 end;
1883 if uReportType = 'R' then
1884 uHTMLDoc := HTML_PRE + uLabLocalReportData.Text + HTML_POST
1885 else
1886 uHTMLDoc := uHTMLPatient + uLabLocalReportData.Text;
1887 Screen.Cursor := crDefault;
1888 x := lstDates.DisplayText[lstDates.ItemIndex];
1889 x1 := piece(x,' ',1);
1890 x2 := piece(x,' ',2);
1891 if not(uRptID = '1:MOST RECENT') and (Uppercase(Copy(x1,1,1)) = 'T') and (Uppercase(Copy(x2,1,1)) = 'T') then
1892 DisplayHeading(piece(x,' ',1) + ';' + piece(x,' ',2))
1893 else
1894 DisplayHeading('d' + lstDates.ItemID);
1895 StatusText('');
1896end;
1897
1898procedure TfrmLabs.cmdOtherTestsClick(Sender: TObject);
1899begin
1900 inherited;
1901 tvReportsClick(self);
1902end;
1903
1904procedure TfrmLabs.GraphList(griddata: TStrings);
1905var
1906 i, j: integer;
1907 ok: boolean;
1908 testname, testnum, testnum1, line: string;
1909begin
1910 lstTestGraph.Clear;
1911 for i := 0 to lstTests.Items.Count - 1 do
1912 begin
1913 testnum := Piece(lstTests.Items[i], '^', 1);
1914 testname := Piece(lstTests.Items[i], '^', 2);
1915 ok := false;
1916 for j := strtoint(Piece(griddata[0], '^', 4)) + 1 to strtointdef(Piece(griddata[0], '^', 5), 0) do
1917 begin
1918 testnum1 := Piece(griddata[j - 1], '^', 1);
1919 if testnum1 = testnum then
1920 begin
1921 ok := true;
1922 line := testnum + '^' + testname + ' (' + MixedCase(Piece(griddata[j - 1], '^', 2)) + ')^';
1923 line := line + Pieces(griddata[j - 1], '^', 3, 6);
1924 lstTestGraph.Items.Add(line);
1925 end;
1926 end;
1927 if not ok then lstTestGraph.Items.Add(lstTests.Items[i]);
1928 end;
1929end;
1930
1931procedure TfrmLabs.HGrid(griddata: TStrings);
1932var
1933 testcnt, datecnt, datacnt, linecnt, offset, x, y, i: integer;
1934 DisplayDateTime: string;
1935begin
1936 offset := 0;
1937 testcnt := strtoint(Piece(griddata[offset], '^', 1));
1938 datecnt := strtoint(Piece(griddata[offset], '^', 2));
1939 datacnt := strtoint(Piece(griddata[offset], '^', 3));
1940 linecnt := testcnt + datecnt + datacnt;
1941 if chkAbnormals.Checked and (linecnt > 0) then
1942 begin
1943 offset := linecnt + 1;
1944 testcnt := strtoint(Piece(griddata[offset], '^', 1));
1945 datecnt := strtoint(Piece(griddata[offset], '^', 2));
1946 datacnt := strtoint(Piece(griddata[offset], '^', 3));
1947 linecnt := testcnt + datecnt + datacnt;
1948 end;
1949 with grdLab do
1950 begin
1951 if testcnt = 0 then ColCount := 3 else ColCount := testcnt + 2;
1952 if datecnt = 0 then RowCount := 2 else RowCount := datecnt + 1;
1953 DefaultColWidth := ResizeWidth( BaseFont, MainFont, 60);
1954 ColWidths[0] := ResizeWidth( BaseFont, MainFont, 80);
1955 FixedCols := 2;
1956 FixedRows := 1;
1957 for y := 0 to RowCount - 1 do
1958 for x := 0 to ColCount - 1 do
1959 Cells[x, y] := '';
1960 Cells[0, 0] := 'Date/Time';
1961 Cells[1, 0] := 'Specimen';
1962 for i := 1 to testcnt do
1963 begin
1964 Cells[i + 1, 0] := Piece(griddata[i + offset], '^', 3);
1965 end;
1966 if datecnt = 0 then
1967 begin
1968 Cells[0, 1] := 'no results';
1969 for x := 1 to ColCount - 1 do
1970 Cells[x, 1] := '';
1971 end;
1972 for i := testcnt + 1 to testcnt + datecnt do
1973 begin
1974 //------------------------------------------------------------------------------------------
1975 //v27.2 - RV - PSI-05-118 / Remedy HD0000000123277 - don't show "00:00" if no time present
1976 if LabPatchInstalled then // Requires lab patch in const "PSI_05_118"
1977 begin
1978 DisplayDateTime := Piece(griddata[i + offset], '^', 2);
1979 if length(DisplayDateTime) > 7 then
1980 Cells[0, i - testcnt] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(DisplayDateTime))
1981 else if length(DisplayDateTime) > 0 then
1982 Cells[0, i - testcnt] := FormatFMDateTime('mm/dd/yy',MakeFMDateTime(DisplayDateTime))
1983 else
1984 Cells[0, i - testcnt] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(Piece(griddata[i + offset], '^', 2)));
1985 end
1986 else // If no lab patch in const "PSI_05_118", continue as is
1987 begin
1988 Cells[0, i - testcnt] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(Piece(griddata[i + offset], '^', 2)));
1989 end;
1990 //------------------------------------------------------------------------------------------
1991 Cells[1, i - testcnt] := MixedCase(Piece(griddata[i + offset], '^', 4)) + ' ' + Piece(griddata[i + offset], '^', 5);
1992 end;
1993 for i := testcnt + datecnt + 1 to linecnt do
1994 begin
1995 y := strtoint(Piece(griddata[i + offset], '^', 1));
1996 x := strtoint(Piece(griddata[i + offset], '^', 2)) + 1;
1997 Cells[x, y] := Piece(griddata[i + offset], '^', 3) + ' ' + Piece(griddata[i + offset], '^', 4);
1998 end;
1999 end;
2000end;
2001
2002procedure TfrmLabs.VGrid(griddata: TStrings);
2003var
2004 testcnt, datecnt, datacnt, linecnt, offset, x, y, i: integer;
2005 DisplayDateTime: string;
2006begin
2007 offset := 0;
2008 testcnt := strtoint(Piece(griddata[offset], '^', 1));
2009 datecnt := strtoint(Piece(griddata[offset], '^', 2));
2010 datacnt := strtoint(Piece(griddata[offset], '^', 3));
2011 linecnt := testcnt + datecnt + datacnt;
2012 if chkAbnormals.Checked and (linecnt > 0) then
2013 begin
2014 offset := linecnt + 1;
2015 testcnt := strtoint(Piece(griddata[offset], '^', 1));
2016 datecnt := strtoint(Piece(griddata[offset], '^', 2));
2017 datacnt := strtoint(Piece(griddata[offset], '^', 3));
2018 linecnt := testcnt + datecnt + datacnt;
2019 end;
2020 with grdLab do
2021 begin
2022 if datecnt = 0 then ColCount := 2 else ColCount := datecnt + 1;
2023 if testcnt = 0 then RowCount := 3 else RowCount := testcnt + 2;
2024 DefaultColWidth := ResizeWidth( BaseFont, MainFont, 80);
2025 ColWidths[0] := ResizeWidth( BaseFont, MainFont, 60);
2026 FixedCols := 1;
2027 FixedRows := 2;
2028 for y := 0 to RowCount - 1 do
2029 for x := 0 to ColCount - 1 do
2030 Cells[x, y] := '';
2031 Cells[0, 0] := 'Date/Time';
2032 Cells[0, 1] := 'Specimen';
2033 for i := 1 to testcnt do
2034 begin
2035 Cells[0, i + 1] := Piece(griddata[i + offset], '^', 3);
2036 end;
2037 if datecnt = 0 then
2038 begin
2039 Cells[1, 0] := 'no results';
2040 for x := 1 to RowCount - 1 do
2041 Cells[x, 1] := '';
2042 end;
2043 for i := testcnt + 1 to testcnt + datecnt do
2044 begin
2045 //------------------------------------------------------------------------------------------
2046 if LabPatchInstalled then // Requires lab patch in const "PSI_05_118"
2047 begin
2048 DisplayDateTime := Piece(griddata[i + offset], '^', 2);
2049 if length(DisplayDateTime) > 7 then
2050 Cells[i - testcnt, 0] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(DisplayDateTime))
2051 else if length(DisplayDateTime) > 0 then
2052 Cells[i - testcnt, 0] := FormatFMDateTime('mm/dd/yy',MakeFMDateTime(DisplayDateTime))
2053 else
2054 Cells[i - testcnt, 0] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(Piece(griddata[i + offset], '^', 2)));
2055 end
2056 else // If no lab patch in const "PSI_05_118", continue as is
2057 begin
2058 Cells[i - testcnt, 0] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(Piece(griddata[i + offset], '^', 2)));
2059 end;
2060 //------------------------------------------------------------------------------------------
2061 Cells[i - testcnt, 1] := MixedCase(Piece(griddata[i + offset], '^', 4));
2062 end;
2063 for i := testcnt + datecnt + 1 to linecnt do
2064 begin
2065 x := strtoint(Piece(griddata[i + offset], '^', 1));
2066 y := strtoint(Piece(griddata[i + offset], '^', 2)) + 1;
2067 Cells[x, y] := Piece(griddata[i + offset], '^', 3) + ' ' + Piece(griddata[i + offset], '^', 4);
2068 end;
2069 end;
2070end;
2071
2072procedure TfrmLabs.GridComments(aitems: TStrings);
2073var
2074 i, start: integer;
2075begin
2076 start := strtointdef(Piece(aitems[0], '^', 5), 1);
2077 memLab.Clear;
2078 uLabLocalReportData.Clear;
2079 uLabRemoteReportData.Clear;
2080 for i := start to aitems.Count - 1 do
2081 memLab.Lines.Add(aitems[i]);
2082 if (memLab.Lines.Count = 0) and (aitems.Count > 1) then
2083 memLab.Lines.Add('<No comments on specimens.>');
2084 memLab.SelStart := 0;
2085end;
2086
2087procedure TfrmLabs.FormDestroy(Sender: TObject);
2088var
2089 i: integer;
2090 aColChange: string;
2091begin
2092 inherited;
2093 if length(uColChange) > 0 then
2094 begin
2095 aColChange := '';
2096 for i := 0 to lvReports.Columns.Count - 1 do
2097 aColChange := aColChange + IntToStr(lvReports.Column[i].width) + ',';
2098 if (Length(aColChange) > 0) and (aColChange <> piece(uColchange,'^',2)) then
2099 SaveColumnSizes(piece(uColChange,'^',1) + '^' + aColChange);
2100 uColChange := '';
2101 end;
2102 RemoteQueryAbortAll;
2103 tmpGrid.free;
2104 uLabLocalReportData.Free;
2105 uLabRemoteReportData.Free;
2106 uTreeStrings.Free;
2107 uEmptyImageList.Free;
2108 uColumns.Free;
2109 uLocalReportData.Free;
2110 uRemoteReportData.Free;
2111end;
2112
2113procedure TfrmLabs.FillGrid(agrid: TStringGrid; aitems: TStrings);
2114var
2115 testcnt, x, y, i: integer;
2116begin
2117 testcnt := strtoint(Piece(aitems[0], '^', 1));
2118 with agrid do
2119 begin
2120 if testcnt = 0 then RowCount := 3 else RowCount := testcnt + 1;
2121 ColCount := 5;
2122 DefaultColWidth := agrid.Width div ColCount - 2;
2123 ColWidths[0] := agrid.Width div 4;
2124 ColWidths[4] := agrid.Width div 4;
2125 ColWidths[2] := agrid.Width div 9;
2126 ColWidths[3] := agrid.Width div 6;
2127 ColWidths[1] := agrid.Width - ColWidths[0] - ColWidths[2] - ColWidths[3] - ColWidths[4] - 8;
2128 FixedCols := 0;
2129 FixedRows := 1;
2130 for y := 0 to RowCount - 1 do
2131 for x := 0 to ColCount - 1 do
2132 Cells[x, y] := '';
2133 Cells[0, 0] := 'Test';
2134 Cells[1, 0] := 'Result';
2135 Cells[2, 0] := 'Flag';
2136 Cells[3, 0] := 'Units';
2137 Cells[4, 0] := 'Ref Range';
2138 for i := 1 to testcnt do
2139 begin
2140 Cells[0, i] := Piece(aitems[i], '^', 2);
2141 Cells[1, i] := Piece(aitems[i], '^', 3);
2142 Cells[2, i] := Piece(aitems[i], '^', 4);
2143 Cells[3, i] := Piece(aitems[i], '^', 5);
2144 Cells[4, i] := Piece(aitems[i], '^', 6);
2145 end;
2146 end;
2147end;
2148
2149procedure TfrmLabs.FillComments(amemo: TRichEdit; aitems:TStrings);
2150var
2151 testcnt, i: integer;
2152 specimen, accession, provider: string;
2153begin
2154 amemo.Lines.Clear;
2155 specimen := Piece(aitems[0], '^', 5);
2156 accession := Piece(aitems[0], '^', 6);
2157 provider := Piece(aitems[0], '^', 7);
2158 amemo.Lines.Add('Specimen: ' + specimen + '; Accession: ' + accession + '; Provider: ' + provider);
2159 testcnt := strtoint(Piece(aitems[0], '^', 1));
2160 for i := testcnt + 1 to aitems.Count - 1 do
2161 amemo.Lines.Add(aitems[i]);
2162 amemo.SelStart := 0;
2163end;
2164
2165procedure TfrmLabs.GetInterimGrid(adatetime: TFMDateTime; direction: integer);
2166var
2167 tmpList: TStringList;
2168 nexton, prevon: boolean;
2169 newest, oldest, DisplayDate: string;
2170begin
2171 tmpList := TStringList.Create;
2172 GetNewestOldest(Patient.DFN, newest, oldest); //****** PATCH
2173 nexton := true;
2174 prevon := true;
2175 try
2176 FastAssign(InterimGrid(Patient.DFN, adatetime, direction, uFormat), tmpList);
2177 if tmpList.Count > 0 then
2178 begin
2179 lblDateFloat.Caption := Piece(tmpList[0], '^', 3);
2180 uFormat := strtointdef(Piece(tmpList[0], '^', 9), 1);
2181 //------------------------------------------------------------------------------------------
2182 //v27.1 - RV - PSI-05-118 / Remedy HD0000000123277 - don't show "00:00" if no time present
2183 if LabPatchInstalled then // Requires lab patch in const "PSI_05_118"
2184 begin
2185 DisplayDate := Piece(tmpList[0], '^', 3);
2186 if length(DisplayDate) > 7 then
2187 lblDate.Caption := FormatFMDateTime('MMM DD, YYYY hh:nn', strtofloat(DisplayDate))
2188 else if length(DisplayDate) > 0 then
2189 lblDate.Caption := FormatFMDateTime('MMM DD, YYYY', strtofloat(DisplayDate))
2190 else
2191 if length(lblDateFloat.Caption) > 0 then
2192 lblDate.Caption := FormatFMDateTime('MMM DD, YYYY hh:nn', strtofloat(lblDateFloat.Caption));
2193 end
2194 else // If no lab patch in const "PSI_05_118", continue as is
2195 begin
2196 if length(lblDateFloat.Caption) > 0 then
2197 lblDate.Caption := FormatFMDateTime('MMM DD, YYYY hh:nn', strtofloat(lblDateFloat.Caption));
2198 end;
2199 //------------------------------------------------------------------------------------------
2200 if length(lblDateFloat.Caption) < 1
2201 then
2202 begin
2203 lblDateFloat.Caption := FloatToStr(adatetime);
2204 nexton := false;
2205 end
2206 else
2207 begin
2208 nexton := lblDateFloat.Caption <> newest;
2209 prevon := lblDateFloat.Caption <> oldest;
2210 end;
2211 if (not nexton) and (uFormat = 3) then
2212 nexton := true;
2213 if (not prevon) and (uFormat = 2) then
2214 prevon := true;
2215 end
2216 else
2217 begin
2218 lblDateFloat.Caption := '';
2219 lblDate.Caption := '';
2220 end;
2221 cmdNext.Enabled := nexton;
2222 cmdRecent.Enabled := nexton;
2223 lblNext.Enabled := nexton;
2224 lblRecent.Enabled := nexton;
2225 cmdPrev.Enabled := prevon;
2226 cmdOld.Enabled := prevon;
2227 lblPrev.Enabled := prevon;
2228 lblOld.Enabled := prevon;
2229 if cmdOld.Enabled and cmdRecent.Enabled then
2230 lblMostRecent.Visible := false
2231 else
2232 begin
2233 lblMostRecent.Visible := true;
2234 if (not cmdOld.Enabled) and (not cmdRecent.Enabled) then
2235 lblMostRecent.Caption := 'No Lab Results'
2236 else if cmdOld.Enabled then
2237 lblMostRecent.Caption := 'Most Recent Lab Result'
2238 else
2239 lblMostRecent.Caption := 'Oldest Lab Result';
2240 end;
2241 if tmpList.Count > 0 then
2242 begin
2243 if Piece(tmpList[0], '^', 2) = 'CH' then
2244 begin
2245 FillGrid(grdLab, tmpList);
2246 FillComments(memLab, tmpList);
2247 if uScreenSplitMoved = false then
2248 begin
2249 pnlRightTop.Height := pnlRight.Height - (pnlRight.Height div 5);
2250 uScreenSplitLoc := sptHorzRight.Top;
2251 end
2252 else
2253 pnlRightTop.Height := uScreenSplitLoc;
2254 pnlRightBottom.Height := pnlLeft.Height div 5;
2255 memLab.Height := pnlLeft.Height div 5;
2256 memLab.Lines.Insert(0,' ');
2257 memLab.Lines.Delete(0);
2258 memLab.SelStart := 0;
2259 grdLab.Align := alClient;
2260 grdLab.Visible := true;
2261 memLab.Visible := true;
2262 pnlFooter.Height := lblHeading.Height + 5;
2263 pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
2264 lblFooter.Caption := ' KEY: "L" = Abnormal Low, "H" = Abnormal High, "*" = Critical Value';
2265 lblFooter.Align := alTop;
2266 pnlFooter.Visible := true;
2267 if (grdLab.VisibleRowCount + 1) < grdLab.RowCount then
2268 grdLab.ColWidths[4] := grdLab.ColWidths[4] - 18;
2269 memLab.Align := alClient;
2270 memLab.Repaint;
2271 end;
2272 if Piece(tmpList[0], '^', 2) = 'MI' then
2273 begin
2274 tmpList.Delete(0);
2275 QuickCopy(tmpList, memLab);
2276 memLab.SelStart := 0;
2277 grdLab.Visible := false;
2278 pnlFooter.Visible := false;
2279 sptHorzRight.Visible := true;
2280 pnlRightTop.Height := pnlHeader.Height + TabControl1.Height;
2281 memLab.Height := pnlRight.Height - (lblHeading.Height + lblTitle.Height + pnlHeader.Height);
2282 pnlRightTop.Visible := true;
2283 memLab.Align := alClient;
2284 memLab.Repaint;
2285 end;
2286 end
2287 else
2288 begin
2289 grdLab.Visible := false;
2290 pnlFooter.Visible := false;
2291 memLab.Align := alClient;
2292 end;
2293 finally
2294 tmpList.Free;
2295 end;
2296end;
2297
2298procedure TfrmLabs.cmdNextClick(Sender: TObject);
2299var
2300 HadFocus: boolean;
2301begin
2302 inherited;
2303 HadFocus := Screen.ActiveControl = cmdNext;
2304 StatusText('Retrieving next lab data...');
2305 if Length(lblDateFloat.Caption) > 0 then GetInterimGrid(strtofloat(lblDateFloat.Caption), -1);
2306 StatusText('');
2307 if HadFocus then begin
2308 if cmdNext.Enabled then cmdNext.SetFocus
2309 else if cmdPrev.Enabled then cmdPrev.SetFocus
2310 else tvReports.SetFocus;
2311 end;
2312end;
2313
2314procedure TfrmLabs.cmdPrevClick(Sender: TObject);
2315var
2316 HadFocus: boolean;
2317begin
2318 inherited;
2319 HadFocus := Screen.ActiveControl = cmdPrev;
2320 StatusText('Retrieving previous lab data...');
2321 if Length(lblDateFloat.Caption) > 0 then GetInterimGrid(strtofloat(lblDateFloat.Caption), 1);
2322 StatusText('');
2323 if HadFocus then begin
2324 if cmdPrev.Enabled then cmdPrev.SetFocus
2325 else if cmdNext.Enabled then cmdNext.SetFocus
2326 else tvReports.Setfocus;
2327 end;
2328end;
2329
2330procedure TfrmLabs.WorksheetChart(test: string; aitems: TStrings);
2331
2332function OkFloatValue(value: string): boolean;
2333var
2334 i, j: integer;
2335 first, second: string;
2336begin
2337 Result := false;
2338 i := strtointdef(value, -99999);
2339 if i <> -99999 then Result := true
2340 else if pos('.', Copy(Value, Pos('.', Value) + 1, Length(Value))) > 0 then Result := false
2341 else
2342 begin
2343 first := Piece(value, '.', 1);
2344 second := Piece(value, '.', 2);
2345 if length(second) > 0 then
2346 begin
2347 i := strtointdef(first, -99999);
2348 j := strtointdef(second, -99999);
2349 if (i <> -99999) and (j <> -99999) then Result := true;
2350 end
2351 else
2352 begin
2353 i :=strtointdef(first, -99999);
2354 if i <> -99999 then Result := true;
2355 end;
2356 end;
2357end;
2358
2359var
2360 datevalue, oldstart, oldend: TDateTime;
2361 labvalue: double;
2362 i, numtest, numcol, numvalues, valuecount: integer;
2363 high, low, start, stop, numspec, value, testcheck, units, specimen, testnum, testorder: string;
2364begin
2365 if chkZoom.Checked and chtChart.Visible then
2366 begin
2367 oldstart := chtChart.BottomAxis.Minimum;
2368 oldend := chtChart.BottomAxis.Maximum;
2369 chtChart.UndoZoom;
2370 chtChart.BottomAxis.Automatic := false;
2371 chtChart.BottomAxis.Minimum := oldstart;
2372 chtChart.BottomAxis.Maximum := oldend;
2373 end
2374 else
2375 begin
2376 chtChart.BottomAxis.Automatic := true;
2377 end;
2378 chtChart.Visible := true;
2379 valuecount := 0;
2380 testnum := Piece(test, '^', 1);
2381 specimen := Piece(test, '^', 3);
2382 units := Piece(test, '^', 4);
2383 low := Piece(test, '^', 5);
2384 high := Piece(test, '^', 6);
2385 numtest := strtoint(Piece(aitems[0], '^', 1));
2386 numcol := strtoint(Piece(aitems[0], '^', 2));
2387 numvalues := strtoint(Piece(aitems[0], '^', 3));
2388 serHigh.Clear; serLow.Clear; serTest.Clear;
2389 if numtest > 0 then
2390 begin
2391 for i := 1 to numtest do
2392 if testnum = Piece(aitems[i], '^', 2) then
2393 begin
2394 testorder := inttostr(i);
2395 break;
2396 end;
2397 GetStartStop(start, stop, aitems);
2398 if OKFloatValue(high) then
2399 begin
2400 serHigh.AddXY(FMToDateTime(start), strtofloat(high), '',clTeeColor);
2401 serHigh.AddXY(FMToDateTime(stop), strtofloat(high), '',clTeeColor);
2402 end;
2403 if OKFloatValue(low) then
2404 begin
2405 serLow.AddXY(FMToDateTime(start), strtofloat(low), '',clTeeColor);
2406 serLow.AddXY(FMToDateTime(stop), strtofloat(low), '',clTeeColor);
2407 end;
2408 numspec := Piece(specimen, '^', 1);
2409 chtChart.Legend.Color := grdLab.Color;
2410 chtChart.Title.Font.Size := MainFontSize;
2411 chtChart.LeftAxis.Title.Caption := units;
2412 serTest.Title := Piece(test, '^', 2);
2413 serHigh.Title := 'Ref High ' + high;
2414 serLow.Title := 'Ref Low ' + low;
2415 testcheck := testorder;
2416 for i := numtest + numcol + 1 to numtest + numcol + numvalues do
2417 if Piece(aitems[i], '^', 2) = testcheck then
2418 if Piece(aitems[numtest + strtoint(Piece(aitems[i], '^', 1))], '^', 3) = numspec then
2419 begin
2420 value := Piece(aitems[i], '^', 3);
2421 if OkFloatValue(value) then
2422 begin
2423 labvalue := strtofloat(value);
2424 datevalue := FMToDateTime(Piece(aitems[numtest + strtoint(Piece(aitems[i], '^', 1))], '^', 2));
2425 serTest.AddXY(datevalue, labvalue, '', clTeeColor);
2426 inc(valuecount);
2427 end;
2428 end;
2429 end;
2430 if valuecount = 0 then
2431 begin
2432 lblGraph.Left := chtChart.Left + ((chtChart.Width - lblGraph.Width) div 2);
2433 lblGraph.Top := 2;
2434 lblGraph.Visible := true;
2435 if length(Piece(specimen, '^', 2)) > 0 then
2436 pnlChart.Caption := '<No results can be graphed for ' + serTest.Title + ' in this date range.> '
2437 else
2438 pnlChart.Caption := '<No results can be graphed for ' + Piece(test, '^', 2) + ' in this date range.>';
2439 chtChart.Visible := false;
2440 end
2441 else
2442 lblGraph.Visible := false;
2443 if not chkZoom.Checked then
2444 begin
2445 chtChart.UndoZoom;
2446 chtChart.ZoomPercent(ZOOM_PERCENT);
2447 end;
2448end;
2449
2450procedure TfrmLabs.GetStartStop(var start, stop: string; aitems: TStrings);
2451var
2452 numtest, numcol: integer;
2453begin
2454 numtest := strtoint(Piece(aitems[0], '^', 1));
2455 numcol := strtoint(Piece(aitems[0], '^', 2));
2456 start := Piece(aitems[numtest + 1], '^', 2);
2457 stop := Piece(aitems[numtest + numcol], '^', 2);
2458end;
2459
2460procedure TfrmLabs.cmdRecentClick(Sender: TObject);
2461var
2462 HadFocus: boolean;
2463begin
2464 inherited;
2465 HadFocus := Screen.ActiveControl = cmdRecent;
2466 StatusText('Retrieving most recent lab data...');
2467 uFormat := 1;
2468 GetInterimGrid(FMToday + 0.2359, 1);
2469 StatusText('');
2470 if HadFocus and cmdPrev.Enabled then cmdPrev.SetFocus;
2471end;
2472
2473procedure TfrmLabs.cmdOldClick(Sender: TObject);
2474var
2475 HadFocus: boolean;
2476begin
2477 inherited;
2478 HadFocus := Screen.ActiveControl = cmdOld;
2479 StatusText('Retrieving oldest lab data...');
2480 uFormat := 1;
2481 GetInterimGrid(2700101, -1);
2482 if HadFocus and cmdNext.Enabled then cmdNext.SetFocus;
2483 StatusText('');
2484end;
2485
2486procedure TfrmLabs.FormResize(Sender: TObject);
2487//var
2488 //aID: integer;
2489begin
2490 inherited;
2491 AlignList;
2492 lblHeaders.Height := lblReports.Height;
2493 lblDates.Height := lblReports.Height;
2494 lblHeading.Height := lblReports.Height;
2495 pnlFooter.Height := lblReports.Height + 5;
2496 lblFooter.Height := lblReports.Height;
2497 {aID := 0;
2498 if CharAt(uRPTID,2) =':' then
2499 aID := StrToInt(piece(uRptID,':',1));
2500 if (aID = 0) and (CharAt(uRPTID,3) =':') then
2501 aID := StrToInt(piece(uRptID,':',1)); }
2502 {case lstReports.ItemIEN of }
2503 {case aID of
2504 1: begin // Most Recent
2505 pnlHeader.Align := alTop;
2506 memLab.Height := pnlLeft.Height div 5;
2507 memLab.Top := pnlLeft.Height - pnlFooter.Height - memLab.Height;
2508 memLab.Align := alBottom;
2509 grdLab.Align := alClient;
2510 if tmpGrid.Count > 0 then HGrid(tmpGrid);
2511 if (grdLab.VisibleRowCount + 1) < grdLab.RowCount then
2512 grdLab.ColWidths[4] := grdLab.ColWidths[4] - 18;
2513 pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
2514 pnlFooter.Align := alBottom;
2515 memLab.Repaint;
2516 pnlRightTop.Height := pnlLeft.Height - (pnlLeft.Height div 5);
2517 //*pnlRightTop.Visible := true;
2518 //*pnlButtons.Visible := true;
2519 //*pnlWorksheet.Visible := false;
2520 //*pnlGraph.Visible := false;
2521 //memLab.Align := alBottom;
2522 sptHorzRight.Visible := true;
2523 pnlRightBottom.Height := pnlLeft.Height div 5;
2524 //memLab.Height := pnlLeft.Height div 5;
2525 //grdLab.Align := alClient;
2526 end;
2527 21: begin // Cumulative
2528 pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
2529 pnlFooter.Align := alBottom;
2530 lblFooter.Align := alTop;
2531 memLab.Align := alClient;
2532 memLab.Repaint;
2533 end;
2534 3: begin // Interim
2535 pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
2536 pnlFooter.Align := alBottom;
2537 lblFooter.Caption := ' KEY: "L" = Abnormal Low, "H" = Abnormal High, "*" = Critical Value';
2538 lblFooter.Align := alTop;
2539 memLab.Align := alClient;
2540 memLab.Repaint;
2541 end;
2542 4: begin // Interim for Selected Tests
2543 pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
2544 pnlFooter.Align := alBottom;
2545 lblFooter.Caption := ' KEY: "L" = Abnormal Low, "H" = Abnormal High, "*" = Critical Value';
2546 lblFooter.Align := alTop;
2547 memLab.Align := alClient;
2548 memLab.Repaint;
2549 end;
2550 5: begin // Worksheet
2551 pnlHeader.Align := alTop;
2552 grdLab.Align := alClient;
2553 ragCorGClick(self);
2554 pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
2555 pnlFooter.Align := alBottom;
2556 end;
2557 6: begin // Graph
2558 if not uGraphingActivated then
2559 begin
2560 memLab.Height := pnlLeft.Height div 4;
2561 memLab.Align := alBottom;
2562 pnlChart.Top := pnlHeader.Height;
2563 pnlChart.Align := alClient;
2564 memLab.Height := pnlLeft.Height div 4;
2565 memLab.Align := alBottom;
2566 memLab.Repaint;
2567 end;
2568 end;
2569 20: begin // Anatomic Path
2570 memLab.Repaint;
2571 end;
2572 2: begin // Blood Bank
2573 memLab.Repaint;
2574 end;
2575 9: begin // Microbiology
2576 memLab.Repaint;
2577 end;
2578 10: begin // Lab Status
2579 memLab.Repaint;
2580 end;
2581 end; }
2582end;
2583
2584procedure TfrmLabs.pnlRightResize(Sender: TObject);
2585begin
2586 inherited;
2587 pnlRight.Refresh;
2588 lblFooter.Height := lblHeading.Height;
2589end;
2590
2591function TfrmLabs.FMToDateTime(FMDateTime: string): TDateTime;
2592var
2593 x, Year: string;
2594begin
2595 { Note: TDateTime cannot store month only or year only dates }
2596 x := FMDateTime + '0000000';
2597 if Length(x) > 12 then x := Copy(x, 1, 12);
2598 if StrToInt(Copy(x, 9, 4)) > 2359 then x := Copy(x,1,7) + '.2359';
2599 Year := IntToStr(17 + StrToInt(Copy(x,1,1))) + Copy(x,2,2);
2600 x := Copy(x,4,2) + '/' + Copy(x,6,2) + '/' + Year + ' ' + Copy(x,9,2) + ':' + Copy(x,11,2);
2601 Result := StrToDateTime(x);
2602end;
2603
2604procedure TfrmLabs.chkValuesClick(Sender: TObject);
2605begin
2606 inherited;
2607 serTest.Marks.Visible := chkValues.Checked;
2608end;
2609
2610procedure TfrmLabs.chk3DClick(Sender: TObject);
2611begin
2612 inherited;
2613 chtChart.View3D := chk3D.Checked;
2614end;
2615
2616procedure TfrmLabs.GraphChart(test: string; aitems: TStrings);
2617var
2618 datevalue: TDateTime;
2619 labvalue: double;
2620 i, numvalues: integer;
2621 high, low, start, stop, value, units, specimen: string;
2622begin
2623 numvalues := strtoint(Piece(aitems[0], '^', 1));
2624 specimen := Piece(aitems[0], '^', 2);
2625 high := Piece(aitems[0], '^', 3);
2626 low := Piece(aitems[0], '^', 4);
2627 units := Piece(aitems[0], '^', 5);
2628 if numvalues > 0 then
2629 begin
2630 start := Piece(aitems[1], '^', 1);
2631 stop := Piece(aitems[numvalues], '^', 1);
2632 chtChart.Legend.Color := grdLab.Color;
2633 serHigh.Clear; serLow.Clear; serTest.Clear;
2634 if high <> '' then
2635 begin
2636 serHigh.AddXY(FMToDateTime(start), strtofloat(high), '',clTeeColor);
2637 serHigh.AddXY(FMToDateTime(stop), strtofloat(high), '',clTeeColor);
2638 end;
2639 if low <> '' then
2640 begin
2641 serLow.AddXY(FMToDateTime(start), strtofloat(low), '',clTeeColor);
2642 serLow.AddXY(FMToDateTime(stop), strtofloat(low), '',clTeeColor);
2643 end;
2644 //chtChart.Title.Text.Strings[0] := Piece(test, '^', 2) + ' (' + MixedCase(specimen) + ')';
2645 //chtChart.Title.Font.Size := 12;
2646 chtChart.LeftAxis.Title.Caption := units;
2647 serTest.Title := Piece(test, '^', 2) + ' (' + MixedCase(specimen) + ')';
2648 serHigh.Title := 'Ref High ' + high;
2649 serLow.Title := 'Ref Low ' + low;
2650 for i := 1 to numvalues do
2651 begin
2652 value := Piece(aitems[i], '^', 2);
2653 labvalue := strtofloat(value);
2654 datevalue := FMToDateTime(Piece(aitems[i], '^', 1));
2655 serTest.AddXY(datevalue, labvalue, '', clTeeColor);
2656 end;
2657 end;
2658end;
2659
2660procedure TfrmLabs.ragHorVClick(Sender: TObject);
2661begin
2662 inherited;
2663 if ragHorV.ItemIndex = 0 then HGrid(tmpGrid) else VGrid(tmpGrid);
2664end;
2665
2666procedure TfrmLabs.ragCorGClick(Sender: TObject);
2667begin
2668 inherited;
2669 if ragCorG.ItemIndex = 0 then // comments
2670 begin
2671 chkZoom.Enabled := false;
2672 chk3D.Enabled := false;
2673 chkValues.Enabled := false;
2674 pnlChart.Visible:= false;
2675 pnlRightTop.Align := alTop;
2676 pnlRightTop.Height := pnlRight.Height - (pnlRight.Height div 6);
2677 pnlRightBottom.Visible := true;
2678 pnlRightBottom.Align := alClient;
2679 memLab.Align := alClient;
2680 memLab.Visible := true;
2681 grdLab.Align := alClient;
2682 end
2683 else // graph
2684 begin
2685 chkZoom.Enabled := true;
2686 chk3D.Enabled := true;
2687 chkValues.Enabled := true;
2688 chk3DClick(self);
2689 chkValuesClick(self);
2690 memLab.Visible := false;
2691 pnlRightBottom.Visible := false;
2692 pnlRightTop.Align := alClient;
2693 pnlChart.Height := pnlRight.Height div 2;
2694 pnlChart.Top := pnlRight.Height - pnlFooter.Height - pnlChart.Height;
2695 pnlChart.Align := alBottom;
2696 pnlChart.Visible := true;
2697 grdLab.Align := alClient;
2698 if lstTestGraph.Items.Count > 0 then
2699 begin
2700 if lstTestGraph.ItemIndex < 0 then
2701 lstTestGraph.ItemIndex := 0;
2702 lstTestGraphClick(self);
2703 end;
2704 end;
2705end;
2706
2707procedure TfrmLabs.lstTestGraphClick(Sender: TObject);
2708begin
2709 inherited;
2710 WorksheetChart(lstTestGraph.Items[lstTestGraph.ItemIndex], tmpGrid);
2711end;
2712
2713procedure TfrmLabs.Print1Click(Sender: TObject);
2714begin
2715 inherited;
2716 RequestPrint;
2717end;
2718
2719procedure TfrmLabs.Copy1Click(Sender: TObject);
2720var
2721 i,j: integer;
2722 line: string;
2723 ListItem: TListItem;
2724 aText: String;
2725begin
2726 inherited;
2727 ClipBoard;
2728 aText := '';
2729 for i := 0 to lvReports.Items.Count - 1 do
2730 if lvReports.Items[i].Selected then
2731 begin
2732 ListItem := lvReports.Items[i];
2733 line := '';
2734 for j := 1 to lvReports.Columns.Count - 1 do
2735 begin
2736 if (lvReports.Column[j].Width <> 0) and (j < (ListItem.SubItems.Count + 1)) then
2737 line := line + ' ' + ListItem.SubItems[j-1];
2738 end;
2739 if (length(line) > 0) and (lvReports.Column[0].Width <> 0) then
2740 line := ListItem.Caption + ' ' + line;
2741 if length(aText) > 0 then
2742 aText := aText + CRLF + line
2743 else aText := line;
2744 end;
2745 ClipBoard.Clear;
2746 ClipBoard.AsText := aText;
2747end;
2748
2749procedure TfrmLabs.Copy2Click(Sender: TObject);
2750begin
2751 inherited;
2752 memLab.CopyToClipboard;
2753end;
2754
2755procedure TfrmLabs.Print2Click(Sender: TObject);
2756begin
2757 inherited;
2758 RequestPrint;
2759end;
2760
2761procedure TfrmLabs.lvReportsColumnClick(Sender: TObject;
2762 Column: TListColumn);
2763var
2764 ClickedColumn: Integer;
2765 a1, a2: integer;
2766 s,s1,s2: string;
2767begin
2768 inherited;
2769 a1 := StrToIntDef(piece(uSortOrder,':',1),0) - 1;
2770 a2 := StrToIntDef(piece(uSortOrder,':',2),0) - 1;
2771 ClickedColumn := Column.Index;
2772 ColumnToSort := Column.Index;
2773 SortIdx1 := StrToIntDef(piece(uColumns[ColumnToSort],'^',9),0);
2774 SortIdx2 := 0;
2775 SortIdx3 := 0;
2776 if a1 > -1 then SortIdx2 := StrToIntDef(piece(uColumns[a1],'^',9),0);
2777 if a2 > -1 then SortIdx3 := StrToIntDef(piece(uColumns[a2],'^',9),0);
2778 if a1 = ColumnToSort then
2779 begin
2780 SortIdx2 := SortIdx3;
2781 SortIdx3 := 0;
2782 end;
2783 if a2 = ColumnToSort then
2784 SortIdx3 := 0;
2785 if ClickedColumn = ColumnToSort then
2786 ColumnSortForward := not ColumnSortForward
2787 else
2788 ColumnSortForward := true;
2789 ColumnToSort := ClickedColumn;
2790 uFirstSort := ColumnToSort;
2791 uSecondSort := a1;
2792 uThirdSort := a2;
2793 lvReports.Hint := '';
2794 if ColumnSortForward = true then
2795 s := 'Sorted forward'
2796 else
2797 s := 'Sorted reverse';
2798 s1 := piece(uColumns[uFirstSort],'^',1);
2799 s2 := '';
2800 if length(piece(s1,' ',2)) > 0 then
2801 s2 := pieces(s1,' ',2,99);
2802 if length(s2) > 0 then s2 := StripSpace(s2);
2803 s := s + ' by ' + piece(s1,' ',1) + ' ' + s2;
2804 if (a1 <> uFirstSort) and (a1 > -1) then
2805 begin
2806 s1 := piece(uColumns[a1], '^', 1);
2807 s2 := '';
2808 if length(piece(s1,' ',2)) > 0 then
2809 s2 := pieces(s1,' ',2,99);
2810 if length(s2) > 0 then s2 := StripSpace(s2);
2811 s := s + ' then by ' + piece(s1,' ',1) + ' ' + s2;
2812 end;
2813 if (a2 <> uFirstSort) and (a2 > -1) then
2814 begin
2815 s1 := piece(uColumns[a2], '^', 1);
2816 s2 := '';
2817 if length(piece(s1,' ',2)) > 0 then
2818 s2 := pieces(s1,' ',2,99);
2819 if length(s2) > 0 then s2 := StripSpace(s2);
2820 s := s + ' then by ' + piece(s1,' ',1) + ' ' + s2;
2821 end;
2822 lvReports.Hint := s;
2823 lvReports.CustomSort(nil, 0);
2824end;
2825
2826procedure TfrmLabs.lvReportsCompare(Sender: TObject; Item1,
2827 Item2: TListItem; Data: Integer; var Compare: Integer);
2828
2829 function CompareValues(Col: Integer): integer;
2830 var
2831 ix: Integer;
2832 s1, s2: string;
2833 v1, v2: extended;
2834 d1, d2: TFMDateTime;
2835 begin
2836 inherited;
2837 if ColumnToSort = 0 then
2838 Result := CompareText(Item1.Caption,Item2.Caption)
2839 else
2840 begin
2841 ix := ColumnToSort - 1;
2842 case Col of
2843 0: //strings
2844 begin
2845 if(Item1.SubItems.Count > 0) and (ix < Item1.SubItems.Count) then
2846 s1 := Item1.SubItems[ix]
2847 else
2848 s1 := '0';
2849 if(Item2.SubItems.Count > 0) and (ix < Item2.SubItems.Count) then
2850 s2 := Item2.SubItems[ix]
2851 else
2852 s2 := '0';
2853 Result := CompareText(s1,s2);
2854 end;
2855
2856 1: //integers
2857 begin
2858 if(Item1.SubItems.Count > 0) and (ix < Item1.SubItems.Count) then
2859 s1 := Item1.SubItems[ix]
2860 else
2861 s1 := '0';
2862 if(Item2.SubItems.Count > 0) and (ix < Item2.SubItems.Count) then
2863 s2 := Item2.SubItems[ix]
2864 else
2865 s2 := '0';
2866 IsValidNumber(s1, v1);
2867 IsValidNumber(s2, v2);
2868 if v1 > v2 then
2869 Result := 1
2870 else
2871 if v1 < v2 then
2872 Result := -1
2873 else
2874 Result := 0;
2875 end;
2876
2877 2: //date/times
2878 begin
2879 if(Item1.SubItems.Count > 1) and (ix < Item1.SubItems.Count) then
2880 s1 := Item1.SubItems[ix]
2881 else
2882 s1 := '1/1/1700';
2883 if(Item2.SubItems.Count > 1) and (ix < Item2.SubItems.Count) then
2884 s2 := Item2.SubItems[ix]
2885 else
2886 s2 := '1/1/1700';
2887 d1 := StringToFMDateTime(s1);
2888 d2 := StringToFMDateTime(s2);
2889 if d1 > d2 then
2890 Result := 1
2891 else
2892 if d1 < d2 then
2893 Result := -1
2894 else
2895 Result := 0;
2896 end;
2897 else
2898 Result := 0; // to make the compiler happy
2899 end;
2900 end;
2901 end;
2902begin
2903 ColumnToSort := uFirstSort;
2904 Compare := CompareValues(SortIdx1);
2905 if Compare = 0 then
2906 begin
2907 if (uSecondSort > -1) and (uFirstSort <> uSecondSort) then
2908 begin
2909 ColumnToSort := uSecondSort;
2910 Compare := CompareValues(SortIdx2);
2911 end;
2912 if Compare = 0 then
2913 if (uThirdSort > -1) and (uFirstSort <> uThirdSort) and (uSecondSort <> uThirdSort) then
2914 begin
2915 ColumnToSort := uThirdSort;
2916 Compare := CompareValues(SortIdx3);
2917 end;
2918 end;
2919 if not ColumnSortForward then Compare := -Compare;
2920end;
2921
2922procedure TfrmLabs.lvReportsKeyUp(Sender: TObject; var Key: Word;
2923 Shift: TShiftState);
2924begin
2925 inherited;
2926 if (Key = 67) and (ssCtrl in Shift) then
2927 Copy1Click(Self);
2928 if (Key = 65) and (ssCtrl in Shift) then
2929 SelectAll1Click(Self);
2930end;
2931
2932procedure TfrmLabs.lvReportsSelectItem(Sender: TObject; Item: TListItem;
2933 Selected: Boolean);
2934var
2935 aID, aSID: string;
2936 i,j,k: integer;
2937 aBasket: TStringList;
2938 aWPFlag: Boolean;
2939 x, HasImages: string;
2940
2941begin
2942 inherited;
2943 if not selected then Exit;
2944 aBasket := TStringList.Create;
2945 uLocalReportData.Clear;
2946 aWPFlag := false;
2947 with lvReports do
2948 begin
2949 aID := Item.SubItems[0];
2950 case uQualifierType of
2951 QT_OTHER:
2952 begin // = 0
2953
2954 end;
2955 QT_DATERANGE:
2956 begin // = 2
2957
2958 end;
2959 QT_IMAGING:
2960 begin // = 3
2961
2962 end;
2963 QT_NUTR:
2964 begin // = 4
2965
2966 end;
2967 QT_HSWPCOMPONENT:
2968 begin // = 6
2969 if lvReports.SelCount < 3 then
2970 begin
2971 memLab.Lines.Clear;
2972 ulvSelectOn := false;
2973 end;
2974 aBasket.Clear;
2975 if (SelCount = 2) and (ulvSelectOn = false) then
2976 begin
2977 ulvSelectOn := true;
2978 for i := 0 to Items.Count - 1 do
2979 if (Items[i].Selected) and (aID <> Items[i].SubItems[0]) then
2980 begin
2981 aSID := Items[i].SubItems[0];
2982 for j := 0 to RowObjects.ColumnList.Count - 1 do
2983 if piece(aSID,':',1) = piece(TCellObject(RowObjects.ColumnList[j]).Handle,':',1) then
2984 if Item.Caption = (piece(TCellObject(RowObjects.ColumnList[j]).Site,';',1)) then
2985 if (TCellObject(RowObjects.ColumnList[j]).Data.Count > 0) and
2986 (TCellObject(RowObjects.ColumnList[j]).Include = '1') then
2987 begin
2988 aWPFlag := true;
2989 MemLab.Lines.Add(TCellObject(RowObjects.ColumnList[j]).Name);
2990 FastAssign(TCellObject(RowObjects.ColumnList[j]).Data, aBasket);
2991 for k := 0 to aBasket.Count - 1 do
2992 MemLab.Lines.Add(' ' + aBasket[k]);
2993 end;
2994 if aWPFlag = true then
2995 begin
2996 memLab.Lines.Add('Facility: ' + Item.Caption);
2997 memLab.Lines.Add('===============================================================================');
2998 end;
2999 end;
3000 end;
3001 aBasket.Clear;
3002 aWPFlag := false;
3003 for i := 0 to RowObjects.ColumnList.Count - 1 do
3004 if piece(aID,':',1) = piece(TCellObject(RowObjects.ColumnList[i]).Handle,':',1) then
3005 if Item.Caption = (piece(TCellObject(RowObjects.ColumnList[i]).Site,';',1)) then
3006 if (TCellObject(RowObjects.ColumnList[i]).Data.Count > 0) and
3007 (TCellObject(RowObjects.ColumnList[i]).Include = '1') then
3008 begin
3009 aWPFlag := true;
3010 MemLab.Lines.Add(TCellObject(RowObjects.ColumnList[i]).Name);
3011 FastAssign(TCellObject(RowObjects.ColumnList[i]).Data, aBasket);
3012 for j := 0 to aBasket.Count - 1 do
3013 MemLab.Lines.Add(' ' + aBasket[j]);
3014 end;
3015 if aWPFlag = true then
3016 begin
3017 memLab.Lines.Add('Facility: ' + Item.Caption);
3018 memLab.Lines.Add('===============================================================================');
3019 end;
3020 if uRptID = 'OR_R18:IMAGING' then
3021 begin
3022 if (Item.SubItems.Count > 8) then //has id, may have case (?)
3023 begin
3024 x := 'RA^' + Item.SubItems[8] + U + Item.SubItems[4] + U + Item.Caption;
3025 SetPiece(x, U, 10, BOOLCHAR[Item.SubItemImages[1] = IMG_1_IMAGE]);
3026 NotifyOtherApps(NAE_REPORT, x);
3027 end
3028 else if (Item.SubItems.Count > 4) then
3029 begin
3030 x := 'RA^' + U + U + Item.SubItems[4] + U + Item.Caption;
3031 SetPiece(x, U, 10, BOOLCHAR[Item.SubItemImages[1] = IMG_1_IMAGE]);
3032 NotifyOtherApps(NAE_REPORT, x);
3033 end
3034 else if Item.SubItemImages[1] = IMG_1_IMAGE then
3035 begin
3036 memLab.Lines.Insert(0,'<Imaging links not active at this site>');
3037 memLab.Lines.Insert(1,' ');
3038 end;
3039 end;
3040 if uRptID = 'OR_PN:PROGRESS NOTES' then
3041 if (Item.SubItems.Count > 7) then
3042 begin
3043 if StrToIntDef(Item.SubItems[7], 0) > 0 then HasImages := '1' else HasImages := '0';
3044 x := 'PN^' + Item.SubItems[7] + U + Item.SubItems[1] + U + Item.Caption;
3045 SetPiece(x, U, 10, HasImages);
3046 NotifyOtherApps(NAE_REPORT, x);
3047 end;
3048 end;
3049 QT_PROCEDURES:
3050 begin // = 19
3051
3052 end;
3053 QT_SURGERY:
3054 begin // = 28
3055
3056 end;
3057 end;
3058 memLab.Lines.Insert(0,' ');
3059 memLab.Lines.Delete(0);
3060 end;
3061 aBasket.Free;
3062end;
3063
3064procedure TfrmLabs.SelectAll1Click(Sender: TObject);
3065var
3066 i: integer;
3067begin
3068 inherited;
3069 for i := 0 to lvReports.Items.Count - 1 do
3070 lvReports.Items[i].Selected := true;
3071end;
3072
3073procedure TfrmLabs.SelectAll2Click(Sender: TObject);
3074begin
3075 inherited;
3076 memLab.SelectAll;
3077end;
3078
3079procedure TfrmLabs.chkGraphValuesClick(Sender: TObject);
3080begin
3081 inherited;
3082 serTest.Marks.Visible := chkGraphValues.Checked;
3083end;
3084
3085procedure TfrmLabs.chkGraph3DClick(Sender: TObject);
3086begin
3087 inherited;
3088 chtChart.View3D := chkGraph3D.Checked;
3089end;
3090
3091procedure TfrmLabs.chkGraphZoomClick(Sender: TObject);
3092begin
3093 inherited;
3094 chtChart.AllowZoom := chkGraphZoom.Checked;
3095 chtChart.AnimatedZoom := chkGraphZoom.Checked;
3096 lblGraphInfo.Caption := 'To Zoom, hold down the mouse button while dragging an area to be enlarged.';
3097 if chkGraphZoom.Checked then
3098 lblGraphInfo.Caption := lblGraphInfo.Caption + #13
3099 + 'To Zoom Back drag to the upper left. You can also use the actions on the right mouse button.';
3100 lblGraphInfo.Visible := chkGraphZoom.Checked;
3101 if not chkGraphZoom.Checked then chtChart.UndoZoom;
3102end;
3103
3104procedure TfrmLabs.chkMaxFreqClick(Sender: TObject);
3105begin
3106 inherited;
3107 if chkMaxFreq.Checked = true then
3108 begin
3109 uMaxOcc := piece(uQualifier, ';', 3);
3110 SetPiece(uQualifier, ';', 3, '');
3111 end
3112 else
3113 begin
3114 SetPiece(uQualifier, ';', 3, uMaxOcc);
3115 end;
3116 tvReportsClick(self);
3117end;
3118
3119procedure TfrmLabs.GotoTop1Click(Sender: TObject);
3120begin
3121 inherited;
3122with memLab do
3123 begin
3124 SetFocus;
3125 SelStart :=0;
3126 SelLength :=0;
3127 end;
3128end;
3129
3130procedure TfrmLabs.GotoBottom1Click(Sender: TObject);
3131var
3132 I,CharCount : Integer;
3133begin
3134 Inherited;
3135 CharCount :=0;
3136 with memLab do
3137 begin
3138 for I := 0 to lines.count-1 do
3139 CharCount := CharCount + Length(Lines[I]) + 2;
3140 SetFocus;
3141 SelStart := CharCount;
3142 SelLength :=0;
3143 end;
3144end;
3145
3146procedure TfrmLabs.FreezeText1Click(Sender: TObject);
3147var
3148 Current, Desired : Longint;
3149 LineCount : Integer;
3150begin
3151 Inherited;
3152 If memLab.SelLength > 0 then begin
3153 Memo1.visible := true;
3154 Memo1.Text := memLab.SelText;
3155 If Memo1.Lines.Count <6 then
3156 LineCount := Memo1.Lines.Count + 1
3157 Else
3158 LineCount := 5;
3159 Memo1.Height := LineCount * frmLabs.Canvas.TextHeight(memLab.SelText);
3160 Current := SendMessage(memLab.handle, EM_GETFIRSTVISIBLELINE, 0, 0);
3161 Desired := SendMessage(memLab.handle, EM_LINEFROMCHAR,
3162 memLab.SelStart + memLab.SelLength ,0);
3163 SendMessage(memLab.Handle,EM_LINESCROLL, 0, Desired - Current);
3164 uFrozen := True;
3165 end;
3166end;
3167
3168procedure TfrmLabs.UnfreezeText1Click(Sender: TObject);
3169begin
3170 Inherited;
3171 If uFrozen = True Then begin
3172 uFrozen := False;
3173 UnFreezeText1.Enabled := False;
3174 Memo1.Visible := False;
3175 Memo1.Text := '';
3176 end;
3177end;
3178
3179procedure TfrmLabs.PopupMenu1Popup(Sender: TObject);
3180begin
3181 inherited;
3182 If Screen.ActiveControl.Name <> memLab.Name then
3183 begin
3184 memLab.SetFocus;
3185 memLab.SelStart := 0;
3186 end;
3187 If memLab.SelLength > 0 Then
3188 FreezeText1.Enabled := True
3189 Else
3190 FreezeText1.Enabled := False;
3191 If Memo1.Visible Then
3192 UnFreezeText1.Enabled := True;
3193 If memLab.SelStart > 0 then
3194 GotoTop1.Enabled := True
3195 Else
3196 GotoTop1.Enabled := False;
3197 If SendMessage(memLab.handle, EM_LINEFROMCHAR,
3198 memLab.SelStart,0) < memLab.Lines.Count then
3199 GotoBottom1.Enabled := True
3200 Else
3201 GotoBottom1.Enabled := False;
3202 {case lstReports.ItemIEN of
3203 1: FreezeText1.Enabled := False;
3204 5: FreezeText1.Enabled := False;
3205 6: FreezeText1.Enabled := False;
3206 end; }
3207end;
3208
3209procedure TfrmLabs.ProcessNotifications;
3210var
3211 //AlertDate, CurrentDate: TFMDateTime;
3212 OrderIFN: string;
3213begin
3214 {uNewest := '';
3215 uOldest := '';
3216 GetNewestOldest(Patient.DFN, uNewest, uOldest); }
3217 {AlertDate := Trunc(StrToFMDateTime(Piece(Piece(Notifications.RecordID, U, 2), ';', 3)));
3218 CurrentDate := FMToday;
3219 lstReports.ItemIndex := 2;
3220 if AlertDate = CurrentDate then
3221 begin
3222 lstDates.ItemIndex := 0;
3223 lstReports.ItemIndex := 0;
3224 end
3225 else if CurrentDate - AlertDate < 7 then lstDates.ItemIndex := 2
3226 else if CurrentDate - AlertDate < 14 then lstDates.ItemIndex := 3
3227 else if CurrentDate - AlertDate < 28 then lstDates.ItemIndex := 4
3228 else lstDates.ItemIndex := 5;
3229
3230 lstReportsClick(self); }
3231
3232 OrderIFN := Piece(Notifications.AlertData, '@', 1);
3233 if StrToIntDef(OrderIFN,0) > 0 then
3234 begin
3235 //the following if condition & clause resolves CQ 16405 & 17076 - a mixture of two different patient's lab results in one display.
3236 if (AnsiContainsStr(tvReports.Selected.Text, 'Microbiology')) or (AnsiContainsStr(tvReports.Selected.Text, 'Anatomic Pathology'))
3237 or (AnsiContainsStr(tvReports.Selected.Text, 'Cytology')) or (AnsiContainsStr(tvReports.Selected.Text, 'Electron Microscopy'))
3238 or (AnsiContainsStr(tvReports.Selected.Text, 'Surgical Pathology')) and (lvReports.Visible = TRUE) then
3239 begin
3240 tvReports.Selected := tvReports.TopItem;
3241 lvReports.Visible := FALSE;
3242 DisplayHeading('');
3243 end;
3244 lstDates.ItemIndex := -1;
3245 Memo1.Visible := false;
3246 lblHeaders.Visible := false;
3247 lstHeaders.Visible := false;
3248 pnlOtherTests.Visible := false;
3249 lblDates.Visible := true;
3250 lstDates.Visible := true;
3251 pnlHeader.Visible := false;
3252 grdLab.Visible := false;
3253 pnlChart.Visible := false;
3254 //WebBrowser1.Visible := false; **Browser Remove**
3255 //WebBrowser1.SendToBack; **Browser Remove**
3256 memLab.Visible := true;
3257 memLab.BringToFront;
3258 pnlFooter.Visible := true;
3259 memLab.Clear;
3260 uLabLocalReportData.Clear;
3261 uLabRemoteReportData.Clear;
3262 pnlRightTop.Height := 5;
3263 memLab.Align := alClient;
3264 FormResize(self);
3265 QuickCopy(ResultOrder(OrderIFN), memLab);
3266 memLab.SelStart := 0;
3267 memLab.Repaint;
3268 lblHeading.Caption := Notifications.Text;
3269 end
3270 else
3271 begin
3272 if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 5;
3273 tvReports.Selected := tvReports.Items.GetFirstNode;
3274 tvReportsClick(self);
3275 end;
3276
3277 case Notifications.FollowUp of
3278 NF_LAB_RESULTS : Notifications.Delete;
3279 NF_ABNORMAL_LAB_RESULTS : Notifications.Delete;
3280 NF_SITE_FLAGGED_RESULTS : Notifications.Delete;
3281 NF_STAT_RESULTS : Notifications.Delete;
3282 NF_CRITICAL_LAB_RESULTS : Notifications.Delete;
3283 NF_LAB_THRESHOLD_EXCEEDED : Notifications.Delete;
3284 end;
3285end;
3286
3287procedure TfrmLabs.chkZoomClick(Sender: TObject);
3288begin
3289 inherited;
3290 chtChart.AllowZoom := chkZoom.Checked;
3291 chtChart.AnimatedZoom := chkZoom.Checked;
3292 if not chkZoom.Checked then
3293 begin
3294 chtChart.UndoZoom;
3295 chtChart.ZoomPercent(ZOOM_PERCENT);
3296 end;
3297end;
3298
3299procedure TfrmLabs.chtChartUndoZoom(Sender: TObject);
3300begin
3301 inherited;
3302 chtChart.BottomAxis.Automatic := true;
3303end;
3304
3305procedure TfrmLabs.popCopyClick(Sender: TObject);
3306begin
3307 inherited;
3308 chtChart.CopyToClipboardBitmap;
3309end;
3310
3311procedure TfrmLabs.popChartPopup(Sender: TObject);
3312begin
3313 inherited;
3314 if pnlWorksheet.Visible then
3315 begin
3316 popValues.Checked := chkValues.Checked;
3317 pop3D.Checked := chk3D.Checked;
3318 popZoom.Checked := chkZoom.Checked;
3319 end
3320 else
3321 begin
3322 popValues.Checked := chkGraphValues.Checked;
3323 pop3D.Checked := chkGraph3D.Checked;
3324 popZoom.Checked := chkGraphZoom.Checked;
3325 end;
3326 popZoomBack.Enabled := popZoom.Checked and not chtChart.BottomAxis.Automatic;;
3327 if chtChart.Hint <> '' then
3328 begin
3329 popDetails.Caption := chtChart.Hint;
3330 popDetails.Enabled := true;
3331 end
3332 else
3333 begin
3334 popDetails.Caption := 'Details';
3335 popDetails.Enabled := false;
3336 end;
3337end;
3338
3339procedure TfrmLabs.popValuesClick(Sender: TObject);
3340begin
3341 inherited;
3342 if pnlWorksheet.Visible then
3343 begin
3344 chkValues.Checked := not chkValues.Checked;
3345 chkValuesClick(self);
3346 end
3347 else
3348 begin
3349 chkGraphValues.Checked := not chkGraphValues.Checked;
3350 chkGraphValuesClick(self);
3351 end;
3352end;
3353
3354procedure TfrmLabs.pop3DClick(Sender: TObject);
3355begin
3356 inherited;
3357 if pnlWorksheet.Visible then
3358 begin
3359 chk3D.Checked := not chk3D.Checked;
3360 chk3DClick(self);
3361 end
3362 else
3363 begin
3364 chkGraph3D.Checked := not chkGraph3D.Checked;
3365 chkGraph3DClick(self);
3366 end;
3367end;
3368
3369procedure TfrmLabs.popZoomClick(Sender: TObject);
3370begin
3371 inherited;
3372 if pnlWorksheet.Visible then
3373 begin
3374 chkZoom.Checked := not chkZoom.Checked;
3375 chkZoomClick(self);
3376 end
3377 else
3378 begin
3379 chkGraphZoom.Checked := not chkGraphZoom.Checked;
3380 chkGraphZoomClick(self);
3381 end;
3382end;
3383
3384procedure TfrmLabs.popZoomBackClick(Sender: TObject);
3385begin
3386 inherited;
3387 chtChart.UndoZoom;
3388end;
3389
3390procedure TfrmLabs.chtChartMouseDown(Sender: TObject; Button: TMouseButton;
3391 Shift: TShiftState; X, Y: Integer);
3392begin
3393 inherited;
3394 chtChart.Hint := '';
3395 chtChart.Tag := 0;
3396end;
3397
3398procedure TfrmLabs.chtChartClickSeries(Sender: TCustomChart;
3399 Series: TChartSeries; ValueIndex: Integer; Button: TMouseButton;
3400 Shift: TShiftState; X, Y: Integer);
3401begin
3402 inherited;
3403 if Series = serHigh then exit;
3404 if Series = serLow then exit;
3405 uDate1 := Series.XValue[ValueIndex];
3406 uDate2 := uDate1;
3407 chtChart.Hint := 'Details - Lab results for ' + FormatDateTime('dddd, mmmm d, yyyy', Series.XValue[ValueIndex]) + '...';
3408 chtChart.Tag := ValueIndex + 1;
3409 if Button <> mbRight then popDetailsClick(self);
3410end;
3411
3412procedure TfrmLabs.chtChartClickLegend(Sender: TCustomChart;
3413 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
3414begin
3415 inherited;
3416 chtChart.Hint := 'Details - for ' + Piece(serTest.Title, '(', 1) + '...';
3417 chtChart.Tag := 0;
3418 if Button <> mbRight then popDetailsClick(self);
3419end;
3420
3421procedure TfrmLabs.popDetailsClick(Sender: TObject);
3422var
3423 tmpList: TStringList;
3424 date1, date2: TFMDateTime;
3425 strdate1, strdate2: string;
3426begin
3427 inherited;
3428 Screen.Cursor := crHourGlass;
3429 if chtChart.Tag > 0 then
3430 begin
3431 tmpList := TStringList.Create;
3432 try
3433 strdate1 := FormatDateTime('mm/dd/yyyy', uDate1);
3434 strdate2 := FormatDateTime('mm/dd/yyyy', uDate2);
3435 uDate1 := StrToDateTime(strdate1);
3436 uDate2 := StrToDateTime(strdate2);
3437 date1 := DateTimeToFMDateTime(uDate1 + 1);
3438 date2 := DateTimeToFMDateTime(uDate2);
3439 StatusText('Retrieving data for ' + FormatDateTime('dddd, mmmm d, yyyy', uDate2) + '...');
3440 Interim(tmpList, Patient.DFN, date1, date2,'ORWLRR INTERIM');
3441 ReportBox(tmpList, 'Lab results on ' + Patient.Name + ' for ' + FormatDateTime('dddd, mmmm d, yyyy', uDate2), True);
3442 finally
3443 tmplist.Free;
3444 end;
3445 end
3446 else
3447 begin
3448 date1 := DateTimeToFMDateTime(chtChart.BottomAxis.Maximum);
3449 date2 := DateTimeToFMDateTime(chtChart.BottomAxis.Minimum);
3450 tmpList := TStringList.Create;
3451 try
3452 if lstTestGraph.ItemIndex > -1 then
3453 tmpList.Add(lstTestGraph.Items[lstTestGraph.ItemIndex])
3454 else
3455 tmpList.Add(Piece(lblSingleTest.Caption, '^', 1));
3456 StatusText('Retrieving data for ' + serTest.Title + '...');
3457 ReportBox(InterimSelect(Patient.DFN, date1, date2, tmpList), Piece(serTest.Title, '(', 1) + 'results on ' + Patient.Name, True);
3458 finally
3459 tmpList.Free;
3460 end;
3461 end;
3462 Screen.Cursor := crDefault;
3463 StatusText('');
3464end;
3465
3466procedure TfrmLabs.popPrintClick(Sender: TObject);
3467begin
3468 inherited;
3469 if chtChart.Visible then PrintLabGraph;
3470end;
3471
3472procedure TfrmLabs.PrintLabGraph;
3473var
3474 GraphTitle: string;
3475begin
3476 inherited;
3477 GraphTitle := Piece(lblSingleTest.Caption, '^', 2);
3478 if (Length(lblSpecimen.Caption) > 2) then GraphTitle := GraphTitle + ' (' + Piece(lblSpecimen.Caption, '^', 2) + ')';
3479 GraphTitle := GraphTitle + ' - ' + lstDates.DisplayText[lstDates.ItemIndex];
3480 if dlgWinPrint.Execute then PrintGraph(chtChart, GraphTitle);
3481end;
3482
3483procedure TfrmLabs.BeginEndDates(var ADate1, ADate2: TFMDateTime; var ADaysBack: integer);
3484var
3485 datetemp: TFMDateTime;
3486 today, datetime1, datetime2: TDateTime;
3487 relativedate: string;
3488begin
3489 today := FMToDateTime(floattostr(FMToday));
3490 relativedate := Piece(lstDates.ItemID, ';', 1);
3491 relativedate := Piece(relativedate, '-', 2);
3492 ADaysBack := strtointdef(relativedate, 0);
3493 ADate1 := DateTimeToFMDateTime(today - ADaysBack);
3494 relativedate := Piece(lstDates.ItemID, ';', 2);
3495 if StrToIntDef(Piece(relativedate, '+', 2), 0) > 0 then
3496 begin
3497 relativedate := Piece(relativedate, '+', 2);
3498 ADaysBack := strtointdef(relativedate, 0);
3499 ADate2 := DateTimeToFMDateTime(today + ADaysBack + 1);
3500 end
3501 else
3502 begin
3503 relativedate := Piece(relativedate, '-', 2);
3504 ADaysBack := strtointdef(relativedate, 0);
3505 ADate2 := DateTimeToFMDateTime(today - ADaysBack);
3506 end;
3507 datetime1 := FMDateTimeToDateTime(ADate1);
3508 datetime2 := FMDateTimeToDateTime(ADate2);
3509 if datetime1 < datetime2 then // reorder dates, if needed
3510 begin
3511 datetemp := ADate1;
3512 ADate1 := ADate2;
3513 ADate2 := datetemp
3514 end;
3515 ADate1 := ADate1 + 0.2359;
3516end;
3517
3518procedure TfrmLabs.Timer1Timer(Sender: TObject);
3519var
3520 i,j: integer;
3521 r0: String;
3522begin
3523 inherited;
3524 with RemoteSites.SiteList do
3525 begin
3526 for i := 0 to Count - 1 do
3527 if TRemoteSite(Items[i]).Selected then
3528 if Length(TRemoteSite(Items[i]).LabRemoteHandle) > 0 then
3529 begin
3530 r0 := GetRemoteStatus(TRemoteSite(Items[i]).LabRemoteHandle);
3531 TRemoteSite(Items[i]).LabQueryStatus := r0; //r0='1^Done' if no errors
3532 if piece(r0,'^',1) = '1' then
3533 begin
3534 RemoteReports.Add(TRemoteSite(Items[i]).CurrentLabQuery,
3535 TRemoteSite(Items[i]).LabRemoteHandle);
3536 GetRemoteData(TRemoteSite(Items[i]).LabData,
3537 TRemoteSite(Items[i]).LabRemoteHandle,Items[i]);
3538 TRemoteSite(Items[i]).LabRemoteHandle := '';
3539 TabControl1.OnChange(nil);
3540 end
3541 else
3542 begin
3543 uRemoteCount := uRemoteCount + 1;
3544 if uRemoteCount > 60 then //5 minute limit
3545 begin
3546 Timer1.Enabled := False;
3547 TRemoteSite(Items[i]).LabQueryStatus := '-1^Timed out';
3548 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Timed out');
3549 StatusText('');
3550 TabControl1.OnChange(nil);
3551 end
3552 else
3553 StatusText('Retrieving Lab data from '
3554 + TRemoteSite(Items[i]).SiteName + '...');
3555 end;
3556 Timer1.Interval := 5000;
3557 end;
3558 if Timer1.Enabled = True then
3559 begin
3560 j := 0;
3561 for i := 0 to Count -1 do
3562 if Length(TRemoteSite(Items[i]).LabRemoteHandle) > 0 then
3563 j := 1;
3564 if j = 0 then //Shutdown timer if all sites have been processed
3565 begin
3566 Timer1.Enabled := False;
3567 StatusText('');
3568 end;
3569 j := 0;
3570 for i := 0 to Count -1 do
3571 if TRemoteSite(Items[i]).Selected = true then
3572 j := 1;
3573 if j = 0 then //Shutdown timer if user has de-selected all sites
3574 begin
3575 Timer1.Enabled := False;
3576 StatusText('');
3577 TabControl1.OnChange(nil);
3578 end;
3579 end;
3580 end;
3581end;
3582
3583procedure TfrmLabs.tvReportsClick(Sender: TObject);
3584var
3585 i: integer;
3586 ListItem: TListItem;
3587 aHeading, aReportType, aRPC, aQualifier, aStartTime, aStopTime, aMax, aRptCode, aRemote, aCategory, aSortOrder, aDaysBack, x, x1, x2: string;
3588 aIFN, aOldID: integer;
3589 aID, aHSTag, aRadParam, aColChange, aDirect, aHDR, aFHIE, aFHIEONLY, aQualifierID: string;
3590 CurrentParentNode, CurrentNode: TTreeNode;
3591begin
3592 inherited;
3593 lvReports.Hint := 'To sort, click on column headers|';
3594 tvReports.TopItem := tvReports.Selected;
3595 uRemoteCount := 0;
3596 uReportInstruction := '';
3597 aHeading := PReportTreeObject(tvReports.Selected.Data)^.Heading;
3598 aRemote := PReportTreeObject(tvReports.Selected.Data)^.Remote;
3599 aReportType := PReportTreeObject(tvReports.Selected.Data)^.RptType;
3600 aQualifier := PReportTreeObject(tvReports.Selected.Data)^.Qualifier;
3601 aID := PReportTreeObject(tvReports.Selected.Data)^.ID;
3602 aRPC := PReportTreeObject(tvReports.Selected.Data)^.RPCName;
3603 aHSTag := PReportTreeObject(tvReports.Selected.Data)^.HSTag;
3604 aCategory := PReportTreeObject(tvReports.Selected.Data)^.Category;
3605 aSortOrder := PReportTreeObject(tvReports.Selected.Data)^.SortOrder;
3606 aDaysBack := PReportTreeObject(tvReports.Selected.Data)^.MaxDaysBack;
3607 aIFN := StrToIntDef(PReportTreeObject(tvReports.Selected.Data)^.IFN,0);
3608 aDirect := PReportTreeObject(tvReports.Selected.Data)^.Direct;
3609 aHDR := PReportTreeObject(tvReports.Selected.Data)^.HDR;
3610 aFHIE := PReportTreeObject(tvReports.Selected.Data)^.FHIE;
3611 aFHIEONLY := PReportTreeObject(tvReports.Selected.Data)^.FHIEONLY;
3612 aStartTime := Piece(aQualifier,';',1);
3613 aStopTime := Piece(aQualifier,';',2);
3614 aMax := Piece(aQualifier,';',3);
3615 aRptCode := Piece(aQualifier,';',4);
3616 aQualifierID:= '';
3617 lstQualifier.ItemIndex := -1;
3618 if length(uColChange) > 0 then
3619 begin
3620 aColChange := '';
3621 for i := 0 to lvReports.Columns.Count - 1 do
3622 aColChange := aColChange + IntToStr(lvReports.Column[i].width) + ',';
3623 if (Length(aColChange) > 0) and (aColChange <> piece(uColchange,'^',2)) then
3624 SaveColumnSizes(piece(uColChange,'^',1) + '^' + aColChange);
3625 uColChange := '';
3626 end;
3627 if (aReportType <> 'M') and (aRPC = '') and (CharAt(aID,1) = 'H') then
3628 begin
3629 aReportType := 'R';
3630 aRptCode := LowerCase(CharAt(aID,1)) + Copy(aID, 2, Length(aID));
3631 aID := '1';
3632 aRPC := 'ORWRP REPORT TEXT';
3633 aHSTag := '';
3634 end;
3635 uLabLocalReportData.Clear;
3636 uLabRemoteReportData.Clear;
3637 if aReportType = '' then aReportType := 'R';
3638 uReportRPC := aRPC;
3639 uRptID := aID;
3640 uDirect := aDirect;
3641 uReportType := aReportType;
3642 uQualifier := aQualifier;
3643 uSortOrder := aSortOrder;
3644 uRemoteType := aRemote + '^' + aReportType + '^' + IntToStr(aIFN) + '^' + aHeading + '^' + aRptCode + '^' + aDaysBack + '^' + aHDR + '^' + aFHIE + '^' + aFHIEONLY;
3645 pnlRightTop.Height := lblTitle.Height; // see below
3646 RedrawSuspend(tvReports.Handle);
3647 RedrawSuspend(memLab.Handle);
3648 uHState := aHSTag;
3649 Timer1.Enabled := False;
3650 TabControl1.Visible := false;
3651 TabControl1.TabStop := false;
3652 sptHorzRight.Visible := true;
3653 lvReports.Visible := false;
3654 if (aRemote = '1') or (aRemote = '2') then
3655 if not(uReportType = 'V') then
3656 if TabControl1.Tabs.Count > 1 then
3657 begin
3658 TabControl1.Visible := true;
3659 TabControl1.TabStop := true;
3660 pnlRightTop.Height := lblTitle.Height + TabControl1.Height;
3661 end;
3662 StatusText('');
3663 uHTMLDoc := '';
3664 //WebBrowser1.Navigate('about:blank'); **Browser Remove**
3665 memLab.Lines.Clear;
3666 memLab.Parent := pnlRightBottom;
3667 memLab.Align := alClient;
3668 lvReports.SmallImages := uEmptyImageList;
3669 lvReports.Items.Clear;
3670 lvReports.Columns.Clear;
3671 lblHeading.Caption := ''; //clears Notification text to reduce confusion with lblTitle.Caption.
3672 DisplayHeading('');
3673 if uReportType = 'H' then
3674 begin
3675 lvReports.Visible := false;
3676 pnlRightBottom.Visible := true;
3677 {WebBrowser1.Visible := true; **Browser Remove**
3678 WebBrowser1.TabStop := true;
3679 WebBrowser1.Navigate('about:blank');
3680 WebBrowser1.BringToFront; }
3681 memLab.Visible := false;
3682 memLab.TabStop := false;
3683 end
3684 else
3685 if uReportType = 'V' then
3686 begin
3687 with lvReports do
3688 begin
3689 RedrawSuspend(lvReports.Handle);
3690 Columns.BeginUpdate;
3691 ViewStyle := vsReport;
3692 ColumnHeaders(uColumns, IntToStr(aIFN));
3693 for i := 0 to uColumns.Count -1 do
3694 begin
3695 uNewColumn := Columns.Add;
3696 uNewColumn.Caption := piece(uColumns.Strings[i],'^',1);
3697 if length(uColChange) < 1 then uColChange := IntToStr(aIFN) + '^';
3698 if piece(uColumns.Strings[i],'^',2) = '1' then
3699 begin
3700 uNewColumn.Width := 0;
3701 uColChange := uColChange + '0,';
3702 end
3703 else
3704 if length(piece(uColumns.Strings[i],'^',10)) > 0 then
3705 begin
3706 uColChange := uColChange + piece(uColumns.Strings[i],'^',10) + ',';
3707 uNewColumn.Width := StrToInt(piece(uColumns.Strings[i],'^',10))
3708 end
3709 else
3710 uNewColumn.Width := ColumnHeaderWidth; //ColumnTextWidth for width of text
3711 if (i = 0) and (((aRemote <> '2') and (aRemote <> '1')) or ((TabControl1.Tabs.Count < 2) and (not (aHDR = '1')))) then
3712 uNewColumn.Width := 0;
3713 end;
3714 Columns.EndUpdate;
3715 RedrawActivate(lvReports.Handle);
3716 end;
3717 lvReports.Visible := true;
3718 sptHorzRight.Visible := true;
3719 //WebBrowser1.Visible := false; **Browser Remove**
3720 //WebBrowser1.TabStop := false; **Browser Remove**
3721 pnlRightBottom.Visible := true;
3722 memLab.Visible := true;
3723 memLab.TabStop := true;
3724 memLab.BringToFront;
3725 RedrawActivate(memLab.Handle);
3726 end
3727 else
3728 begin
3729 lvReports.Visible := true;
3730 sptHorzRight.Visible := false;
3731 //WebBrowser1.Visible := false; **Browser Remove**
3732 //WebBrowser1.TabStop := false; **Browser Remove**
3733 pnlRightBottom.Visible := True;
3734 memLab.Visible := true;
3735 memLab.TabStop := true;
3736 memLab.BringToFront;
3737 RedrawActivate(memLab.Handle);
3738 end;
3739 uLocalReportData.Clear;
3740 RowObjects.Clear;
3741 uRemoteReportData.Clear;
3742 lstHeaders.Visible := false;
3743 lstHeaders.TabStop := false;
3744 lblHeaders.Visible := false;
3745 lstHeaders.Clear;
3746 for i := 0 to RemoteSites.SiteList.Count - 1 do
3747 TRemoteSite(RemoteSites.SiteList.Items[i]).LabClear;
3748 if uFrozen = True then
3749 begin
3750 memo1.visible := False;
3751 memo1.TabStop := False;
3752 end;
3753 Screen.Cursor := crHourGlass;
3754 if aReportType = 'M' then
3755 begin
3756 pnlLeftBottom.Visible := false;
3757 splitter1.Visible := false;
3758 CommonComponentVisible(false,false,false,false,false,false,false,false,false,false,false,false);
3759 memLab.Clear;
3760 chkBrowser;
3761 pnlHeader.Visible := false;
3762 sptHorzRight.Visible := true;
3763 lvReports.Visible := false;
3764 pnlRighttop.Height := lblHeading.Height;
3765 memLab.Height := pnlRight.Height - (lblHeading.Height + lblTitle.Height);
3766 pnlRightTop.Visible := true;
3767 memLab.Align := alClient;
3768 FormResize(self);
3769 end
3770 else
3771 begin
3772 uQualifierType := StrToIntDef(aRptCode,0);
3773 case uQualifierType of
3774 QT_OTHER:
3775 begin // = 0
3776 memLab.Lines.Clear;
3777 If aID = '1:MOST RECENT' then
3778 begin
3779 CommonComponentVisible(false,false,false,false,false,true,true,false,true,false,false,false);
3780 pnlRightTop.Height := pnlLeft.Height - (pnlLeft.Height div 5);
3781 pnlRightTop.Visible := true;
3782 pnlButtons.Visible := true;
3783 pnlWorksheet.Visible := false;
3784 pnlGraph.Visible := false;
3785 memLab.Align := alBottom;
3786 pnlRightTop.Align := alTop;
3787 pnlRightBottom.Align := alclient;
3788 sptHorzRight.Visible := true;
3789 pnlRightBottom.Visible := true;
3790 pnlRightBottom.Height := pnlLeft.Height div 5;
3791 memLab.Height := pnlLeft.Height div 5;
3792 grdLab.Align := alTop;
3793 memLab.Clear;
3794 {if uReportType = 'H' then **Browser Remove**
3795 begin
3796 WebBrowser1.Navigate('about:blank');
3797 WebBrowser1.Align := alBottom;
3798 WebBrowser1.Height := pnlLeft.Height div 5;
3799 WebBrowser1.Visible := true;
3800 WebBrowser1.BringToFront;
3801 memLab.Visible := false;
3802 end
3803 else
3804 begin
3805 WebBrowser1.Visible := false;
3806 WebBrowser1.SendToBack; }
3807 memLab.Visible := true;
3808 memLab.BringToFront;
3809 //end; }
3810 FormResize(self);
3811 cmdRecentClick(self);
3812 uPrevReportNode := tvReports.Selected;
3813 end
3814 else if aID = '4:SELECTED TESTS BY DATE' then
3815 begin // Interim for Selected Tests
3816 if uPrevReportNode <> tvReports.Selected then
3817 begin
3818 lstTests.Clear;
3819 lblSpecimen.Caption := '';
3820 end;
3821 SelectTests(Font.Size);
3822 if lstTests.Items.Count > 0 then
3823 begin
3824 CommonComponentVisible(false,false,true,true,true,false,false,false,true,false,false,false);
3825 pnlRighttop.Height := lblHeading.Height + lblTitle.Height;
3826 pnlRightTop.Visible := false;
3827 memLab.Clear;
3828 chkBrowser;
3829 FormResize(self);
3830 RedrawActivate(memLab.Handle);
3831 lstDatesClick(self);
3832 //lstQualifierClick(self);
3833 cmdOtherTests.SetFocus;
3834 cmdOtherTests.Default := true;
3835 uPrevReportNode := tvReports.Selected;
3836 end
3837 else tvReports.Selected := uPrevReportNode;
3838 end
3839 else if aID = '5:WORKSHEET' then
3840 begin // Worksheet
3841 if uPrevReportNode <> tvReports.Selected then
3842 begin
3843 lstTests.Clear;
3844 lblSpecimen.Caption := '';
3845 end;
3846 SelectTestGroups(Font.Size);
3847 if lstTests.Items.Count > 0 then
3848 begin
3849 CommonComponentVisible(false,false,true,true,true,true,true,false,false,false,false,false);
3850 pnlRighttop.Height := pnlRight.Height - (pnlRight.Height div 4);
3851 pnlRightTop.Visible := true;
3852 pnlHeader.Align := alTop;
3853 pnlChart.Align := alTop;
3854 sptHorzRight.Visible := true;
3855 chtChart.Visible := true;
3856 memLab.Visible := false;
3857 pnlButtons.Visible := false;
3858 pnlWorksheet.Visible := true;
3859 pnlGraph.Visible := false;
3860 lstTestGraph.Width := 97;
3861 ragCorG.ItemIndex := 0;
3862 FormResize(self);
3863 lblFooter.Caption := ' KEY: "L" = Abnormal Low, "H" = Abnormal High, "*" = Critical Value, "**" = Comments on Specimen';
3864 //chkZoom.Checked := false;
3865 //chkZoomClick(self);
3866 lstDatesClick(self);
3867 //lstQualifierClick(self);
3868 cmdOtherTests.SetFocus;
3869 cmdOtherTests.Default := true;
3870 uPrevReportNode := tvReports.Selected;
3871 if ScreenReaderSystemActive then
3872 grdLab.SetFocus;
3873 end
3874 else tvReports.Selected := uPrevReportNode;
3875 end
3876
3877 else if aID = '6:GRAPH' then
3878 begin // Graph
3879 // do if graphing is activiated
3880 if uGraphingActivated then
3881 begin
3882 memLab.Clear;
3883 chkBrowser;
3884 FormResize(self);
3885 memLab.Align := alClient;
3886 CommonComponentVisible(false,false,false,false,false,false,false,false,false,false,false,false);
3887 pnlRightTop.Visible := false;
3888 RedrawActivate(memLab.Handle);
3889 StatusText('');
3890 memLab.Lines.Insert(0, ' ');
3891 memLab.Lines.Insert(1, 'Graphing activated');
3892 memLab.SelStart := 0;
3893 frmFrame.mnuToolsGraphingClick(self); // make it just lab tests ??
3894 //tvReports.Selected := uPrevReportNode;
3895 end
3896 else // otherwise, do lab graph
3897 begin
3898 if uPrevReportNode <> tvReports.Selected then
3899 begin
3900 lblSingleTest.Caption := '';
3901 lblSpecimen.Caption := '';
3902 end;
3903 SelectTest(Font.Size);
3904 if (length(lblSingleTest.Caption) > 2) and (length(lblSpecimen.Caption) > 2) then
3905 begin
3906 CommonComponentVisible(false,false,true,true,true,true,false,false,true,false,false,false);
3907 pnlChart.Visible := true;
3908 chtChart.Visible := true;
3909 pnlButtons.Visible := false;
3910 pnlWorksheet.Visible := false;
3911 pnlGraph.Visible := true;
3912 memLab.Height := pnlRight.Height div 5;
3913 memLab.Clear;
3914 {if uReportType = 'H' then **Browser Remove**
3915 begin
3916 WebBrowser1.Visible := true;
3917 WebBrowser1.Navigate('about:blank');
3918 WebBrowser1.Height := pnlRight.Height div 5;
3919 WebBrowser1.BringToFront;
3920 memLab.Visible := false;
3921 end
3922 else
3923 begin
3924 WebBrowser1.Visible := false;
3925 WebBrowser1.SendToBack; }
3926 memLab.Visible := true;
3927 memLab.BringToFront;
3928 //end; }
3929 lstTestGraph.Items.Clear;
3930 lstTestGraph.Width := 0;
3931 FormResize(self);
3932 RedrawActivate(memLab.Handle);
3933 lblFooter.Caption := '';
3934 chkGraphZoom.Checked := false;
3935 chkGraphZoomClick(self);
3936 chkGraph3DClick(self);
3937 chkGraphValuesClick(self);
3938 lstDatesClick(self);
3939 //lstQualifierClick(self);
3940 cmdOtherTests.SetFocus;
3941 cmdOtherTests.Default := true;
3942 uPrevReportNode := tvReports.Selected;
3943 end
3944 else
3945 tvReports.Selected := uPrevReportNode;
3946 end;
3947 end
3948
3949 else if (aID = '9:MICROBIOLOGY') or (aID = '20:ANATOMIC PATHOLOGY') or (aID = '2:BLOOD BANK') or (aID = '10:LAB STATUS') or (aID = '3:ALL TESTS BY DATE') or (aID = '21:CUMULATIVE') or (aID = '27:AUTOPSY') then
3950 begin
3951 //added to deal with other reports from file 101.24
3952 memLab.Clear;
3953 chkBrowser;
3954 pnlHeader.Visible := false;
3955 pnlRightTop.Visible := false;
3956 pnlRightBottom.Visible := false;
3957 sptHorzRight.Visible := false;
3958 pnlRightTop.Height := lblHeading.Height;
3959 pnlRightTop.Align := alTop;
3960 pnlRightBottom.Align := alclient;
3961 sptHorzRight.Visible := true;
3962 pnlRightBottom.Visible := true;
3963 lvReports.Visible := false;
3964 memLab.Height := pnlRight.Height - (lblHeading.Height + lblTitle.Height);
3965 memLab.Align := alClient;
3966 FormResize(self);
3967 aOldID := 1;
3968 if aID = '9:MICROBIOLOGY' then aOldID := 4;
3969 //if aID = '20:ANATOMIC PATHOLOGY' then AOldID := 8;
3970 if aID = '2:BLOOD BANK' then AOldID := 9;
3971 if aID = '10:LAB STATUS' then AOldID := 10;
3972 if aID = '3:ALL TESTS BY DATE' then AOldID := 3;
3973 if aID = '21:CUMULATIVE' then AOldID := 2;
3974 case StrToInt(aCategory) of
3975 {Categories of reports:
3976 0:Fixed
3977 1:Fixed w/Dates
3978 2:Fixed w/Headers
3979 3:Fixed w/Dates & Headers
3980 4:Specialized
3981 5:Graphic}
3982
3983 0: begin
3984 CommonComponentVisible(false,false,false,false,false,false,false,false,false,false,false,false);
3985 StatusText('Retrieving data...');
3986 GoRemoteOld(uLabRemoteReportData,0,aOldID,'',uReportRPC,'0','9999','1',0,0);
3987 //GoRemote(uRemoteReportData, aID, aRptCode, aRPC, uHState, aHDR, aFHIE);
3988 TabControl1.OnChange(nil);
3989 Reports(uLabLocalReportData,Patient.DFN, 'L:' + Piece(aID,':',1), '0', '9999', '1', 0, 0, uReportRPC);
3990 if TabControl1.TabIndex < 1 then
3991 QuickCopy(uLabLocalReportData,memLab);
3992 RedrawActivate(memLab.Handle);
3993 StatusText('');
3994 memLab.Lines.Insert(0,' ');
3995 memLab.Lines.Delete(0);
3996 memLab.SelStart := 0;
3997 if uReportType = 'R' then
3998 uHTMLDoc := HTML_PRE + uLabLocalReportData.Text + HTML_POST
3999 else
4000 uHTMLDoc := uHTMLPatient + uLabLocalReportData.Text;
4001 //if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank'); **Browser Remove**
4002 end;
4003 1: begin
4004 CommonComponentVisible(false,false,false,true,true,false,false,false,false,false,false,false);
4005 memLab.Repaint;
4006 lstDatesClick(self);
4007 //lstQualifierClick(self);
4008 end;
4009 2: begin
4010 CommonComponentVisible(true,true,false,false,false,false,false,false,false,false,false,false);
4011 lstHeaders.Clear;
4012 StatusText('Retrieving data...');
4013 GoRemoteOld(uLabRemoteReportData,0,aOldID,'',uReportRPC,'0','9999','1',0,0);
4014 //GoRemote(uRemoteReportData, aID, aRptCode, aRPC, uHState, aHDR, aFHIE);
4015 TabControl1.OnChange(nil);
4016 Reports(uLabLocalReportData,Patient.DFN, Piece(aID,':',1), '0', '9999', '1', 0, 0, uReportRPC);
4017 if uLabLocalReportData.Count > 0 then
4018 begin
4019 TabControl1.OnChange(nil);
4020 if lstHeaders.Items.Count > 0 then lstHeaders.ItemIndex := 0;
4021 end;
4022 RedrawActivate(memLab.Handle);
4023 StatusText('');
4024 memLab.Lines.Insert(0,' ');
4025 memLab.Lines.Delete(0);
4026 if uReportType = 'R' then
4027 uHTMLDoc := HTML_PRE + uLabLocalReportData.Text + HTML_POST
4028 else
4029 uHTMLDoc := uHTMLPatient + uLabLocalReportData.Text;
4030 //if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank'); **Browser Remove**
4031 end;
4032 3: begin
4033 CommonComponentVisible(true,true,false,true,true,false,false,false,true,false,false,false);
4034 lstDatesClick(self);
4035 //lstQualifierClick(self);
4036 memLab.Lines.Insert(0,' ');
4037 memLab.Lines.Delete(0);
4038 end;
4039 end;
4040 uPrevReportNode := tvReports.Selected;
4041 end
4042
4043 //else if aID = '20:ANATOMIC PATHOLOGY' then
4044
4045 //else if aID = '2:BLOOD BANK' then
4046
4047 //else if aID = '10:LAB STATUS' then
4048
4049
4050 else
4051 begin
4052 pnlLeftBottom.Visible := false;
4053 splitter1.Visible := false;
4054 CommonComponentVisible(true,true,false,false,false,false,false,false,false,false,false,false);
4055 pnlRightTop.Visible := true;
4056 StatusText('Retrieving ' + tvReports.Selected.Text + '...');
4057 GoRemote(uRemoteReportData, 'L:' + aID, aRptCode, aRPC, uHState, aHDR, aFHIE);
4058 uReportInstruction := #13#10 + 'Retrieving data...';
4059 TabControl1.OnChange(nil);
4060 if not(piece(uRemoteType, '^', 9) = '1') then
4061 LoadReportText(uLocalReportData, 'L:' + aID, aRptCode, aRPC, uHState);
4062 QuickCopy(uLocalReportData, memLab);
4063 if uLocalReportData.Count > 0 then
4064 TabControl1.OnChange(nil);
4065 StatusText('');
4066 uPrevReportNode := tvReports.Selected;
4067 end;
4068 end;
4069 QT_DATERANGE:
4070 begin // = 2
4071
4072 ListReportDateRanges(lstQualifier.Items);
4073 if lstQualifier.ItemID = '' then
4074 begin
4075 lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
4076 lvReports.SmallImages := uEmptyImageList;
4077 lvReports.Items.Clear;
4078 lstQualifierClick(self);
4079 end
4080 else
4081 lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
4082
4083 lblQualifier.Caption := 'Date Range';
4084 pnlLeftBottom.Visible := true;
4085 splitter1.Visible := true;
4086 uPrevReportNode := tvReports.Selected;
4087 end;
4088 QT_HSCOMPONENT:
4089 begin // = 5
4090 pnlRightTop.Height := pnlRight.Height - (pnlRight.Height div 4);
4091 pnlLeftBottom.Visible := false;
4092 splitter1.Visible := false;
4093 StatusText('Retrieving ' + tvReports.Selected.Text + '...');
4094 uReportInstruction := #13#10 + 'Retrieving data...';
4095 CommonComponentVisible(false,false,false,false,false,false,false,false,false,false,true,true);
4096 pnlRightTop.Visible := true;
4097 lvReports.Visible := true;
4098 lvReports.SmallImages := uEmptyImageList;
4099 lvReports.Items.Clear;
4100 RowObjects.Clear;
4101 memLab.Lines.Clear;
4102 if (length(piece(aHSTag,';',2)) > 0) then
4103 begin
4104 if aCategory <> '0' then
4105 begin
4106 ListReportDateRanges(lstQualifier.Items);
4107 aQualifierID := lstQualifier.ItemID;
4108 if aQualifierID = '' then
4109 begin
4110 if aHDR = '1' then
4111 lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
4112 else
4113 if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
4114 lstQualifierClick(self);
4115 end
4116 else
4117 begin
4118 GoRemote(uRemoteReportData, 'L:' + aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
4119 if aHDR = '1' then
4120 lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
4121 else
4122 if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
4123 lstQualifierClick(self);
4124 end;
4125 lblQualifier.Caption := 'Date Range';
4126 pnlLeftBottom.Visible := true;
4127 splitter1.Visible := true;
4128 end
4129 else
4130 begin
4131 if not (aRemote = '2' ) then
4132 GoRemote(uRemoteReportData, 'L:' + aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
4133 if not(piece(uRemoteType, '^', 9) = '1') then
4134 begin
4135 LoadReportText(uLocalReportData, 'L:' + aID, aQualifier, aRPC, uHState);
4136 LoadListView(uLocalReportData);
4137 end;
4138 end;
4139 end
4140 else
4141 begin
4142 if (aRemote = '1') or (aRemote = '2') then
4143 if TabControl1.Tabs.Count > 1 then
4144 ShowTabControl;
4145 GoRemote(uRemoteReportData, 'L:' + aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
4146 if not(piece(uRemoteType, '^', 9) = '1') then
4147 LoadReportText(uLocalReportData, 'L:' + aID, aQualifier, aRPC, uHState);
4148 if uLocalReportData.Count < 1 then
4149 uReportInstruction := '<No Report Available>'
4150 else
4151 begin
4152 if TabControl1.TabIndex < 1 then
4153 QuickCopy(uLocalReportData,memLab);
4154 end;
4155 TabControl1.OnChange(nil);
4156 if aCategory <> '0' then
4157 begin
4158 ListReportDateRanges(lstQualifier.Items);
4159 if lstQualifier.ItemID = '' then
4160 begin
4161 lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
4162 lstQualifierClick(self);
4163 end
4164 else
4165 lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
4166
4167 lblQualifier.Caption := 'Date Range';
4168 pnlLeftBottom.Visible := true;
4169 splitter1.Visible := true;
4170 end
4171 else
4172 begin
4173 if uLocalReportData.Count < 1 then
4174 begin
4175 uReportInstruction := '<No Report Available>';
4176 memLab.Lines.Add(uReportInstruction);
4177 end
4178 else
4179 begin
4180 QuickCopy(uLocalReportData,memLab);
4181 TabControl1.OnChange(nil);
4182 end;
4183 end;
4184 end;
4185 StatusText('');
4186 uPrevReportNode := tvReports.Selected;
4187 end;
4188 QT_HSWPCOMPONENT:
4189 begin // = 6
4190 if uScreenSplitMoved = false then
4191 begin
4192 pnlRightTop.Height := pnlRight.Height - (pnlRight.Height div 2);
4193 uScreenSplitLoc := sptHorzRight.Top;
4194 end
4195 else
4196 pnlRightTop.Height := uScreenSplitLoc;
4197 pnlLeftBottom.Visible := false;
4198 splitter1.Visible := false;
4199 StatusText('Retrieving ' + tvReports.Selected.Text + '...');
4200 uReportInstruction := #13#10 + 'Retrieving data...';
4201 CommonComponentVisible(false,false,false,false,false,false,false,false,false,false,false,false);
4202 pnlRightTop.Visible := true;
4203 lvReports.Visible := true;
4204 sptHorzRight.Visible := true;
4205 memLab.Visible := true;
4206 TabControl1.OnChange(nil);
4207 RowObjects.Clear;
4208 memLab.Lines.Clear;
4209 lvReports.SmallImages := uEmptyImageList;
4210 lvReports.Items.Clear;
4211 if (length(piece(aHSTag,';',2)) > 0) then
4212 begin
4213 if aCategory <> '0' then
4214 begin
4215 ListReportDateRanges(lstQualifier.Items);
4216 aQualifierID := lstQualifier.ItemID;
4217 if aQualifierID = '' then
4218 begin
4219 if aHDR = '1' then
4220 lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
4221 else
4222 if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
4223 lstQualifierClick(self);
4224 end
4225 else
4226 begin
4227 GoRemote(uRemoteReportData, 'L:' + aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
4228 if aHDR = '1' then
4229 lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
4230 else
4231 if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
4232 lstQualifierClick(self);
4233 end;
4234 lblQualifier.Caption := 'Date Range';
4235 CommonComponentVisible(false,false,false,false,false,false,false,false,false,true,true,true);
4236 pnlLeftBottom.Visible := true;
4237 splitter1.Visible := true;
4238 end
4239 else
4240 begin
4241 GoRemote(uRemoteReportData, 'L:' + aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
4242 if not (aRemote = '2' ) and (not(piece(uRemoteType, '^', 9) = '1')) then
4243 begin
4244 LoadReportText(uLocalReportData, 'L:' + aID, aQualifier, aRPC, uHState);
4245 LoadListView(uLocalReportData);
4246 end;
4247 end;
4248 end
4249 else
4250 begin
4251 if (aRemote = '1') or (aRemote = '2') then
4252 ShowTabControl;
4253 GoRemote(uRemoteReportData, 'L:' + aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
4254 if not(piece(uRemoteType, '^', 9) = '1') then
4255 LoadReportText(uLocalReportData, 'L:' + aID, aQualifier, aRPC, uHState);
4256 if uLocalReportData.Count < 1 then
4257 uReportInstruction := '<No Report Available>'
4258 else
4259 begin
4260 if TabControl1.TabIndex < 1 then
4261 QuickCopy(uLocalReportData,memLab);
4262 end;
4263 TabControl1.OnChange(nil);
4264 if aCategory <> '0' then
4265 begin
4266
4267 ListReportDateRanges(lstQualifier.Items);
4268 if lstQualifier.ItemID = '' then
4269 begin
4270 lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
4271 lstQualifierClick(self);
4272 end
4273 else
4274 lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
4275
4276 lblQualifier.Caption := 'Date Range';
4277 pnlLeftBottom.Visible := true;
4278 splitter1.Visible := true;
4279 end
4280 else
4281 begin
4282 LoadListView(uLocalReportData);
4283 end;
4284 end;
4285 StatusText('');
4286 uPrevReportNode := tvReports.Selected;
4287 end;
4288 else
4289 begin // = ?
4290 uQualifierType := QT_OTHER;
4291 pnlLeftBottom.Visible := false;
4292 splitter1.Visible := false;
4293 StatusText('Retrieving ' + tvReports.Selected.Text + '...');
4294 GoRemote(uRemoteReportData, 'L:' + aID, aRptCode, aRPC, uHState, aHDR, aFHIE);
4295 uReportInstruction := #13#10 + 'Retrieving data...';
4296 TabControl1.OnChange(nil);
4297 //LoadReportText(uLocalReportData, 'L:' + aID, aRptCode, aRPC, uHState);
4298 if not(piece(uRemoteType, '^', 9) = '1') then
4299 LoadReportText(uLocalReportData, 'L:' + aID, '', aRPC, uHState);
4300 if uLocalReportData.Count < 1 then
4301 uReportInstruction := '<No Report Available>'
4302 else
4303 begin
4304 if TabControl1.TabIndex < 1 then
4305 QuickCopy(uLocalReportData,memLab);
4306 end;
4307 TabControl1.OnChange(nil);
4308 StatusText('');
4309 uPrevReportNode := tvReports.Selected;
4310 end;
4311 lstQualifier.Caption := lblQualifier.Caption;
4312 end;
4313 end;
4314 if lstQualifier.ItemIndex > -1 then
4315 begin
4316 if not (aHDR = '1') then
4317 if aCategory <> '0' then
4318 DisplayHeading(uQualifier)
4319 else
4320 DisplayHeading('');
4321 end
4322 else
4323 begin
4324 if not (aHDR = '1') then
4325 if aCategory <> '0' then
4326 begin
4327 //lstDatesClick(self);
4328 x := lstDates.DisplayText[lstDates.ItemIndex];
4329 x1 := piece(x,' ',1);
4330 x2 := piece(x,' ',2);
4331 if (Uppercase(Copy(x1,1,1)) = 'T') and (Uppercase(Copy(x2,1,1)) = 'T') then
4332 DisplayHeading(piece(x,' ',1) + ';' + piece(x,' ',2))
4333 else
4334 DisplayHeading('d' + lstDates.ItemID);
4335 end
4336 else
4337 DisplayHeading('');
4338 end;
4339
4340 SendMessage(tvReports.Handle, WM_HSCROLL, SB_THUMBTRACK, 0);
4341 RedrawActivate(tvReports.Handle);
4342
4343 memLab.Visible := true;
4344 memLab.TabStop := true;
4345 memLab.BringToFront;
4346 RedrawActivate(memLab.Handle);
4347
4348 {if WebBrowser1.Visible = true then **Browser Remove**
4349 begin
4350 WebBrowser1.Navigate('about:blank');
4351 WebBrowser1.BringToFront;
4352 end }
4353 {else if not GraphFormActive then
4354 begin
4355 memLab.Visible := true;
4356 memLab.TabStop := true;
4357 memLab.BringToFront;
4358 RedrawActivate(memLab.Handle);
4359 end}
4360 //else **Browser Remove**
4361 //begin **Browser Remove**
4362 {GraphPanel(true);
4363 with GraphForm do
4364 begin
4365 lstDateRange.Items := cboDateRange.Items;
4366 lstDateRange.ItemIndex := cboDateRange.ItemIndex;
4367 ViewSelections;
4368 BringToFront;
4369 end; }
4370 //end; **Browser Remove**
4371 lvReports.Columns.BeginUpdate;
4372 lvReports.Columns.EndUpdate;
4373 Screen.Cursor := crDefault;
4374end;
4375
4376procedure TfrmLabs.tvReportsCollapsing(Sender: TObject; Node: TTreeNode;
4377 var AllowCollapse: Boolean);
4378begin
4379 inherited;
4380 tvReports.Selected := Node;
4381end;
4382
4383procedure TfrmLabs.tvReportsExpanding(Sender: TObject; Node: TTreeNode;
4384 var AllowExpansion: Boolean);
4385begin
4386 inherited;
4387 tvReports.Selected := Node;
4388end;
4389
4390procedure TfrmLabs.tvReportsKeyDown(Sender: TObject; var Key: Word;
4391 Shift: TShiftState);
4392begin
4393 inherited;
4394 case Key of
4395 VK_LBUTTON, VK_RETURN, VK_SPACE:
4396 begin
4397 tvReportsClick(Sender);
4398 Key := 0;
4399 end;
4400 end;
4401end;
4402
4403procedure TfrmLabs.GoRemote(Dest: TStringList; AItem: string; AQualifier, ARpc: string; AHSTag: string; AHDR: string; aFHIE: string);
4404var
4405 i, j: integer;
4406 LocalHandle, Query, Report, Seq: string;
4407 HSType, DaysBack, ExamID, MaxOcc: string;
4408 Alpha, Omega, Trans: double;
4409begin
4410 HSType := '';
4411 DaysBack := '';
4412 ExamID := '';
4413 Alpha := 0;
4414 Omega := 0;
4415 Seq := '';
4416 if AHDR = '1' then
4417 begin
4418 if HDRActive = '0' then
4419 begin
4420 InfoBox('The HDR is currently inactive.' + CRLF + 'Unable to retrieve HDR data at this time.', 'HDR Error', MB_OK);
4421 Exit;
4422 end;
4423 InfoBox('You must use VistaWeb to view this report.', 'Use VistaWeb for HDR data', MB_OK);
4424 if (Piece(AItem, ':', 1) = 'OR_VWAL') or (Piece(AItem, ':', 1) = 'OR_VWRX') then
4425 AQualifier := 'T-50000;T+50000;99999';
4426 if (Piece(AItem, ':', 1) = 'OR_VWVS') and (CharAt(AQualifier, 1) = ';') then
4427 AQualifier := 'T-50000;T+50000;99999';
4428 end;
4429 if CharAt(AQualifier, 1) = 'd' then
4430 begin
4431 DaysBack := Copy(AQualifier, 2, Length(AQualifier));
4432 AQualifier := ('T-' + Piece(DaysBack,';',1) + ';T;' + Pieces(AQualifier,';',2,3));
4433 DaysBack := '';
4434 end;
4435 if CharAt(AQualifier, 1) = 'T' then
4436 begin
4437 if Piece(AQualifier,';',1) = 'T-0' then SetPiece(AQualifier,';',1,'T');
4438 if (Piece(Aqualifier,';',1) = 'T') and (Piece(Aqualifier,';',2) = 'T')
4439 then SetPiece(AQualifier,';',2,'T+1');
4440 Alpha := StrToFMDateTime(Piece(AQualifier,';',1));
4441 Omega := StrToFMDateTime(Piece(AQualifier,';',2));
4442 if Alpha > Omega then
4443 begin
4444 Trans := Omega;
4445 Omega := Alpha;
4446 Alpha := Trans;
4447 end;
4448 MaxOcc := Piece(AQualifier,';',3);
4449 SetPiece(AHSTag,';',4,MaxOcc);
4450 end;
4451 if CharAt(AQualifier, 1) = 'h' then HSType := Copy(AQualifier, 2, Length(AQualifier));
4452 if CharAt(AQualifier, 1) = 'i' then ExamID := Copy(AQualifier, 2, Length(AQualifier));
4453 with RemoteSites.SiteList do for i := 0 to Count - 1 do
4454 begin
4455 if (AHDR='1') and (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') then
4456 begin
4457 TRemoteSite(Items[i]).Selected := true;
4458 frmFrame.lstCIRNLocations.Checked[i+2] := true;
4459 end;
4460 if TRemoteSite(Items[i]).Selected then
4461 begin
4462 TRemoteSite(Items[i]).ReportClear;
4463 if (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') and not(AHDR = '1') then
4464 begin
4465 TRemoteSite(Items[i]).QueryStatus := '1^Not Included';
4466 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
4467 TRemoteSite(Items[i]).RemoteHandle := '';
4468 TRemoteSite(Items[i]).QueryStatus := '1^Done';
4469 if uQualifierType = 6 then seq := '1^';
4470 TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
4471 if uQualifierType = 6 then seq := '2^';
4472 TRemoteSite(Items[i]).Data.Add(seq + '<No HDR Data Included> - Use "HDR Reports" menu for HDR Data.');
4473 TabControl1.OnChange(nil);
4474 if (length(piece(uHState,';',2)) > 0) then
4475 LoadListView(TRemoteSite(Items[i]).Data);
4476 continue;
4477 end;
4478 if (AHDR = '1') and not(LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') then
4479 begin
4480 TRemoteSite(Items[i]).QueryStatus := '1^Not Included';
4481 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
4482 TRemoteSite(Items[i]).RemoteHandle := '';
4483 TRemoteSite(Items[i]).QueryStatus := '1^Done';
4484 if uQualifierType = 6 then seq := '1^';
4485 TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
4486 if uQualifierType = 6 then seq := '2^';
4487 TRemoteSite(Items[i]).Data.Add(seq + '<No HDR Data> This site is not a source for HDR Data.');
4488 TabControl1.OnChange(nil);
4489 if (length(piece(uHState,';',2)) > 0) then
4490 LoadListView(TRemoteSite(Items[i]).Data);
4491 continue;
4492 end;
4493 if (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200') and not(aFHIE = '1') then
4494 begin
4495 TRemoteSite(Items[i]).QueryStatus := '1^Not Included';
4496 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
4497 TRemoteSite(Items[i]).RemoteHandle := '';
4498 TRemoteSite(Items[i]).QueryStatus := '1^Done';
4499 if uQualifierType = 6 then seq := '1^';
4500 TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
4501 if uQualifierType = 6 then seq := '2^';
4502 TRemoteSite(Items[i]).Data.Add(seq + '<No DOD Data> - Use "Dept. of Defense Reports" Menu to retrieve data from DOD.');
4503 TabControl1.OnChange(nil);
4504 if (length(piece(uHState,';',2)) > 0) then
4505 LoadListView(TRemoteSite(Items[i]).Data);
4506 continue;
4507 end;
4508 TRemoteSite(Items[i]).CurrentReportQuery := 'Report' + Patient.DFN + ';'
4509 + Patient.ICN + '^' + AItem + '^^^' + ARpc + '^' + HSType +
4510 '^' + DaysBack + '^' + ExamID + '^' + FloatToStr(Alpha) + '^' +
4511 FloatToStr(Omega) + '^' + TRemoteSite(Items[i]).SiteID + '^' + AHSTag + '^' + AHDR;
4512 LocalHandle := '';
4513 Query := TRemoteSite(Items[i]).CurrentReportQuery;
4514 for j := 0 to RemoteReports.Count - 1 do
4515 begin
4516 Report := TRemoteReport(RemoteReports.ReportList.Items[j]).Report;
4517 if Report = Query then
4518 begin
4519 LocalHandle := TRemoteReport(RemoteReports.ReportList.Items[j]).Handle;
4520 break;
4521 end;
4522 end;
4523 if Length(LocalHandle) > 1 then
4524 with RemoteSites.SiteList do
4525 begin
4526 GetRemoteData(TRemoteSite(Items[i]).Data,LocalHandle,Items[i]);
4527 TRemoteSite(Items[i]).RemoteHandle := '';
4528 TRemoteSite(Items[i]).QueryStatus := '1^Done';
4529 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Done');
4530 TabControl1.OnChange(nil);
4531 if (length(piece(uHState,';',2)) > 0) then //and (chkText.Checked = false) then
4532 LoadListView(TRemoteSite(Items[i]).Data);
4533 end
4534 else
4535 begin
4536 if uDirect = '1' then
4537 begin
4538 StatusText('Retrieving reports from ' + TRemoteSite(Items[i]).SiteName + '...');
4539 TRemoteSite(Items[i]).QueryStatus := '1^Direct Call';
4540 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Direct Call');
4541 DirectQuery(Dest, AItem, HSType, Daysback, ExamID, Alpha, Omega, TRemoteSite(Items[i]).SiteID, ARpc, AHSTag);
4542 if Copy(Dest[0],1,2) = '-1' then
4543 begin
4544 TRemoteSite(Items[i]).QueryStatus := '-1^Communication error';
4545 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication error');
4546 if uQualifierType = 6 then seq := '1^';
4547 TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
4548 if uQualifierType = 6 then seq := '2^';
4549 TRemoteSite(Items[i]).Data.Add(seq + '<ERROR>- Unable to communicate with Remote site');
4550 TabControl1.OnChange(nil);
4551 if (length(piece(uHState,';',2)) > 0) then
4552 LoadListView(TRemoteSite(Items[i]).Data);
4553 end
4554 else
4555 begin
4556 QuickCopy(Dest,TRemoteSite(Items[i]).Data);
4557 TRemoteSite(Items[i]).RemoteHandle := '';
4558 TRemoteSite(Items[i]).QueryStatus := '1^Done';
4559 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Done');
4560 TabControl1.OnChange(nil);
4561 if (length(piece(uHState,';',2)) > 0) then
4562 LoadListView(TRemoteSite(Items[i]).Data);
4563 end;
4564 StatusText('');
4565 end
4566 else
4567 begin
4568 RemoteQuery(Dest, AItem, HSType, Daysback, ExamID, Alpha, Omega, TRemoteSite(Items[i]).SiteID, ARpc, AHSTag);
4569 if Dest[0] = '' then
4570 begin
4571 TRemoteSite(Items[i]).QueryStatus := '-1^Communication error';
4572 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication error');
4573 if uQualifierType = 6 then seq := '1^';
4574 TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
4575 if uQualifierType = 6 then seq := '2^';
4576 TRemoteSite(Items[i]).Data.Add(seq + '<ERROR>- Unable to communicate with Remote site');
4577 TabControl1.OnChange(nil);
4578 if (length(piece(uHState,';',2)) > 0) then
4579 LoadListView(TRemoteSite(Items[i]).Data);
4580 end
4581 else
4582 begin
4583 TRemoteSite(Items[i]).RemoteHandle := Dest[0];
4584 TRemoteSite(Items[i]).QueryStatus := '0^initialization...';
4585 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'initialization');
4586 Timer1.Enabled := True;
4587 StatusText('Retrieving reports from ' + TRemoteSite(Items[i]).SiteName + '...');
4588 end;
4589 end;
4590 end;
4591 end;
4592 end;
4593end;
4594
4595procedure TfrmLabs.GoRemoteOld(Dest: TStringList; AItem, AReportID: Int64; AQualifier,
4596 ARpc, AHSType, ADaysBack, ASection: string; ADate1, ADate2: TFMDateTime);
4597var
4598 i,j: integer;
4599 LocalHandle, Report, Query, seq: String;
4600begin
4601 { AReportID := 1 Generic report RemoteLabReports
4602 2 Cumulative RemoteLabCumulative
4603 3 Interim RemoteLabInterim
4604 4 Microbioloby RemoteLabMicro }
4605seq := '';
4606 with RemoteSites.SiteList do
4607 for i := 0 to Count - 1 do
4608 if TRemoteSite(Items[i]).Selected then
4609 begin
4610 TRemoteSite(Items[i]).LabClear;
4611 if (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') then
4612 begin
4613 TRemoteSite(Items[i]).LabQueryStatus := '1^Not Included';
4614 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
4615 TabControl1.OnChange(nil);
4616 continue;
4617 end;
4618 if (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200') then
4619 begin
4620 TRemoteSite(Items[i]).QueryStatus := '1^Not Included';
4621 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
4622 TabControl1.OnChange(nil);
4623 continue;
4624 end;
4625 TRemoteSite(Items[i]).CurrentLabQuery := 'Lab' + Patient.DFN + ';' + Patient.ICN +
4626 '^' + IntToStr(AItem) + '^' + 'L:' + IntToStr(AReportID) + '^^' + ARpc + '^' + AHSType +
4627 '^' + ADaysBack + '^' + ASection + '^' + DateToStr(ADate1) + '^' + DateToStr(ADate2) + '^' +
4628 TRemoteSite(Items[i]).SiteID;
4629 LocalHandle := '';
4630 for j := 0 to RemoteReports.Count - 1 do
4631 begin
4632 Query := TRemoteSite(Items[i]).CurrentLabQuery;
4633 Report := TRemoteReport(RemoteReports.ReportList.Items[j]).Report;
4634 if Report = Query then
4635 begin
4636 LocalHandle := TRemoteReport(RemoteReports.ReportList.Items[j]).Handle;
4637 break;
4638 end;
4639 end;
4640 if Length(LocalHandle) > 1 then
4641 with RemoteSites.SiteList do
4642 begin
4643 GetRemoteData(TRemoteSite(Items[i]).LabData,LocalHandle,Items[i]);
4644 TRemoteSite(Items[i]).LabRemoteHandle := '';
4645 TRemoteSite(Items[i]).LabQueryStatus := '1^Done';
4646 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Done');
4647 TabControl1.OnChange(nil);
4648 end
4649 else
4650 begin
4651 case AReportID of
4652 1: begin
4653 RemoteLabReports(Dest, Patient.DFN + ';' + Patient.ICN, IntToStr(AItem),
4654 AHSType, ADaysBack, ASection, ADate1, ADate2,
4655 TRemoteSite(Items[i]).SiteID, ARpc);
4656 end;
4657 2: begin
4658 RemoteLabCumulative(Dest, Patient.DFN + ';' + Patient.ICN,
4659 StrToInt(Adaysback), Adate1, Adate2, TRemoteSite(Items[i]).SiteID,ARpc);
4660 end;
4661 3: begin
4662 RemoteLabInterim(Dest, Patient.DFN + ';' + Patient.ICN, Adate1, Adate2,
4663 TRemoteSite(Items[i]).SiteID, ARpc);
4664 end;
4665 4: begin
4666 RemoteLabMicro(Dest, Patient.DFN + ';' + Patient.ICN, Adate1, Adate2,
4667 TRemoteSite(Items[i]).SiteID, ARpc);
4668 end;
4669 else begin
4670 RemoteLab(Dest, Patient.DFN + ';' + Patient.ICN, IntToStr(AItem),
4671 AHSType, ADaysBack, ASection, ADate1, ADate2,
4672 TRemoteSite(Items[i]).SiteID, ARpc);
4673 end;
4674 end;
4675 if Dest[0] = '' then
4676 begin
4677 TRemoteSite(Items[i]).LabQueryStatus := '-1^Communication error';
4678 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Communication error');
4679 end
4680 else
4681 begin
4682 TRemoteSite(Items[i]).LabRemoteHandle := Dest[0];
4683 TRemoteSite(Items[i]).LabQueryStatus := '0^initialization...';
4684 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Initialization');
4685 Timer1.Enabled := True;
4686 StatusText('Retrieving reports from '
4687 + TRemoteSite(Items[i]).SiteName + '...');
4688 end;
4689 end;
4690 end;
4691end;
4692
4693procedure TfrmLabs.TabControl1Change(Sender: TObject);
4694var
4695 aStatus: string;
4696 hook: Boolean;
4697 i: integer;
4698begin
4699 inherited;
4700 memLab.Lines.Clear;
4701 lstHeaders.Items.Clear;
4702 with TabControl1 do
4703 begin
4704 memLab.Lines.BeginUpdate;
4705 if TabIndex > 0 then
4706 begin
4707 aStatus := TRemoteSite(Tabs.Objects[TabIndex]).LabQueryStatus;
4708 if aStatus = '1^Done' then
4709 begin
4710 if Piece(TRemoteSite(Tabs.Objects[TabIndex]).LabData[0],'^',1) = '[HIDDEN TEXT]' then
4711 begin
4712 lstHeaders.Clear;
4713 hook := false;
4714 for i := 1 to TRemoteSite(Tabs.Objects[TabIndex]).LabData.Count - 1 do
4715 if hook = true then
4716 memLab.Lines.Add(TRemoteSite(Tabs.Objects[TabIndex]).LabData[i])
4717 else
4718 begin
4719 lstHeaders.Items.Add(MixedCase(TRemoteSite(Tabs.Objects[TabIndex]).LabData[i]));
4720 if Piece(TRemoteSite(Tabs.Objects[TabIndex]).LabData[i],'^',1) = '[REPORT TEXT]' then
4721 hook := true;
4722 end;
4723 end
4724 else
4725 QuickCopy(TRemoteSite(Tabs.Objects[TabIndex]).LabData,memLab);
4726 memLab.Lines.Insert(0,' ');
4727 memLab.Lines.Delete(0);
4728 end;
4729 if Piece(aStatus,'^',1) = '-1' then
4730 memLab.Lines.Add('Remote data transmission error: ' + Piece(aStatus,'^',2));
4731 if Piece(aStatus,'^',1) = '0' then
4732 memLab.Lines.Add('Transmission in progress: ' + Piece(aStatus,'^',2));
4733 if Piece(aStatus,'^',1) = '' then
4734 memLab.Lines.Add('Select a report...');
4735 end
4736 else
4737 if uLabLocalReportData.Count > 0 then
4738 begin
4739 if Piece(uLabLocalReportData[0],'^',1) = '[HIDDEN TEXT]' then
4740 begin
4741 lstHeaders.Clear;
4742 hook := false;
4743 for i := 1 to uLabLocalReportData.Count - 1 do
4744 if hook = true then
4745 memLab.Lines.Add(uLabLocalReportData[i])
4746 else
4747 begin
4748 lstHeaders.Items.Add(MixedCase(uLabLocalReportData[i]));
4749 if Piece(uLabLocalReportData[i],'^',1) = '[REPORT TEXT]' then
4750 hook := true;
4751 end;
4752 end
4753 else
4754 QuickCopy(uLabLocalReportData,memLab);
4755 memLab.Lines.Insert(0,' ');
4756 memLab.Lines.Delete(0);
4757 end;
4758 memLab.SelStart := 0;
4759 memLab.Lines.EndUpdate;
4760 end;
4761end;
4762
4763procedure TfrmLabs.WebBrowser1DocumentComplete(Sender: TObject; //**Browser Remove**
4764 const pDisp: IDispatch; var URL: OleVariant);
4765var
4766 //WebDoc: IHtmlDocument2; **Browser Remove**
4767 v: variant;
4768begin
4769 inherited;
4770 if uHTMLDoc = '' then Exit;
4771 if not(uReportType = 'H') then Exit; //this can be removed if & when browser replaces memLab control
4772 //if not Assigned(WebBrowser1.Document) then Exit; **Browser Remove**
4773 //WebDoc := WebBrowser1.Document as IHtmlDocument2; **Browser Remove**
4774 v := VarArrayCreate([0, 0], varVariant);
4775 v[0] := uHTMLDoc;
4776 //WebDoc.write(PSafeArray(TVarData(v).VArray)); **Browser Remove**
4777 //WebDoc.close; **Browser Remove**
4778 //uHTMLDoc := '';
4779end;
4780
4781procedure TfrmLabs.ChkBrowser; // **Browser Remove**
4782begin
4783 {if uReportType = 'H' then **Browser Remove**
4784 begin
4785 WebBrowser1.Visible := true;
4786 WebBrowser1.Navigate('about:blank');
4787 WebBrowser1.BringToFront;
4788 memLab.Visible := false;
4789 end
4790 else
4791 begin
4792 WebBrowser1.Visible := false;
4793 WebBrowser1.SendToBack; }
4794 memLab.Visible := true;
4795 memLab.BringToFront;
4796 //end; }
4797end;
4798
4799procedure TfrmLabs.CommonComponentVisible(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12: Boolean);
4800begin
4801 lstDates.Visible := false; // turned off to realign correctly
4802 lblDates.Visible := false;
4803 lstQualifier.Visible := false;
4804 lblQualifier.Visible := false;
4805 pnlOtherTests.Visible := false;
4806 lstHeaders.Visible := false;
4807 lblHeaders.Visible := false;
4808 sptHorzRight.Visible := false;
4809 lblHeaders.Visible := A1;
4810 lstHeaders.Visible := A2;
4811 lblQualifier.Visible := A11;
4812 lstQualifier.Visible := A12;
4813 lblDates.Visible := A4;
4814 lstDates.Visible := A5; // reordered to realign
4815 pnlOtherTests.Visible := A3;
4816 pnlHeader.Visible := A6;
4817 grdLab.Visible := A7;
4818 pnlChart.Visible := A8;
4819 pnlFooter.Visible := A9;
4820 lvReports.Visible := A10;
4821 sptHorzRight.Visible := A10;
4822 if A4 and A1 and (lblDates.Top < lblHeaders.Top) then
4823 begin
4824 lblDates.Caption := 'Headings'; // swithes captions if not aligned
4825 lblHeaders.Caption := 'Date Range';
4826 end
4827 else
4828 begin
4829 lblDates.Caption := 'Date Range';
4830 lblHeaders.Caption := 'Headings';
4831 end;
4832 lstDates.Caption := lblDates.Caption;
4833 lstHeaders.Caption := lblHeaders.Caption;
4834 if A4 or A2 or A12 then
4835 begin
4836 pnlLeftBottom.Visible := true;
4837 Splitter1.Visible := true;
4838 end;
4839end;
4840
4841procedure TfrmLabs.ShowTabControl;
4842begin
4843 if TabControl1.Tabs.Count > 1 then
4844 begin
4845 TabControl1.Visible := true;
4846 TabControl1.TabStop := true;
4847 pnlRightTop.Height := lblTitle.Height + TabControl1.Height;
4848 end;
4849end;
4850
4851procedure TfrmLabs.Splitter1CanResize(Sender: TObject; var NewSize: Integer;
4852 var Accept: Boolean);
4853begin
4854 inherited;
4855 if NewSize < 150 then
4856 Newsize := 150;
4857end;
4858
4859procedure TfrmLabs.sptHorzRightCanResize(Sender: TObject; var NewSize: Integer;
4860 var Accept: Boolean);
4861begin
4862 inherited;
4863 if NewSize < 10 then
4864 Newsize := 10;
4865end;
4866
4867procedure TfrmLabs.sptHorzRightMoved(Sender: TObject);
4868begin
4869 inherited;
4870 uScreenSplitMoved := true;
4871 uScreenSplitLoc := sptHorzRight.Top;
4872end;
4873
4874procedure TfrmLabs.Memo1KeyUp(Sender: TObject; var Key: Word;
4875 Shift: TShiftState);
4876begin
4877 inherited;
4878 if (Key = VK_TAB) then
4879 begin
4880 if ssShift in Shift then
4881 begin
4882 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
4883 Key := 0;
4884 end
4885 else if ssCtrl in Shift then
4886 begin
4887 FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
4888 Key := 0;
4889 end;
4890 end;
4891 if (key = VK_ESCAPE) then begin
4892 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
4893 key := 0;
4894 end;
4895end;
4896
4897{ TGrdLab508Manager }
4898
4899constructor TGrdLab508Manager.Create;
4900begin
4901 inherited Create([mtValue, mtItemChange]);
4902end;
4903
4904function TGrdLab508Manager.GetItem(Component: TWinControl): TObject;
4905var
4906 sg : TCaptionStringGrid;
4907begin
4908 sg := TCaptionStringGrid(Component);
4909 Result := TObject(sg.Selection.Top + sg.Selection.Left);
4910end;
4911
4912function TGrdLab508Manager.GetTextToSpeak(sg: TCaptionStringGrid): String;
4913var
4914 textToSpeak : String;
4915 CurrRowStrings,HeaderStrings : TStrings;
4916 i : integer;
4917begin
4918 textToSpeak := '';
4919 HeaderStrings := sg.Rows[0];
4920 CurrRowStrings := sg.Rows[sg.Selection.Top];
4921 for i := 0 to CurrRowStrings.Count - 1 do begin
4922 textToSpeak := TextToSpeak + ', ' + HeaderStrings[i] + ', ' + ToBlankIfEmpty(CurrRowStrings[i]);
4923 end;
4924 Result := textToSpeak;
4925end;
4926
4927function TGrdLab508Manager.GetValue(Component: TWinControl): string;
4928var
4929 sg : TCaptionStringGrid;
4930begin
4931 sg := TCaptionStringGrid(Component);
4932 Result := GetTextToSpeak(sg);
4933end;
4934
4935function TGrdLab508Manager.ToBlankIfEmpty(aString: String): String;
4936begin
4937 Result := aString;
4938 if aString = '' then
4939 Result := 'blank';
4940end;
4941
4942initialization
4943 SpecifyFormIsNotADialog(TfrmLabs);
4944
4945end.
Note: See TracBrowser for help on using the repository browser.