Changeset 830 for cprs/trunk/CPRS-Chart/fLabPrint.pas
- Timestamp:
- Jul 7, 2010, 4:51:54 PM (14 years ago)
- File:
-
- 1 edited
-
cprs/trunk/CPRS-Chart/fLabPrint.pas (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
cprs/trunk/CPRS-Chart/fLabPrint.pas
r456 r830 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 StdCtrls, ORCtrls, ORNet, Mask, ComCtrls; 7 StdCtrls, ORCtrls, ORNet, Mask, ComCtrls, fBase508Form, 8 VA508AccessibilityManager; 8 9 9 10 type 10 TfrmLabPrint = class(T Form)11 TfrmLabPrint = class(TfrmBase508Form) 11 12 lblLabTitle: TMemo; 12 13 lblPrintTo: TLabel; … … 21 22 dlgWinPrinter: TPrintDialog; 22 23 chkDefault: TCheckBox; 23 procedure FormCreate(Sender: TObject);24 24 procedure cboDeviceChange(Sender: TObject); 25 25 procedure cboDeviceNeedData(Sender: TObject; const StartFrom: String; … … 27 27 procedure cmdOKClick(Sender: TObject); 28 28 procedure cmdCancelClick(Sender: TObject); 29 procedure F ormDestroy(Sender: TObject);29 procedure FindVType; 30 30 private 31 31 { Private declarations } 32 FReports: Integer;32 FReports: String; 33 33 FDaysBack: Integer; 34 34 FReportText: TRichEdit; … … 41 41 frmLabPrint: TfrmLabPrint; 42 42 43 procedure PrintLabs(AReports: Longint; const ALabTitle: string; ADaysBack: Integer); 43 procedure PrintLabs(AReports: String; const ALabTitle: string; ADaysBack: Integer); //Lontint 44 function StringPad(aString: string; aStringCount, aPadCount: integer): String; 44 45 45 46 implementation … … 47 48 {$R *.DFM} 48 49 49 uses ORFn, rCore, uCore, fLabs, rLabs, Printers, rReports ;50 uses ORFn, rCore, uCore, fLabs, rLabs, Printers, rReports, fFrame, uReports; 50 51 51 52 const … … 54 55 TX_ERR_CAP = 'Print Error'; 55 56 PAGE_BREAK = '**PAGE BREAK**'; 56 57 procedure PrintLabs(AReports: Integer; const ALabTitle: string; ADaysBack: Integer); 57 QT_OTHER = 0; 58 QT_HSTYPE = 1; 59 QT_DATERANGE = 2; 60 QT_IMAGING = 3; 61 QT_NUTR = 4; 62 QT_PROCEDURES = 19; 63 QT_SURGERY = 28; 64 QT_HSCOMPONENT = 5; 65 QT_HSWPCOMPONENT = 6; 66 67 procedure PrintLabs(AReports: String; const ALabTitle: string; ADaysBack: Integer); 58 68 { displays a form that prompts for a device and then prints the report } 59 69 var … … 105 115 end; 106 116 107 procedure TfrmLabPrint.FormCreate(Sender: TObject);108 begin109 inherited;110 FReportText := TRichEdit.Create(Self);111 with FReportText do112 begin113 Parent := Self;114 Visible := False;115 Width := 600;116 end;117 end;118 119 117 procedure TfrmLabPrint.cboDeviceChange(Sender: TObject); 120 118 begin … … 133 131 inherited; 134 132 cboDevice.ForDataUse(SubsetOfDevices(StartFrom, Direction)); 133 end; 134 135 function StringPad(aString: string; aStringCount, aPadCount: integer): String; 136 var 137 s: integer; 138 begin 139 if aStringCount >= aPadCount then 140 aStringCount := aPadCount - 1; 141 Result := copy(aString, 1, aStringCount); 142 s := aPadCount - length(Result); 143 if s < 0 then s := 0; 144 Result := Result + StringOfChar(' ', s); 135 145 end; 136 146 … … 143 153 RemoteSiteID: string; //for Remote site printing 144 154 RemoteQuery: string; //for Remote site printing 155 ListItem: TListItem; 156 aReport: TStringList; 157 aQualifier: string; 158 i: integer; 159 MoreID: String; //Restores MaxOcc value 160 aCaption: string; 145 161 begin 146 162 inherited; 163 FReportText := CreateReportTextComponent(Self); 147 164 RemoteSiteID := ''; 148 165 RemoteQuery := ''; 166 MoreID := ''; 167 aReport := TStringList.Create; 168 if uQualifier = '' then 169 aQualifier := piece(uRemoteType,'^',5) //Health Summary Type Report 170 else 171 begin 172 MoreID := ';' + Piece(uQualifier,';',3); 173 aQualifier := piece(uRemoteType,'^',5); 174 end; 149 175 with frmLabs.TabControl1 do 150 176 if TabIndex > 0 then … … 175 201 if dlgWinPrinter.Execute then with FReportText do 176 202 begin 177 Lines.Assign(GetFormattedLabReport(FReports, FDaysBack, Patient.DFN, 178 frmLabs.lstTests.Items, date1, date2, RemoteSiteID, RemoteQuery)); 179 PrintWindowsReport(FReportText, PAGE_BREAK, Self.Caption, ErrMsg); 203 if uReportType = 'V' then 204 begin 205 case uQualifierType of 206 QT_IMAGING: 207 begin 208 for i := 0 to frmLabs.lvReports.Items.Count - 1 do 209 if frmLabs.lvReports.Items[i].Selected then 210 begin 211 ListItem := frmLabs.lvReports.Items[i]; 212 aQualifier := ListItem.SubItems[0]; 213 ADevice := Piece(cboDevice.ItemID, ';', 2); 214 QuickCopy(GetFormattedReport(FReports, aQualifier, 215 Patient.DFN, nil , RemoteSiteID, RemoteQuery, uHState), FReportText); 216 aCaption := piece(uRemoteType,'^',4); //nil used to be uHSComponents 217 PrintWindowsReport(FReportText, PAGE_BREAK, aCaption, ErrMsg); 218 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); 219 end; 220 end; 221 QT_NUTR: 222 begin 223 for i := 0 to frmLabs.lvReports.Items.Count - 1 do 224 if frmLabs.lvReports.Items[i].Selected then 225 begin 226 ListItem := frmLabs.lvReports.Items[i]; 227 aQualifier := ListItem.SubItems[0]; 228 ADevice := Piece(cboDevice.ItemID, ';', 2); 229 QuickCopy(GetFormattedReport(FReports, aQualifier + MoreID, 230 Patient.DFN, nil, RemoteSiteID, RemoteQuery, uHState), FReportText); 231 aCaption := piece(uRemoteType,'^',4); 232 PrintWindowsReport(FReportText, PAGE_BREAK, aCaption, ErrMsg); 233 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); 234 end; 235 end; 236 QT_HSCOMPONENT: 237 begin 238 if (length(piece(uHState,';',2)) > 0) then 239 begin 240 FReportText.Clear; 241 aReport.Clear; 242 CreatePatientHeader(aReport,piece(uRemoteType,'^',4)); 243 QuickCopy(aReport, FReportText); 244 FindVType; 245 aCaption := piece(uRemoteType,'^',4) + ';1'; 246 PrintWindowsReport(FReportText, PAGE_BREAK, aCaption, ErrMsg); 247 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); 248 end 249 else 250 begin 251 QuickCopy(GetFormattedReport(FReports, aQualifier + MoreID, 252 Patient.DFN, nil, RemoteSiteID, RemoteQuery, uHState), FReportText); 253 aCaption := piece(uRemoteType,'^',4); 254 PrintWindowsReport(FReportText, PAGE_BREAK, aCaption, ErrMsg); 255 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); 256 end; 257 end; 258 QT_HSWPCOMPONENT: 259 begin 260 if (length(piece(uHState,';',2)) > 0) then 261 begin 262 FReportText.Clear; 263 aReport.Clear; 264 CreatePatientHeader(aReport,piece(uRemoteType,'^',4)); 265 QuickCopy(aReport, FReportText); 266 FindVType; 267 aCaption := piece(uRemoteType,'^',4) + ';1'; 268 PrintWindowsReport(FReportText, PAGE_BREAK, aCaption, ErrMsg); 269 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); 270 end 271 else 272 begin 273 QuickCopy(GetFormattedReport(FReports, aQualifier + MoreID, 274 Patient.DFN, nil, RemoteSiteID, RemoteQuery, uHState), FReportText); 275 aCaption := piece(uRemoteType,'^',4); 276 PrintWindowsReport(FReportText, PAGE_BREAK, aCaption, ErrMsg); 277 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); 278 end; 279 end; 280 QT_PROCEDURES: 281 begin 282 for i := 0 to frmLabs.lvReports.Items.Count - 1 do 283 if frmLabs.lvReports.Items[i].Selected then 284 begin 285 ListItem := frmLabs.lvReports.Items[i]; 286 aQualifier := ListItem.SubItems[0]; 287 ADevice := Piece(cboDevice.ItemID, ';', 2); 288 QuickCopy(GetFormattedReport(FReports, aQualifier, 289 Patient.DFN, nil, RemoteSiteID, RemoteQuery, uHState), FReportText); 290 aCaption := piece(uRemoteType,'^',4); 291 PrintWindowsReport(FReportText, PAGE_BREAK, aCaption, ErrMsg); 292 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); 293 end; 294 end; 295 QT_SURGERY: 296 begin 297 for i := 0 to frmLabs.lvReports.Items.Count - 1 do 298 if frmLabs.lvReports.Items[i].Selected then 299 begin 300 ListItem := frmLabs.lvReports.Items[i]; 301 aQualifier := ListItem.SubItems[0]; 302 ADevice := Piece(cboDevice.ItemID, ';', 2); 303 QuickCopy(GetFormattedReport(FReports, aQualifier, 304 Patient.DFN, nil, RemoteSiteID, RemoteQuery, uHState), FReportText); 305 aCaption := piece(uRemoteType,'^',4); 306 PrintWindowsReport(FReportText, PAGE_BREAK, aCaption, ErrMsg); 307 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); 308 end; 309 end; 310 end; 311 end 312 else 313 begin 314 QuickCopy(GetFormattedLabReport(FReports, FDaysBack, Patient.DFN, 315 frmLabs.lstTests.Items, date1, date2, RemoteSiteID, RemoteQuery), FReportText); 316 PrintWindowsReport(FReportText, PAGE_BREAK, Self.Caption, ErrMsg); 317 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); 318 end; 319 end; 320 end 321 else // if it's not a Win printer 322 begin 323 if uReportType = 'V' then 324 begin 325 case uQualifierType of 326 QT_HSCOMPONENT: 327 begin 328 if (length(piece(uHState,';',2)) > 0) then 329 begin 330 FindVType; 331 aReport.Clear; 332 QuickCopy(FReportText.Lines, aReport); 333 ADevice := Piece(cboDevice.ItemID, ';', 2); 334 PrintVReports(ErrMsg, ADevice, piece(uRemoteType,'^',4),aReport); 335 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); 336 end 337 else 338 begin 339 ADevice := Piece(cboDevice.ItemID, ';', 2); 340 PrintReportsToDevice(FReports, aQualifier + MoreID, 341 Patient.DFN, ADevice, ErrMsg, nil, RemoteSiteID, RemoteQuery, uHState); 342 ErrMsg := Piece(FReportText.Lines[0], U, 2); 343 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); 344 end; 345 end; 346 QT_HSWPCOMPONENT: 347 begin 348 if (length(piece(uHState,';',2)) > 0) then 349 begin 350 FindVType; 351 aReport.Clear; 352 QuickCopy(FReportText, aReport); 353 ADevice := Piece(cboDevice.ItemID, ';', 2); 354 PrintVReports(ErrMsg, ADevice, piece(uRemoteType,'^',4),aReport); 355 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); 356 end 357 else 358 begin 359 ADevice := Piece(cboDevice.ItemID, ';', 2); 360 PrintReportsToDevice(FReports, aQualifier + MoreID, 361 Patient.DFN, ADevice, ErrMsg, nil, RemoteSiteID, RemoteQuery, uHState); 362 ErrMsg := Piece(FReportText.Lines[0], U, 2); 363 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); 364 end; 365 end; 366 end; 367 end 368 else 369 begin 370 ADevice := Piece(cboDevice.ItemID, ';', 2); 371 PrintLabsToDevice(FReports, FDaysBack, Patient.DFN, ADevice, 372 frmLabs.lstTests.Items, ErrMsg, date1, date2, RemoteSiteID, RemoteQuery); 373 ErrMsg := Piece(FReportText.Lines[0], U, 2); 180 374 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); 181 375 end; 182 end183 else184 begin185 ADevice := Piece(cboDevice.ItemID, ';', 2);186 PrintLabsToDevice(FReports, FDaysBack, Patient.DFN, ADevice,187 frmLabs.lstTests.Items, ErrMsg, date1, date2, RemoteSiteID, RemoteQuery);188 ErrMsg := Piece(FReportText.Lines[0], U, 2);189 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);190 376 end; 191 377 if chkDefault.Checked then SaveDefaultPrinter(Piece(cboDevice.ItemID, ';', 1)); 192 378 User.CurrentPrinter := cboDevice.ItemID; 379 aReport.Free; 380 FReportText.Free; 193 381 Close; 382 end; 383 procedure TfrmLabPrint.FindVType; 384 var 385 i,j,k,L,cnt: integer; 386 aBasket: TStringList; 387 aID, aHead, aData, aCol, x: string; 388 ListItem: TListItem; 389 aWPFlag: Boolean; 390 begin 391 aBasket := TStringList.Create; 392 aBasket.Clear; 393 //frmReports.MemText.Clear; 394 aHead := ''; 395 cnt := 2; 396 //aWPFlag := false; 397 for i := 0 to uColumns.Count - 1 do 398 begin 399 if (piece(uColumns[i],'^',7) = '1') and (not(piece(uColumns[i],'^',4) = '1')) then 400 begin 401 L := StrToIntDef(piece(uColumns[i],'^',6),15); 402 if length(piece(uColumns[i],'^',8)) > 0 then 403 x := piece(uColumns[i],'^',8) 404 else 405 x := piece(uColumns[i],'^',1); 406 x := StringPad(x, L, L+1); 407 if frmLabs.TabControl1.Tabs.Count > 1 then 408 aHead := aHead + x 409 else 410 if i = 0 then 411 continue 412 else 413 aHead := aHead + x; 414 end; 415 end; 416 if length(aHead) > 0 then 417 begin 418 FReportText.Lines.Add(aHead); 419 FReportText.Lines.Add('-------------------------------------------------------------------------------'); 420 //frmReports.memText.Lines.Add(aHead); 421 //frmReports.MemText.Lines.Add('-------------------------------------------------------------------------------'); 422 end; 423 for i := 0 to frmLabs.lvReports.Items.Count - 1 do 424 if frmLabs.lvReports.Items[i].Selected then 425 begin 426 aData := ''; 427 aWPFlag := false; 428 ListItem := frmLabs.lvReports.Items[i]; 429 aID := ListItem.SubItems[0]; 430 if frmLabs.TabControl1.Tabs.Count > 1 then 431 begin 432 L := StrToIntDef(piece(uColumns[0],'^',6),10); 433 x := StringPad(ListItem.Caption, L, L+1); 434 aData := x; 435 end; 436 for j := 0 to RowObjects.ColumnList.Count - 1 do 437 begin 438 aCol := TCellObject(RowObjects.ColumnList[j]).Handle; 439 if piece(aID,':',1) = piece(TCellObject(RowObjects.ColumnList[j]).Handle,':',1) then 440 if ListItem.Caption = (piece(TCellObject(RowObjects.ColumnList[j]).Site,';',1)) then 441 begin 442 if (piece(uColumns[StrToInt(piece(aCol,':',2))],'^',7) = '1') and 443 (not (piece(uColumns[StrToInt(piece(aCol,':',2))],'^',4) = '1')) then 444 begin 445 FastAssign(TCellObject(RowObjects.ColumnList[j]).Data, aBasket); 446 for k := 0 to aBasket.Count - 1 do 447 begin 448 L := StrToIntDef(piece(uColumns[StrToInt(piece(aCol,':',2))],'^',6),15); 449 x := StringPad(aBasket[k], L, L+1); 450 aData := aData + x; 451 end; 452 end; 453 end; 454 end; 455 //frmReports.memText.Lines.Add(aData); 456 FReportText.Lines.Add(aData); 457 cnt := cnt + 1; 458 if cnt > 40 then 459 begin 460 cnt := 0; 461 //frmReports.memText.Lines.Add('**PAGE BREAK**'); 462 FReportText.Lines.Add('**PAGE BREAK**'); 463 end; 464 for j := 0 to RowObjects.ColumnList.Count - 1 do 465 begin 466 aCol := TCellObject(RowObjects.ColumnList[j]).Handle; 467 if piece(aID,':',1) = piece(TCellObject(RowObjects.ColumnList[j]).Handle,':',1) then 468 if ListItem.Caption = (piece(TCellObject(RowObjects.ColumnList[j]).Site,';',1)) then 469 begin 470 if (piece(uColumns[StrToInt(piece(aCol,':',2))],'^',7) = '1') and 471 (piece(uColumns[StrToInt(piece(aCol,':',2))],'^',4) = '1') then 472 begin 473 aWPFlag := true; 474 FastAssign(TCellObject(RowObjects.ColumnList[j]).Data, aBasket); 475 //frmReports.MemText.Lines.Add(TCellObject(RowObjects.ColumnList[j]).Name); 476 FReportText.Lines.Add(TCellObject(RowObjects.ColumnList[j]).Name); 477 cnt := cnt + 1; 478 for k := 0 to aBasket.Count - 1 do 479 begin 480 //frmReports.memText.Lines.Add(' ' + aBasket[k]); 481 FReportText.Lines.Add(' ' + aBasket[k]); 482 cnt := cnt + 1; 483 if cnt > 40 then 484 begin 485 cnt := 0; 486 //frmReports.memText.Lines.Add('**PAGE BREAK**'); 487 FReportText.Lines.Add('**PAGE BREAK**'); 488 end; 489 end; 490 end; 491 end; 492 end; 493 if aWPFlag = true then 494 begin 495 //frmReports.MemText.Lines.Add('==============================================================================='); 496 FReportText.Lines.Add('==============================================================================='); 497 end; 498 end; 499 aBasket.Free; 194 500 end; 195 501 … … 200 506 end; 201 507 202 procedure TfrmLabPrint.FormDestroy(Sender: TObject);203 begin204 FReportText.Free;205 inherited;206 end;207 208 508 end.
Note:
See TracChangeset
for help on using the changeset viewer.
