Context Navigation

fReports.pas@ 594

Last change on this file since 594 was 460, checked in by Kevin Toppenberg, 16 years ago
Uploading from OR_30_258
File size: 115.9 KB

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

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

Context Navigation

source: cprs/branches/foia-cprs/CPRS-Chart/fReports.pas@ 594

Download in other formats: