Context Navigation

fReports.pas@ 1707

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

Line
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,
8	OleCtrls, SHDocVw, Buttons, ClipBrd, rECS, Variants, StrUtils, fBase508Form,
9	VA508AccessibilityManager, VA508ImageListLabeler;
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;
56	pnlTopRtLabel: TPanel;
57	lblTitle: TOROffsetLabel;
58	chkMaxFreq: TCheckBox;
59	imgLblImages: TVA508ImageListLabeler;
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);
72	procedure GoRemote(Dest: TStringList; AItem: string; AQualifier, ARpc: string; AHSTag: string; AHDR: string; aFHIE: string);
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);
113	procedure tvProceduresClick(Sender: TObject);
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);
122	procedure chkMaxFreqClick(Sender: TObject);
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,
173	fReportsAdhocComponent1, activex, mshtml, dShared, fGraphs, fGraphData, rGraphs,
174	VA508AccessibilityRouter, VAUtils;
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;
216	imgLblImages.ComponentImageListChanged;
217	lvReports.Items.Clear;
218	uLocalReportData.Clear;
219	uRemoteReportData.Clear;
220	TabControl1.Tabs.Clear;
221	TabControl1.Visible := false;
222	TabControl1.TabStop := false;
223	lstDateRange.Tag := 0; // used to reset date default on graph
224	if (GraphForm <> nil) and GraphFormActive then
225	with GraphForm do
226	begin
227	GraphForm.SendToBack;
228	Initialize;
229	DisplayData('top');
230	DisplayData('bottom');
231	GtslCheck.Clear;
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');
260	GtslCheck.Clear;
261	GraphPanel(true);
262	frmGraphData.pnlData.Hint := Patient.DFN;
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
278	else if GraphFormActive and (frmGraphData.pnlData.Hint = Patient.DFN) then
279	begin // displaying same patient
280	if Tag <> reportien then
281	with GraphForm do
282	begin // new report
283	pnlMain.Tag := reportien;
284	Initialize;
285	//DisplayData('top');
286	//DisplayData('bottom');
287	GtslCheck.Clear;
288	GraphPanel(true);
289	BringToFront;
290	end;
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;
311	end;
312	end;
313
314	procedure TfrmReports.GraphPanel(active: boolean);
315	var
316	adddaterange: boolean;
317	i: integer;
318	aQualifier, aStartTime, aStopTime, aNewLine: string;
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);
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);
347	lstDateRange.Items := GraphForm.cboDateRange.Items;
348	GraphForm.DateDefaults;
349	lstDateRange.ItemIndex := GraphForm.cboDateRange.ItemIndex;
350	//lstDateRange.ItemIndex := lstDateRange.Items.Count - 1;
351	//lstDateRange.ItemIndex := lstDateRange.Items.Count - 2; //set to all results till fixed
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
442	i{, OrigSelection}: integer;
443	{OrigDateIEN: Int64;
444	OrigDateItemID: Variant;
445	OrigReportCat, OrigProcedure: TTreeNode; }
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>'
461	+ '<TD nowrap><B>Age: ' + IntToStr(Patient.Age) + '</B></TD>'
462	+ '</TR></TABLE></DIV><HR>';
463	//the preferred method would be to use headers and footers
464	//so this is just an interim solution.
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
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
477	uColChange := '';
478	lstQualifier.Clear;
479	tvProcedures.Items.Clear;
480	lblProcTypeMsg.Visible := FALSE;
481	lvReports.SmallImages := uEmptyImageList;
482	imgLblImages.ComponentImageListChanged;
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;
502	tvReportsClick(self);
503	end;
504	end;
505	case CallingContext of
506	CC_INIT_PATIENT: if not InitPatient then
507	begin
508	uColChange := '';
509	lstQualifier.Clear;
510	tvProcedures.Items.Clear;
511	lblProcTypeMsg.Visible := FALSE;
512	lvReports.SmallImages := uEmptyImageList;
513	imgLblImages.ComponentImageListChanged;
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;
521	tvReportsClick(self);
522	end;
523	end;
524	CC_NOTIFICATION: ProcessNotifications;
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;
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;
602	currentNode, parentNode, grandParentNode, gtGrandParentNode: TTreeNode;
603	x: string;
604	addchild, addgrandchild, addgtgrandchild: boolean;
605	begin
606	tvReports.Items.Clear;
607	memText.Clear;
608	uHTMLDoc := '';
609	WebBrowser1.Navigate('about:blank');
610	tvProcedures.Items.Clear;
611	lblProcTypeMsg.Visible := FALSE;
612	lvReports.SmallImages := uEmptyImageList;
613	imgLblImages.ComponentImageListChanged;
614	lvReports.Items.Clear;
615	uTreeStrings.Clear;
616	lblTitle.Caption := '';
617	lvReports.Caption := '';
618	ListReports(uTreeStrings);
619	addchild := false;
620	addgrandchild := false;
621	addgtgrandchild := false;
622	parentNode := nil;
623	grandParentNode := nil;
624	gtGrandParentNode := nil;
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
631	if addgtgrandchild = true then
632	begin
633	currentNode := gtgrandParentNode;
634	addgtgrandchild := false;
635	end
636	else
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;
647	continue;
648	end;
649	if UpperCase(Piece(x,'^',1))='[PARENT START]' then
650	begin
651	if addgtgrandchild = true then
652	currentNode := tvReports.Items.AddChildObject(gtGrandParentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)))
653	else
654	if addgrandchild = true then
655	begin
656	currentNode := tvReports.Items.AddChildObject(grandParentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)));
657	addgtgrandchild := true;
658	gtgrandParentNode := currentNode;
659	end
660	else
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;
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
682	if addgtgrandchild = true then
683	currentNode := tvReports.Items.AddChildObject(gtGrandParentNode,Piece(x,'^',2),MakeReportTreeObject(x))
684	else
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));
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);
705	var
706	pnlRightMiddlePct: Real;
707	frmReportsHeight, pnlRightHeight: Integer;
708
709	begin
710	pnlRightMiddlePct := (pnlRightMiddle.Height / (pnlRight.Height - (sptHorzRight.Height + pnlRightTop.Height)));
711	pnlRightMiddle.Constraints.MaxHeight := 20;
712	inherited SetFontSize(NewFontSize);
713	memText.Font.Size := NewFontSize;
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;
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;
912	imgLblImages.ComponentImageListChanged;
913	for i := 0 to Items.Count - 1 do
914	if (Items[i].SubItems.Count > 7) and (Items[i].SubItems[7] = 'Y') then
915	Items[i].SubItemImages[1] := IMG_1_IMAGE
916	else
917	Items[i].SubItemImages[1] := IMG_NO_IMAGES;
918	end
919	else //lvReports.SmallImages := uEmptyImageList;
920	if uRptID = 'OR_PN:PROGRESS NOTES' then with lvReports do //set image indicator for "Progress Notes" report
921	begin
922	SmallImages := dmodShared.imgImages;
923	imgLblImages.ComponentImageListChanged;
924	for i := 0 to Items.Count - 1 do
925	if (Items[i].SubItems.Count > 7) and (StrToInt(Items[i].SubItems[7]) > 0) then
926	Items[i].SubItemImages[2] := IMG_1_IMAGE
927	else
928	Items[i].SubItemImages[2] := IMG_NO_IMAGES;
929	end
930	else begin
931	lvReports.SmallImages := uEmptyImageList;
932	imgLblImages.ComponentImageListChanged;
933	end;
934	end;
935	end;
936	if aErr = 1 then
937	if User.HasKey('XUPROGMODE') then
938	ShowMsg('Programmer message: One or more Column ID''s in file 101.24 do not match ID''s coded in extract routine');
939	end;
940
941	procedure TfrmReports.lstQualifierClick(Sender: TObject);
942	var
943	MoreID: String; //Restores MaxOcc value
944	aRemote, aHDR, aFHIE, aMax: string;
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);
954	if chkMaxFreq.checked = true then
955	begin
956	MoreID := '';
957	SetPiece(uQualifier,';',3,'');
958	end;
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';
964	aRemote := piece(uRemoteType,'^',1);
965	aHDR := piece(uRemoteType,'^',7);
966	aFHIE := piece(uRemoteType,'^',8);
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;
1063	imgLblImages.ComponentImageListChanged;
1064	lvReports.Items.Clear;
1065	memText.Lines.Clear;
1066	RowObjects.Clear;
1067	if ((aRemote = '1') or (aRemote = '2')) then
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;
1081	LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
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;
1093	end;
1094	QT_HSWPCOMPONENT:
1095	begin // = 6
1096	lvReports.SmallImages := uEmptyImageList;
1097	imgLblImages.ComponentImageListChanged;
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;
1104	GoRemote(uRemoteReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR, aFHIE);
1105	end;
1106	if not(piece(uRemoteType, '^', 9) = '1') then
1107	if (length(piece(uHState,';',2)) > 0) then
1108	begin
1109	if not(aRemote = '2') then
1110	LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
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;
1130	end
1131	else
1132	begin
1133	Screen.Cursor := crDefault;
1134	GoRemote(uRemoteReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR, aFHIE);
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
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);
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;
1176	SendMessage(memText.Handle, WM_VSCROLL, SB_TOP, 0);
1177	{GoToTop1.Enabled := false;
1178	GoToBottom1.Enabled := true; }
1179	end;
1180
1181	procedure TfrmReports.GotoBottom1Click(Sender: TObject);
1182	begin
1183	Inherited;
1184	SendMessage(memText.Handle, WM_VSCROLL, SB_BOTTOM, 0);
1185	{GoToTop1.Enabled := true;
1186	GoToBottom1.Enabled := false; }
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;
1238	{If memText.SelStart > 0 then
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
1246	GotoBottom1.Enabled := False; }
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
1269	j, AnIndex, IDColumn: integer;
1270	SelectID: string;
1271	ListItem: TListItem;
1272	tmpRptID: string;
1273
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;
1292
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;
1314	case Notifications.Followup of
1315	NF_IMAGING_RESULTS, NF_ABNORMAL_IMAGING_RESULTS, NF_IMAGING_RESULTS_AMENDED:
1316	begin
1317	if not FindReport(QT_IMAGING, AnIndex) then exit;
1318	tvReports.Selected := tvReports.Items[AnIndex];
1319	SelectID := 'i' + Piece(Notifications.AlertData, '~', 1) +
1320	'-' + Piece(Notifications.AlertData, '~', 2);
1321	IDColumn := 0;
1322	if tvReports.Selected <> tvReports.Items[AnIndex] then
1323	tvReports.Selected := tvReports.Items[AnIndex];
1324	end;
1325	NF_IMAGING_REQUEST_CHANGED:
1326	begin
1327	if not FindReport(QT_IMAGING, AnIndex) then exit;
1328	tvReports.Selected := tvReports.Items[AnIndex];
1329	SelectID := 'i' + Piece(Notifications.AlertData, '/', 2) +
1330	'-' + Piece(Notifications.AlertData, '/', 3);
1331	IDColumn := 0;
1332	if tvReports.Selected <> tvReports.Items[AnIndex] then
1333	tvReports.Selected := tvReports.Items[AnIndex];
1334	end;
1335	NF_STAT_RESULTS :
1336	begin
1337	if not FindReport(QT_IMAGING, AnIndex) then exit;
1338	tvReports.Selected := tvReports.Items[AnIndex];
1339	SelectID := 'i' + Piece(Notifications.AlertData, '~', 2) +
1340	'-' + Piece(Piece(Notifications.AlertData, '~', 3), '@', 1);
1341	IDColumn := 0;
1342	if tvReports.Selected <> tvReports.Items[AnIndex] then
1343	tvReports.Selected := tvReports.Items[AnIndex];
1344	end;
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
1361	if Notifications.AlertData = '^1^^^0^0^0' then //code snippet to handle the processing of v26 AP alerts in a v27 environment.
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];
1398	end;
1399	if tvReports.Selected <> nil then
1400	begin
1401	tvReportsClick(Self);
1402	Application.ProcessMessages;
1403	for j := 0 to lvReports.Items.Count - 1 do
1404	begin
1405	ListItem := lvReports.Items[j];
1406	if ListItem.Subitems[IDColumn] = SelectID then
1407	begin
1408	lvReports.Selected := lvReports.Items[j];
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);
1452	if Copy(y,8,2) = '18' then y := 'EARLIEST RESULT';
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;
1469	if piece(uRemoteType, '^', 9) = '1' then x := x + ' <<ONLY REMOTE DATA INCLUDED IN REPORT>>';
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
1684	procedure TfrmReports.GoRemote(Dest: TStringList; AItem: string; AQualifier, ARpc: string; AHSTag: string; AHDR: string; aFHIE: string);
1685	var
1686	i, j: integer;
1687	LocalHandle, Query, Report, Seq: string;
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;
1696	Seq := '';
1697	if AHDR = '1' then
1698	begin
1699	if HDRActive = '0' then
1700	begin
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);
1702	Exit;
1703	end;
1704	//InfoBox('You must use VistaWeb to view this report.', 'Use VistaWeb for HDR data', MB_OK);
1705	if (Piece(AItem, ':', 1) = 'OR_VWAL') or (Piece(AItem, ':', 1) = 'OR_VWRX') then
1706	AQualifier := 'T-50000;T+50000;99999';
1707	if (Piece(AItem, ':', 1) = 'OR_VWVS') and (CharAt(AQualifier, 1) = ';') then
1708	AQualifier := 'T-50000;T+50000;99999';
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
1738	//TRemoteSite(Items[i]).Selected := true;
1739	//frmFrame.lstCIRNLocations.Checked[i+1] := true;
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');
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.');
1754	TabControl1.OnChange(nil);
1755	if (length(piece(uHState,';',2)) > 0) then
1756	LoadListView(TRemoteSite(Items[i]).Data);
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');
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.');
1769	TabControl1.OnChange(nil);
1770	if (length(piece(uHState,';',2)) > 0) then
1771	LoadListView(TRemoteSite(Items[i]).Data);
1772	continue;
1773	end;
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;
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');
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);
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');
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);
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) + ',';
1887	if (Length(aColChange) > 0) and (aColChange <> piece(uColchange,'^',2)) then
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;
1996	aID, aHSTag, aRadParam, aColChange, aDirect, aHDR, aFHIE, aFHIEONLY, aQualifierID: string;
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;
2017	aFHIE := PReportTreeObject(tvReports.Selected.Data)^.FHIE;
2018	aFHIEONLY := PReportTreeObject(tvReports.Selected.Data)^.FHIEONLY;
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) + ',';
2029	if (Length(aColChange) > 0) and (aColChange <> piece(uColchange,'^',2)) then
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;
2044	uReportID := aID;
2045	uDirect := aDirect;
2046	uReportType := aReportType;
2047	uQualifier := aQualifier;
2048	uSortOrder := aSortOrder;
2049	uRemoteType := aRemote + '^' + aReportType + '^' + IntToStr(aIFN) + '^' + aHeading + '^' + aRptCode + '^' + aDaysBack + '^' + aHDR + '^' + aFHIE + '^' + aFHIEONLY;
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;
2080	imgLblImages.ComponentImageListChanged;
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
2101	Columns.BeginUpdate;
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;
2125	Columns.EndUpdate;
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 + '...');
2222	GoRemote(uRemoteReportData, aID, aRptCode, aRPC, uHState, aHDR, aFHIE);
2223	uReportInstruction := #13#10 + 'Retrieving data...';
2224	TabControl1.OnChange(nil);
2225	if not(piece(uRemoteType, '^', 9) = '1') then
2226	begin
2227	LoadReportText(uLocalReportData, aID, aRptCode, aRPC, uHState);
2228	QuickCopy(uLocalReportData, memText);
2229	end;
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;
2248	imgLblImages.ComponentImageListChanged;
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;
2271	imgLblImages.ComponentImageListChanged;
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;
2298	Splitter1.Visible := True;
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
2350	if Notifications.AlertData <> '' then
2351	pnlRightMiddle.Height := 75
2352	else
2353	pnlRightMiddle.Height := pnlRight.Height - (pnlRight.Height div 2);
2354	pnlLeftBottom.Visible := false;
2355	splitter1.Visible := false;
2356	StatusText('Retrieving ' + tvReports.Selected.Text + '...');
2357	uReportInstruction := #13#10 + 'Retrieving data...';
2358	lvReports.SmallImages := uEmptyImageList;
2359	imgLblImages.ComponentImageListChanged;
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
2372	lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
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
2379	GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
2380	if aHDR = '1' then
2381	lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
2382	else
2383	if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2384	lstQualifierClick(self);
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
2393	GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
2394	if not(piece(uRemoteType, '^', 9) = '1') then
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;
2408	GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
2409	if not(piece(uRemoteType, '^', 9) = '1') then
2410	LoadReportText(uLocalReportData, aID, aQualifier, aRPC, uHState);
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
2452	if Notifications.AlertData <> '' then
2453	pnlRightMiddle.Height := 75
2454	else
2455	pnlRightMiddle.Height := pnlRight.Height - (pnlRight.Height div 2);
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;
2464	imgLblImages.ComponentImageListChanged;
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
2475	lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
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
2482	GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
2483	if aHDR = '1' then
2484	lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
2485	else
2486	if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2487	lstQualifierClick(self);
2488	end;
2489	lblQualifier.Caption := 'Date Range';
2490	pnlLeftBottom.Visible := true;
2491	splitter1.Visible := true;
2492	end
2493	else
2494	begin
2495	GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
2496	if not (aRemote = '2' ) and (not(piece(uRemoteType, '^', 9) = '1')) then
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;
2509	GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
2510	if not(piece(uRemoteType, '^', 9) = '1') then
2511	LoadReportText(uLocalReportData, aID, aQualifier, aRPC, uHState);
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 + '...');
2608	GoRemote(uRemoteReportData, aID, aRptCode, aRPC, uHState, aHDR, aFHIE);
2609	uReportInstruction := #13#10 + 'Retrieving data...';
2610	TabControl1.OnChange(nil);
2611	//LoadReportText(uLocalReportData, aID, aRptCode, aRPC, uHState);
2612	if not(piece(uRemoteType, '^', 9) = '1') then
2613	LoadReportText(uLocalReportData, aID, '', aRPC, uHState);
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);
2635	RedrawActivate(memText.Handle);
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;
2658	lvReports.Columns.BeginUpdate;
2659	lvReports.Columns.EndUpdate;
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;
2831	x, HasImages: string;
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);
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;
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);
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;
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);
2941	FastAssign(TCellObject(RowObjects.ColumnList[j]).Data, aBasket);
2942	for k := 0 to aBasket.Count - 1 do
2943	MemText.Lines.Add(' ' + aBasket[k]);
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);
2962	FastAssign(TCellObject(RowObjects.ColumnList[i]).Data, aBasket);
2963	for j := 0 to aBasket.Count - 1 do
2964	MemText.Lines.Add(' ' + aBasket[j]);
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
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;
2991	if uRptID = 'OR_PN:PROGRESS NOTES' then
2992	if (Item.SubItems.Count > 7) then
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;
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);
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;
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);
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;
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;
3245	x, HasImages: string;
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;
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;
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
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
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);
3365	FastAssign(GraphForm.cboDateRange.Items, lstDateRange.Items);
3366	lstDateRange.ItemIndex := GraphForm.cboDateRange.ItemIndex;
3367	//Exit;
3368	end;
3369
3370	end;
3371
3372	procedure TfrmReports.sptHorzMoved(Sender: TObject);
3373	begin
3374	inherited;
3375	pnlTopViews.Height := 80;
3376	end;
3377
3378	initialization
3379	SpecifyFormIsNotADialog(TfrmReports);
3380
3381	end.

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

Context Navigation

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

Download in other formats: