1 | unit rReports;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses Windows, SysUtils, Classes, ORNet, ORFn, ComCtrls, Chart, graphics;
|
---|
6 |
|
---|
7 | { Consults }
|
---|
8 | procedure ListConsults(Dest: TStrings);
|
---|
9 | procedure LoadConsultText(Dest: TStrings; IEN: Integer);
|
---|
10 |
|
---|
11 | { Reports }
|
---|
12 | procedure ListReports(Dest: TStrings);
|
---|
13 | procedure ListLabReports(Dest: TStrings);
|
---|
14 | procedure ListReportDateRanges(Dest: TStrings);
|
---|
15 | procedure ListHealthSummaryTypes(Dest: TStrings);
|
---|
16 | procedure ListImagingExams(Dest: TStrings);
|
---|
17 | procedure ListProcedures(Dest: TStrings);
|
---|
18 | procedure ListNutrAssessments(Dest: TStrings);
|
---|
19 | procedure ListSurgeryReports(Dest: TStrings);
|
---|
20 | procedure ColumnHeaders(Dest: TStrings; AReportType: String);
|
---|
21 | procedure SaveColumnSizes(aColumn: String);
|
---|
22 | procedure LoadReportText(Dest: TStrings; ReportType: string; const Qualifier: string; ARpc, AHSTag: string);
|
---|
23 | procedure RemoteQueryAbortAll;
|
---|
24 | procedure RemoteQuery(Dest: TStrings; AReportType: string; AHSType, ADaysback,
|
---|
25 | AExamID: string; Alpha, AOmega: Double; ASite, ARemoteRPC, AHSTag: String);
|
---|
26 | procedure DirectQuery(Dest: TStrings; AReportType: string; AHSType, ADaysback,
|
---|
27 | AExamID: string; Alpha, AOmega: Double; ASite, ARemoteRPC, AHSTag: String);
|
---|
28 | function ReportQualifierType(ReportType: Integer): Integer;
|
---|
29 | function ImagingParams: String;
|
---|
30 | function AutoRDV: String;
|
---|
31 | function HDRActive: String;
|
---|
32 | procedure PrintReportsToDevice(AReport: string; const Qualifier, Patient,
|
---|
33 | ADevice: string; var ErrMsg: string; aComponents: TStringlist;
|
---|
34 | ARemoteSiteID, ARemoteQuery, AHSTag: string);
|
---|
35 | function HSFileLookup(aFile: String; const StartFrom: string;
|
---|
36 | Direction: Integer): TStrings;
|
---|
37 | procedure HSComponentFiles(Dest: TStrings; aComponent: String);
|
---|
38 | procedure HSSubItems(Dest: TStrings; aItem: String);
|
---|
39 | procedure HSReportText(Dest: TStrings; aComponents: TStringlist);
|
---|
40 | procedure HSComponents(Dest: TStrings);
|
---|
41 | procedure HSABVComponents(Dest: TStrings);
|
---|
42 | procedure HSDispComponents(Dest: TStrings);
|
---|
43 | procedure HSComponentSubs(Dest: TStrings; aItem: String);
|
---|
44 | procedure HealthSummaryCheck(Dest: TStrings; aQualifier: string);
|
---|
45 | function GetFormattedReport(AReport: string; const Qualifier, Patient: string;
|
---|
46 | aComponents: TStringlist; ARemoteSiteID, ARemoteQuery, AHSTag: string): TStrings;
|
---|
47 | procedure PrintWindowsReport(ARichEdit: TRichEdit; APageBreak, ATitle: string;
|
---|
48 | var ErrMsg: string);
|
---|
49 | function DefaultToWindowsPrinter: Boolean;
|
---|
50 | procedure PrintGraph(GraphImage: TChart; PageTitle: string);
|
---|
51 | procedure PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap);
|
---|
52 | procedure CreatePatientHeader(var HeaderList: TStringList; PageTitle: string);
|
---|
53 | procedure SaveDefaultPrinter(DefPrinter: string) ;
|
---|
54 | function GetRemoteStatus(aHandle: string): String;
|
---|
55 | function GetAdhocLookup: integer;
|
---|
56 | procedure SetAdhocLookup(aLookup: integer);
|
---|
57 | procedure GetRemoteData(Dest: TStrings; aHandle: string; aItem: PChar);
|
---|
58 | procedure ModifyHDRData(Dest: string; aHandle: string; aID: string);
|
---|
59 | procedure PrintVReports(Dest, ADevice, AHeader: string; AReport: TStringList);
|
---|
60 |
|
---|
61 | implementation
|
---|
62 |
|
---|
63 | uses uCore, rCore, Printers, clipbrd, uReports, fReports;
|
---|
64 |
|
---|
65 | var
|
---|
66 | uTree: TStringList;
|
---|
67 | uReportsList: TStringList;
|
---|
68 | uLabReports: TStringList;
|
---|
69 | uDateRanges: TStringList;
|
---|
70 | uHSTypes: TStringList;
|
---|
71 |
|
---|
72 | { Consults }
|
---|
73 |
|
---|
74 | procedure ListConsults(Dest: TStrings);
|
---|
75 | var
|
---|
76 | i: Integer;
|
---|
77 | x: string;
|
---|
78 | begin
|
---|
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;
|
---|
93 | end;
|
---|
94 |
|
---|
95 | procedure LoadConsultText(Dest: TStrings; IEN: Integer);
|
---|
96 | begin
|
---|
97 | CallV('ORWCS REPORT TEXT', [Patient.DFN, IEN]);
|
---|
98 | QuickCopy(RPCBrokerV.Results,Dest);
|
---|
99 | end;
|
---|
100 |
|
---|
101 | { Reports }
|
---|
102 |
|
---|
103 | procedure ExtractSection(Dest: TStrings; const Section: string; Mixed: Boolean);
|
---|
104 | var
|
---|
105 | i: Integer;
|
---|
106 | begin
|
---|
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;
|
---|
126 | end;
|
---|
127 |
|
---|
128 | procedure LoadReportLists;
|
---|
129 | begin
|
---|
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);
|
---|
137 | end;
|
---|
138 |
|
---|
139 | procedure LoadLabReportLists;
|
---|
140 | begin
|
---|
141 | CallV('ORWRP LAB REPORT LISTS', [nil]);
|
---|
142 | uLabReports := TStringList.Create;
|
---|
143 | ExtractSection(uLabReports, '[LAB REPORT LIST]', true);
|
---|
144 | end;
|
---|
145 |
|
---|
146 | procedure LoadTree;
|
---|
147 | begin
|
---|
148 | CallV('ORWRP3 EXPAND COLUMNS', [nil]);
|
---|
149 | uTree := TStringList.Create;
|
---|
150 | ExtractSection(uTree, '[REPORT LIST]', false);
|
---|
151 | end;
|
---|
152 |
|
---|
153 | procedure ListReports(Dest: TStrings);
|
---|
154 | var
|
---|
155 | i: Integer;
|
---|
156 | begin
|
---|
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));
|
---|
165 | end;
|
---|
166 |
|
---|
167 | procedure ListLabReports(Dest: TStrings);
|
---|
168 | var
|
---|
169 | i: integer;
|
---|
170 | begin
|
---|
171 | if uLabreports = nil then LoadLabReportLists;
|
---|
172 | for i := 0 to uLabReports.Count - 1 do Dest.Add(Pieces(uLabReports[i], U, 1, 10));
|
---|
173 | end;
|
---|
174 |
|
---|
175 | procedure ListReportDateRanges(Dest: TStrings);
|
---|
176 | begin
|
---|
177 | if uDateRanges = nil then LoadReportLists;
|
---|
178 | Dest.Assign(uDateRanges);
|
---|
179 | end;
|
---|
180 |
|
---|
181 | procedure ListHealthSummaryTypes(Dest: TStrings);
|
---|
182 | begin
|
---|
183 | if uHSTypes = nil then LoadReportLists;
|
---|
184 | MixedCaseList(uHSTypes);
|
---|
185 | Dest.Assign(uHSTypes);
|
---|
186 | end;
|
---|
187 |
|
---|
188 | procedure HealthSummaryCheck(Dest: TStrings; aQualifier: string);
|
---|
189 |
|
---|
190 | begin
|
---|
191 | if aQualifier = '1' then
|
---|
192 | begin
|
---|
193 | ListHealthSummaryTypes(Dest);
|
---|
194 | end;
|
---|
195 | end;
|
---|
196 |
|
---|
197 | procedure ColumnHeaders(Dest: TStrings; AReportType: String);
|
---|
198 | begin
|
---|
199 | CallV('ORWRP COLUMN HEADERS',[AReportType]);
|
---|
200 | Dest.Assign(RPCBrokerV.Results);
|
---|
201 | end;
|
---|
202 |
|
---|
203 | procedure SaveColumnSizes(aColumn: String);
|
---|
204 | begin
|
---|
205 | CallV('ORWCH SAVECOL', [aColumn]);
|
---|
206 | end;
|
---|
207 |
|
---|
208 | procedure ListImagingExams(Dest: TStrings);
|
---|
209 | var
|
---|
210 | x: string;
|
---|
211 | i: Integer;
|
---|
212 | begin
|
---|
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;
|
---|
231 | end;
|
---|
232 |
|
---|
233 | procedure ListProcedures(Dest: TStrings);
|
---|
234 | var
|
---|
235 | x,sdate: string;
|
---|
236 | i: Integer;
|
---|
237 | begin
|
---|
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;
|
---|
253 | end;
|
---|
254 |
|
---|
255 | procedure ListNutrAssessments(Dest: TStrings);
|
---|
256 | var
|
---|
257 | x: string;
|
---|
258 | i: Integer;
|
---|
259 | begin
|
---|
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;
|
---|
271 | end;
|
---|
272 |
|
---|
273 | procedure 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)
|
---|
276 | var
|
---|
277 | i: integer;
|
---|
278 | x, AFormat: string;
|
---|
279 | begin
|
---|
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;
|
---|
294 | end;
|
---|
295 |
|
---|
296 | procedure LoadReportText(Dest: TStrings; ReportType: string; const Qualifier: string; ARpc, AHSTag: string);
|
---|
297 | var
|
---|
298 | HSType, DaysBack, ExamID, MaxOcc, AReport, x: string;
|
---|
299 | Alpha, Omega, Trans: double;
|
---|
300 | begin
|
---|
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;
|
---|
339 | end;
|
---|
340 |
|
---|
341 | procedure RemoteQueryAbortAll;
|
---|
342 | begin
|
---|
343 | CallV('XWB DEFERRED CLEARALL',[nil]);
|
---|
344 | end;
|
---|
345 |
|
---|
346 | procedure RemoteQuery(Dest: TStrings; AReportType: string; AHSType, ADaysback,
|
---|
347 | AExamID: string; Alpha, AOmega: Double; ASite, ARemoteRPC, AHSTag: String);
|
---|
348 | var
|
---|
349 | AReport: string;
|
---|
350 | begin
|
---|
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);
|
---|
357 | end;
|
---|
358 |
|
---|
359 | procedure DirectQuery(Dest: TStrings; AReportType: string; AHSType, ADaysback,
|
---|
360 | AExamID: string; Alpha, AOmega: Double; ASite, ARemoteRPC, AHSTag: String);
|
---|
361 | var
|
---|
362 | AReport: string;
|
---|
363 | begin
|
---|
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);
|
---|
370 | end;
|
---|
371 |
|
---|
372 | function ReportQualifierType(ReportType: Integer): Integer;
|
---|
373 | var
|
---|
374 | i: Integer;
|
---|
375 | begin
|
---|
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);
|
---|
380 | end;
|
---|
381 |
|
---|
382 | function ImagingParams: String;
|
---|
383 | begin
|
---|
384 | Result := sCallV('ORWTPD GETIMG',[nil]);
|
---|
385 | end;
|
---|
386 |
|
---|
387 | function AutoRDV: String;
|
---|
388 | begin
|
---|
389 | Result := sCallV('ORWCIRN AUTORDV', [nil]);
|
---|
390 | end;
|
---|
391 |
|
---|
392 | function HDRActive: String;
|
---|
393 | begin
|
---|
394 | Result := sCallV('ORWCIRN HDRON', [nil]);
|
---|
395 | end;
|
---|
396 |
|
---|
397 | procedure PrintVReports(Dest, ADevice, AHeader: string; AReport: TStringList);
|
---|
398 | begin
|
---|
399 | CallV('ORWRP PRINT V REPORT', [ADevice, Patient.DFN, AHeader, AReport]);
|
---|
400 | end;
|
---|
401 |
|
---|
402 | procedure 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 }
|
---|
405 | var
|
---|
406 | HSType, DaysBack, ExamID, MaxOcc, ARpt, x: string;
|
---|
407 | Alpha, Omega: double;
|
---|
408 | j: integer;
|
---|
409 | RemoteHandle,Report: string;
|
---|
410 | aHandles: TStringlist;
|
---|
411 | begin
|
---|
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;
|
---|
465 | end;
|
---|
466 |
|
---|
467 | function GetFormattedReport(AReport: string; const Qualifier, Patient: string;
|
---|
468 | aComponents: TStringlist; ARemoteSiteID, ARemoteQuery, AHSTag: string): TStrings;
|
---|
469 | { prints a report on the selected device }
|
---|
470 | var
|
---|
471 | HSType, DaysBack, ExamID, MaxOcc, ARpt, x: string;
|
---|
472 | Alpha, Omega: double;
|
---|
473 | j: integer;
|
---|
474 | RemoteHandle,Report: string;
|
---|
475 | aHandles: TStringlist;
|
---|
476 | begin
|
---|
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;
|
---|
530 | end;
|
---|
531 |
|
---|
532 | function DefaultToWindowsPrinter: Boolean;
|
---|
533 | begin
|
---|
534 | Result := (StrToIntDef(sCallV('ORWRP WINPRINT DEFAULT',[]), 0) > 0);
|
---|
535 | end;
|
---|
536 |
|
---|
537 | procedure PrintWindowsReport(ARichEdit: TRichEdit; APageBreak, Atitle: string; var ErrMsg: string);
|
---|
538 | var
|
---|
539 | i, j, x, y, LineHeight: integer;
|
---|
540 | aGoHead: string;
|
---|
541 | aHeader: TStringList;
|
---|
542 | const
|
---|
543 | TX_ERR_CAP = 'Print Error';
|
---|
544 | TX_FONT_SIZE = 10;
|
---|
545 | TX_FONT_NAME = 'Courier New';
|
---|
546 | begin
|
---|
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;
|
---|
617 | end;
|
---|
618 |
|
---|
619 | procedure CreatePatientHeader(var HeaderList: TStringList; PageTitle: string);
|
---|
620 | // standard patient header, from HEAD^ORWRPP
|
---|
621 | var
|
---|
622 | tmpStr, tmpItem: string;
|
---|
623 | begin
|
---|
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;
|
---|
639 | end;
|
---|
640 |
|
---|
641 | procedure PrintGraph(GraphImage: TChart; PageTitle: string);
|
---|
642 | var
|
---|
643 | AHeader: TStringList;
|
---|
644 | i, y, LineHeight: integer;
|
---|
645 | GraphPic: TBitMap;
|
---|
646 | Magnif: integer;
|
---|
647 | const
|
---|
648 | TX_FONT_SIZE = 12;
|
---|
649 | TX_FONT_NAME = 'Courier New';
|
---|
650 | CF_BITMAP = 2; // from Windows.pas
|
---|
651 | begin
|
---|
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;
|
---|
686 | end;
|
---|
687 |
|
---|
688 | procedure SaveDefaultPrinter(DefPrinter: string) ;
|
---|
689 | begin
|
---|
690 | CallV('ORWRP SAVE DEFAULT PRINTER', [DefPrinter]);
|
---|
691 | end;
|
---|
692 |
|
---|
693 | function HSFileLookup(aFile: String; const StartFrom: string;
|
---|
694 | Direction:Integer): TStrings;
|
---|
695 | begin
|
---|
696 | CallV('ORWRP2 HS FILE LOOKUP', [aFile, StartFrom, Direction]);
|
---|
697 | MixedCaseList(RPCBrokerV.Results);
|
---|
698 | Result := RPCBrokerV.Results;
|
---|
699 | end;
|
---|
700 |
|
---|
701 | procedure HSComponentFiles(Dest: TStrings; aComponent: String);
|
---|
702 | begin
|
---|
703 | CallV('ORWRP2 HS COMP FILES', [aComponent]);
|
---|
704 | QuickCopy(RPCBrokerV.Results,Dest);
|
---|
705 | end;
|
---|
706 |
|
---|
707 | procedure HSSubItems(Dest: TStrings; aItem: String);
|
---|
708 | begin
|
---|
709 | CallV('ORWRP2 HS SUBITEMS', [aItem]);
|
---|
710 | MixedCaseList(RPCBrokerV.Results);
|
---|
711 | QuickCopy(RPCBrokerV.Results,Dest);
|
---|
712 | end;
|
---|
713 |
|
---|
714 | procedure HSReportText(Dest: TStrings; aComponents: TStringlist);
|
---|
715 | begin
|
---|
716 | CallV('ORWRP2 HS REPORT TEXT', [aComponents, Patient.DFN]);
|
---|
717 | QuickCopy(RPCBrokerV.Results,Dest);
|
---|
718 | end;
|
---|
719 |
|
---|
720 | procedure HSComponents(Dest: TStrings);
|
---|
721 | begin
|
---|
722 | CallV('ORWRP2 HS COMPONENTS', [nil]);
|
---|
723 | QuickCopy(RPCBrokerV.Results,Dest);
|
---|
724 | end;
|
---|
725 |
|
---|
726 | procedure HSABVComponents(Dest: TStrings);
|
---|
727 | begin
|
---|
728 | CallV('ORWRP2 COMPABV', [nil]);
|
---|
729 | QuickCopy(RPCBrokerV.Results,Dest);
|
---|
730 | end;
|
---|
731 |
|
---|
732 | procedure HSDispComponents(Dest: TStrings);
|
---|
733 | begin
|
---|
734 | CallV('ORWRP2 COMPDISP', [nil]);
|
---|
735 | QuickCopy(RPCBrokerV.Results,Dest);
|
---|
736 | end;
|
---|
737 |
|
---|
738 | procedure HSComponentSubs(Dest: TStrings; aItem: String);
|
---|
739 | begin
|
---|
740 | CallV('ORWRP2 HS COMPONENT SUBS',[aItem]);
|
---|
741 | MixedCaseList(RPCBrokerV.Results);
|
---|
742 | QuickCopy(RPCBrokerV.Results,Dest);
|
---|
743 | end;
|
---|
744 |
|
---|
745 | function GetRemoteStatus(aHandle: string): String;
|
---|
746 | begin
|
---|
747 | CallV('XWB REMOTE STATUS CHECK', [aHandle]);
|
---|
748 | Result := RPCBrokerV.Results[0];
|
---|
749 | end;
|
---|
750 |
|
---|
751 | function GetAdhocLookup: integer;
|
---|
752 | begin
|
---|
753 | CallV('ORWRP2 GETLKUP', [nil]);
|
---|
754 | if RPCBrokerV.Results.Count > 0 then
|
---|
755 | Result := StrToInt(RPCBrokerV.Results[0])
|
---|
756 | else
|
---|
757 | Result := 0;
|
---|
758 | end;
|
---|
759 |
|
---|
760 | procedure SetAdhocLookup(aLookup: integer);
|
---|
761 |
|
---|
762 | begin
|
---|
763 | CallV('ORWRP2 SAVLKUP', [IntToStr(aLookup)]);
|
---|
764 | end;
|
---|
765 |
|
---|
766 | procedure GetRemoteData(Dest: TStrings; aHandle: string; aItem: PChar);
|
---|
767 | begin
|
---|
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);
|
---|
774 | end;
|
---|
775 |
|
---|
776 | procedure ModifyHDRData(Dest: string; aHandle: string; aID: string);
|
---|
777 | begin
|
---|
778 | CallV('ORWRP4 HDR MODIFY', [aHandle, aID]);
|
---|
779 | end;
|
---|
780 |
|
---|
781 | procedure PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap);
|
---|
782 | var
|
---|
783 | BitmapHeader: pBitmapInfo;
|
---|
784 | BitmapImage : POINTER;
|
---|
785 | HeaderSize : DWORD; // Use DWORD for D3-D5 compatibility
|
---|
786 | ImageSize : DWORD;
|
---|
787 | begin
|
---|
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
|
---|
807 | end {PrintBitmap};
|
---|
808 |
|
---|
809 | initialization
|
---|
810 | { nothing to initialize }
|
---|
811 |
|
---|
812 | finalization
|
---|
813 | uTree.Free;
|
---|
814 | uReportsList.Free;
|
---|
815 | uLabReports.Free;
|
---|
816 | uDateRanges.Free;
|
---|
817 | uHSTypes.Free;
|
---|
818 |
|
---|
819 | end.
|
---|