Context Navigation

source: cprs/trunk/CPRS-Chart/fReports.pas@ 1008

Last change on this file since 1008 was 830, checked in by Kevin Toppenberg, 14 years ago
Upgrading to version 27
File size: 128.3 KB

Rev	Line
[456]	1	unit fReports;
	2
	3	interface
	4
	5	uses
	6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
	7	fHSplit, StdCtrls, ExtCtrls, ORCtrls, ComCtrls, Menus, uConst, ORDtTmRng,
[830]	8	OleCtrls, SHDocVw, Buttons, ClipBrd, rECS, Variants, StrUtils, fBase508Form,
	9	VA508AccessibilityManager, VA508ImageListLabeler;
[456]	10
	11	type
	12	TfrmReports = class(TfrmHSplit)
	13	PopupMenu1: TPopupMenu;
	14	GotoTop1: TMenuItem;
	15	GotoBottom1: TMenuItem;
	16	FreezeText1: TMenuItem;
	17	UnFreezeText1: TMenuItem;
	18	calApptRng: TORDateRangeDlg;
	19	Timer1: TTimer;
	20	pnlLefTop: TPanel;
	21	lblTypes: TOROffsetLabel;
	22	Splitter1: TSplitter;
	23	pnlLeftBottom: TPanel;
	24	lblQualifier: TOROffsetLabel;
	25	lblHeaders: TLabel;
	26	lstHeaders: TORListBox;
	27	lstQualifier: TORListBox;
	28	pnlRightTop: TPanel;
	29	pnlRightBottom: TPanel;
	30	pnlRightMiddle: TPanel;
	31	TabControl1: TTabControl;
	32	lvReports: TCaptionListView;
	33	Memo1: TMemo;
	34	WebBrowser1: TWebBrowser;
	35	memText: TRichEdit;
	36	sptHorzRight: TSplitter;
	37	tvReports: TORTreeView;
	38	PopupMenu2: TPopupMenu;
	39	Print1: TMenuItem;
	40	Copy1: TMenuItem;
	41	Print2: TMenuItem;
	42	Copy2: TMenuItem;
	43	SelectAll1: TMenuItem;
	44	SelectAll2: TMenuItem;
	45	pnlProcedures: TPanel;
	46	lblProcedures: TOROffsetLabel;
	47	tvProcedures: TORTreeView;
	48	lblProcTypeMsg: TOROffsetLabel;
	49	pnlViews: TORAutoPanel;
	50	chkDualViews: TCheckBox;
	51	btnChangeView: TORAlignButton;
	52	btnGraphSelections: TORAlignButton;
	53	lblDateRange: TLabel;
	54	lstDateRange: TORListBox;
	55	pnlTopViews: TPanel;
[830]	56	pnlTopRtLabel: TPanel;
	57	lblTitle: TOROffsetLabel;
	58	chkMaxFreq: TCheckBox;
	59	imgLblImages: TVA508ImageListLabeler;
[456]	60	procedure lstQualifierClick(Sender: TObject);
	61	procedure GotoTop1Click(Sender: TObject);
	62	procedure GotoBottom1Click(Sender: TObject);
	63	procedure FreezeText1Click(Sender: TObject);
	64	procedure UnFreezeText1Click(Sender: TObject);
	65	procedure PopupMenu1Popup(Sender: TObject);
	66	procedure FormCreate(Sender: TObject);
	67	procedure DisplayHeading(aRanges: string);
	68	procedure FormShow(Sender: TObject);
	69	procedure Timer1Timer(Sender: TObject);
	70	procedure TabControl1Change(Sender: TObject);
	71	procedure FormDestroy(Sender: TObject);
[830]	72	procedure GoRemote(Dest: TStringList; AItem: string; AQualifier, ARpc: string; AHSTag: string; AHDR: string; aFHIE: string);
[456]	73	procedure lstHeadersClick(Sender: TObject);
	74	procedure Splitter1CanResize(Sender: TObject; var NewSize: Integer;
	75	var Accept: Boolean);
	76	procedure WebBrowser1DocumentComplete(Sender: TObject;
	77	const pDisp: IDispatch; var URL: OleVariant);
	78	procedure sptHorzRightCanResize(Sender: TObject; var NewSize: Integer;
	79	var Accept: Boolean);
	80	procedure lstQualifierDrawItem(Control: TWinControl; Index: Integer;
	81	Rect: TRect; State: TOwnerDrawState);
	82	procedure tvReportsClick(Sender: TObject);
	83	procedure lvReportsColumnClick(Sender: TObject; Column: TListColumn);
	84	procedure lvReportsCompare(Sender: TObject; Item1, Item2: TListItem;
	85	Data: Integer; var Compare: Integer);
	86	procedure lvReportsSelectItem(Sender: TObject; Item: TListItem;
	87	Selected: Boolean);
	88	procedure LoadListView(aReportData: TStringList);
	89	procedure LoadTreeView;
	90	procedure tvReportsExpanding(Sender: TObject; Node: TTreeNode;
	91	var AllowExpansion: Boolean);
	92	procedure tvReportsCollapsing(Sender: TObject; Node: TTreeNode;
	93	var AllowCollapse: Boolean);
	94	procedure Print1Click(Sender: TObject);
	95	procedure Copy1Click(Sender: TObject);
	96	procedure Copy2Click(Sender: TObject);
	97	procedure Print2Click(Sender: TObject);
	98	procedure UpdateRemoteStatus(aSiteID, aStatus: string);
	99	procedure lvReportsKeyUp(Sender: TObject; var Key: Word;
	100	Shift: TShiftState);
	101	procedure SelectAll1Click(Sender: TObject);
	102	procedure SelectAll2Click(Sender: TObject);
	103	procedure tvReportsKeyDown(Sender: TObject; var Key: Word;
	104	Shift: TShiftState);
	105	procedure Memo1KeyUp(Sender: TObject; var Key: Word;
	106	Shift: TShiftState);
	107	procedure LoadProceduresTreeView(x: string; var CurrentParentNode: TTreeNode;
	108	var CurrentNode: TTreeNode);
	109	procedure tvProceduresCollapsing(Sender: TObject; Node: TTreeNode;
	110	var AllowCollapse: Boolean);
	111	procedure tvProceduresExpanding(Sender: TObject; Node: TTreeNode;
	112	var AllowExpansion: Boolean);
[830]	113	procedure tvProceduresClick(Sender: TObject);
[456]	114	procedure tvProceduresChange(Sender: TObject; Node: TTreeNode);
	115	procedure tvProceduresKeyDown(Sender: TObject; var Key: Word;
	116	Shift: TShiftState);
	117	procedure chkDualViewsClick(Sender: TObject);
	118	procedure btnChangeViewClick(Sender: TObject);
	119	procedure btnGraphSelectionsClick(Sender: TObject);
	120	procedure lstDateRangeClick(Sender: TObject);
	121	procedure sptHorzMoved(Sender: TObject);
[830]	122	procedure chkMaxFreqClick(Sender: TObject);
[456]	123
	124	private
	125	SortIdx1, SortIdx2, SortIdx3: Integer;
	126	procedure ProcessNotifications;
	127	procedure ShowTabControl;
	128	procedure Graph(reportien: integer);
	129	procedure GraphPanel(active: boolean);
	130	public
	131	procedure ClearPtData; override;
	132	function AllowContextChange(var WhyNot: string): Boolean; override;
	133	procedure DisplayPage; override;
	134	procedure SetFontSize(NewFontSize: Integer); override;
	135	procedure RequestPrint; override;
	136	end;
	137
	138	var
	139	frmReports: TfrmReports;
	140	uHSComponents: TStringList; //components selected
	141	//segment^OccuranceLimit^TimeLimit^Header...
	142	//^(value of uComponents...)
	143	uHSAll: TStringList; //List of all displayable Health Summaries
	144	uLocalReportData: TStringList; //Storage for Local report data
	145	uRemoteReportData: TStringList; //Storage for status of Remote data
	146	uReportInstruction: String; //User Instructions
	147	uNewColumn: TListColumn;
	148	uListItem: TListItem;
	149	uColumns: TStringList;
	150	uTreeStrings: TStrings;
	151	uMaxOcc: string;
	152	uHState: string;
	153	uQualifier: string;
	154	uReportType: string;
	155	uSortOrder: string;
	156	uQualifierType: Integer;
	157	uFirstSort: Integer;
	158	uSecondSort: Integer;
	159	uThirdSort: Integer;
	160	uColChange: string; //determines when column widths have changed
	161	uUpdateStat: boolean; //flag turned on when remote status is being updated
	162	ulvSelectOn: boolean; //flag turned on when multiple items in lvReports control have been selected
	163	uListState: Integer; //Checked state of list of Adhoc components Checked: Abbreviation, UnChecked: Name
	164	uECSReport: TECSReport; //Event Capture Report, initiated in fFrame when Click Event Capture under Tools
	165	UpdatingLvReports: Boolean; //Currently updating lvReports
	166	UpdatingTvProcedures: Boolean; //Currently updating tvProcedures
	167
	168	implementation
	169
	170	{$R *.DFM}
	171
	172	uses ORFn, rCore, rReports, fFrame, uCore, uReports, fReportsPrint,
[830]	173	fReportsAdhocComponent1, activex, mshtml, dShared, fGraphs, fGraphData, rGraphs,
	174	VA508AccessibilityRouter, VAUtils
	175	{ TODO -oRV -cWVEHR Long Age : Changed to use long age }
	176	, rWVEHR;
[456]	177
	178	const
	179	CT_REPORTS =10; // ID for REPORTS tab used by frmFrame
	180	QT_OTHER = 0;
	181	QT_HSTYPE = 1;
	182	QT_DATERANGE = 2;
	183	QT_IMAGING = 3;
	184	QT_NUTR = 4;
	185	QT_PROCEDURES = 19;
	186	QT_SURGERY = 28;
	187	QT_HSCOMPONENT = 5;
	188	QT_HSWPCOMPONENT = 6;
	189	TX_NOREPORT = 'No report is currently selected.';
	190	TX_NOREPORT_CAP = 'No Report Selected';
	191	HTML_PRE = '<html><head><style>' + CRLF +
	192	'PRE {font-size:8pt;font-family: "Courier New", "monospace"}' + CRLF +
	193	'</style></head><body><pre>';
	194	HTML_POST = CRLF + '</pre></body></html>';
	195
	196	var
	197	uRemoteCount: Integer;
	198	uFrozen: Boolean;
	199	uHTMLDoc: string;
	200	uReportRPC: string;
	201	uHTMLPatient: ANSIstring;
	202	uRptID: String;
	203	uDirect: String;
	204	uEmptyImageList: TImageList;
	205	ColumnToSort: Integer;
	206	ColumnSortForward: Boolean;
	207	GraphForm: TfrmGraphs;
	208	GraphFormActive: boolean;
	209
	210	procedure TfrmReports.ClearPtData;
	211	begin
	212	inherited ClearPtData;
	213	Timer1.Enabled := False;
	214	memText.Clear;
	215	tvProcedures.Items.Clear;
	216	lblProcTypeMsg.Visible := FALSE;
	217	lvReports.SmallImages := uEmptyImageList;
[830]	218	imgLblImages.ComponentImageListChanged;
[456]	219	lvReports.Items.Clear;
	220	uLocalReportData.Clear;
	221	uRemoteReportData.Clear;
	222	TabControl1.Tabs.Clear;
	223	TabControl1.Visible := false;
	224	TabControl1.TabStop := false;
[830]	225	lstDateRange.Tag := 0; // used to reset date default on graph
[456]	226	if (GraphForm <> nil) and GraphFormActive then
	227	with GraphForm do
	228	begin
	229	GraphForm.SendToBack;
	230	Initialize;
	231	DisplayData('top');
	232	DisplayData('bottom');
[830]	233	GtslCheck.Clear;
[456]	234	GraphFormActive := false;
	235	end;
	236	begin
	237	end;
	238	end;
	239
	240	procedure TfrmReports.Graph(reportien: integer);
	241	begin
	242	if GraphForm = nil then
	243	begin
	244	GraphForm := TfrmGraphs.Create(self);
	245	try
	246	with GraphForm do
	247	begin
	248	if btnClose.Tag = 1 then
	249	Exit;
	250	Parent := pnlRight;
	251	Align := alClient;
	252	pnlFooter.Tag := 1; //suppresses bottom of graph form
	253	pnlBottom.Height := 1;
	254	pnlMain.BevelInner := bvLowered;
	255	pnlMain.BevelOuter := bvRaised;
	256	pnlMain.Tag := reportien;
	257	Initialize;
	258	ResizeAnchoredFormToFont(GraphForm);
	259	Show;
	260	DisplayData('top');
	261	DisplayData('bottom');
[830]	262	GtslCheck.Clear;
[456]	263	GraphPanel(true);
[830]	264	frmGraphData.pnlData.Hint := Patient.DFN;
[456]	265	BringToFront;
	266	end;
	267	finally
	268	if GraphForm.btnClose.Tag = 1 then
	269	begin
	270	GraphFormActive := false;
	271	GraphForm.Free;
	272	GraphForm := nil;
	273	end
	274	else
	275	GraphFormActive := true;
	276	end;
	277	end
	278	else if GraphForm.btnClose.Tag = 1 then
	279	Exit
[830]	280	else
	281	begin
[456]	282	with GraphForm do
[830]	283	if pnlMain.Tag <> reportien then
	284	begin // different report
[456]	285	pnlMain.Tag := reportien;
	286	Initialize;
[830]	287	GtslCheck.Clear;
[456]	288	GraphPanel(true);
	289	BringToFront;
	290	end;
	291	end;
	292	end;
	293
	294	procedure TfrmReports.GraphPanel(active: boolean);
	295	var
[830]	296	adddaterange: boolean;
	297	i: integer;
	298	aQualifier, aStartTime, aStopTime, aNewLine: string;
[456]	299	begin
	300	if active then
	301	begin
	302	pnlLeftBottom.Height := pnlLeft.Height div 2;
	303	pnlViews.Height := pnlLeftBottom.Height;
	304	if pnlLeft.Height < 200 then
	305	pnlTopViews.Height := 3
	306	else
	307	pnlTopViews.Height := 80;
	308	lblQualifier.Visible := false;
	309	lstQualifier.Visible := false;
	310	pnlViews.Visible := true;
	311	if lstDateRange.Tag = 0 then
	312	begin
	313	lstDateRange.Tag := 1;
	314	aQualifier := PReportTreeObject(tvReports.Selected.Data)^.Qualifier;
	315	aStartTime := Piece(aQualifier,';',1);
	316	aStopTime := Piece(aQualifier,';',2);
[830]	317	adddaterange := true;
	318	aNewLine := '^' + aStartTime + ' to ' + aStopTime +'^^^' + aStartTime + ';' + aStopTime +
	319	'^' + floattostr(strtofmdatetime(aStartTime)) + '^' + floattostr(strtofmdatetime(aStopTime));
	320	for i := 0 to GraphForm.cboDateRange.Items.Count - 1 do
	321	if GraphForm.cboDateRange.Items[i] = aNewLine then
	322	begin
	323	adddaterange := false;
	324	break;
	325	end;
	326	if adddaterange then GraphForm.cboDateRange.Items.Add(aNewLine);
[456]	327	lstDateRange.Items := GraphForm.cboDateRange.Items;
[830]	328	GraphForm.DateDefaults;
	329	lstDateRange.ItemIndex := GraphForm.cboDateRange.ItemIndex;
[456]	330	//lstDateRange.ItemIndex := lstDateRange.Items.Count - 1;
[830]	331	//lstDateRange.ItemIndex := lstDateRange.Items.Count - 2; //set to all results till fixed
[456]	332	lstDateRangeClick(self);
	333	end;
	334	pnlLeftBottom.Visible := true;
	335	splitter1.Visible := true;
	336	end
	337	else
	338	begin
	339	lblQualifier.Visible := true;
	340	lstQualifier.Visible := true;
	341	pnlViews.Visible := false;
	342	pnlLeftBottom.Height := lblHeaders.Height + lblQualifier.Height + 90;
	343	end;
	344	end;
	345
	346	function TfrmReports.AllowContextChange(var WhyNot: string): Boolean;
	347	var
	348	i: integer;
	349	begin
	350	Result := inherited AllowContextChange(WhyNot); // sets result = true
	351	if Timer1.Enabled = true then
	352	case BOOLCHAR[frmFrame.CCOWContextChanging] of
	353	'1': begin
	354	WhyNot := 'A remote data query in progress will be aborted.';
	355	Result := False;
	356	end;
	357	'0': if WhyNot = 'COMMIT' then
	358	begin
	359	with RemoteSites.SiteList do for i := 0 to Count - 1 do
	360	if TRemoteSite(Items[i]).Selected then
	361	if Length(TRemoteSite(Items[i]).RemoteHandle) > 0 then
	362	begin
	363	TRemoteSite(Items[i]).ReportClear;
	364	TRemoteSite(Items[i]).QueryStatus := '-1^Aborted';
	365	UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Query Aborted');
	366	end;
	367	Timer1.Enabled := false;
	368	Result := True;
	369	end;
	370	end;
	371	end;
	372
	373	procedure TfrmReports.RequestPrint;
	374	begin
	375	if uReportType = 'M' then
	376	begin
	377	InfoBox(TX_NOREPORT, TX_NOREPORT_CAP, MB_OK);
	378	Exit;
	379	end;
	380	if (uReportType = 'V') and (length(piece(uHState,';',2)) > 0) then
	381	begin
	382	if lvReports.Items.Count < 1 then
	383	begin
	384	InfoBox('There are no items to be printed.', 'No Items to Print', MB_OK);
	385	Exit;
	386	end;
	387	if lvReports.SelCount < 1 then
	388	begin
	389	InfoBox('Please select one or more items from the list to be printed.', 'No Items Selected', MB_OK);
	390	Exit;
	391	end;
	392	end;
	393	if (uReportType = 'G') and GraphFormActive then
	394	with GraphForm do
	395	begin
	396	if (lvwItemsTop.SelCount < 1) and (lvwItemsBottom.SelCount < 1) then
	397	begin
	398	InfoBox('There are no items graphed.', 'No Items to Print', MB_OK);
	399	Exit;
	400	end
	401	else
	402	begin
	403	mnuPopGraphPrintClick(mnuPopGraphPrint);
	404	Exit;
	405	end;
	406	end;
	407	if uQualifierType = QT_DATERANGE then
	408	begin // = 2
	409	if lstQualifier.ItemIndex < 0 then
	410	begin
	411	InfoBox('Please select from one of the Date Range items before printing', 'Incomplete Information', MB_OK);
	412	end
	413	else
	414	PrintReports(uRptID, piece(uRemoteType,'^',4));
	415	end
	416	else
	417	PrintReports(uRptID, piece(uRemoteType,'^',4));
	418	end;
	419
	420	procedure TfrmReports.DisplayPage;
	421	var
	422	i: integer;
	423	begin
	424	inherited DisplayPage;
	425	frmFrame.mnuFilePrint.Tag := CT_REPORTS;
	426	frmFrame.mnuFilePrint.Enabled := True;
	427	frmFrame.mnuFilePrintSetup.Enabled := True;
	428	uUpdateStat := false;
	429	ulvSelectOn := false;
	430	uListState := GetAdhocLookup();
	431	memText.SelStart := 0;
	432	FormShow(self);
	433	uHTMLPatient := '<DIV align left>'
	434	+ '<TABLE width="75%" border="0" cellspacing="0" cellpadding="1">'
	435	+ '<TR valign="bottom" align="left">'
	436	+ '<TD nowrap><B>Patient: ' + Patient.Name + '</B></TD>'
	437	+ '<TD nowrap><B>' + Patient.SSN + '</B></TD>'
[830]	438	{ TODO -oRV -cWVEHR Long Age : Changed to use long age }
	439	//+ '<TD nowrap><B>Age: ' + IntToStr(Patient.Age) + '</B></TD>'
	440	+ '<TD nowrap><B>Age: ' + GetPatientBriefAge(Patient.DFN) + '</B></TD>'
	441	{}
[456]	442	+ '</TR></TABLE></DIV><HR>';
	443	//the preferred method would be to use headers and footers
	444	//so this is just an interim solution.
	445	if not GraphFormActive then
	446	pnlLeftBottom.Visible := False;
	447	if InitPage then
	448	begin
	449	Splitter1.Visible := false;
	450	pnlLeftBottom.Visible := false;
	451	uMaxOcc := '';
	452	uColChange := '';
	453	LoadTreeView;
	454	end;
	455	if InitPatient and not (CallingContext = CC_NOTIFICATION) then
	456	begin
[830]	457	uColChange := '';
[456]	458	lstQualifier.Clear;
	459	tvProcedures.Items.Clear;
	460	lblProcTypeMsg.Visible := FALSE;
	461	lvReports.SmallImages := uEmptyImageList;
[830]	462	imgLblImages.ComponentImageListChanged;
[456]	463	lvReports.Items.Clear;
	464	lvReports.Columns.Clear;
	465	lblTitle.Caption := '';
	466	lvReports.Caption := '';
	467	Splitter1.Visible := false;
	468	pnlLeftBottom.Visible := false;
	469	memText.Parent := pnlRightBottom;
	470	memText.Align := alClient;
	471	memText.Clear;
	472	uReportInstruction := '';
	473	uLocalReportData.Clear;
	474	for i := 0 to RemoteSites.SiteList.Count - 1 do
	475	TRemoteSite(RemoteSites.SiteList.Items[i]).ReportClear;
	476	pnlRightTop.Height := lblTitle.Height + TabControl1.Height;
	477	StatusText('');
	478	with tvReports do
	479	if Items.Count > 0 then
	480	begin
	481	tvReports.Selected := tvReports.Items.GetFirstNode;
[830]	482	tvReportsClick(self);
[456]	483	end;
	484	end;
	485	case CallingContext of
	486	CC_INIT_PATIENT: if not InitPatient then
	487	begin
[830]	488	uColChange := '';
[456]	489	lstQualifier.Clear;
	490	tvProcedures.Items.Clear;
	491	lblProcTypeMsg.Visible := FALSE;
	492	lvReports.SmallImages := uEmptyImageList;
[830]	493	imgLblImages.ComponentImageListChanged;
[456]	494	lvReports.Items.Clear;
	495	Splitter1.Visible := false;
	496	pnlLeftBottom.Visible := false;
	497	with tvReports do
	498	if Items.Count > 0 then
	499	begin
	500	tvReports.Selected := tvReports.Items.GetFirstNode;
[830]	501	tvReportsClick(self);
[456]	502	end;
	503	end;
	504	CC_NOTIFICATION: ProcessNotifications;
[830]	505	end;
[456]	506	end;
	507
	508	procedure TfrmReports.UpdateRemoteStatus(aSiteID, aStatus: string);
	509	var
	510	j: integer;
	511	s: string;
	512	c: boolean;
	513	begin
	514	if uUpdateStat = true then exit; //uUpdateStat also looked at in fFrame
	515	uUpdateStat := true;
	516	for j := 0 to frmFrame.lstCIRNLocations.Items.Count - 1 do
	517	begin
	518	s := frmFrame.lstCIRNLocations.Items[j];
	519	c := frmFrame.lstCIRNLocations.checked[j];
	520	if piece(s, '^', 1) = aSiteID then
	521	begin
	522	frmFrame.lstCIRNLocations.Items[j] := pieces(s, '^', 1, 3) + '^' + aStatus;
	523	frmFrame.lstCIRNLocations.checked[j] := c;
	524	end;
	525	end;
	526	uUpdateStat := false;
	527	end;
	528
	529	procedure TfrmReports.LoadTreeView;
	530	var
	531	i,j: integer;
[830]	532	currentNode, parentNode, grandParentNode, gtGrandParentNode: TTreeNode;
[456]	533	x: string;
[830]	534	addchild, addgrandchild, addgtgrandchild: boolean;
[456]	535	begin
	536	tvReports.Items.Clear;
	537	memText.Clear;
	538	uHTMLDoc := '';
	539	WebBrowser1.Navigate('about:blank');
	540	tvProcedures.Items.Clear;
[830]	541	lblProcTypeMsg.Visible := FALSE;
[456]	542	lvReports.SmallImages := uEmptyImageList;
[830]	543	imgLblImages.ComponentImageListChanged;
[456]	544	lvReports.Items.Clear;
	545	uTreeStrings.Clear;
	546	lblTitle.Caption := '';
	547	lvReports.Caption := '';
	548	ListReports(uTreeStrings);
	549	addchild := false;
	550	addgrandchild := false;
[830]	551	addgtgrandchild := false;
[456]	552	parentNode := nil;
	553	grandParentNode := nil;
[830]	554	gtGrandParentNode := nil;
[456]	555	currentNode := nil;
	556	for i := 0 to uTreeStrings.Count - 1 do
	557	begin
	558	x := uTreeStrings[i];
	559	if UpperCase(Piece(x,'^',1))='[PARENT END]' then
	560	begin
[830]	561	if addgtgrandchild = true then
[456]	562	begin
[830]	563	currentNode := gtgrandParentNode;
	564	addgtgrandchild := false;
[456]	565	end
	566	else
[830]	567	if addgrandchild = true then
	568	begin
	569	currentNode := grandParentNode;
	570	addgrandchild := false;
	571	end
	572	else
	573	begin
	574	currentNode := parentNode;
	575	addchild := false;
	576	end;
[456]	577	continue;
	578	end;
	579	if UpperCase(Piece(x,'^',1))='[PARENT START]' then
	580	begin
[830]	581	if addgtgrandchild = true then
	582	currentNode := tvReports.Items.AddChildObject(gtGrandParentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)))
[456]	583	else
[830]	584	if addgrandchild = true then
[456]	585	begin
[830]	586	currentNode := tvReports.Items.AddChildObject(grandParentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)));
	587	addgtgrandchild := true;
	588	gtgrandParentNode := currentNode;
[456]	589	end
	590	else
[830]	591	if addchild = true then
	592	begin
	593	currentNode := tvReports.Items.AddChildObject(parentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)));
	594	addgrandchild := true;
	595	grandParentNode := currentNode;
	596	end
	597	else
	598	begin
	599	currentNode := tvReports.Items.AddObject(currentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)));
	600	parentNode := currentNode;
	601	addchild := true;
	602	end;
[456]	603	end
	604	else
	605	if addchild = false then
	606	begin
	607	currentNode := tvReports.Items.AddObject(currentNode,Piece(x,'^',2),MakeReportTreeObject(x));
	608	parentNode := currentNode;
	609	end
	610	else
	611	begin
[830]	612	if addgtgrandchild = true then
	613	currentNode := tvReports.Items.AddChildObject(gtGrandParentNode,Piece(x,'^',2),MakeReportTreeObject(x))
[456]	614	else
[830]	615	if addgrandchild = true then
	616	currentNode := tvReports.Items.AddChildObject(grandParentNode,Piece(x,'^',2),MakeReportTreeObject(x))
	617	else
	618	currentNode := tvReports.Items.AddChildObject(parentNode,Piece(x,'^',2),MakeReportTreeObject(x));
[456]	619	end;
	620	end;
	621	for i := 0 to tvReports.Items.Count - 1 do
	622	if Piece(PReportTreeObject(tvReports.Items[i].Data)^.Qualifier,';',4) = '1' then
	623	begin
	624	HealthSummaryCheck(uHSAll,'1');
	625	for j := 0 to uHSAll.Count - 1 do
	626	tvReports.Items.AddChildObject(tvReports.Items[i],Piece(uHSAll[j],'^',2),MakeReportTreeObject(uHSAll[j]));
	627	end;
	628	if tvReports.Items.Count > 0 then begin
	629	tvReports.Selected := tvReports.Items.GetFirstNode;
	630	tvReportsClick(self);
	631	end;
	632	end;
	633
	634	procedure TfrmReports.SetFontSize(NewFontSize: Integer);
[830]	635	var
	636	pnlRightMiddlePct: Real;
	637	frmReportsHeight, pnlRightHeight: Integer;
	638
[456]	639	begin
[830]	640	pnlRightMiddlePct := (pnlRightMiddle.Height / (pnlRight.Height - (sptHorzRight.Height + pnlRightTop.Height)));
	641	pnlRightMiddle.Constraints.MaxHeight := 20;
[456]	642	inherited SetFontSize(NewFontSize);
	643	memText.Font.Size := NewFontSize;
[830]	644	frmReportsHeight := frmFrame.pnlPatientSelectedHeight - (frmFrame.pnlToolbar.Height + frmFrame.stsArea.Height + frmFrame.tabPage.Height + 2);
	645	pnlRightHeight := frmReportsHeight - shpPageBottom.Height;
	646	pnlRightMiddle.Constraints.MaxHeight := 0;
	647	pnlRightMiddle.Height := (Round((pnlRightHeight - (sptHorzRight.Height + pnlRightTop.Height)) * pnlRightMiddlePct) - 14);
	648	if frmFrame.Height <> frmFrame.frmFrameHeight then
	649	begin
	650	pnlRight.Height := pnlRightHeight;
	651	frmReports.Height := frmReportsHeight;
	652	frmFrame.Height := frmFrame.frmFrameHeight;
	653	end;
[456]	654	end;
	655
	656	procedure TfrmReports.LoadListView(aReportData: TStringList);
	657	var
	658	i,j,k,aErr: integer;
	659	aTmpAray: TStringList;
	660	aColCtr, aCurCol, aCurRow, aColID: integer;
	661	x,y,z,c,aSite: string;
	662	ListItem: TListItem;
	663	begin
	664	aSite := '';
	665	aErr := 0;
	666	ListItem := nil;
	667	case uQualifierType of
	668	QT_HSCOMPONENT:
	669	begin // = 5
	670	if (length(piece(uHState,';',2)) > 0) then //and (chkText.Checked = false) then
	671	begin
	672	with lvReports do
	673	begin
	674	ViewStyle := vsReport;
	675	for j := 0 to aReportData.Count - 1 do
	676	begin
	677	if piece(aReportData[j],'^',1) = '-1' then //error condition, most likely remote call
	678	continue;
	679	ListItem := Items.Add;
	680	aSite := piece(aReportData[j],'^',1);
	681	ListItem.Caption := piece(aSite,';',1);
	682	for k := 2 to uColumns.Count do
	683	begin
	684	ListItem.SubItems.Add(piece(aReportData[j],'^',k));
	685	end;
	686	end;
	687	if aReportData.Count = 0 then
	688	begin
	689	uReportInstruction := '<No Data Available>';
	690	memText.Lines.Clear;
	691	memText.Lines.Add(uReportInstruction);
	692	end
	693	else
	694	memText.Lines.Clear;
	695	end;
	696	end;
	697	end;
	698	QT_HSWPCOMPONENT:
	699	begin // = 6
	700	if (length(piece(uHState,';',2)) > 0) then //and (chkText.Checked = false) then
	701	begin
	702	aTmpAray := TStringList.Create;
	703	aCurRow := 0;
	704	aCurCol := 0;
	705	aColCtr := 9;
	706	aTmpAray.Clear;
	707	with lvReports do
	708	begin
	709	for j := 0 to aReportData.Count - 1 do
	710	begin
	711	x := aReportData[j];
	712	aColID := StrToIntDef(piece(x,'^',1),-1);
	713	if aColID < 0 then //this is an error condition most likely an incompatible remote call
	714	continue;
	715	if aColID > (uColumns.Count - 1) then
	716	begin
	717	aErr := 1;
	718	continue; //extract is out of sync with columns defined in 101.24
	719	end;
	720	if aColID < aColCtr then
	721	begin
	722	if aTmpAray.Count > 0 then
	723	begin
	724	if aColCtr = 1 then
	725	begin
	726	ListItem := Items.Add;
	727	aSite := piece(aTmpAray[j],'^',1);
	728	ListItem.Caption := piece(aSite,';',1);
	729	ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol));
	730	end
	731	else
	732	begin
	733	c := aTmpAray[0];
	734	if piece(uColumns.Strings[aCurCol],'^',4) = '1' then
	735	c := c + '...';
	736	z := piece(c,'^',1);
	737	y := copy(c, (pos('^', c)), 9999);
	738	if pos('^',y) > 0 then
	739	begin
	740	while pos('^',y) > 0 do
	741	begin
	742	y := copy(y, (pos('^', y)+1), 9999);
	743	z := z + '^' + y;
	744	end;
	745	ListItem.SubItems.Add(z);
	746	end
	747	else
	748	begin
	749	ListItem.SubItems.Add(y);
	750	end;
	751	end;
	752	RowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray);
	753	aTmpAray.Clear;
	754	end;
	755	aColCtr := 0;
	756	aCurCol := aColID;
	757	aCurRow := aCurRow + 1;
	758	end
	759	else
	760	if aColID = aCurCol then
	761	begin
	762	z := '';
	763	y := piece(x,'^',2);
	764	if length(y) > 0 then z := y;
	765	y := copy(x, (pos('^', x)+1), 9999);
	766	if pos('^',y) > 0 then
	767	begin
	768	while pos('^',y) > 0 do
	769	begin
	770	y := copy(y, (pos('^', y)+1), 9999);
	771	z := z + '^' + y;
	772	end;
	773	aTmpAray.Add(z);
	774	end
	775	else
	776	begin
	777	aTmpAray.Add(y);
	778	end;
	779	continue;
	780	end;
	781	if aTmpAray.Count > 0 then
	782	begin
	783	if aColCtr = 1 then
	784	begin
	785	ListItem := Items.Add;
	786	aSite := piece(aTmpAray[0],'^',1);
	787	ListItem.Caption := piece(aSite,';',1);
	788	ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol));
	789	end
	790	else
	791	begin
	792	c := aTmpAray[0];
	793	if piece(uColumns.Strings[aCurCol],'^',4) = '1' then
	794	c := c + '...';
	795	ListItem.SubItems.Add(c);
	796	end;
	797	RowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray);
	798	aTmpAray.Clear;
	799	end;
	800	aCurCol := aColID;
	801	Inc(aColCtr);
	802	y := '';
	803	for k := 2 to 10 do
	804	if length(piece(x,'^',k)) > 0 then
	805	begin
	806	if length(y) > 0 then y := y + '^' + piece(x,'^',k)
	807	else y := y + piece(x,'^',k);
	808	end;
	809	aTmpAray.Add(y);
	810	if aColCtr > 0 then
	811	while aColCtr < aCurCol do
	812	begin
	813	ListItem.SubItems.Add('');
	814	Inc(aColCtr);
	815	end;
	816	end;
	817	if aTmpAray.Count > 0 then
	818	begin
	819	if aColCtr = 1 then
	820	begin
	821	ListItem := Items.Add;
	822	aSite := piece(aTmpAray[0],'^',1);
	823	ListItem.Caption := piece(aSite,';',1);
	824	ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol));
	825	end
	826	else
	827	begin
	828	c := aTmpAray[0];
	829	if piece(uColumns.Strings[aCurCol],'^',4) = '1' then
	830	c := c + '...';
	831	ListItem.SubItems.Add(c);
	832	end;
	833	RowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray);
	834	aTmpAray.Clear;
	835	end;
	836	end;
	837	aTmpAray.Free;
	838	end;
	839	if uRptID = 'OR_R18:IMAGING' then with lvReports do //set image indicator for "Imaging" report
	840	begin
	841	SmallImages := dmodShared.imgImages;
[830]	842	imgLblImages.ComponentImageListChanged;
[456]	843	for i := 0 to Items.Count - 1 do
[830]	844	if (Items[i].SubItems.Count > 7) and (Items[i].SubItems[7] = 'Y') then
[456]	845	Items[i].SubItemImages[1] := IMG_1_IMAGE
	846	else
	847	Items[i].SubItemImages[1] := IMG_NO_IMAGES;
	848	end
[830]	849	else //lvReports.SmallImages := uEmptyImageList;
[456]	850	if uRptID = 'OR_PN:PROGRESS NOTES' then with lvReports do //set image indicator for "Progress Notes" report
	851	begin
	852	SmallImages := dmodShared.imgImages;
[830]	853	imgLblImages.ComponentImageListChanged;
[456]	854	for i := 0 to Items.Count - 1 do
[830]	855	if (Items[i].SubItems.Count > 7) and (StrToInt(Items[i].SubItems[7]) > 0) then
[456]	856	Items[i].SubItemImages[2] := IMG_1_IMAGE
	857	else
	858	Items[i].SubItemImages[2] := IMG_NO_IMAGES;
	859	end
[830]	860	else begin
	861	lvReports.SmallImages := uEmptyImageList;
	862	imgLblImages.ComponentImageListChanged;
	863	end;
[456]	864	end;
	865	end;
	866	if aErr = 1 then
	867	if User.HasKey('XUPROGMODE') then
[830]	868	ShowMsg('Programmer message: One or more Column ID''s in file 101.24 do not match ID''s coded in extract routine');
[456]	869	end;
	870
	871	procedure TfrmReports.lstQualifierClick(Sender: TObject);
	872	var
	873	MoreID: String; //Restores MaxOcc value
[830]	874	aRemote, aHDR, aFHIE: string;
[456]	875	i: integer;
	876	begin
	877	inherited;
	878	if uFrozen = True then
	879	begin
	880	memo1.visible := False;
	881	memo1.TabStop := False;
	882	end;
	883	MoreID := ';' + Piece(uQualifier,';',3);
[830]	884	if chkMaxFreq.checked = true then
	885	begin
	886	MoreID := '';
	887	SetPiece(uQualifier,';',3,'');
	888	end;
[456]	889	aRemote := piece(uRemoteType,'^',1);
	890	aHDR := piece(uRemoteType,'^',7);
[830]	891	aFHIE := piece(uRemoteType,'^',8);
[456]	892	SetPiece(uRemoteType,'^',5,lstQualifier.ItemID);
	893	uHSComponents.Clear;
	894	uHSAll.Clear;
	895	tvProcedures.Items.Clear;
	896	lblProcTypeMsg.Visible := FALSE;
	897	uHTMLDoc := '';
	898	if uReportType = 'H' then
	899	begin
	900	WebBrowser1.Visible := true;
	901	WebBrowser1.TabStop := true;
	902	WebBrowser1.Navigate('about:blank');
	903	WebBrowser1.BringToFront;
	904	memText.Visible := false;
	905	memText.TabStop := false;
	906	end
	907	else
	908	begin
	909	WebBrowser1.Visible := false;
	910	WebBrowser1.TabStop := false;
	911	memText.Visible := true;
	912	memText.TabStop := true;
	913	memText.BringToFront;
	914	RedrawActivate(memText.Handle);
	915	end;
	916	uLocalReportData.Clear;
	917	uRemoteReportData.Clear;
	918	for i := 0 to RemoteSites.SiteList.Count - 1 do
	919	TRemoteSite(RemoteSites.SiteList.Items[i]).ReportClear;
	920	uRemoteCount := 0;
	921	if aHDR = '1' then
	922	DisplayHeading(lstQualifier.ItemID)
	923	else
	924	DisplayHeading(lstQualifier.ItemID + MoreID);
	925	if lstQualifier.ItemID = 'ds' then
	926	begin
	927	with calApptRng do
	928	if Not (Execute) then
	929	begin
	930	lstQualifier.ItemIndex := -1;
	931	Exit;
	932	end
	933	else if (Length(TextOfStart) > 0) and (Length(TextOfStop) > 0) then
	934	begin
	935	if (Length(piece(uRemoteType,'^',6)) > 0) and (StrToInt(piece(uRemoteType,'^',6)) > 0) then
	936	if abs(FMDateTimeToDateTime(FMDateStart) - FMDateTimeToDateTime(FMDateStop)) > StrToInt(piece(uRemoteType,'^',6)) then
	937	begin
	938	InfoBox('The Date Range selected is greater than the' + CRLF + 'Maximum Days Allowed of ' + piece(uRemoteType,'^',6)
	939	+ ' for this report.', 'No Report Generated',MB_OK);
	940	lstQualifier.ItemIndex := -1;
	941	exit;
	942	end;
	943	lstQualifier.ItemIndex := lstQualifier.Items.Add(RelativeStart +
	944	';' + RelativeStop + U + TextOfStart + ' to ' + TextOfStop);
	945	DisplayHeading(lstQualifier.ItemID + MoreID);
	946	SetPiece(uRemoteType,'^',5,lstQualifier.ItemID);
	947	end
	948	else
	949	begin
	950	lstQualifier.ItemIndex := -1;
	951	InfoBox('Invalid Date Range entered. Please try again','Invalid Date/time entry',MB_OK);
	952	if (Execute) and (Length(TextOfStart) > 0) and (Length(TextOfStop) > 0) then
	953	begin
	954	lstQualifier.ItemIndex := lstQualifier.Items.Add(RelativeStart +
	955	';' + RelativeStop + U + TextOfStart + ' to ' + TextOfStop);
	956	DisplayHeading(lstQualifier.ItemID + MoreID);
	957	SetPiece(uRemoteType,'^',5,lstQualifier.ItemID);
	958	end
	959	else
	960	begin
	961	lstQualifier.ItemIndex := -1;
	962	InfoBox('No Report Generated!','Invalid Date/time entry',MB_OK);
	963	exit;
	964	end;
	965	end;
	966	end;
	967	if (CharAt(lstQualifier.ItemID,1) = 'd') and (Length(piece(uRemoteType,'^',6)) > 0) and (StrToInt(piece(uRemoteType,'^',6)) > 0) then
	968	if ExtractInteger(lstQualifier.ItemID) > (StrToInt(piece(uRemoteType,'^',6))) then
	969	begin
	970	InfoBox('The Date Range selected is greater than the' + CRLF + 'Maximum Days Allowed of ' + piece(uRemoteType,'^',6)
	971	+ ' for this report.', 'No Report Generated',MB_OK);
	972	lstQualifier.ItemIndex := -1;
	973	exit;
	974	end;
	975	StatusText('Retrieving ' + lblTitle.Caption + '...');
	976	Screen.Cursor := crHourGlass;
	977	uReportInstruction := #13#10 + 'Retrieving data...';
	978	memText.Lines.Add(uReportInstruction);
	979	if WebBrowser1.Visible = true then
	980	begin
	981	uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST;
	982	WebBrowser1.Navigate('about:blank');
	983	end;
	984	case uQualifierType of
	985	QT_HSCOMPONENT:
	986	begin // = 5
	987	lvReports.SmallImages := uEmptyImageList;
[830]	988	imgLblImages.ComponentImageListChanged;
[456]	989	lvReports.Items.Clear;
	990	memText.Lines.Clear;
	991	RowObjects.Clear;
	992	if ((aRemote = '1') or (aRemote = '2')) then
[830]	993	GoRemote(uRemoteReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR, aFHIE);
	994	if not(piece(uRemoteType, '^', 9) = '1') then
	995	if (length(piece(uHState,';',2)) > 0) then
	996	begin
	997	if not(aRemote = '2') then
	998	LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
	999	LoadListView(uLocalReportData);
	1000	end
	1001	else
	1002	begin
	1003	if ((aRemote = '1') or (aRemote = '2')) then
	1004	ShowTabControl;
	1005	pnlRightMiddle.Visible := false;
[456]	1006	LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
[830]	1007	if uLocalReportData.Count < 1 then
	1008	begin
	1009	uReportInstruction := '<No Report Available>';
	1010	memText.Lines.Add(uReportInstruction);
	1011	end
	1012	else
	1013	begin
	1014	QuickCopy(uLocalReportData,memText);
	1015	TabControl1.OnChange(nil);
	1016	end;
	1017	end;
[456]	1018	end;
	1019	QT_HSWPCOMPONENT:
	1020	begin // = 6
	1021	lvReports.SmallImages := uEmptyImageList;
[830]	1022	imgLblImages.ComponentImageListChanged;
[456]	1023	lvReports.Items.Clear;
	1024	RowObjects.Clear;
	1025	memText.Lines.Clear;
	1026	if ((aRemote = '1') or (aRemote = '2')) then
	1027	begin
	1028	Screen.Cursor := crDefault;
[830]	1029	GoRemote(uRemoteReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR, aFHIE);
[456]	1030	end;
[830]	1031	if not(piece(uRemoteType, '^', 9) = '1') then
	1032	if (length(piece(uHState,';',2)) > 0) then
	1033	begin
	1034	if not(aRemote = '2') then
[456]	1035	LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
[830]	1036	LoadListView(uLocalReportData);
	1037	end
	1038	else
	1039	begin
	1040	if ((aRemote = '1') or (aRemote = '2')) then
	1041	ShowTabControl;
	1042	pnlRightMiddle.Visible := false;
	1043	if not (aRemote = '2') then
	1044	begin
	1045	LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
	1046	if uLocalReportData.Count < 1 then
	1047	begin
	1048	uReportInstruction := '<No Report Available>';
	1049	memText.Lines.Add(uReportInstruction);
	1050	end
	1051	else
	1052	QuickCopy(uLocalReportData,memText);
	1053	end;
	1054	end;
[456]	1055	end
	1056	else
	1057	begin
	1058	Screen.Cursor := crDefault;
[830]	1059	GoRemote(uRemoteReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR, aFHIE);
[456]	1060	if Pos('ECS',Piece(uRptID,':',1))>0 then
	1061	begin
	1062	if Pos('OR_ECS1',uRptID)>0 then
	1063	uECSReport.ReportHandle := 'ECPCER';
	1064	if Pos('OR_ECS2',uRptID)>0 then
	1065	uECSReport.ReportHandle := 'ECPAT';
	1066	uECSReport.ReportType := 'D';
	1067	if uECSReport.ReportHandle = 'ECPAT' then
	1068	begin
	1069	if InfoBox('Would you like the procedure reason be included in the report?', 'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
	1070	uECSReport.NeedReason := 'Y'
	1071	else
	1072	uECSReport.NeedReason := 'N';
	1073	end;
	1074	FormatECSDate(lstQualifier.ItemID, uECSReport);
	1075	LoadECSReportText(uLocalReportData, uECSReport);
	1076	end else
[830]	1077	if not(piece(uRemoteType, '^', 9) = '1') then
	1078	LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
	1079	if not(piece(uRemoteType, '^', 9) = '1') then
	1080	if TabControl1.TabIndex < 1 then
	1081	QuickCopy(uLocalReportData,memText);
[456]	1082	end;
	1083	end;
	1084	Screen.Cursor := crDefault;
	1085	StatusText('');
	1086	memText.Lines.Insert(0,' ');
	1087	memText.Lines.Delete(0);
	1088	if WebBrowser1.Visible = true then
	1089	begin
	1090	if uReportType = 'R' then
	1091	uHTMLDoc := HTML_PRE + uLocalReportData.Text + HTML_POST
	1092	else
	1093	uHTMLDoc := uHTMLPatient + uLocalReportData.Text;
	1094	WebBrowser1.Navigate('about:blank');
	1095	end;
	1096	end;
	1097
	1098	procedure TfrmReports.GotoTop1Click(Sender: TObject);
	1099	var
	1100	Current, Desired : Longint;
	1101	begin
	1102	inherited;
	1103	with memText do
	1104	begin
	1105	SetFocus;
	1106	SelStart :=0;
	1107	SelLength :=0;
	1108	Current := SendMessage(memText.handle, EM_GETFIRSTVISIBLELINE, 0, 0);
	1109	Desired := SendMessage(memText.handle, EM_LINEFROMCHAR,
	1110	memText.SelStart + memText.SelLength ,0) - 1;
	1111	SendMessage(memText.Handle,EM_LINESCROLL, 0, Desired - Current);
	1112	end;
	1113	end;
	1114
	1115	procedure TfrmReports.GotoBottom1Click(Sender: TObject);
	1116	var
	1117	Current, Desired : Longint;
	1118	I,LineCount : Integer;
	1119	begin
	1120	Inherited;
	1121	LineCount :=0;
	1122	with memText do
	1123	begin
	1124	for I := 0 to lines.count-1 do
	1125	LineCount := LineCount + Length(Lines[I]) + 2;
	1126	SetFocus;
	1127	SelStart := LineCount;
	1128	SelLength :=0;
	1129	end;
	1130	Current := SendMessage(memText.handle, EM_GETFIRSTVISIBLELINE, 0, 0);
	1131	Desired := SendMessage(memText.handle, EM_LINEFROMCHAR,
	1132	memText.SelStart + memText.SelLength ,0);
	1133	SendMessage(memText.Handle,EM_LINESCROLL, 0, Desired - Current - 5);
	1134	end;
	1135
	1136	procedure TfrmReports.FreezeText1Click(Sender: TObject);
	1137	var
	1138	Current, Desired : Longint;
	1139	LineCount : Integer;
	1140	begin
	1141	Inherited;
	1142	If memText.SelLength > 0 then begin
	1143	Memo1.visible := true;
	1144	Memo1.TabStop := true;
	1145	Memo1.Text := memText.SelText;
	1146	If Memo1.Lines.Count <6 then
	1147	LineCount := Memo1.Lines.Count + 1
	1148	Else
	1149	LineCount := 5;
	1150	Memo1.Height := LineCount * frmReports.Canvas.TextHeight(memText.SelText);
	1151	Current := SendMessage(memText.handle, EM_GETFIRSTVISIBLELINE, 0, 0);
	1152	Desired := SendMessage(memText.handle, EM_LINEFROMCHAR,
	1153	memText.SelStart + memText.SelLength ,0);
	1154	SendMessage(memText.Handle,EM_LINESCROLL, 0, Desired - Current);
	1155	uFrozen := True;
	1156	end;
	1157	end;
	1158
	1159	procedure TfrmReports.UnFreezeText1Click(Sender: TObject);
	1160	begin
	1161	Inherited;
	1162	If uFrozen = True Then begin
	1163	uFrozen := False;
	1164	UnFreezeText1.Enabled := False;
	1165	Memo1.Visible := False;
	1166	Memo1.TabStop := False;
	1167	Memo1.Text := '';
	1168	end;
	1169	end;
	1170
	1171	procedure TfrmReports.PopupMenu1Popup(Sender: TObject);
	1172	begin
	1173	inherited;
	1174	If Screen.ActiveControl.Name <> memText.Name then
	1175	begin
	1176	memText.SetFocus;
	1177	memText.SelStart := 0;
	1178	end;
	1179	If memText.SelLength > 0 Then
	1180	FreezeText1.Enabled := True
	1181	Else
	1182	FreezeText1.Enabled := False;
	1183	If Memo1.Visible Then
	1184	UnFreezeText1.Enabled := True;
	1185	If memText.SelStart > 0 then
	1186	GotoTop1.Enabled := True
	1187	Else
	1188	GotoTop1.Enabled := False;
	1189	If SendMessage(memText.handle, EM_LINEFROMCHAR,
	1190	memText.SelStart,0) < memText.Lines.Count then
	1191	GotoBottom1.Enabled := True
	1192	Else
	1193	GotoBottom1.Enabled := False;
	1194	end;
	1195
	1196	procedure TfrmReports.FormCreate(Sender: TObject);
	1197	begin
	1198	inherited;
	1199	PageID := CT_REPORTS;
	1200	uFrozen := False;
	1201	uHSComponents := TStringList.Create;
	1202	uHSAll := TStringList.Create;
	1203	uLocalReportData := TStringList.Create;
	1204	uRemoteReportData := TStringList.Create;
	1205	uColumns := TStringList.Create;
	1206	uTreeStrings := TStringList.Create;
	1207	uEmptyImageList := TImageList.Create(Self);
	1208	uEmptyImageList.Width := 0;
	1209	RowObjects := TRowObject.Create;
	1210	uRemoteCount := 0;
	1211	GraphFormActive := false;
	1212	end;
	1213
	1214	procedure TfrmReports.ProcessNotifications;
	1215	var
[830]	1216	j, AnIndex, IDColumn: integer;
[456]	1217	SelectID: string;
	1218	ListItem: TListItem;
[830]	1219	tmpRptID: string;
[456]	1220
[830]	1221	function FindReport(QualType: integer; var AnIndex: integer): boolean; overload;
	1222	var
	1223	Found: boolean;
	1224	i: integer;
	1225	begin
	1226	Found := False;
	1227	with tvReports do
	1228	begin
	1229	for i := 0 to Items.Count -1 do
	1230	if StrToIntDef(Piece(PReportTreeObject(tvReports.Items[i].Data)^.Qualifier,';',4),0) = QualType then
	1231	begin
	1232	Found := True;
	1233	break;
	1234	end;
	1235	end;
	1236	Result := Found ;
	1237	AnIndex := i;
	1238	end;
[456]	1239
[830]	1240	function FindReport(ReportID: string; var AnIndex: integer): boolean; overload;
	1241	var
	1242	Found: boolean;
	1243	i: integer;
	1244	begin
	1245	Found := False;
	1246	with tvReports do
	1247	begin
	1248	for i := 0 to Items.Count -1 do
	1249	if Piece(PReportTreeObject(tvReports.Items[i].Data)^.ID, ':', 1) = ReportID then
	1250	begin
	1251	Found := True;
	1252	break;
	1253	end;
	1254	end;
	1255	Result := Found ;
	1256	AnIndex := i;
	1257	end;
	1258
	1259	begin
	1260	IDColumn := 0;
[456]	1261	case Notifications.Followup of
	1262	NF_IMAGING_RESULTS, NF_ABNORMAL_IMAGING_RESULTS, NF_IMAGING_RESULTS_AMENDED:
	1263	begin
[830]	1264	if not FindReport(QT_IMAGING, AnIndex) then exit;
	1265	tvReports.Selected := tvReports.Items[AnIndex];
[456]	1266	SelectID := 'i' + Piece(Notifications.AlertData, '~', 1) +
	1267	'-' + Piece(Notifications.AlertData, '~', 2);
[830]	1268	IDColumn := 0;
	1269	if tvReports.Selected <> tvReports.Items[AnIndex] then
	1270	tvReports.Selected := tvReports.Items[AnIndex];
[456]	1271	end;
	1272	NF_IMAGING_REQUEST_CHANGED:
	1273	begin
[830]	1274	if not FindReport(QT_IMAGING, AnIndex) then exit;
	1275	tvReports.Selected := tvReports.Items[AnIndex];
[456]	1276	SelectID := 'i' + Piece(Notifications.AlertData, '/', 2) +
	1277	'-' + Piece(Notifications.AlertData, '/', 3);
[830]	1278	IDColumn := 0;
	1279	if tvReports.Selected <> tvReports.Items[AnIndex] then
	1280	tvReports.Selected := tvReports.Items[AnIndex];
[456]	1281	end;
	1282	NF_STAT_RESULTS :
	1283	begin
[830]	1284	if not FindReport(QT_IMAGING, AnIndex) then exit;
	1285	tvReports.Selected := tvReports.Items[AnIndex];
[456]	1286	SelectID := 'i' + Piece(Notifications.AlertData, '~', 2) +
	1287	'-' + Piece(Piece(Notifications.AlertData, '~', 3), '@', 1);
[830]	1288	IDColumn := 0;
	1289	if tvReports.Selected <> tvReports.Items[AnIndex] then
	1290	tvReports.Selected := tvReports.Items[AnIndex];
[456]	1291	end;
[830]	1292	NF_MAMMOGRAM_RESULTS :
	1293	begin
	1294	if not FindReport('OR_R18', AnIndex) then exit;
	1295	tvReports.Selected := tvReports.Items[AnIndex];
	1296	SelectID := 'i' + Piece(Notifications.AlertData, '~', 1) +
	1297	'-' + Piece(Notifications.AlertData, '~', 2);
	1298	IDColumn := 8;
	1299	if tvReports.Selected <> tvReports.Items[AnIndex] then
	1300	tvReports.Selected := tvReports.Items[AnIndex];
	1301	end;
	1302	NF_ANATOMIC_PATHOLOGY_RESULTS :
	1303	//OR_SP^Surgical Pathology
	1304	//OR_CY^Cytology
	1305	//OR_EM^Electron Microscopy
	1306	//OR_AU^Autopsy
	1307	begin
	1308	if Notifications.AlertData = '^1^^^0^0^0' then //code snippet to handle the processing of v26 AP alerts in a v27 environment.
	1309	begin
	1310	if pnlRightMiddle.Visible then pnlRightMiddle.Visible := FALSE;
	1311	InfoBox('This alert was generated in a v26 environment as an informational alert and'
	1312	+ CRLF + 'therefore cannot be processed as an action alert in a v27 environment.',
	1313	'Unable to Process as Action Alert', MB_OK or MB_ICONWARNING);
	1314	memText.Text := 'Unable to Process as an Action Alert. In order to view the associated Anatomic Pathology report, please manually'
	1315	+ CRLF + 'locate the appropriate report under the Anatomic Pathology section (also found under Laboratory, Clinical Reports).';
	1316	Notifications.Delete;
	1317	exit;
	1318	end;
	1319	tmpRptID := Piece(Notifications.AlertData, U, 1);
	1320	//if tmpRptID = 'CY' then tmpRptID := 'APR';
	1321	//if tmpRptID = 'EM' then tmpRptID := 'APR';
	1322	//if tmpRptID = 'SP' then tmpRptID := 'APR';
	1323	if not FindReport('OR_' + tmpRptID, AnIndex) then exit;
	1324	tvReports.Selected := tvReports.Items[AnIndex];
	1325	SelectID := Piece(Notifications.AlertData, U, 2);
	1326	if (tmpRptID = 'CY') or (tmpRptID = 'EM') or (tmpRptID = 'SP') then
	1327	IDColumn := 3;
	1328	//if tmpRptID = 'APR' then IDColumn := 3
	1329	//else if tmpRptID = 'SP' then IDColumn := 3
	1330	//else if tmpRptID = 'EM' then IDColumn := 3
	1331	//else if tmpRptID = 'CY' then IDColumn := 3 ;
	1332	if tvReports.Selected <> tvReports.Items[AnIndex] then
	1333	tvReports.Selected := tvReports.Items[AnIndex];
	1334	end;
	1335	NF_PAP_SMEAR_RESULTS :
	1336	begin
	1337	if not FindReport('OR_CY', AnIndex) then exit;
	1338	tvReports.Selected := tvReports.Items[AnIndex];
	1339	SelectID := Piece(Notifications.AlertData, U, 2);
	1340	IDColumn := 3;
	1341	if tvReports.Selected <> tvReports.Items[AnIndex] then
	1342	tvReports.Selected := tvReports.Items[AnIndex];
	1343	end;
	1344	else with tvReports do if Items.Count > 0 then Selected := Items[0];
[456]	1345	end;
	1346	if tvReports.Selected <> nil then
	1347	begin
	1348	tvReportsClick(Self);
[830]	1349	Application.ProcessMessages;
	1350	for j := 0 to lvReports.Items.Count - 1 do
[456]	1351	begin
[830]	1352	ListItem := lvReports.Items[j];
	1353	if ListItem.Subitems[IDColumn] = SelectID then
[456]	1354	begin
[830]	1355	lvReports.Selected := lvReports.Items[j];
[456]	1356	break;
	1357	end;
	1358	end;
	1359	Notifications.Delete;
	1360	end;
	1361	end;
	1362
	1363	procedure TfrmReports.DisplayHeading(aRanges: string);
	1364	var
	1365	x,x1,x2,y,z,DaysBack: string;
	1366	d1,d2: TFMDateTime;
	1367	begin
	1368	with lblTitle do
	1369	begin
	1370	x := '';
	1371	if tvReports.Selected = nil then
	1372	tvReports.Selected := tvReports.Items.GetFirstNode;
	1373	if tvReports.Selected.Parent <> nil then
	1374	x := tvReports.Selected.Parent.Text + ' ' + tvReports.Selected.Text
	1375	else
	1376	x := tvReports.Selected.Text;
	1377	x1 := '';
	1378	x2 := '';
	1379	if uReportType <> 'M' then
	1380	begin
	1381	if CharAt(aRanges, 1) = 'd' then
	1382	begin
	1383	if length(piece(aRanges,';',2)) > 0 then
	1384	begin
	1385	x2 := ' Max/site:' + piece(aRanges,';',2);
	1386	aRanges := piece(aRanges,';',1);
	1387	end;
	1388	DaysBack := Copy(aRanges, 2, Length(aRanges));
	1389	if DaysBack = '0' then
	1390	aRanges := 'T' + ';T'
	1391	else
	1392	aRanges := 'T-' + DaysBack + ';T';
	1393	end;
	1394	if length(piece(aRanges,';',1)) > 0 then
[830]	1395	if uReportType <> 'G' then // graphs don't display date ranges here
[456]	1396	begin
	1397	d1 := ValidDateTimeStr(piece(aRanges,';',1),'');
	1398	d2 := ValidDateTimeStr(piece(aRanges,';',2),'');
	1399	y := FormatFMDateTime('mmm dd,yyyy',d1);
[830]	1400	if Copy(y,8,2) = '18' then y := 'EARLIEST RESULT';
[456]	1401	z := FormatFMDateTime('mmm dd,yyyy',d2);
	1402	x1 := ' [From: ' + y + ' to ' + z + ']';
	1403	end;
	1404	if length(piece(aRanges,';',3)) > 0 then
	1405	x2 := ' Max/site:' + piece(aRanges,';',3);
	1406	case uQualifierType of
	1407	QT_DATERANGE:
	1408	x := x + x1;
	1409	QT_HSCOMPONENT:
	1410	x := x + x1 + x2;
	1411	QT_HSWPCOMPONENT:
	1412	x := x + x1 + x2;
	1413	QT_IMAGING:
	1414	x := x + x1 + x2;
	1415	end;
	1416	end;
[830]	1417	if piece(uRemoteType, '^', 9) = '1' then x := x + ' <<ONLY REMOTE DOD DATA INCLUDED IN REPORT>>';
[456]	1418	Caption := x;
	1419	end;
	1420	lvReports.Caption := x;
	1421	end;
	1422
	1423	procedure TfrmReports.FormShow(Sender: TObject);
	1424	begin
	1425	inherited;
	1426	if RemoteSites.SiteList.Count > 0 then
	1427	begin
	1428	case uQualifierType of
	1429	QT_HSWPCOMPONENT:;
	1430	QT_HSCOMPONENT:;
	1431	QT_IMAGING:;
	1432	QT_PROCEDURES:;
	1433	QT_NUTR:;
	1434	else
	1435	ShowTabControl;
	1436	end;
	1437	end;
	1438	end;
	1439
	1440	procedure TfrmReports.Timer1Timer(Sender: TObject);
	1441	var
	1442	i,j,fail: integer;
	1443	r0,aSite: String;
	1444	aHDR, aID, aRet: String;
	1445	begin
	1446	inherited;
	1447	with RemoteSites.SiteList do
	1448	begin
	1449	for i := 0 to Count - 1 do
	1450	if TRemoteSite(Items[i]).Selected then
	1451	begin
	1452	if Length(TRemoteSite(Items[i]).RemoteHandle) > 0 then
	1453	begin
	1454	r0 := GetRemoteStatus(TRemoteSite(Items[i]).RemoteHandle);
	1455	aSite := TRemoteSite(Items[i]).SiteName;
	1456	TRemoteSite(Items[i]).QueryStatus := r0; //r0='1^Done' if no errors
	1457	UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, piece(r0,'^',2));
	1458	if piece(r0,'^',1) = '1' then
	1459	begin
	1460	aHDR := piece(TRemoteSite(Items[i]).CurrentReportQuery, '^', 13);
	1461	aID := piece(piece(TRemoteSite(Items[i]).CurrentReportQuery, '^', 2),':',1);
	1462	if aHDR = '1' then
	1463	begin
	1464	ModifyHDRData(aRet, TRemoteSite(Items[i]).RemoteHandle ,aID);
	1465	end;
	1466	GetRemoteData(TRemoteSite(Items[i]).Data, TRemoteSite(Items[i]).RemoteHandle,Items[i]);
	1467	RemoteReports.Add(TRemoteSite(Items[i]).CurrentReportQuery,
	1468	TRemoteSite(Items[i]).RemoteHandle);
	1469	TRemoteSite(Items[i]).RemoteHandle := '';
	1470	TabControl1.OnChange(nil);
	1471	if (length(piece(uHState,';',2)) > 0) then
	1472	begin
	1473	uRemoteReportData.Clear;
	1474	QuickCopy(TRemoteSite(Items[i]).Data,uRemoteReportData);
	1475	fail := 0;
	1476	if uRemoteReportData.Count > 0 then
	1477	begin
	1478	if uRemoteReportData[0] = 'Report not available at this time.' then
	1479	begin
	1480	fail := 1;
	1481	UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Report not available');
	1482	end;
	1483	if piece(uRemoteReportData[0],'^',1) = '-1' then
	1484	begin
	1485	fail := 1;
	1486	UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication failure');
	1487	end;
	1488	if fail = 0 then
	1489	LoadListView(uRemoteReportData);
	1490	end;
	1491	end;
	1492	end
	1493	else
	1494	begin
	1495	uRemoteCount := uRemoteCount + 1;
	1496	if uRemoteCount > 90 then
	1497	begin
	1498	TRemoteSite(Items[i]).RemoteHandle := '';
	1499	TRemoteSite(Items[i]).QueryStatus := '-1^Timed out';
	1500	UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Timed out');
	1501	StatusText('');
	1502	TabControl1.OnChange(nil);
	1503	end
	1504	else
	1505	StatusText('Retrieving reports from '
	1506	+ TRemoteSite(Items[i]).SiteName + '...');
	1507	end;
	1508	Timer1.Interval := 10000;
	1509	end;
	1510	end;
	1511	if Timer1.Enabled = True then
	1512	begin
	1513	j := 0;
	1514	for i := 0 to Count -1 do
	1515	begin
	1516	if Length(TRemoteSite(Items[i]).RemoteHandle) > 0 then
	1517	begin
	1518	j := 1;
	1519	break;
	1520	end;
	1521	end;
	1522	if j = 0 then //Shutdown timer if all sites have been processed
	1523	begin
	1524	Timer1.Enabled := False;
	1525	StatusText('');
	1526	end;
	1527	j := 0;
	1528	for i := 0 to Count -1 do
	1529	if TRemoteSite(Items[i]).Selected = true then
	1530	begin
	1531	j := 1;
	1532	break;
	1533	end;
	1534	if j = 0 then //Shutdown timer if user has de-selected all sites
	1535	begin
	1536	Timer1.Enabled := False;
	1537	StatusText('');
	1538	TabControl1.OnChange(nil);
	1539	end;
	1540	end;
	1541	end;
	1542	end;
	1543
	1544	procedure TfrmReports.TabControl1Change(Sender: TObject);
	1545	var
	1546	aStatus,aSite: string;
	1547	hook: Boolean;
	1548	i: integer;
	1549	begin
	1550	inherited;
	1551	if (uQualifiertype <> 6) or (length(piece(uHState,';',2)) < 1) then
	1552	memText.Lines.Clear;
	1553	lstHeaders.Items.Clear;
	1554	uHTMLDoc := '';
	1555	if WebBrowser1.visible = true then WebBrowser1.Navigate('about:blank');
	1556	if (length(piece(uHState,';',2)) = 0) then with TabControl1 do
	1557	begin
	1558	memText.Lines.BeginUpdate;
	1559	if TabIndex > 0 then
	1560	begin
	1561	aStatus := TRemoteSite(Tabs.Objects[TabIndex]).QueryStatus;
	1562	aSite := TRemoteSite(Tabs.Objects[TabIndex]).SiteName;
	1563	if aStatus = '1^Done' then
	1564	begin
	1565	if Piece(TRemoteSite(Tabs.Objects[TabIndex]).Data[0],'^',1) = '[HIDDEN TEXT]' then
	1566	begin
	1567	lstHeaders.Clear;
	1568	hook := false;
	1569	for i := 1 to TRemoteSite(Tabs.Objects[TabIndex]).Data.Count - 1 do
	1570	if hook = true then
	1571	memText.Lines.Add(TRemoteSite(Tabs.Objects[TabIndex]).Data[i])
	1572	else
	1573	begin
	1574	lstHeaders.Items.Add(MixedCase(TRemoteSite(Tabs.Objects[TabIndex]).Data[i]));
	1575	if Piece(TRemoteSite(Tabs.Objects[TabIndex]).Data[i],'^',1) = '[REPORT TEXT]' then
	1576	hook := true;
	1577	end;
	1578	end
	1579	else
	1580	QuickCopy(TRemoteSite(Tabs.Objects[TabIndex]).Data,memText);
	1581	memText.Lines.Insert(0,' ');
	1582	memText.Lines.Delete(0);
	1583	end;
	1584	if Piece(aStatus,'^',1) = '-1' then
	1585	begin
	1586	memText.Lines.Add('Remote data transmission error: ' + Piece(aStatus,'^',2));
	1587	end;
	1588	if Piece(aStatus,'^',1) = '0' then
	1589	memText.Lines.Add('Retrieving data... ' + Piece(aStatus,'^',2));
	1590	if Piece(aStatus,'^',1) = '' then
	1591	memText.Lines.Add(uReportInstruction);
	1592	end
	1593	else
	1594	if uLocalReportData.Count > 0 then
	1595	begin
	1596	if Piece(uLocalReportData[0],'^',1) = '[HIDDEN TEXT]' then
	1597	begin
	1598	lstHeaders.Clear;
	1599	hook := false;
	1600	for i := 1 to uLocalReportData.Count - 1 do
	1601	if hook = true then
	1602	memText.Lines.Add(uLocalReportData[i])
	1603	else
	1604	begin
	1605	lstHeaders.Items.Add(MixedCase(uLocalReportData[i]));
	1606	if Piece(uLocalReportData[i],'^',1) = '[REPORT TEXT]' then
	1607	hook := true;
	1608	end;
	1609	end
	1610	else
	1611	if tvReports.Selected.Text = 'Imaging (local only)' then
	1612	memText.Lines.clear
	1613	else
	1614	QuickCopy(uLocalReportData,memText);
	1615	memText.Lines.Insert(0,' ');
	1616	memText.Lines.Delete(0);
	1617	end
	1618	else
	1619	memText.Lines.Add(uReportInstruction);
	1620	if WebBrowser1.Visible = true then
	1621	begin
	1622	if uReportType = 'R' then
	1623	uHTMLDoc := HTML_PRE + memText.Lines.Text + HTML_POST
	1624	else
	1625	uHTMLDoc := uHTMLPatient + memText.Lines.Text;
	1626	WebBrowser1.Navigate('about:blank');
	1627	end;
	1628	memText.Lines.EndUpdate;
	1629	end;
	1630	end;
	1631
[830]	1632	procedure TfrmReports.GoRemote(Dest: TStringList; AItem: string; AQualifier, ARpc: string; AHSTag: string; AHDR: string; aFHIE: string);
[456]	1633	var
	1634	i, j: integer;
[830]	1635	LocalHandle, Query, Report, Seq: string;
[456]	1636	HSType, DaysBack, ExamID, MaxOcc: string;
	1637	Alpha, Omega, Trans: double;
	1638	begin
	1639	HSType := '';
	1640	DaysBack := '';
	1641	ExamID := '';
	1642	Alpha := 0;
	1643	Omega := 0;
[830]	1644	Seq := '';
[456]	1645	if AHDR = '1' then
	1646	begin
	1647	if HDRActive = '0' then
	1648	begin
	1649	InfoBox('The HDR is currently inactive.' + CRLF + 'Unable to retrieve HDR data at this time.', 'HDR Error', MB_OK);
	1650	Exit;
	1651	end;
[830]	1652	InfoBox('You must use VistaWeb to view this report.', 'Use VistaWeb for HDR data', MB_OK);
[456]	1653	if (Piece(AItem, ':', 1) = 'OR_VWAL') or (Piece(AItem, ':', 1) = 'OR_VWRX') then
[830]	1654	AQualifier := 'T-50000;T+50000;99999';
[456]	1655	if (Piece(AItem, ':', 1) = 'OR_VWVS') and (CharAt(AQualifier, 1) = ';') then
[830]	1656	AQualifier := 'T-50000;T+50000;99999';
[456]	1657	end;
	1658	if CharAt(AQualifier, 1) = 'd' then
	1659	begin
	1660	DaysBack := Copy(AQualifier, 2, Length(AQualifier));
	1661	AQualifier := ('T-' + Piece(DaysBack,';',1) + ';T;' + Pieces(AQualifier,';',2,3));
	1662	DaysBack := '';
	1663	end;
	1664	if CharAt(AQualifier, 1) = 'T' then
	1665	begin
	1666	if Piece(AQualifier,';',1) = 'T-0' then SetPiece(AQualifier,';',1,'T');
	1667	if (Piece(Aqualifier,';',1) = 'T') and (Piece(Aqualifier,';',2) = 'T')
	1668	then SetPiece(AQualifier,';',2,'T+1');
	1669	Alpha := StrToFMDateTime(Piece(AQualifier,';',1));
	1670	Omega := StrToFMDateTime(Piece(AQualifier,';',2));
	1671	if Alpha > Omega then
	1672	begin
	1673	Trans := Omega;
	1674	Omega := Alpha;
	1675	Alpha := Trans;
	1676	end;
	1677	MaxOcc := Piece(AQualifier,';',3);
	1678	SetPiece(AHSTag,';',4,MaxOcc);
	1679	end;
	1680	if CharAt(AQualifier, 1) = 'h' then HSType := Copy(AQualifier, 2, Length(AQualifier));
	1681	if CharAt(AQualifier, 1) = 'i' then ExamID := Copy(AQualifier, 2, Length(AQualifier));
	1682	with RemoteSites.SiteList do for i := 0 to Count - 1 do
	1683	begin
	1684	if (AHDR='1') and (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') then
	1685	begin
	1686	TRemoteSite(Items[i]).Selected := true;
	1687	frmFrame.lstCIRNLocations.Checked[i+2] := true;
	1688	end;
	1689	if TRemoteSite(Items[i]).Selected then
	1690	begin
	1691	TRemoteSite(Items[i]).ReportClear;
	1692	if (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') and not(AHDR = '1') then
	1693	begin
	1694	TRemoteSite(Items[i]).QueryStatus := '1^Not Included';
	1695	UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
[830]	1696	TRemoteSite(Items[i]).RemoteHandle := '';
	1697	TRemoteSite(Items[i]).QueryStatus := '1^Done';
	1698	if uQualifierType = 6 then seq := '1^';
	1699	TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
	1700	if uQualifierType = 6 then seq := '2^';
	1701	TRemoteSite(Items[i]).Data.Add(seq + '<No HDR Data Included> - Use "HDR Reports" menu for HDR Data.');
[456]	1702	TabControl1.OnChange(nil);
[830]	1703	if (length(piece(uHState,';',2)) > 0) then
	1704	LoadListView(TRemoteSite(Items[i]).Data);
[456]	1705	continue;
	1706	end;
	1707	if (AHDR = '1') and not(LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') then
	1708	begin
	1709	TRemoteSite(Items[i]).QueryStatus := '1^Not Included';
	1710	UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
[830]	1711	TRemoteSite(Items[i]).RemoteHandle := '';
	1712	TRemoteSite(Items[i]).QueryStatus := '1^Done';
	1713	if uQualifierType = 6 then seq := '1^';
	1714	TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
	1715	if uQualifierType = 6 then seq := '2^';
	1716	TRemoteSite(Items[i]).Data.Add(seq + '<No HDR Data> This site is not a source for HDR Data.');
[456]	1717	TabControl1.OnChange(nil);
[830]	1718	if (length(piece(uHState,';',2)) > 0) then
	1719	LoadListView(TRemoteSite(Items[i]).Data);
[456]	1720	continue;
	1721	end;
[830]	1722	if (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200') and not(aFHIE = '1') then
	1723	begin
	1724	TRemoteSite(Items[i]).QueryStatus := '1^Not Included';
	1725	UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
	1726	TRemoteSite(Items[i]).RemoteHandle := '';
	1727	TRemoteSite(Items[i]).QueryStatus := '1^Done';
	1728	if uQualifierType = 6 then seq := '1^';
	1729	TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
	1730	if uQualifierType = 6 then seq := '2^';
	1731	TRemoteSite(Items[i]).Data.Add(seq + '<No DOD Data> - Use "Dept. of Defense Reports" Menu to retrieve data from DOD.');
	1732	TabControl1.OnChange(nil);
	1733	if (length(piece(uHState,';',2)) > 0) then
	1734	LoadListView(TRemoteSite(Items[i]).Data);
	1735	continue;
	1736	end;
[456]	1737	TRemoteSite(Items[i]).CurrentReportQuery := 'Report' + Patient.DFN + ';'
	1738	+ Patient.ICN + '^' + AItem + '^^^' + ARpc + '^' + HSType +
	1739	'^' + DaysBack + '^' + ExamID + '^' + FloatToStr(Alpha) + '^' +
	1740	FloatToStr(Omega) + '^' + TRemoteSite(Items[i]).SiteID + '^' + AHSTag + '^' + AHDR;
	1741	LocalHandle := '';
	1742	Query := TRemoteSite(Items[i]).CurrentReportQuery;
	1743	for j := 0 to RemoteReports.Count - 1 do
	1744	begin
	1745	Report := TRemoteReport(RemoteReports.ReportList.Items[j]).Report;
	1746	if Report = Query then
	1747	begin
	1748	LocalHandle := TRemoteReport(RemoteReports.ReportList.Items[j]).Handle;
	1749	break;
	1750	end;
	1751	end;
	1752	if Length(LocalHandle) > 1 then
	1753	with RemoteSites.SiteList do
	1754	begin
	1755	GetRemoteData(TRemoteSite(Items[i]).Data,LocalHandle,Items[i]);
	1756	TRemoteSite(Items[i]).RemoteHandle := '';
	1757	TRemoteSite(Items[i]).QueryStatus := '1^Done';
	1758	UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Done');
	1759	TabControl1.OnChange(nil);
	1760	if (length(piece(uHState,';',2)) > 0) then //and (chkText.Checked = false) then
	1761	LoadListView(TRemoteSite(Items[i]).Data);
	1762	end
	1763	else
	1764	begin
	1765	if uDirect = '1' then
	1766	begin
	1767	StatusText('Retrieving reports from ' + TRemoteSite(Items[i]).SiteName + '...');
	1768	TRemoteSite(Items[i]).QueryStatus := '1^Direct Call';
	1769	UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Direct Call');
	1770	DirectQuery(Dest, AItem, HSType, Daysback, ExamID, Alpha, Omega, TRemoteSite(Items[i]).SiteID, ARpc, AHSTag);
	1771	if Copy(Dest[0],1,2) = '-1' then
	1772	begin
	1773	TRemoteSite(Items[i]).QueryStatus := '-1^Communication error';
	1774	UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication error');
[830]	1775	if uQualifierType = 6 then seq := '1^';
	1776	TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
	1777	if uQualifierType = 6 then seq := '2^';
	1778	TRemoteSite(Items[i]).Data.Add(seq + '<ERROR>- Unable to communicate with Remote site');
	1779	TabControl1.OnChange(nil);
	1780	if (length(piece(uHState,';',2)) > 0) then
	1781	LoadListView(TRemoteSite(Items[i]).Data);
[456]	1782	end
	1783	else
	1784	begin
	1785	QuickCopy(Dest,TRemoteSite(Items[i]).Data);
	1786	TRemoteSite(Items[i]).RemoteHandle := '';
	1787	TRemoteSite(Items[i]).QueryStatus := '1^Done';
	1788	UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Done');
	1789	TabControl1.OnChange(nil);
	1790	if (length(piece(uHState,';',2)) > 0) then
	1791	LoadListView(TRemoteSite(Items[i]).Data);
	1792	end;
	1793	StatusText('');
	1794	end
	1795	else
	1796	begin
	1797	RemoteQuery(Dest, AItem, HSType, Daysback, ExamID, Alpha, Omega, TRemoteSite(Items[i]).SiteID, ARpc, AHSTag);
	1798	if Dest[0] = '' then
	1799	begin
	1800	TRemoteSite(Items[i]).QueryStatus := '-1^Communication error';
	1801	UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication error');
[830]	1802	if uQualifierType = 6 then seq := '1^';
	1803	TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
	1804	if uQualifierType = 6 then seq := '2^';
	1805	TRemoteSite(Items[i]).Data.Add(seq + '<ERROR>- Unable to communicate with Remote site');
	1806	TabControl1.OnChange(nil);
	1807	if (length(piece(uHState,';',2)) > 0) then
	1808	LoadListView(TRemoteSite(Items[i]).Data);
[456]	1809	end
	1810	else
	1811	begin
	1812	TRemoteSite(Items[i]).RemoteHandle := Dest[0];
	1813	TRemoteSite(Items[i]).QueryStatus := '0^initialization...';
	1814	UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'initialization');
	1815	Timer1.Enabled := True;
	1816	StatusText('Retrieving reports from ' + TRemoteSite(Items[i]).SiteName + '...');
	1817	end;
	1818	end;
	1819	end;
	1820	end;
	1821	end;
	1822	end;
	1823
	1824	procedure TfrmReports.FormDestroy(Sender: TObject);
	1825	var
	1826	i: integer;
	1827	aColChange: string;
	1828	begin
	1829	inherited;
	1830	if length(uColChange) > 0 then
	1831	begin
	1832	aColChange := '';
	1833	for i := 0 to lvReports.Columns.Count - 1 do
	1834	aColChange := aColChange + IntToStr(lvReports.Column[i].width) + ',';
[830]	1835	if (Length(aColChange) > 0) and (aColChange <> piece(uColchange,'^',2)) then
[456]	1836	SaveColumnSizes(piece(uColChange,'^',1) + '^' + aColChange);
	1837	uColChange := '';
	1838	end;
	1839	RemoteQueryAbortAll;
	1840	RowObjects.Free;
	1841	uHSComponents.Free;
	1842	uHSAll.Free;
	1843	uLocalReportData.Free;
	1844	uRemoteReportData.Free;
	1845	uColumns.Free;
	1846	uTreeStrings.Free;
	1847	uEmptyImageList.Free;
	1848	uECSReport.Free;
	1849	if GraphForm <> nil then GraphForm.Release;
	1850	end;
	1851
	1852	procedure TfrmReports.lstHeadersClick(Sender: TObject);
	1853	var
	1854	Current, Desired: integer;
	1855	begin
	1856	inherited;
	1857	if uFrozen = True then
	1858	begin
	1859	memo1.visible := False;
	1860	memo1.TabStop := False;
	1861	end;
	1862	Current := SendMessage(memText.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
	1863	Desired := lstHeaders.ItemIEN;
	1864	SendMessage(memText.Handle, EM_LINESCROLL, 0, Desired - Current - 1);
	1865	end;
	1866
	1867	procedure TfrmReports.Splitter1CanResize(Sender: TObject;
	1868	var NewSize: Integer; var Accept: Boolean);
	1869	begin
	1870	inherited;
	1871	if NewSize < 50 then
	1872	Newsize := 50;
	1873	end;
	1874
	1875	procedure TfrmReports.WebBrowser1DocumentComplete(Sender: TObject;
	1876	const pDisp: IDispatch; var URL: OleVariant);
	1877	var
	1878	WebDoc: IHtmlDocument2;
	1879	v: variant;
	1880	begin
	1881	inherited;
	1882	if uHTMLDoc = '' then Exit;
	1883	if not(uReportType = 'H') then Exit; //this can be removed if & when browser replaces memtext control
	1884	if not Assigned(WebBrowser1.Document) then Exit;
	1885	WebDoc := WebBrowser1.Document as IHtmlDocument2;
	1886	v := VarArrayCreate([0, 0], varVariant);
	1887	v[0] := uHTMLDoc;
	1888	WebDoc.write(PSafeArray(TVarData(v).VArray));
	1889	WebDoc.close;
	1890	//uHTMLDoc := '';
	1891	end;
	1892
	1893	procedure TfrmReports.sptHorzRightCanResize(Sender: TObject;
	1894	var NewSize: Integer; var Accept: Boolean);
	1895	begin
	1896	inherited;
	1897	if NewSize < 50 then
	1898	Newsize := 50;
	1899	end;
	1900
	1901	procedure TfrmReports.lstQualifierDrawItem(Control: TWinControl;
	1902	Index: Integer; Rect: TRect; State: TOwnerDrawState);
	1903	var
	1904	x: string;
	1905	AnImage: TBitMap;
	1906	const
	1907	STD_DATE = 'MMM DD,YY@HH:NN';
	1908	begin
	1909	inherited;
	1910	AnImage := TBitMap.Create;
	1911	try
	1912	with (Control as TORListBox).Canvas do { draw on control canvas, not on the form }
	1913	begin
	1914	x := (Control as TORListBox).Items[Index];
	1915	FillRect(Rect); { clear the rectangle }
	1916	if uQualifierType = QT_IMAGING then // moved position of assignment in all case branches
	1917	begin
	1918	AnImage.LoadFromResourceName(hInstance, 'BMP_IMAGEFLAG_1');
	1919	if Piece(x, U, 4) = 'Y' then
	1920	begin
	1921	BrushCopy(Bounds(Rect.Left, Rect.Top, AnImage.Width, AnImage.Height),
	1922	AnImage, Bounds(0, 0, AnImage.Width, AnImage.Height), clRed); {render ImageFlag}
	1923	end;
	1924	TextOut(Rect.Left + AnImage.Width, Rect.Top, Piece(x, U, 2));
	1925	TextOut(Rect.Left + AnImage.Width + TextWidth(STD_DATE), Rect.Top, Piece(x, U, 3));
	1926	end
	1927	else
	1928	begin
	1929	TextOut(Rect.Left, Rect.Top, Piece(x, U, 2));
	1930	TextOut(Rect.Left + TextWidth(STD_DATE), Rect.Top, Piece(x, U, 3));
	1931	end;
	1932	end;
	1933	finally
	1934	AnImage.Free;
	1935	end;
	1936	end;
	1937
	1938	procedure TfrmReports.tvReportsClick(Sender: TObject);
	1939	var
	1940	i,j: integer;
	1941	ListItem: TListItem;
	1942	aHeading, aReportType, aRPC, aQualifier, aStartTime, aStopTime, aMax, aRptCode, aRemote, aCategory, aSortOrder, aDaysBack, x: string;
	1943	aIFN: integer;
[830]	1944	aID, aHSTag, aRadParam, aColChange, aDirect, aHDR, aFHIE, aFHIEONLY, aQualifierID: string;
[456]	1945	CurrentParentNode, CurrentNode: TTreeNode;
	1946	begin
	1947	inherited;
	1948	lvReports.Hint := 'To sort, click on column headers\|';
	1949	tvReports.TopItem := tvReports.Selected;
	1950	uRemoteCount := 0;
	1951	uReportInstruction := '';
	1952	aHeading := PReportTreeObject(tvReports.Selected.Data)^.Heading;
	1953	aRemote := PReportTreeObject(tvReports.Selected.Data)^.Remote;
	1954	aReportType := PReportTreeObject(tvReports.Selected.Data)^.RptType;
	1955	aQualifier := PReportTreeObject(tvReports.Selected.Data)^.Qualifier;
	1956	aID := PReportTreeObject(tvReports.Selected.Data)^.ID;
	1957	aRPC := PReportTreeObject(tvReports.Selected.Data)^.RPCName;
	1958	aHSTag := PReportTreeObject(tvReports.Selected.Data)^.HSTag;
	1959	aCategory := PReportTreeObject(tvReports.Selected.Data)^.Category;
	1960	aSortOrder := PReportTreeObject(tvReports.Selected.Data)^.SortOrder;
	1961	aDaysBack := PReportTreeObject(tvReports.Selected.Data)^.MaxDaysBack;
	1962	aIFN := StrToIntDef(PReportTreeObject(tvReports.Selected.Data)^.IFN,0);
	1963	aDirect := PReportTreeObject(tvReports.Selected.Data)^.Direct;
	1964	aHDR := PReportTreeObject(tvReports.Selected.Data)^.HDR;
[830]	1965	aFHIE := PReportTreeObject(tvReports.Selected.Data)^.FHIE;
	1966	aFHIEONLY := PReportTreeObject(tvReports.Selected.Data)^.FHIEONLY;
[456]	1967	aStartTime := Piece(aQualifier,';',1);
	1968	aStopTime := Piece(aQualifier,';',2);
	1969	aMax := Piece(aQualifier,';',3);
	1970	aRptCode := Piece(aQualifier,';',4);
	1971	aQualifierID:= '';
	1972	if length(uColChange) > 0 then
	1973	begin
	1974	aColChange := '';
	1975	for i := 0 to lvReports.Columns.Count - 1 do
	1976	aColChange := aColChange + IntToStr(lvReports.Column[i].width) + ',';
[830]	1977	if (Length(aColChange) > 0) and (aColChange <> piece(uColchange,'^',2)) then
[456]	1978	SaveColumnSizes(piece(uColChange,'^',1) + '^' + aColChange);
	1979	uColChange := '';
	1980	end;
	1981	if (aReportType <> 'M') and (aRPC = '') and (CharAt(aID,1) = 'H') then
	1982	begin
	1983	aReportType := 'R';
	1984	aRptCode := LowerCase(CharAt(aID,1)) + Copy(aID, 2, Length(aID));
	1985	aID := '1';
	1986	aRPC := 'ORWRP REPORT TEXT';
	1987	aHSTag := '';
	1988	end;
	1989	if aReportType = '' then aReportType := 'R';
	1990	uReportRPC := aRPC;
	1991	uRptID := aID;
	1992	uDirect := aDirect;
	1993	uReportType := aReportType;
	1994	uQualifier := aQualifier;
	1995	uSortOrder := aSortOrder;
[830]	1996	uRemoteType := aRemote + '^' + aReportType + '^' + IntToStr(aIFN) + '^' + aHeading + '^' + aRptCode + '^' + aDaysBack + '^' + aHDR + '^' + aFHIE + '^' + aFHIEONLY;
[456]	1997	pnlRightTop.Height := lblTitle.Height; // see below
	1998	RedrawSuspend(tvReports.Handle);
	1999	RedrawSuspend(memText.Handle);
	2000	uHState := aHSTag;
	2001	Timer1.Enabled := False;
	2002	TabControl1.Visible := false;
	2003	TabControl1.TabStop := false;
	2004	sptHorzRight.Visible := false;
	2005	lblProcTypeMsg.Visible := FALSE;
	2006	pnlRightMiddle.Visible := false;
	2007	pnlProcedures.Visible := FALSE;
	2008	if (aRemote = '1') or (aRemote = '2') then
	2009	if not(uReportType = 'V') then
	2010	if TabControl1.Tabs.Count > 1 then
	2011	begin
	2012	TabControl1.Visible := true;
	2013	TabControl1.TabStop := true;
	2014	pnlRightTop.Height := lblTitle.Height + TabControl1.Height;
	2015	end;
	2016	StatusText('');
	2017	uHTMLDoc := '';
	2018	WebBrowser1.Navigate('about:blank');
	2019	memText.Lines.Clear;
	2020	memText.Parent := pnlRightBottom;
	2021	memText.Align := alClient;
	2022	UpdatingLvReports := TRUE; {lw added}
	2023	tvProcedures.Items.Clear;
	2024	UpdatingLvReports := FALSE; {lw added}
	2025	lblProcTypeMsg.Visible := FALSE;
	2026	lvReports.SmallImages := uEmptyImageList;
[830]	2027	imgLblImages.ComponentImageListChanged;
[456]	2028	lvReports.Items.Clear;
	2029	lvReports.Columns.Clear;
	2030	uHSComponents.Clear;
	2031	DisplayHeading('');
	2032	if uReportType = 'H' then
	2033	begin
	2034	pnlRightMiddle.Visible := false;
	2035	pnlRightBottom.Visible := true;
	2036	WebBrowser1.Visible := true;
	2037	WebBrowser1.TabStop := true;
	2038	WebBrowser1.Navigate('about:blank');
	2039	WebBrowser1.BringToFront;
	2040	memText.Visible := false;
	2041	memText.TabStop := false;
	2042	end
	2043	else
	2044	if uReportType = 'V' then
	2045	begin
	2046	with lvReports do
	2047	begin
[830]	2048	Columns.BeginUpdate;
[456]	2049	ViewStyle := vsReport;
	2050	ColumnHeaders(uColumns, IntToStr(aIFN));
	2051	for i := 0 to uColumns.Count -1 do
	2052	begin
	2053	uNewColumn := Columns.Add;
	2054	uNewColumn.Caption := piece(uColumns.Strings[i],'^',1);
	2055	if length(uColChange) < 1 then uColChange := IntToStr(aIFN) + '^';
	2056	if piece(uColumns.Strings[i],'^',2) = '1' then
	2057	begin
	2058	uNewColumn.Width := 0;
	2059	uColChange := uColChange + '0,';
	2060	end
	2061	else
	2062	if length(piece(uColumns.Strings[i],'^',10)) > 0 then
	2063	begin
	2064	uColChange := uColChange + piece(uColumns.Strings[i],'^',10) + ',';
	2065	uNewColumn.Width := StrToInt(piece(uColumns.Strings[i],'^',10))
	2066	end
	2067	else
	2068	uNewColumn.Width := ColumnHeaderWidth; //ColumnTextWidth for width of text
	2069	if (i = 0) and (((aRemote <> '2') and (aRemote <> '1')) or ((TabControl1.Tabs.Count < 2) and (not (aHDR = '1')))) then
	2070	uNewColumn.Width := 0;
	2071	end;
[830]	2072	Columns.EndUpdate;
[456]	2073	end;
	2074	pnlRightMiddle.Visible := true;
	2075	sptHorzRight.Visible := true;
	2076	WebBrowser1.Visible := false;
	2077	WebBrowser1.TabStop := false;
	2078	pnlRightBottom.Visible := true;
	2079	memText.Visible := true;
	2080	memText.TabStop := true;
	2081	memText.BringToFront;
	2082	end
	2083	else
	2084	begin
	2085	pnlRightMiddle.Visible := false;
	2086	sptHorzRight.Visible := false;
	2087	WebBrowser1.Visible := false;
	2088	WebBrowser1.TabStop := false;
	2089	pnlRightBottom.Visible := True;
	2090	memText.Visible := true;
	2091	memText.TabStop := true;
	2092	memText.BringToFront;
	2093	end;
	2094	uLocalReportData.Clear;
	2095	RowObjects.Clear;
	2096	uRemoteReportData.Clear;
	2097	lstHeaders.Visible := false;
	2098	lstHeaders.TabStop := false;
	2099	lblHeaders.Visible := false;
	2100	lstHeaders.Clear;
	2101	for i := 0 to RemoteSites.SiteList.Count - 1 do
	2102	TRemoteSite(RemoteSites.SiteList.Items[i]).ReportClear;
	2103	if uFrozen = True then
	2104	begin
	2105	memo1.visible := False;
	2106	memo1.TabStop := False;
	2107	end;
	2108	Screen.Cursor := crHourGlass;
	2109	if (GraphForm <> nil) and (aReportType <> 'G') then
	2110	begin
	2111	GraphForm.SendToBack;
	2112	GraphPanel(false);
	2113	GraphFormActive := false;
	2114	end;
	2115	if aReportType = 'G' then
	2116	Graph(aIFN)
	2117	else
	2118	if aReportType = 'M' then
	2119	begin
	2120	pnlLeftBottom.Visible := false;
	2121	splitter1.Visible := false;
	2122	end
	2123	else
	2124	begin
	2125	uQualifierType := StrToIntDef(aRptCode,0);
	2126	case uQualifierType of
	2127	QT_OTHER:
	2128	begin // = 0
	2129	memText.Lines.Clear;
	2130	If copy(aRptCode,1,2) = 'h0' then //HS Adhoc
	2131	begin
	2132	if TabControl1.TabIndex > 0 then
	2133	begin
	2134	InfoBox('Adhoc report is not available for remote sites',
	2135	'Information', MB_OK);
	2136	TabControl1.TabIndex := 0;
	2137	end;
	2138	with RemoteSites.SiteList do
	2139	for j := 0 to Count - 1 do
	2140	begin
	2141	TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
	2142	TRemoteSite(RemoteSites.SiteList[j]).LabClear;
	2143	end;
	2144	uHTMLDoc := '';
	2145	if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank');
	2146	ExecuteAdhoc1; //Calls Adhoc form
	2147	if uLocalReportData.Count < 1 then
	2148	uReportInstruction := '<No Report Available>'
	2149	else
	2150	begin
	2151	if TabControl1.TabIndex < 1 then
	2152	QuickCopy(uLocalReportData,memText);
	2153	if WebBrowser1.Visible = true then
	2154	begin
	2155	if uReportType = 'R' then
	2156	uHTMLDoc := HTML_PRE + uLocalReportData.Text + HTML_POST
	2157	else
	2158	uHTMLDoc := uHTMLPatient + uLocalReportData.Text;
	2159	WebBrowser1.Navigate('about:blank');
	2160	end;
	2161	end;
	2162	TabControl1.OnChange(nil);
	2163	end
	2164	else
	2165	begin
	2166	pnlLeftBottom.Visible := false;
	2167	splitter1.Visible := false;
	2168	StatusText('Retrieving ' + tvReports.Selected.Text + '...');
[830]	2169	GoRemote(uRemoteReportData, aID, aRptCode, aRPC, uHState, aHDR, aFHIE);
[456]	2170	uReportInstruction := #13#10 + 'Retrieving data...';
	2171	TabControl1.OnChange(nil);
[830]	2172	if not(piece(uRemoteType, '^', 9) = '1') then
	2173	begin
	2174	LoadReportText(uLocalReportData, aID, aRptCode, aRPC, uHState);
	2175	QuickCopy(uLocalReportData, memText);
	2176	end;
[456]	2177	if uLocalReportData.Count > 0 then
	2178	TabControl1.OnChange(nil);
	2179	StatusText('');
	2180	end;
	2181	end;
	2182	QT_HSTYPE:
	2183	begin // = 1
	2184	pnlLeftBottom.Visible := false;
	2185	splitter1.Visible := false;
	2186	end;
	2187	QT_DATERANGE:
	2188	begin // = 2
	2189
	2190	ListReportDateRanges(lstQualifier.Items);
	2191	if lstQualifier.ItemID = '' then
	2192	begin
	2193	lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
	2194	lvReports.SmallImages := uEmptyImageList;
[830]	2195	imgLblImages.ComponentImageListChanged;
[456]	2196	lvReports.Items.Clear;
	2197	lstQualifierClick(self);
	2198	end
	2199	else
	2200	lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
	2201
	2202	lblQualifier.Caption := 'Date Range';
	2203	pnlLeftBottom.Visible := true;
	2204	splitter1.Visible := true;
	2205	end;
	2206	QT_IMAGING:
	2207	begin // = 3
	2208	pnlLeftBottom.Visible := false;
	2209	splitter1.Visible := false;
	2210	ListImagingExams(uLocalReportData);
	2211	aRadParam := ImagingParams;
	2212	uQualifier := StringReplace(aRadParam, '^', ';', [rfReplaceAll]);
	2213	with lvReports do
	2214	begin
	2215	Items.BeginUpdate;
	2216	ViewStyle := vsReport;
	2217	SmallImages := dmodShared.imgImages;
[830]	2218	imgLblImages.ComponentImageListChanged;
[456]	2219	CurrentParentNode := nil;
	2220	CurrentNode := nil;
	2221	for i := 0 to uLocalReportData.Count - 1 do
	2222	begin
	2223	ListItem := Items.Add;
	2224	ListItem.Caption := piece(piece(uLocalReportData[i],'^',1),';',1);
	2225	if uColumns.Count > 1 then
	2226	begin
	2227	for j := 2 to uColumns.Count do
	2228	ListItem.SubItems.Add(piece(uLocalReportData[i],'^',j));
	2229	// if pieces are (added to/removed from) return string, PLEASE UPDATE THIS!! (RV)
	2230	if Piece(uLocalReportData[i], U, 9) = 'Y' then
	2231	ListItem.SubItemImages[1] := IMG_1_IMAGE
	2232	else
	2233	ListItem.SubItemImages[1] := IMG_NO_IMAGES;
	2234	end;
	2235	LoadProceduresTreeView(uLocalReportData[i], CurrentParentNode, CurrentNode);
	2236	if CurrentNode <> nil then
	2237	PProcTreeObj(CurrentNode.Data)^.Associate := lvReports.Items.IndexOf(ListItem);
	2238	end;
	2239	if tvProcedures.Items.Count > 0 then
	2240	tvProcedures.Selected := tvProcedures.Items.GetFirstNode;
	2241	lblProcTypeMsg.Visible := TRUE;
	2242	pnlRightTop.Height := lblTitle.Height + lblProcTypeMsg.Height;
	2243	pnlLeftBottom.Visible := FALSE;
	2244	pnlProcedures.Visible := TRUE;
[830]	2245	Splitter1.Visible := True;
[456]	2246	if lvReports.Columns.Count > 0 then lvReports.Columns[1].Width := 0;
	2247	Items.EndUpdate;
	2248	tvProcedures.TopItem := tvProcedures.Selected;
	2249	end;
	2250	if TabControl1.TabIndex > 0 then TabControl1.TabIndex := 0;
	2251	if uLocalReportData.Count > 0
	2252	then x := #13#10 + 'Select an imaging exam...'
	2253	else x := #13#10 + 'No imaging reports found...';
	2254	uReportInstruction := PChar(x);
	2255	memText.Lines.Add(uReportInstruction);
	2256	if WebBrowser1.Visible = true then
	2257	begin
	2258	uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST;
	2259	WebBrowser1.Navigate('about:blank');
	2260	end;
	2261	end;
	2262	QT_NUTR:
	2263	begin // = 4
	2264	lblQualifier.Caption := 'Nutritional Assessments';
	2265	pnlLeftBottom.Visible := false;
	2266	splitter1.Visible := false;
	2267	ListNutrAssessments(uLocalReportData);
	2268	with lvReports do
	2269	begin
	2270	Items.BeginUpdate;
	2271	ViewStyle := vsReport;
	2272	for i := 0 to uLocalReportData.Count - 1 do
	2273	begin
	2274	ListItem := Items.Add;
	2275	ListItem.Caption := piece(piece(uLocalReportData[i],'^',1),';',1);
	2276	if uColumns.Count > 1 then
	2277	for j := 2 to uColumns.Count do
	2278	ListItem.SubItems.Add(piece(uLocalReportData[i],'^',j));
	2279	end;
	2280	if lvReports.Columns.Count > 0 then lvReports.Columns[1].Width := 0;
	2281	Items.EndUpdate;
	2282	end;
	2283	if TabControl1.TabIndex > 0 then TabControl1.TabIndex := 0;
	2284	if uLocalReportData.Count > 0
	2285	then x := #13#10 + 'Select an assessment date...'
	2286	else x := #13#10 + 'No nutritional assessments found...';
	2287	uReportInstruction := PChar(x);
	2288	memText.Lines.Add(uReportInstruction);
	2289	if WebBrowser1.Visible = true then
	2290	begin
	2291	uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST;
	2292	WebBrowser1.Navigate('about:blank');
	2293	end;
	2294	end;
	2295	QT_HSCOMPONENT:
	2296	begin // = 5
[830]	2297	if Notifications.AlertData <> '' then
	2298	pnlRightMiddle.Height := 75
	2299	else
	2300	pnlRightMiddle.Height := pnlRight.Height - (pnlRight.Height div 2);
[456]	2301	pnlLeftBottom.Visible := false;
	2302	splitter1.Visible := false;
	2303	StatusText('Retrieving ' + tvReports.Selected.Text + '...');
	2304	uReportInstruction := #13#10 + 'Retrieving data...';
	2305	lvReports.SmallImages := uEmptyImageList;
[830]	2306	imgLblImages.ComponentImageListChanged;
[456]	2307	lvReports.Items.Clear;
	2308	RowObjects.Clear;
	2309	memText.Lines.Clear;
	2310	if (length(piece(aHSTag,';',2)) > 0) then
	2311	begin
	2312	if aCategory <> '0' then
	2313	begin
	2314	ListReportDateRanges(lstQualifier.Items);
	2315	aQualifierID := lstQualifier.ItemID;
	2316	if aQualifierID = '' then
	2317	begin
	2318	if aHDR = '1' then
[830]	2319	lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
[456]	2320	else
	2321	if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
	2322	lstQualifierClick(self);
	2323	end
	2324	else
	2325	begin
[830]	2326	GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
[456]	2327	if aHDR = '1' then
[830]	2328	lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
[456]	2329	else
	2330	if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
[830]	2331	lstQualifierClick(self);
[456]	2332	end;
	2333	lblQualifier.Caption := 'Date Range';
	2334	pnlLeftBottom.Visible := true;
	2335	splitter1.Visible := true;
	2336	end
	2337	else
	2338	begin
	2339	if not (aRemote = '2' ) then
[830]	2340	GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
	2341	if not(piece(uRemoteType, '^', 9) = '1') then
[456]	2342	begin
	2343	LoadReportText(uLocalReportData, aID, aQualifier, aRPC, uHState);
	2344	LoadListView(uLocalReportData);
	2345	end;
	2346	end;
	2347	end
	2348	else
	2349	begin
	2350	if (aRemote = '1') or (aRemote = '2') then
	2351	if TabControl1.Tabs.Count > 1 then
	2352	ShowTabControl;
	2353	sptHorzRight.Visible := false;
	2354	pnlRightMiddle.Visible := false;
[830]	2355	GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
	2356	if not(piece(uRemoteType, '^', 9) = '1') then
	2357	LoadReportText(uLocalReportData, aID, aQualifier, aRPC, uHState);
[456]	2358	if uLocalReportData.Count < 1 then
	2359	uReportInstruction := '<No Report Available>'
	2360	else
	2361	begin
	2362	if TabControl1.TabIndex < 1 then
	2363	QuickCopy(uLocalReportData,memText);
	2364	end;
	2365	TabControl1.OnChange(nil);
	2366	if aCategory <> '0' then
	2367	begin
	2368	ListReportDateRanges(lstQualifier.Items);
	2369	if lstQualifier.ItemID = '' then
	2370	begin
	2371	lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
	2372	lstQualifierClick(self);
	2373	end
	2374	else
	2375	lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
	2376
	2377	lblQualifier.Caption := 'Date Range';
	2378	pnlLeftBottom.Visible := true;
	2379	splitter1.Visible := true;
	2380	end
	2381	else
	2382	begin
	2383	if uLocalReportData.Count < 1 then
	2384	begin
	2385	uReportInstruction := '<No Report Available>';
	2386	memText.Lines.Add(uReportInstruction);
	2387	end
	2388	else
	2389	begin
	2390	QuickCopy(uLocalReportData,memText);
	2391	TabControl1.OnChange(nil);
	2392	end;
	2393	end;
	2394	end;
	2395	StatusText('');
	2396	end;
	2397	QT_HSWPCOMPONENT:
	2398	begin // = 6
[830]	2399	if Notifications.AlertData <> '' then
	2400	pnlRightMiddle.Height := 75
	2401	else
	2402	pnlRightMiddle.Height := pnlRight.Height - (pnlRight.Height div 2);
[456]	2403	pnlLeftBottom.Visible := false;
	2404	splitter1.Visible := false;
	2405	StatusText('Retrieving ' + tvReports.Selected.Text + '...');
	2406	uReportInstruction := #13#10 + 'Retrieving data...';
	2407	TabControl1.OnChange(nil);
	2408	RowObjects.Clear;
	2409	memText.Lines.Clear;
	2410	lvReports.SmallImages := uEmptyImageList;
[830]	2411	imgLblImages.ComponentImageListChanged;
[456]	2412	lvReports.Items.Clear;
	2413	if (length(piece(aHSTag,';',2)) > 0) then
	2414	begin
	2415	if aCategory <> '0' then
	2416	begin
	2417	ListReportDateRanges(lstQualifier.Items);
	2418	aQualifierID := lstQualifier.ItemID;
	2419	if aQualifierID = '' then
	2420	begin
	2421	if aHDR = '1' then
[830]	2422	lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
[456]	2423	else
	2424	if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
	2425	lstQualifierClick(self);
	2426	end
	2427	else
	2428	begin
[830]	2429	GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
[456]	2430	if aHDR = '1' then
[830]	2431	lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
[456]	2432	else
	2433	if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
[830]	2434	lstQualifierClick(self);
[456]	2435	end;
	2436	lblQualifier.Caption := 'Date Range';
	2437	pnlLeftBottom.Visible := true;
	2438	splitter1.Visible := true;
	2439	end
	2440	else
	2441	begin
[830]	2442	GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
	2443	if not (aRemote = '2' ) and (not(piece(uRemoteType, '^', 9) = '1')) then
[456]	2444	begin
	2445	LoadReportText(uLocalReportData, aID, aQualifier, aRPC, uHState);
	2446	LoadListView(uLocalReportData);
	2447	end;
	2448	end;
	2449	end
	2450	else
	2451	begin
	2452	if (aRemote = '1') or (aRemote = '2') then
	2453	ShowTabControl;
	2454	sptHorzRight.Visible := false;
	2455	pnlRightMiddle.Visible := false;
[830]	2456	GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
	2457	if not(piece(uRemoteType, '^', 9) = '1') then
	2458	LoadReportText(uLocalReportData, aID, aQualifier, aRPC, uHState);
[456]	2459	if uLocalReportData.Count < 1 then
	2460	uReportInstruction := '<No Report Available>'
	2461	else
	2462	begin
	2463	if TabControl1.TabIndex < 1 then
	2464	QuickCopy(uLocalReportData,memText);
	2465	end;
	2466	TabControl1.OnChange(nil);
	2467	if aCategory <> '0' then
	2468	begin
	2469
	2470	ListReportDateRanges(lstQualifier.Items);
	2471	if lstQualifier.ItemID = '' then
	2472	begin
	2473	lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
	2474	lstQualifierClick(self);
	2475	end
	2476	else
	2477	lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
	2478
	2479	lblQualifier.Caption := 'Date Range';
	2480	pnlLeftBottom.Visible := true;
	2481	splitter1.Visible := true;
	2482	end
	2483	else
	2484	begin
	2485	LoadListView(uLocalReportData);
	2486	end;
	2487	end;
	2488	StatusText('');
	2489	end;
	2490	QT_PROCEDURES:
	2491	begin // = 19
	2492	pnlLeftBottom.Visible := false;
	2493	splitter1.Visible := false;
	2494	ListProcedures(uLocalReportData);
	2495	with lvReports do
	2496	begin
	2497	Items.BeginUpdate;
	2498	ViewStyle := vsReport;
	2499	for i := 0 to uLocalReportData.Count - 1 do
	2500	begin
	2501	ListItem := Items.Add;
	2502	ListItem.Caption := piece(piece(uLocalReportData[i],'^',1),';',1);
	2503	if uColumns.Count > 1 then
	2504	for j := 2 to uColumns.Count do
	2505	ListItem.SubItems.Add(piece(uLocalReportData[i],'^',j));
	2506	end;
	2507	if lvReports.Columns.Count > 0 then lvReports.Columns[1].Width := 0;
	2508	Items.EndUpdate;
	2509	end;
	2510	if uLocalReportData.Count > 0
	2511	then x := #13#10 + 'Select a procedure...'
	2512	else x := #13#10 + 'No procedures found...';
	2513	uReportInstruction := PChar(x);
	2514	if WebBrowser1.Visible = true then
	2515	begin
	2516	uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST;
	2517	WebBrowser1.Navigate('about:blank');
	2518	end;
	2519	if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank');
	2520	end;
	2521	QT_SURGERY:
	2522	begin // = 28
	2523	pnlLeftBottom.Visible := false;
	2524	splitter1.Visible := false;
	2525	ListSurgeryReports(uLocalReportData);
	2526	with lvReports do
	2527	begin
	2528	Items.BeginUpdate;
	2529	ViewStyle := vsReport;
	2530	for i := 0 to uLocalReportData.Count - 1 do
	2531	begin
	2532	ListItem := Items.Add;
	2533	ListItem.Caption := piece(piece(uLocalReportData[i],'^',1),';',1);
	2534	if uColumns.Count > 1 then
	2535	for j := 2 to uColumns.Count do
	2536	ListItem.SubItems.Add(piece(uLocalReportData[i],'^',j));
	2537	end;
	2538	if lvReports.Columns.Count > 0 then lvReports.Columns[1].Width := 0;
	2539	Items.EndUpdate;
	2540	end;
	2541	if uLocalReportData.Count > 0
	2542	then x := #13#10 + 'Select a surgery case...'
	2543	else x := #13#10 + 'No surgery cases found...';
	2544	uReportInstruction := PChar(x);
	2545	memText.Lines.Add(uReportInstruction);
	2546	uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST;
	2547	if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank');
	2548	end;
	2549	else
	2550	begin // = ?
	2551	uQualifierType := QT_OTHER;
	2552	pnlLeftBottom.Visible := false;
	2553	splitter1.Visible := false;
	2554	StatusText('Retrieving ' + tvReports.Selected.Text + '...');
[830]	2555	GoRemote(uRemoteReportData, aID, aRptCode, aRPC, uHState, aHDR, aFHIE);
[456]	2556	uReportInstruction := #13#10 + 'Retrieving data...';
	2557	TabControl1.OnChange(nil);
[830]	2558	//LoadReportText(uLocalReportData, aID, aRptCode, aRPC, uHState);
	2559	if not(piece(uRemoteType, '^', 9) = '1') then
	2560	LoadReportText(uLocalReportData, aID, '', aRPC, uHState);
[456]	2561	if uLocalReportData.Count < 1 then
	2562	uReportInstruction := '<No Report Available>'
	2563	else
	2564	begin
	2565	if TabControl1.TabIndex < 1 then
	2566	QuickCopy(uLocalReportData,memText);
	2567	end;
	2568	TabControl1.OnChange(nil);
	2569	StatusText('');
	2570	end;
	2571	lstQualifier.Caption := lblQualifier.Caption;
	2572	end;
	2573	end;
	2574	if not (aHDR = '1') then
	2575	if aCategory <> '0' then
	2576	DisplayHeading(uQualifier)
	2577	else
	2578	DisplayHeading('');
	2579
	2580	SendMessage(tvReports.Handle, WM_HSCROLL, SB_THUMBTRACK, 0);
	2581	RedrawActivate(tvReports.Handle);
[830]	2582	RedrawActivate(memText.Handle);
[456]	2583	if WebBrowser1.Visible = true then
	2584	begin
	2585	WebBrowser1.Navigate('about:blank');
	2586	WebBrowser1.BringToFront;
	2587	end
	2588	else if not GraphFormActive then
	2589	begin
	2590	memText.Visible := true;
	2591	memText.TabStop := true;
	2592	memText.BringToFront;
	2593	end
	2594	else
	2595	begin
	2596	GraphPanel(true);
	2597	with GraphForm do
	2598	begin
	2599	lstDateRange.Items := cboDateRange.Items;
	2600	lstDateRange.ItemIndex := cboDateRange.ItemIndex;
	2601	ViewSelections;
	2602	BringToFront;
	2603	end;
	2604	end;
[830]	2605	lvReports.Columns.BeginUpdate;
	2606	lvReports.Columns.EndUpdate;
[456]	2607	Screen.Cursor := crDefault;
	2608	end;
	2609
	2610	procedure TfrmReports.lvReportsColumnClick(Sender: TObject;
	2611	Column: TListColumn);
	2612	var
	2613	ClickedColumn: Integer;
	2614	a1, a2: integer;
	2615	s,s1,s2: string;
	2616	begin
	2617	inherited;
	2618	a1 := StrToIntDef(piece(uSortOrder,':',1),0) - 1;
	2619	a2 := StrToIntDef(piece(uSortOrder,':',2),0) - 1;
	2620	ClickedColumn := Column.Index;
	2621	ColumnToSort := Column.Index;
	2622	SortIdx1 := StrToIntDef(piece(uColumns[ColumnToSort],'^',9),0);
	2623	SortIdx2 := 0;
	2624	SortIdx3 := 0;
	2625	if a1 > -1 then SortIdx2 := StrToIntDef(piece(uColumns[a1],'^',9),0);
	2626	if a2 > -1 then SortIdx3 := StrToIntDef(piece(uColumns[a2],'^',9),0);
	2627	if a1 = ColumnToSort then
	2628	begin
	2629	SortIdx2 := SortIdx3;
	2630	SortIdx3 := 0;
	2631	end;
	2632	if a2 = ColumnToSort then
	2633	SortIdx3 := 0;
	2634	if ClickedColumn = ColumnToSort then
	2635	ColumnSortForward := not ColumnSortForward
	2636	else
	2637	ColumnSortForward := true;
	2638	ColumnToSort := ClickedColumn;
	2639	uFirstSort := ColumnToSort;
	2640	uSecondSort := a1;
	2641	uThirdSort := a2;
	2642	lvReports.Hint := '';
	2643	if ColumnSortForward = true then
	2644	s := 'Sorted forward'
	2645	else
	2646	s := 'Sorted reverse';
	2647	s1 := piece(uColumns[uFirstSort],'^',1);
	2648	s2 := '';
	2649	if length(piece(s1,' ',2)) > 0 then
	2650	s2 := pieces(s1,' ',2,99);
	2651	if length(s2) > 0 then s2 := StripSpace(s2);
	2652	s := s + ' by ' + piece(s1,' ',1) + ' ' + s2;
	2653	if (a1 <> uFirstSort) and (a1 > -1) then
	2654	begin
	2655	s1 := piece(uColumns[a1], '^', 1);
	2656	s2 := '';
	2657	if length(piece(s1,' ',2)) > 0 then
	2658	s2 := pieces(s1,' ',2,99);
	2659	if length(s2) > 0 then s2 := StripSpace(s2);
	2660	s := s + ' then by ' + piece(s1,' ',1) + ' ' + s2;
	2661	end;
	2662	if (a2 <> uFirstSort) and (a2 > -1) then
	2663	begin
	2664	s1 := piece(uColumns[a2], '^', 1);
	2665	s2 := '';
	2666	if length(piece(s1,' ',2)) > 0 then
	2667	s2 := pieces(s1,' ',2,99);
	2668	if length(s2) > 0 then s2 := StripSpace(s2);
	2669	s := s + ' then by ' + piece(s1,' ',1) + ' ' + s2;
	2670	end;
	2671	lvReports.Hint := s;
	2672	lvReports.CustomSort(nil, 0);
	2673	end;
	2674
	2675	procedure TfrmReports.lvReportsCompare(Sender: TObject; Item1,
	2676	Item2: TListItem; Data: Integer; var Compare: Integer);
	2677
	2678	function CompareValues(Col: Integer): integer;
	2679	var
	2680	ix: Integer;
	2681	s1, s2: string;
	2682	v1, v2: extended;
	2683	d1, d2: TFMDateTime;
	2684	begin
	2685	inherited;
	2686	if ColumnToSort = 0 then
	2687	Result := CompareText(Item1.Caption,Item2.Caption)
	2688	else
	2689	begin
	2690	ix := ColumnToSort - 1;
	2691	case Col of
	2692	0: //strings
	2693	begin
	2694	if(Item1.SubItems.Count > 0) and (ix < Item1.SubItems.Count) then
	2695	s1 := Item1.SubItems[ix]
	2696	else
	2697	s1 := '0';
	2698	if(Item2.SubItems.Count > 0) and (ix < Item2.SubItems.Count) then
	2699	s2 := Item2.SubItems[ix]
	2700	else
	2701	s2 := '0';
	2702	Result := CompareText(s1,s2);
	2703	end;
	2704
	2705	1: //integers
	2706	begin
	2707	if(Item1.SubItems.Count > 0) and (ix < Item1.SubItems.Count) then
	2708	s1 := Item1.SubItems[ix]
	2709	else
	2710	s1 := '0';
	2711	if(Item2.SubItems.Count > 0) and (ix < Item2.SubItems.Count) then
	2712	s2 := Item2.SubItems[ix]
	2713	else
	2714	s2 := '0';
	2715	IsValidNumber(s1, v1);
	2716	IsValidNumber(s2, v2);
	2717	if v1 > v2 then
	2718	Result := 1
	2719	else
	2720	if v1 < v2 then
	2721	Result := -1
	2722	else
	2723	Result := 0;
	2724	end;
	2725
	2726	2: //date/times
	2727	begin
	2728	if(Item1.SubItems.Count > 1) and (ix < Item1.SubItems.Count) then
	2729	s1 := Item1.SubItems[ix]
	2730	else
	2731	s1 := '1/1/1700';
	2732	if(Item2.SubItems.Count > 1) and (ix < Item2.SubItems.Count) then
	2733	s2 := Item2.SubItems[ix]
	2734	else
	2735	s2 := '1/1/1700';
	2736	d1 := StringToFMDateTime(s1);
	2737	d2 := StringToFMDateTime(s2);
	2738	if d1 > d2 then
	2739	Result := 1
	2740	else
	2741	if d1 < d2 then
	2742	Result := -1
	2743	else
	2744	Result := 0;
	2745	end;
	2746	else
	2747	Result := 0; // to make the compiler happy
	2748	end;
	2749	end;
	2750	end;
	2751	begin
	2752	ColumnToSort := uFirstSort;
	2753	Compare := CompareValues(SortIdx1);
	2754	if Compare = 0 then
	2755	begin
	2756	if (uSecondSort > -1) and (uFirstSort <> uSecondSort) then
	2757	begin
	2758	ColumnToSort := uSecondSort;
	2759	Compare := CompareValues(SortIdx2);
	2760	end;
	2761	if Compare = 0 then
	2762	if (uThirdSort > -1) and (uFirstSort <> uThirdSort) and (uSecondSort <> uThirdSort) then
	2763	begin
	2764	ColumnToSort := uThirdSort;
	2765	Compare := CompareValues(SortIdx3);
	2766	end;
	2767	end;
	2768	if not ColumnSortForward then Compare := -Compare;
	2769	end;
	2770
	2771	procedure TfrmReports.lvReportsSelectItem(Sender: TObject; Item: TListItem;
	2772	Selected: Boolean);
	2773	var
	2774	aID, aMoreID, aSID: string;
	2775	i,j,k: integer;
	2776	aBasket: TStringList;
	2777	aWPFlag: Boolean;
[830]	2778	x, HasImages: string;
[456]	2779
	2780	begin
	2781	inherited;
	2782	if not selected then Exit;
	2783	aBasket := TStringList.Create;
	2784	uLocalReportData.Clear;
	2785	aWPFlag := false;
	2786	with lvReports do
	2787	begin
	2788	aID := Item.SubItems[0];
	2789	case uQualifierType of
	2790	QT_OTHER:
	2791	begin // = 0
	2792
	2793	end;
	2794	QT_HSTYPE:
	2795	begin // = 1
	2796	aMoreID := ';' + Item.SubItems[2];
	2797	end;
	2798	QT_DATERANGE:
	2799	begin // = 2
	2800
	2801	end;
	2802	QT_IMAGING:
	2803	begin // = 3
	2804	if lvReports.SelCount = 1 then
	2805	begin
	2806	memText.Lines.Clear;
	2807	if not UpdatingTvProcedures then
	2808	begin
	2809	UpdatingLvReports := TRUE;
	2810	for i := 0 to (tvProcedures.Items.Count - 1) do
	2811	if PProcTreeObj(tvProcedures.Items[i].Data)^.ExamDtTm = Item.SubItems[0] then
	2812	if PProcTreeObj(tvProcedures.Items[i].Data)^.ProcedureName = Item.SubItems[2] then
	2813	begin
	2814	if tvProcedures.Items[i].Parent <> nil then
	2815	begin
	2816	tvProcedures.Items[i].Parent.Expanded := True;
	2817	if PProcTreeObj(tvProcedures.Items[i].Data)^.MemberOfSet = '1' then
	2818	lblProcTypeMsg.Caption := 'Descendent Procedure'
	2819	else if PProcTreeObj(tvProcedures.Items[i].Data)^.MemberOfSet = '2' then
	2820	lblProcTypeMsg.Caption := 'Descendent Procedure with shared report';
	2821	end
	2822	else
	2823	lblProcTypeMsg.Caption := 'Standalone (single) procedure';
	2824	tvProcedures.Items[i].Selected := TRUE;
	2825	end;
	2826	UpdatingLvReports := False;
	2827	end;
	2828	end
	2829	else
	2830	if not UpdatingTvProcedures then
	2831	tvProcedures.Selected := nil;
	2832
	2833	if MemText.Lines.Count > 0 then
	2834	memText.Lines.Add('===============================================================================');
	2835	aMoreID := '#' + Item.SubItems[5];
	2836	SetPiece(uRemoteType,'^',5,aID + aMoreID);
[830]	2837	if not(piece(uRemoteType, '^', 9) = '1') then
	2838	begin
	2839	LoadReportText(uLocalReportData, uRptID, aID + aMoreID, uReportRPC, '');
	2840	for i := 0 to uLocalReportData.Count - 1 do
	2841	MemText.Lines.Add(uLocalReportData[i]);
	2842	if Item.SubItems.Count > 5 then
	2843	x := 'RA^' + aID + U + Item.SubItems[5]
	2844	else
	2845	x := 'RA^' + aID;
	2846	HasImages := BOOLCHAR[Item.SubItemImages[1] = IMG_1_IMAGE];
	2847	SetPiece(x, U, 10, HasImages);
	2848	NotifyOtherApps(NAE_REPORT, x);
	2849	end;
[456]	2850	end;
	2851	QT_NUTR:
	2852	begin // = 4
	2853	if lvReports.SelCount = 1 then
	2854	memText.Lines.Clear;
	2855	if MemText.Lines.Count > 0 then
	2856	memText.Lines.Add('===============================================================================');
	2857	SetPiece(uRemoteType,'^',5,aID);
[830]	2858	if not(piece(uRemoteType, '^', 9) = '1') then
	2859	begin
	2860	LoadReportText(uLocalReportData, uRptID, aID, uReportRPC, '');
	2861	for i := 0 to uLocalReportData.Count - 1 do
	2862	MemText.Lines.Add(uLocalReportData[i]);
	2863	end;
[456]	2864	end;
	2865	QT_HSWPCOMPONENT:
	2866	begin // = 6
	2867	if lvReports.SelCount < 3 then
	2868	begin
	2869	memText.Lines.Clear;
	2870	ulvSelectOn := false;
	2871	end;
	2872	aBasket.Clear;
	2873	if (SelCount = 2) and (ulvSelectOn = false) then
	2874	begin
	2875	ulvSelectOn := true;
	2876	for i := 0 to Items.Count - 1 do
	2877	if (Items[i].Selected) and (aID <> Items[i].SubItems[0]) then
	2878	begin
	2879	aSID := Items[i].SubItems[0];
	2880	for j := 0 to RowObjects.ColumnList.Count - 1 do
	2881	if piece(aSID,':',1) = piece(TCellObject(RowObjects.ColumnList[j]).Handle,':',1) then
	2882	if Item.Caption = (piece(TCellObject(RowObjects.ColumnList[j]).Site,';',1)) then
	2883	if (TCellObject(RowObjects.ColumnList[j]).Data.Count > 0) and
	2884	(TCellObject(RowObjects.ColumnList[j]).Include = '1') then
	2885	begin
	2886	aWPFlag := true;
	2887	MemText.Lines.Add(TCellObject(RowObjects.ColumnList[j]).Name);
[830]	2888	FastAssign(TCellObject(RowObjects.ColumnList[j]).Data, aBasket);
[456]	2889	for k := 0 to aBasket.Count - 1 do
	2890	MemText.Lines.Add(' ' + aBasket[k]);
	2891	end;
	2892	if aWPFlag = true then
	2893	begin
	2894	memText.Lines.Add('Facility: ' + Item.Caption);
	2895	memText.Lines.Add('===============================================================================');
	2896	end;
	2897	end;
	2898	end;
	2899	aBasket.Clear;
	2900	aWPFlag := false;
	2901	for i := 0 to RowObjects.ColumnList.Count - 1 do
	2902	if piece(aID,':',1) = piece(TCellObject(RowObjects.ColumnList[i]).Handle,':',1) then
	2903	if Item.Caption = (piece(TCellObject(RowObjects.ColumnList[i]).Site,';',1)) then
	2904	if (TCellObject(RowObjects.ColumnList[i]).Data.Count > 0) and
	2905	(TCellObject(RowObjects.ColumnList[i]).Include = '1') then
	2906	begin
	2907	aWPFlag := true;
	2908	MemText.Lines.Add(TCellObject(RowObjects.ColumnList[i]).Name);
[830]	2909	FastAssign(TCellObject(RowObjects.ColumnList[i]).Data, aBasket);
[456]	2910	for j := 0 to aBasket.Count - 1 do
	2911	MemText.Lines.Add(' ' + aBasket[j]);
	2912	end;
	2913	if aWPFlag = true then
	2914	begin
	2915	memText.Lines.Add('Facility: ' + Item.Caption);
	2916	memText.Lines.Add('===============================================================================');
	2917	end;
	2918	if uRptID = 'OR_R18:IMAGING' then
[830]	2919	begin
	2920	if (Item.SubItems.Count > 8) then //has id, may have case (?)
	2921	begin
	2922	x := 'RA^' + Item.SubItems[8] + U + Item.SubItems[4] + U + Item.Caption;
	2923	SetPiece(x, U, 10, BOOLCHAR[Item.SubItemImages[1] = IMG_1_IMAGE]);
	2924	NotifyOtherApps(NAE_REPORT, x);
	2925	end
	2926	else if (Item.SubItems.Count > 4) then
	2927	begin
	2928	x := 'RA^' + U + U + Item.SubItems[4] + U + Item.Caption;
	2929	SetPiece(x, U, 10, BOOLCHAR[Item.SubItemImages[1] = IMG_1_IMAGE]);
	2930	NotifyOtherApps(NAE_REPORT, x);
	2931	end
	2932	else if Item.SubItemImages[1] = IMG_1_IMAGE then
	2933	begin
	2934	memText.Lines.Insert(0,'<Imaging links not active at this site>');
	2935	memText.Lines.Insert(1,' ');
	2936	end;
	2937	end;
[456]	2938	if uRptID = 'OR_PN:PROGRESS NOTES' then
	2939	if (Item.SubItems.Count > 7) then
[830]	2940	begin
	2941	if StrToIntDef(Item.SubItems[7], 0) > 0 then HasImages := '1' else HasImages := '0';
	2942	x := 'PN^' + Item.SubItems[7] + U + Item.SubItems[1] + U + Item.Caption;
	2943	SetPiece(x, U, 10, HasImages);
	2944	NotifyOtherApps(NAE_REPORT, x);
	2945	end;
[456]	2946	end;
	2947	QT_PROCEDURES:
	2948	begin // = 19
	2949	if lvReports.SelCount = 1 then
	2950	memText.Lines.Clear;
	2951	if MemText.Lines.Count > 0 then
	2952	memText.Lines.Add('===============================================================================');
	2953	SetPiece(uRemoteType,'^',5,aID);
[830]	2954	if not(piece(uRemoteType, '^', 9) = '1') then
	2955	begin
	2956	LoadReportText(uLocalReportData, uRptID, aID + aMoreID, uReportRPC, '');
	2957	for i := 0 to uLocalReportData.Count - 1 do
	2958	MemText.Lines.Add(uLocalReportData[i]);
	2959	end;
[456]	2960	end;
	2961	QT_SURGERY:
	2962	begin // = 28
	2963	if lvReports.SelCount = 1 then
	2964	memText.Lines.Clear;
	2965	if MemText.Lines.Count > 0 then
	2966	memText.Lines.Add('===============================================================================');
	2967	SetPiece(uRemoteType,'^',5,aID);
[830]	2968	if not(piece(uRemoteType, '^', 9) = '1') then
	2969	begin
	2970	LoadReportText(uLocalReportData, uRptID, aID + aMoreID, uReportRPC, '');
	2971	for i := 0 to uLocalReportData.Count - 1 do
	2972	MemText.Lines.Add(uLocalReportData[i]);
	2973	NotifyOtherApps(NAE_REPORT, 'SUR^' + aID);
	2974	end;
[456]	2975	end;
	2976	end;
	2977	memText.Lines.Insert(0,' ');
	2978	memText.Lines.Delete(0);
	2979	end;
	2980	aBasket.Free;
	2981	end;
	2982
	2983	procedure TfrmReports.tvReportsExpanding(Sender: TObject; Node: TTreeNode;
	2984	var AllowExpansion: Boolean);
	2985	begin
	2986	inherited;
	2987	tvReports.Selected := Node;
	2988	end;
	2989
	2990	procedure TfrmReports.tvReportsCollapsing(Sender: TObject; Node: TTreeNode;
	2991	var AllowCollapse: Boolean);
	2992	begin
	2993	inherited;
	2994	tvReports.Selected := Node;
	2995	end;
	2996
	2997
	2998	procedure TfrmReports.Print1Click(Sender: TObject);
	2999	begin
	3000	inherited;
	3001	RequestPrint;
	3002	end;
	3003
	3004	procedure TfrmReports.Copy1Click(Sender: TObject);
	3005	var
	3006	i,j: integer;
	3007	line: string;
	3008	ListItem: TListItem;
	3009	aText: String;
	3010	begin
	3011	inherited;
	3012	ClipBoard;
	3013	aText := '';
	3014	for i := 0 to lvReports.Items.Count - 1 do
	3015	if lvReports.Items[i].Selected then
	3016	begin
	3017	ListItem := lvReports.Items[i];
	3018	line := '';
	3019	for j := 1 to lvReports.Columns.Count - 1 do
	3020	begin
	3021	if (lvReports.Column[j].Width <> 0) and (j < (ListItem.SubItems.Count + 1)) then
	3022	line := line + ' ' + ListItem.SubItems[j-1];
	3023	end;
	3024	if (length(line) > 0) and (lvReports.Column[0].Width <> 0) then
	3025	line := ListItem.Caption + ' ' + line;
	3026	if length(aText) > 0 then
	3027	aText := aText + CRLF + line
	3028	else aText := line;
	3029	end;
	3030	ClipBoard.Clear;
	3031	ClipBoard.AsText := aText;
	3032	end;
	3033
	3034	procedure TfrmReports.Copy2Click(Sender: TObject);
	3035	begin
	3036	inherited;
	3037	memText.CopyToClipboard;
	3038	end;
	3039
	3040	procedure TfrmReports.Print2Click(Sender: TObject);
	3041	begin
	3042	inherited;
	3043	RequestPrint;
	3044	end;
	3045
	3046	procedure TfrmReports.lvReportsKeyUp(Sender: TObject; var Key: Word;
	3047	Shift: TShiftState);
	3048	begin
	3049	inherited;
	3050	if (Key = 67) and (ssCtrl in Shift) then
	3051	Copy1Click(Self);
	3052	if (Key = 65) and (ssCtrl in Shift) then
	3053	SelectAll1Click(Self);
	3054	end;
	3055
	3056	procedure TfrmReports.SelectAll1Click(Sender: TObject);
	3057	var
	3058	i: integer;
	3059	begin
	3060	inherited;
	3061	for i := 0 to lvReports.Items.Count - 1 do
	3062	lvReports.Items[i].Selected := true;
	3063	end;
	3064
	3065	procedure TfrmReports.SelectAll2Click(Sender: TObject);
	3066	begin
	3067	inherited;
	3068	memText.SelectAll;
	3069	end;
	3070
	3071
	3072	procedure TfrmReports.tvReportsKeyDown(Sender: TObject; var Key: Word;
	3073	Shift: TShiftState);
	3074	begin
	3075	inherited;
	3076	case Key of
	3077	VK_LBUTTON, VK_RETURN, VK_SPACE:
	3078	begin
	3079	tvReportsClick(Sender);
	3080	Key := 0;
	3081	end;
	3082	end;
	3083	end;
	3084
	3085	procedure TfrmReports.ShowTabControl;
	3086	begin
	3087	if TabControl1.Tabs.Count > 1 then
	3088	begin
	3089	TabControl1.Visible := true;
	3090	TabControl1.TabStop := true;
	3091	pnlRightTop.Height := lblTitle.Height + TabControl1.Height;
	3092	end;
	3093	end;
	3094
	3095	procedure TfrmReports.Memo1KeyUp(Sender: TObject; var Key: Word;
	3096	Shift: TShiftState);
	3097	begin
	3098	inherited;
	3099	if (Key = VK_TAB) then
	3100	begin
	3101	if ssShift in Shift then
	3102	begin
	3103	FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
	3104	Key := 0;
	3105	end
	3106	else if ssCtrl in Shift then
	3107	begin
	3108	FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
	3109	Key := 0;
	3110	end;
	3111	end;
	3112	if (key = VK_ESCAPE) then begin
	3113	FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
	3114	key := 0;
	3115	end;
	3116	end;
	3117
	3118	procedure TfrmReports.LoadProceduresTreeView(x: string; var CurrentParentNode: TTreeNode; var CurrentNode: TTreeNode);
	3119	var
	3120	PTO, PTO2: PProcTreeObj;
	3121
	3122	begin
	3123	PTO := MakeProcedureTreeObject(x);
	3124	PTO2 := MakeProcedureTreeObject(x);
	3125	PTO2.ProcedureName := '';
	3126	if PTO^.ParentName = '' then
	3127	begin // New stand-alone
	3128	CurrentParentNode := tvProcedures.Items.AddObject(CurrentParentNode,PTO^.ProcedureName,PTO);
	3129	CurrentNode := CurrentParentNode;
	3130	end
	3131	else
	3132	if (CurrentParentNode <> nil) and (PTO^.ParentName = PProcTreeObj(CurrentParentNode.Data)^.ParentName) then
	3133	// another child for same parent
	3134	CurrentNode := tvProcedures.Items.AddChildObject(CurrentParentNode,PTO^.ProcedureName,PTO)
	3135	else
	3136	begin //New child and parent
	3137	CurrentParentNode := tvProcedures.Items.AddObject(CurrentParentNode,PTO2^.ParentName,PTO2);
	3138	CurrentNode := tvProcedures.Items.AddChildObjectFirst(CurrentParentNode,PTO^.ProcedureName,PTO);
	3139	end;
	3140	end;
	3141
	3142	procedure TfrmReports.tvProceduresCollapsing(Sender: TObject;
	3143	Node: TTreeNode; var AllowCollapse: Boolean);
	3144	begin
	3145	inherited;
	3146	tvReports.Selected := Node;
	3147	end;
	3148
	3149	procedure TfrmReports.tvProceduresExpanding(Sender: TObject;
	3150	Node: TTreeNode; var AllowExpansion: Boolean);
	3151	begin
	3152	inherited;
	3153	tvReports.Selected := Node;
	3154	end;
	3155
	3156	procedure TfrmReports.tvProceduresClick(Sender: TObject);
	3157	var
	3158	Associate: Integer;
	3159	SelNode: TTreeNode;
	3160	begin
	3161	inherited;
	3162	SelNode := TTreeView(Sender).Selected;
	3163	if not assigned(SelNode) then Exit;
	3164	Associate := PProcTreeObj(SelNode.Data)^.Associate;
	3165	lvReports.Selected := nil;
	3166	if PProcTreeObj(SelNode.Data)^.ProcedureName <> '' then //if it is a descendent or a stand-alone
	3167	begin
	3168	memText.Lines.Clear;
	3169	lvReports.Selected := lvReports.Items[Associate];
	3170	if PProcTreeObj(SelNode.Data)^.MemberOfSet = '1' then
	3171	lblProcTypeMsg.Caption := 'Descendent Procedure'
	3172	else
	3173	if PProcTreeObj(SelNode.Data)^.MemberOfSet = '2' then
	3174	lblProcTypeMsg.Caption := 'Descendent Procedure with shared report';
	3175	end
	3176	else //if it is a parent with descendents
	3177	if PProcTreeObj(SelNode.Data)^.MemberOfSet = '2' then //printset = shared report
	3178	lblProcTypeMsg.Caption := 'Descendent Procedures with shared report'
	3179	else if PProcTreeObj(SelNode.Data)^.MemberOfSet = '1' then //examset - individual reports
	3180	begin
	3181	memText.Lines.Clear;
	3182	lblProcTypeMsg.Caption := 'Descendent Procedures - Select to view individual reports';
	3183	memText.Lines.Add('Descendent Procedures - Select to view individual reports...')
	3184	end;
	3185	end;
	3186
	3187	procedure TfrmReports.tvProceduresChange(Sender: TObject; Node: TTreeNode);
	3188	var
	3189	Associate, i: Integer;
	3190	FirstChild: TTreeNode;
	3191	aID, aMoreID: string;
[830]	3192	x, HasImages: string;
[456]	3193	begin
	3194	inherited;
	3195	if UpdatingLvReports or not assigned(Node) then Exit;
	3196	UpdatingTVProcedures := TRUE;
	3197	Associate := PProcTreeObj(Node.Data)^.Associate;
	3198	lvReports.Selected := nil;
	3199	if PProcTreeObj(Node.Data)^.ProcedureName <> '' then //if it is a descendent or a stand-alone
	3200	if (Associate >= 0) and (Associate < (lvReports.Items.Count)) then // if valid associate in lvReports
	3201	if lvReports.Items[Associate].Selected = FALSE then // if not already selected
	3202	begin
	3203	lvReports.Selected := lvReports.Items[Associate];
	3204	if PProcTreeObj(Node.Data)^.MemberOfSet = '1' then
	3205	begin
	3206	lblProcTypeMsg.Caption := 'Descendent Procedure';
	3207	end
	3208	else if PProcTreeObj(Node.Data)^.MemberOfSet = '2' then
	3209	lblProcTypeMsg.Caption := 'Descendent Procedures with shared report'
	3210	else if PProcTreeObj(Node.Data)^.MemberOfSet = '' then
	3211	lblProcTypeMsg.Caption := 'Standalone (single) procedure';
	3212	end;
	3213	UpdatingTvProcedures := FALSE;
	3214
	3215	if PProcTreeObj(Node.Data)^.ProcedureName = '' then //Parent with descendents
	3216	if PProcTreeObj(Node.Data)^.MemberOfSet = '2' then //printset = shared report
	3217	begin
	3218	lblProcTypeMsg.Caption := 'Descendent Procedures with shared report';
	3219	FirstChild := Node.GetFirstChild;
	3220	Associate := PProcTreeObj(FirstChild.Data)^.Associate;
	3221	aID := lvReports.Items[Associate].SubItems[0];
	3222	aMoreID := '#' + lvReports.Items[Associate].SubItems[5];
	3223	SetPiece(uRemoteType,'^',5,aID + aMoreID);
	3224	uLocalReportData.Clear;
	3225	MemText.Lines.Clear;
[830]	3226	if not(piece(uRemoteType, '^', 9) = '1') then
	3227	begin
	3228	LoadReportText(uLocalReportData, uRptID, aID + aMoreID, uReportRPC, '');
	3229	for i := 0 to uLocalReportData.Count - 1 do
	3230	MemText.Lines.Add(uLocalReportData[i]);
	3231	memText.SelStart := 0;
	3232	if lvReports.Items[Associate].SubItems.Count > 5 then
	3233	x := 'RA^' + aID + U + lvReports.Items[Associate].SubItems[5]
	3234	else
	3235	x := 'RA^' + aID;
	3236	HasImages := BOOLCHAR[lvReports.Items[Associate].SubItemImages[1] = IMG_1_IMAGE];
	3237	SetPiece(x, U, 10, HasImages);
	3238	NotifyOtherApps(NAE_REPORT, x);
	3239	end;
[456]	3240	end
	3241	else if PProcTreeObj(Node.Data)^.MemberOfSet = '1' then //examset - individual reports
	3242	begin
	3243	memText.Lines.Clear;
	3244	lblProcTypeMsg.Caption := 'Descendent Procedures - Select to view individual reports';
	3245	memText.Lines.Add('Descendent Procedures - Select to view individual reports...');
	3246	end;
	3247	end;
	3248
	3249	procedure TfrmReports.tvProceduresKeyDown(Sender: TObject; var Key: Word;
	3250	Shift: TShiftState);
	3251	begin
	3252	inherited;
	3253	case Key of
	3254	VK_LBUTTON, VK_RETURN, VK_SPACE:
	3255	begin
	3256	tvReportsClick(Sender);
	3257	Key := 0;
	3258	end;
	3259	end;
	3260
	3261	end;
	3262
	3263	procedure TfrmReports.chkDualViewsClick(Sender: TObject);
	3264	begin
	3265	inherited;
	3266	if (GraphForm <> nil) and GraphFormActive then
	3267	GraphForm.chkDualViews.Checked := chkDualViews.Checked;
	3268	end;
	3269
[830]	3270	procedure TfrmReports.chkMaxFreqClick(Sender: TObject);
	3271	begin
	3272	inherited;
	3273	if chkMaxFreq.Checked = true then
	3274	begin
	3275	uMaxOcc := piece(uQualifier, ';', 3);
	3276	SetPiece(uQualifier, ';', 3, '');
	3277	end
	3278	else
	3279	begin
	3280	SetPiece(uQualifier, ';', 3, uMaxOcc);
	3281	end;
	3282	tvReportsClick(self);
	3283	end;
	3284
[456]	3285	procedure TfrmReports.btnChangeViewClick(Sender: TObject);
	3286	begin
	3287	inherited;
	3288	if (GraphForm <> nil) and GraphFormActive then
	3289	begin
	3290	GraphForm.btnChangeSettingsClick(GraphForm);
	3291	chkDualViews.Checked := GraphForm.chkDualViews.Checked;
	3292	end;
	3293	end;
	3294
	3295	procedure TfrmReports.btnGraphSelectionsClick(Sender: TObject);
	3296	begin
	3297	inherited;
	3298	if (GraphForm <> nil) and GraphFormActive then
	3299	begin
	3300	GraphForm.btnGraphSelectionsClick(GraphForm);
	3301	chkDualViews.Checked := GraphForm.chkDualViews.Checked;
	3302	end;
	3303	end;
	3304
	3305	procedure TfrmReports.lstDateRangeClick(Sender: TObject);
	3306	begin
	3307	inherited;
	3308	if (GraphForm <> nil) then
	3309	begin
	3310	GraphForm.cboDateRange.ItemIndex := lstDateRange.ItemIndex;
	3311	GraphForm.cboDateRangeChange(self);
[830]	3312	FastAssign(GraphForm.cboDateRange.Items, lstDateRange.Items);
[456]	3313	lstDateRange.ItemIndex := GraphForm.cboDateRange.ItemIndex;
	3314	//Exit;
	3315	end;
[830]	3316
[456]	3317	end;
	3318
	3319	procedure TfrmReports.sptHorzMoved(Sender: TObject);
	3320	begin
	3321	inherited;
	3322	pnlTopViews.Height := 80;
	3323	end;
	3324
[830]	3325	initialization
	3326	SpecifyFormIsNotADialog(TfrmReports);
	3327
[456]	3328	end.

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

Download in other formats: