Context Navigation

fReports.pas@ 1710

Last change on this file since 1710 was 1693, checked in by healthsevak, 10 years ago
Committing the files for first time to this new branch
File size: 130.3 KB

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

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

Context Navigation

source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fReports.pas@ 1710

Download in other formats: