Context Navigation

fLabs.pas@ 1726

Last change on this file since 1726 was 1679, checked in by healthsevak, 10 years ago
Updating the working copy to CPRS version 28
File size: 193.0 KB

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

Note: See TracBrowser for help on using the repository browser.

Context Navigation

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

Download in other formats: