source: cprs/branches/tmg-cprs/CPRS-Chart/fReports.pas@ 1099

Last change on this file since 1099 was 453, checked in by Kevin Toppenberg, 16 years ago

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