source: cprs/branches/foia-cprs/CPRS-Chart/rReports.pas@ 745

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

Uploading from OR_30_258

File size: 26.3 KB
Line 
1unit rReports;
2
3interface
4
5uses Windows, SysUtils, Classes, ORNet, ORFn, ComCtrls, Chart, graphics;
6
7{ Consults }
8procedure ListConsults(Dest: TStrings);
9procedure LoadConsultText(Dest: TStrings; IEN: Integer);
10
11{ Reports }
12procedure ListReports(Dest: TStrings);
13procedure ListLabReports(Dest: TStrings);
14procedure ListReportDateRanges(Dest: TStrings);
15procedure ListHealthSummaryTypes(Dest: TStrings);
16procedure ListImagingExams(Dest: TStrings);
17procedure ListProcedures(Dest: TStrings);
18procedure ListNutrAssessments(Dest: TStrings);
19procedure ListSurgeryReports(Dest: TStrings);
20procedure ColumnHeaders(Dest: TStrings; AReportType: String);
21procedure SaveColumnSizes(aColumn: String);
22procedure LoadReportText(Dest: TStrings; ReportType: string; const Qualifier: string; ARpc, AHSTag: string);
23procedure RemoteQueryAbortAll;
24procedure RemoteQuery(Dest: TStrings; AReportType: string; AHSType, ADaysback,
25 AExamID: string; Alpha, AOmega: Double; ASite, ARemoteRPC, AHSTag: String);
26procedure DirectQuery(Dest: TStrings; AReportType: string; AHSType, ADaysback,
27 AExamID: string; Alpha, AOmega: Double; ASite, ARemoteRPC, AHSTag: String);
28function ReportQualifierType(ReportType: Integer): Integer;
29function ImagingParams: String;
30function AutoRDV: String;
31function HDRActive: String;
32procedure PrintReportsToDevice(AReport: string; const Qualifier, Patient,
33 ADevice: string; var ErrMsg: string; aComponents: TStringlist;
34 ARemoteSiteID, ARemoteQuery, AHSTag: string);
35function HSFileLookup(aFile: String; const StartFrom: string;
36 Direction: Integer): TStrings;
37procedure HSComponentFiles(Dest: TStrings; aComponent: String);
38procedure HSSubItems(Dest: TStrings; aItem: String);
39procedure HSReportText(Dest: TStrings; aComponents: TStringlist);
40procedure HSComponents(Dest: TStrings);
41procedure HSABVComponents(Dest: TStrings);
42procedure HSDispComponents(Dest: TStrings);
43procedure HSComponentSubs(Dest: TStrings; aItem: String);
44procedure HealthSummaryCheck(Dest: TStrings; aQualifier: string);
45function GetFormattedReport(AReport: string; const Qualifier, Patient: string;
46 aComponents: TStringlist; ARemoteSiteID, ARemoteQuery, AHSTag: string): TStrings;
47procedure PrintWindowsReport(ARichEdit: TRichEdit; APageBreak, ATitle: string;
48 var ErrMsg: string);
49function DefaultToWindowsPrinter: Boolean;
50procedure PrintGraph(GraphImage: TChart; PageTitle: string);
51procedure PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap);
52procedure CreatePatientHeader(var HeaderList: TStringList; PageTitle: string);
53procedure SaveDefaultPrinter(DefPrinter: string) ;
54function GetRemoteStatus(aHandle: string): String;
55function GetAdhocLookup: integer;
56procedure SetAdhocLookup(aLookup: integer);
57procedure GetRemoteData(Dest: TStrings; aHandle: string; aItem: PChar);
58procedure ModifyHDRData(Dest: string; aHandle: string; aID: string);
59procedure PrintVReports(Dest, ADevice, AHeader: string; AReport: TStringList);
60
61implementation
62
63uses uCore, rCore, Printers, clipbrd, uReports, fReports;
64
65var
66 uTree: TStringList;
67 uReportsList: TStringList;
68 uLabReports: TStringList;
69 uDateRanges: TStringList;
70 uHSTypes: TStringList;
71
72{ Consults }
73
74procedure ListConsults(Dest: TStrings);
75var
76 i: Integer;
77 x: string;
78begin
79 CallV('ORWCS LIST OF CONSULT REPORTS', [Patient.DFN]);
80 with RPCBrokerV do
81 begin
82 SortByPiece(TStringList(Results), U, 2);
83 InvertStringList(TStringList(Results));
84 SetListFMDateTime('mmm dd,yy', TStringList(Results), U, 2);
85 for i := 0 to Results.Count - 1 do
86 begin
87 x := Results[i];
88 x := Pieces(x, U, 1, 2) + U + Piece(x, U, 3) + ' (' + Piece(x, U, 4) + ')';
89 Results[i] := x;
90 end;
91 Dest.Assign(Results);
92 end;
93end;
94
95procedure LoadConsultText(Dest: TStrings; IEN: Integer);
96begin
97 CallV('ORWCS REPORT TEXT', [Patient.DFN, IEN]);
98 QuickCopy(RPCBrokerV.Results,Dest);
99end;
100
101{ Reports }
102
103procedure ExtractSection(Dest: TStrings; const Section: string; Mixed: Boolean);
104var
105 i: Integer;
106begin
107 with RPCBrokerV do
108 begin
109 i := -1;
110 repeat Inc(i) until (i = Results.Count) or (Results[i] = Section);
111 Inc(i);
112 while (i < Results.Count) and (Results[i] <> '$$END') do
113 begin
114 {if (Pos('OR_ECS',UpperCase(Results[i]))>0) and (not uECSReport.ECSPermit) then
115 begin
116 Inc(i);
117 Continue;
118 end;}
119 if Mixed = true then
120 Dest.Add(MixedCase(Results[i]))
121 else
122 Dest.Add(Results[i]);
123 Inc(i);
124 end;
125 end;
126end;
127
128procedure LoadReportLists;
129begin
130 CallV('ORWRP REPORT LISTS', [nil]);
131 uDateRanges := TStringList.Create;
132 uHSTypes := TStringList.Create;
133 uReportsList := TStringList.Create;
134 ExtractSection(uDateRanges, '[DATE RANGES]', true);
135 ExtractSection(uHSTypes, '[HEALTH SUMMARY TYPES]', true);
136 ExtractSection(uReportsList, '[REPORT LIST]', true);
137end;
138
139procedure LoadLabReportLists;
140begin
141 CallV('ORWRP LAB REPORT LISTS', [nil]);
142 uLabReports := TStringList.Create;
143 ExtractSection(uLabReports, '[LAB REPORT LIST]', true);
144end;
145
146procedure LoadTree;
147begin
148 CallV('ORWRP3 EXPAND COLUMNS', [nil]);
149 uTree := TStringList.Create;
150 ExtractSection(uTree, '[REPORT LIST]', false);
151end;
152
153procedure ListReports(Dest: TStrings);
154var
155 i: Integer;
156begin
157 if uTree = nil
158 then LoadTree
159 else
160 begin
161 uTree.Clear;
162 LoadTree;
163 end;
164 for i := 0 to uTree.Count - 1 do Dest.Add(Pieces(uTree[i], '^', 1, 15));
165end;
166
167procedure ListLabReports(Dest: TStrings);
168var
169 i: integer;
170begin
171 if uLabreports = nil then LoadLabReportLists;
172 for i := 0 to uLabReports.Count - 1 do Dest.Add(Pieces(uLabReports[i], U, 1, 10));
173end;
174
175procedure ListReportDateRanges(Dest: TStrings);
176begin
177 if uDateRanges = nil then LoadReportLists;
178 Dest.Assign(uDateRanges);
179end;
180
181procedure ListHealthSummaryTypes(Dest: TStrings);
182begin
183 if uHSTypes = nil then LoadReportLists;
184 MixedCaseList(uHSTypes);
185 Dest.Assign(uHSTypes);
186end;
187
188procedure HealthSummaryCheck(Dest: TStrings; aQualifier: string);
189
190begin
191 if aQualifier = '1' then
192 begin
193 ListHealthSummaryTypes(Dest);
194 end;
195end;
196
197procedure ColumnHeaders(Dest: TStrings; AReportType: String);
198begin
199 CallV('ORWRP COLUMN HEADERS',[AReportType]);
200 Dest.Assign(RPCBrokerV.Results);
201end;
202
203procedure SaveColumnSizes(aColumn: String);
204begin
205 CallV('ORWCH SAVECOL', [aColumn]);
206end;
207
208procedure ListImagingExams(Dest: TStrings);
209var
210 x: string;
211 i: Integer;
212begin
213 CallV('ORWRA IMAGING EXAMS1', [Patient.DFN]);
214 with RPCBrokerV do
215 begin
216 SetListFMDateTime('mm/dd/yyyy hh:nn', TStringList(Results), U, 3);
217 for i := 0 to Results.Count - 1 do
218 begin
219 x := Results[i];
220 if Piece(x,U,7) = 'Y' then SetPiece(x,U,7, ' - Abnormal');
221 x := Piece(x,U,1) + U + 'i' + Pieces(x,U,2,3)+ U + Piece(x,U,4)
222 + U + Piece(x,U,6) + Piece(x,U,7) + U
223 + MixedCase(Piece(Piece(x,U,9),'~',2)) + U + Piece(x,U,5) + U + '[+]'
224 + U + Pieces(x, U, 15,17);
225(* x := Piece(x,U,1) + U + 'i' + Pieces(x,U,2,3)+ U + Piece(x,U,4)
226 + U + Piece(x,U,6) + Piece(x,U,7) + U + Piece(x,U,5) + U + '[+]' + U + Piece(x, U, 15);*)
227 Results[i] := x;
228 end;
229 Dest.Assign(Results);
230 end;
231end;
232
233procedure ListProcedures(Dest: TStrings);
234var
235 x,sdate: string;
236 i: Integer;
237begin
238 CallV('ORWMC PATIENT PROCEDURES1', [Patient.DFN]);
239 with RPCBrokerV do
240 begin
241 for i := 0 to Results.Count - 1 do
242 begin
243 x := Results[i];
244 if length(piece(x, U, 8)) > 0 then
245 begin
246 sdate := ShortDateStrToDate(piece(piece(x, U, 8),'@',1)) + ' ' + piece(piece(x, U, 8),'@',2);
247 end;
248 x := Piece(x, U, 1) + U + 'i' + Piece(x, U, 2) + U + sdate + U + Piece(x, U, 3) + U + Piece(x, U, 9) + '^[+]';
249 Results[i] := x;
250 end;
251 Dest.Assign(Results);
252 end;
253end;
254
255procedure ListNutrAssessments(Dest: TStrings);
256var
257 x: string;
258 i: Integer;
259begin
260 CallV('ORWRP1 LISTNUTR', [Patient.DFN]);
261 with RPCBrokerV do
262 begin
263 for i := 0 to Results.Count - 1 do
264 begin
265 x := Results[i];
266 x := Piece(x, U, 1) + U + 'i' + Piece(x, U, 3) + U + Piece(x, U, 3);
267 Results[i] := x;
268 end;
269 Dest.Assign(Results);
270 end;
271end;
272
273procedure ListSurgeryReports(Dest: TStrings);
274{ returns a list of surgery cases for a patient, without documents}
275//Facility^Case #^Date/Time of Operation^Operative Procedure^Surgeon name)
276var
277 i: integer;
278 x, AFormat: string;
279begin
280 CallV('ORWSR RPTLIST', [Patient.DFN]);
281 with RPCBrokerV do
282 begin
283 for i := 0 to Results.Count - 1 do
284 begin
285 x := Results[i];
286 if Piece(Piece(x, U, 3), '.', 2) = '' then AFormat := 'mm/dd/yyyy' else AFormat := 'mm/dd/yyyy hh:nn';
287 x := Piece(x, U, 1) + U + 'i' + Piece(x, U, 2) + U + FormatFMDateTimeStr(AFormat, Piece(x, U, 3))+ U +
288 Piece(x, U, 4)+ U + Piece(x, U, 5);
289 if Piece(Results[i], U, 6) = '+' then x := x + '^[+]';
290 Results[i] := x;
291 end;
292 Dest.Assign(Results);
293 end;
294end;
295
296procedure LoadReportText(Dest: TStrings; ReportType: string; const Qualifier: string; ARpc, AHSTag: string);
297var
298 HSType, DaysBack, ExamID, MaxOcc, AReport, x: string;
299 Alpha, Omega, Trans: double;
300begin
301 HSType := '';
302 DaysBack := '';
303 ExamID := '';
304 Alpha := 0;
305 Omega := 0;
306 if CharAt(Qualifier, 1) = 'T' then
307 begin
308 Alpha := StrToFMDateTime(Piece(Qualifier,';',1));
309 Omega := StrToFMDateTime(Piece(Qualifier,';',2));
310 if Alpha > Omega then
311 begin
312 Trans := Omega;
313 Omega := Alpha;
314 Alpha := Trans;
315 end;
316 MaxOcc := Piece(Qualifier,';',3);
317 SetPiece(AHSTag,';',4,MaxOcc);
318 end;
319 if CharAt(Qualifier, 1) = 'd' then
320 begin
321 MaxOcc := Piece(Qualifier,';',2);
322 SetPiece(AHSTag,';',4,MaxOcc);
323 x := Piece(Qualifier,';',1);
324 DaysBack := Copy(x, 2, Length(x));
325 end;
326 if CharAt(Qualifier, 1) = 'h' then HSType := Copy(Qualifier, 2, Length(Qualifier));
327 if CharAt(Qualifier, 1) = 'i' then ExamID := Copy(Qualifier, 2, Length(Qualifier));
328 AReport := ReportType + '~' + AHSTag;
329 if Length(ARpc) > 0 then
330 begin
331 CallV(ARpc, [Patient.DFN, AReport, HSType, DaysBack, ExamID, Alpha, Omega]);
332 QuickCopy(RPCBrokerV.Results,Dest);
333 end
334 else
335 begin
336 Dest.Add('RPC is missing from report definition (file 101.24).');
337 Dest.Add('Please contact Technical Support.');
338 end;
339end;
340
341procedure RemoteQueryAbortAll;
342begin
343 CallV('XWB DEFERRED CLEARALL',[nil]);
344end;
345
346procedure RemoteQuery(Dest: TStrings; AReportType: string; AHSType, ADaysback,
347 AExamID: string; Alpha, AOmega: Double; ASite, ARemoteRPC, AHSTag: String);
348var
349 AReport: string;
350begin
351 AReport := AReportType + ';1' + '~' + AHSTag;
352 if length(AHSType) > 0 then
353 AHSType := piece(AHSType,':',1) + ';' + piece(AHSType,':',2); //format for backward compatibility
354 CallV('XWB REMOTE RPC', [ASite, ARemoteRPC, 0, Patient.DFN + ';' + Patient.ICN,
355 AReport, AHSType, ADaysBack, AExamID, Alpha, AOmega]);
356 QuickCopy(RPCBrokerV.Results,Dest);
357end;
358
359procedure DirectQuery(Dest: TStrings; AReportType: string; AHSType, ADaysback,
360 AExamID: string; Alpha, AOmega: Double; ASite, ARemoteRPC, AHSTag: String);
361var
362 AReport: string;
363begin
364 AReport := AReportType + ';1' + '~' + AHSTag;
365 if length(AHSType) > 0 then
366 AHSType := piece(AHSType,':',1) + ';' + piece(AHSType,':',2); //format for backward compatibility
367 CallV('XWB DIRECT RPC', [ASite, ARemoteRPC, 0, Patient.DFN + ';' + Patient.ICN,
368 AReport, AHSType, ADaysBack, AExamID, Alpha, AOmega]);
369 QuickCopy(RPCBrokerV.Results,Dest);
370end;
371
372function ReportQualifierType(ReportType: Integer): Integer;
373var
374 i: Integer;
375begin
376 Result := 0;
377 for i := 0 to uReportsList.Count - 1 do
378 if StrToIntDef(Piece(uReportsList[i], U, 1), 0) = ReportType
379 then Result := StrToIntDef(Piece(uReportsList[i], U, 3), 0);
380end;
381
382function ImagingParams: String;
383begin
384 Result := sCallV('ORWTPD GETIMG',[nil]);
385end;
386
387function AutoRDV: String;
388begin
389 Result := sCallV('ORWCIRN AUTORDV', [nil]);
390end;
391
392function HDRActive: String;
393begin
394 Result := sCallV('ORWCIRN HDRON', [nil]);
395end;
396
397procedure PrintVReports(Dest, ADevice, AHeader: string; AReport: TStringList);
398begin
399 CallV('ORWRP PRINT V REPORT', [ADevice, Patient.DFN, AHeader, AReport]);
400end;
401
402procedure PrintReportsToDevice(AReport: string; const Qualifier, Patient, ADevice: string;
403 var ErrMsg: string; aComponents: TStringlist; ARemoteSiteID, ARemoteQuery, AHSTag: string);
404{ prints a report on the selected device }
405var
406 HSType, DaysBack, ExamID, MaxOcc, ARpt, x: string;
407 Alpha, Omega: double;
408 j: integer;
409 RemoteHandle,Report: string;
410 aHandles: TStringlist;
411begin
412 HSType := '';
413 DaysBack := '';
414 ExamID := '';
415 Alpha := 0;
416 Omega := 0;
417 aHandles := TStringList.Create;
418 if CharAt(Qualifier, 1) = 'T' then
419 begin
420 Alpha := StrToFMDateTime(Piece(Qualifier,';',1));
421 Omega := StrToFMDateTime(Piece(Qualifier,';',2));
422 MaxOcc := Piece(Qualifier,';',3);
423 SetPiece(AHSTag,';',4,MaxOcc);
424 end;
425 if CharAt(Qualifier, 1) = 'd' then
426 begin
427 MaxOcc := Piece(Qualifier,';',2);
428 SetPiece(AHSTag,';',4,MaxOcc);
429 x := Piece(Qualifier,';',1);
430 DaysBack := Copy(x, 2, Length(x));
431 end;
432 if CharAt(Qualifier, 1) = 'h' then HSType := Copy(Qualifier, 2, Length(Qualifier));
433 if CharAt(Qualifier, 1) = 'i' then ExamID := Copy(Qualifier, 2, Length(Qualifier));
434 if Length(ARemoteSiteID) > 0 then
435 begin
436 RemoteHandle := '';
437 for j := 0 to RemoteReports.Count - 1 do
438 begin
439 Report := TRemoteReport(RemoteReports.ReportList.Items[j]).Report;
440 if Report = ARemoteQuery then
441 begin
442 RemoteHandle := TRemoteReport(RemoteReports.ReportList.Items[j]).Handle
443 + '^' + Pieces(Report,'^',9,10);
444 break;
445 end;
446 end;
447 if Length(RemoteHandle) > 1 then
448 with RemoteSites.SiteList do
449 aHandles.Add(ARemoteSiteID + '^' + RemoteHandle);
450 end;
451 ARpt := AReport + '~' + AHSTag;
452 if aHandles.Count > 0 then
453 begin
454 ErrMsg := sCallV('ORWRP PRINT REMOTE REPORT',[ADevice, Patient, ARpt, aHandles]);
455 if Piece(ErrMsg, U, 1) = '0' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
456 end
457 else
458 begin
459 ErrMsg := sCallV('ORWRP PRINT REPORT',[ADevice, Patient, ARpt, HSType,
460 DaysBack, ExamID, aComponents, Alpha, Omega]);
461 if Piece(ErrMsg, U, 1) = '0' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
462 end;
463 aHandles.Clear;
464 aHandles.Free;
465end;
466
467function GetFormattedReport(AReport: string; const Qualifier, Patient: string;
468 aComponents: TStringlist; ARemoteSiteID, ARemoteQuery, AHSTag: string): TStrings;
469{ prints a report on the selected device }
470var
471 HSType, DaysBack, ExamID, MaxOcc, ARpt, x: string;
472 Alpha, Omega: double;
473 j: integer;
474 RemoteHandle,Report: string;
475 aHandles: TStringlist;
476begin
477 HSType := '';
478 DaysBack := '';
479 ExamID := '';
480 Alpha := 0;
481 Omega := 0;
482 aHandles := TStringList.Create;
483 if CharAt(Qualifier, 1) = 'T' then
484 begin
485 Alpha := StrToFMDateTime(Piece(Qualifier,';',1));
486 Omega := StrToFMDateTime(Piece(Qualifier,';',2));
487 MaxOcc := Piece(Qualifier,';',3);
488 SetPiece(AHSTag,';',4,MaxOcc);
489 end;
490 if CharAt(Qualifier, 1) = 'd' then
491 begin
492 MaxOcc := Piece(Qualifier,';',2);
493 SetPiece(AHSTag,';',4,MaxOcc);
494 x := Piece(Qualifier,';',1);
495 DaysBack := Copy(x, 2, Length(x));
496 end;
497 if CharAt(Qualifier, 1) = 'h' then HSType := Copy(Qualifier, 2, Length(Qualifier));
498 if CharAt(Qualifier, 1) = 'i' then ExamID := Copy(Qualifier, 2, Length(Qualifier));
499 if Length(ARemoteSiteID) > 0 then
500 begin
501 RemoteHandle := '';
502 for j := 0 to RemoteReports.Count - 1 do
503 begin
504 Report := TRemoteReport(RemoteReports.ReportList.Items[j]).Report;
505 if Report = ARemoteQuery then
506 begin
507 RemoteHandle := TRemoteReport(RemoteReports.ReportList.Items[j]).Handle
508 + '^' + Pieces(Report,'^',9,10);
509 break;
510 end;
511 end;
512 if Length(RemoteHandle) > 1 then
513 with RemoteSites.SiteList do
514 aHandles.Add(ARemoteSiteID + '^' + RemoteHandle);
515 end;
516 ARpt := AReport + '~' + AHSTag;
517 if aHandles.Count > 0 then
518 begin
519 CallV('ORWRP PRINT WINDOWS REMOTE',[Patient, ARpt, aHandles]);
520 Result := RPCBrokerV.Results;
521 end
522 else
523 begin
524 CallV('ORWRP PRINT WINDOWS REPORT',[Patient, ARpt, HSType,
525 DaysBack, ExamID, aComponents, Alpha, Omega]);
526 Result := RPCBrokerV.Results;
527 end;
528 aHandles.Clear;
529 aHandles.Free;
530end;
531
532function DefaultToWindowsPrinter: Boolean;
533begin
534 Result := (StrToIntDef(sCallV('ORWRP WINPRINT DEFAULT',[]), 0) > 0);
535end;
536
537procedure PrintWindowsReport(ARichEdit: TRichEdit; APageBreak, Atitle: string; var ErrMsg: string);
538var
539 i, j, x, y, LineHeight: integer;
540 aGoHead: string;
541 aHeader: TStringList;
542const
543 TX_ERR_CAP = 'Print Error';
544 TX_FONT_SIZE = 10;
545 TX_FONT_NAME = 'Courier New';
546begin
547 aHeader := TStringList.Create;
548 aGoHead := '';
549 if piece(Atitle,';',2) = '1' then
550 begin
551 Atitle := piece(Atitle,';',1);
552 aGoHead := '1';
553 end;
554 CreatePatientHeader(aHeader ,ATitle);
555 with ARichEdit do
556 begin
557(* if Lines[Lines.Count - 1] = APageBreak then // remove trailing form feed
558 Lines.Delete(Lines.Count - 1);
559 while (Lines[0] = '') or (Lines[0] = APageBreak) do
560 Lines.Delete(0); // remove leading blank lines and form feeds*)
561
562 {v20.4 - SFC-0602-62899 - RV}
563 while (Lines.Count > 0) and ((Lines[Lines.Count - 1] = '') or (Lines[Lines.Count - 1] = APageBreak)) do
564 Lines.Delete(Lines.Count - 1); // remove trailing blank lines and form feeds
565 while (Lines.Count > 0) and ((Lines[0] = '') or (Lines[0] = APageBreak)) do
566 Lines.Delete(0); // remove leading blank lines and form feeds
567
568 if Lines.Count > 1 then
569 begin
570(* i := Lines.IndexOf(APageBreak);
571 if ((i >= 0 ) and (i < Lines.Count - 1)) then // removed in v15.9 (RV)
572 begin*)
573 Printer.Canvas.Font.Size := TX_FONT_SIZE;
574 Printer.Canvas.Font.Name := TX_FONT_NAME;
575 Printer.Title := ATitle;
576 x := Trunc(Printer.Canvas.TextWidth(StringOfChar('=', TX_FONT_SIZE)) * 0.75);
577 LineHeight := Printer.Canvas.TextHeight(TX_FONT_NAME);
578 y := LineHeight * 5; // 5 lines = .83" top margin v15.9 (RV)
579 Printer.BeginDoc;
580 for i := 0 to Lines.Count - 1 do
581 begin
582 if Lines[i] = APageBreak then
583 begin
584 Printer.NewPage;
585 y := LineHeight * 5; // 5 lines = .83" top margin v15.9 (RV)
586 if aGoHead = '1' then
587 begin
588 for j := 0 to aHeader.Count - 1 do
589 begin
590 Printer.Canvas.TextOut(x, y, aHeader[j]);
591 y := y + LineHeight;
592 end;
593 end;
594 end
595 else
596 begin
597 Printer.Canvas.TextOut(x, y, Lines[i]);
598 y := y + LineHeight;
599 end;
600 end;
601 Printer.EndDoc;
602(* end
603 else // removed in v15.9 (RV) TRichEdit.Print no longer used.
604 try
605 Font.Size := TX_FONT_SIZE;
606 Font.Name := TX_FONT_NAME;
607 Print(ATitle);
608 except
609 ErrMsg := TX_ERR_CAP;
610 end;*)
611 end
612 else if ARichEdit.Lines.Count = 1 then
613 if Piece(ARichEdit.Lines[0], U, 1) <> '0' then
614 ErrMsg := Piece(ARichEdit.Lines[0], U, 2);
615 end;
616 aHeader.Free;
617end;
618
619procedure CreatePatientHeader(var HeaderList: TStringList; PageTitle: string);
620// standard patient header, from HEAD^ORWRPP
621var
622 tmpStr, tmpItem: string;
623begin
624 with HeaderList do
625 begin
626 Add(' ');
627 Add(StringOfChar(' ', (74 - Length(PageTitle)) div 2) + PageTitle);
628 Add(' ');
629 tmpStr := Patient.Name + ' ' + Patient.SSN;
630 tmpItem := tmpStr + StringOfChar(' ', 39 - Length(tmpStr)) + Encounter.LocationName;
631 tmpStr := FormatFMDateTime('mmm dd, yyyy', Patient.DOB) + ' (' + IntToStr(Patient.Age) + ')';
632 tmpItem := tmpItem + StringOfChar(' ', 74 - (Length(tmpItem) + Length(tmpStr))) + tmpStr;
633 Add(tmpItem);
634 Add(StringOfChar('=', 74));
635 Add('*** WORK COPY ONLY ***' + StringOfChar(' ', 24) + 'Printed: ' + FormatFMDateTime('mmm dd, yyyy hh:nn', FMNow));
636 Add(' ');
637 Add(' ');
638 end;
639end;
640
641procedure PrintGraph(GraphImage: TChart; PageTitle: string);
642var
643 AHeader: TStringList;
644 i, y, LineHeight: integer;
645 GraphPic: TBitMap;
646 Magnif: integer;
647const
648 TX_FONT_SIZE = 12;
649 TX_FONT_NAME = 'Courier New';
650 CF_BITMAP = 2; // from Windows.pas
651begin
652 ClipBoard;
653 AHeader := TStringList.Create;
654 CreatePatientHeader(AHeader, PageTitle);
655 GraphPic := TBitMap.Create;
656 try
657 GraphImage.CopyToClipboardBitMap;
658 GraphPic.LoadFromClipBoardFormat(CF_BITMAP, ClipBoard.GetAsHandle(CF_BITMAP), 0);
659 with Printer do
660 begin
661 Canvas.Font.Size := TX_FONT_SIZE;
662 Canvas.Font.Name := TX_FONT_NAME;
663 Title := PageTitle;
664 Magnif := (Canvas.TextWidth(StringOfChar('=', 74)) div GraphImage.Width);
665 LineHeight := Printer.Canvas.TextHeight(TX_FONT_NAME);
666 y := LineHeight;
667 BeginDoc;
668 try
669 for i := 0 to AHeader.Count - 1 do
670 begin
671 Canvas.TextOut(0, y, AHeader[i]);
672 y := y + LineHeight;
673 end;
674 y := y + (4 * LineHeight);
675 //GraphImage.PrintPartial(Rect(0, y, Canvas.TextWidth(StringOfChar('=', 74)), y + (Magnif * GraphImage.Height)));
676 PrintBitmap(Canvas, Rect(0, y, Canvas.TextWidth(StringOfChar('=', 74)), y + (Magnif * GraphImage.Height)), GraphPic);
677 finally
678 EndDoc;
679 end;
680 end;
681 finally
682 ClipBoard.Clear;
683 GraphPic.Free;
684 AHeader.Free;
685 end;
686end;
687
688procedure SaveDefaultPrinter(DefPrinter: string) ;
689begin
690 CallV('ORWRP SAVE DEFAULT PRINTER', [DefPrinter]);
691end;
692
693function HSFileLookup(aFile: String; const StartFrom: string;
694 Direction:Integer): TStrings;
695begin
696 CallV('ORWRP2 HS FILE LOOKUP', [aFile, StartFrom, Direction]);
697 MixedCaseList(RPCBrokerV.Results);
698 Result := RPCBrokerV.Results;
699end;
700
701procedure HSComponentFiles(Dest: TStrings; aComponent: String);
702begin
703 CallV('ORWRP2 HS COMP FILES', [aComponent]);
704 QuickCopy(RPCBrokerV.Results,Dest);
705end;
706
707procedure HSSubItems(Dest: TStrings; aItem: String);
708begin
709 CallV('ORWRP2 HS SUBITEMS', [aItem]);
710 MixedCaseList(RPCBrokerV.Results);
711 QuickCopy(RPCBrokerV.Results,Dest);
712end;
713
714procedure HSReportText(Dest: TStrings; aComponents: TStringlist);
715begin
716 CallV('ORWRP2 HS REPORT TEXT', [aComponents, Patient.DFN]);
717 QuickCopy(RPCBrokerV.Results,Dest);
718end;
719
720procedure HSComponents(Dest: TStrings);
721begin
722 CallV('ORWRP2 HS COMPONENTS', [nil]);
723 QuickCopy(RPCBrokerV.Results,Dest);
724end;
725
726procedure HSABVComponents(Dest: TStrings);
727begin
728 CallV('ORWRP2 COMPABV', [nil]);
729 QuickCopy(RPCBrokerV.Results,Dest);
730end;
731
732procedure HSDispComponents(Dest: TStrings);
733begin
734 CallV('ORWRP2 COMPDISP', [nil]);
735 QuickCopy(RPCBrokerV.Results,Dest);
736end;
737
738procedure HSComponentSubs(Dest: TStrings; aItem: String);
739begin
740 CallV('ORWRP2 HS COMPONENT SUBS',[aItem]);
741 MixedCaseList(RPCBrokerV.Results);
742 QuickCopy(RPCBrokerV.Results,Dest);
743end;
744
745function GetRemoteStatus(aHandle: string): String;
746begin
747 CallV('XWB REMOTE STATUS CHECK', [aHandle]);
748 Result := RPCBrokerV.Results[0];
749end;
750
751function GetAdhocLookup: integer;
752begin
753 CallV('ORWRP2 GETLKUP', [nil]);
754 if RPCBrokerV.Results.Count > 0 then
755 Result := StrToInt(RPCBrokerV.Results[0])
756 else
757 Result := 0;
758end;
759
760procedure SetAdhocLookup(aLookup: integer);
761
762begin
763 CallV('ORWRP2 SAVLKUP', [IntToStr(aLookup)]);
764end;
765
766procedure GetRemoteData(Dest: TStrings; aHandle: string; aItem: PChar);
767begin
768 CallV('XWB REMOTE GETDATA', [aHandle]);
769 if RPCBrokerV.Results.Count < 1 then
770 RPCBrokerV.Results[0] := 'No data found.';
771 if (RPCBrokerV.Results.Count < 2) and (RPCBrokerV.Results[0] = '') then
772 RPCBrokerV.Results[0] := 'No data found.';
773 QuickCopy(RPCBrokerV.Results,Dest);
774end;
775
776procedure ModifyHDRData(Dest: string; aHandle: string; aID: string);
777begin
778 CallV('ORWRP4 HDR MODIFY', [aHandle, aID]);
779end;
780
781procedure PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap);
782var
783 BitmapHeader: pBitmapInfo;
784 BitmapImage : POINTER;
785 HeaderSize : DWORD; // Use DWORD for D3-D5 compatibility
786 ImageSize : DWORD;
787begin
788 GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);
789 GetMem(BitmapHeader, HeaderSize);
790 GetMem(BitmapImage, ImageSize);
791 try
792 GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^);
793 StretchDIBits(Canvas.Handle,
794 DestRect.Left, DestRect.Top, // Destination Origin
795 DestRect.Right - DestRect.Left, // Destination Width
796 DestRect.Bottom - DestRect.Top, // Destination Height
797 0, 0, // Source Origin
798 Bitmap.Width, Bitmap.Height, // Source Width & Height
799 BitmapImage,
800 TBitmapInfo(BitmapHeader^),
801 DIB_RGB_COLORS,
802 SRCCOPY)
803 finally
804 FreeMem(BitmapHeader);
805 FreeMem(BitmapImage)
806 end
807end {PrintBitmap};
808
809initialization
810 { nothing to initialize }
811
812finalization
813 uTree.Free;
814 uReportsList.Free;
815 uLabReports.Free;
816 uDateRanges.Free;
817 uHSTypes.Free;
818
819end.
Note: See TracBrowser for help on using the repository browser.