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

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

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