[456] | 1 | unit fLabPrint;
|
---|
| 2 |
|
---|
| 3 | interface
|
---|
| 4 |
|
---|
| 5 | uses
|
---|
| 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
[830] | 7 | StdCtrls, ORCtrls, ORNet, Mask, ComCtrls, fBase508Form,
|
---|
| 8 | VA508AccessibilityManager;
|
---|
[456] | 9 |
|
---|
| 10 | type
|
---|
[830] | 11 | TfrmLabPrint = class(TfrmBase508Form)
|
---|
[456] | 12 | lblLabTitle: TMemo;
|
---|
| 13 | lblPrintTo: TLabel;
|
---|
| 14 | grpDevice: TGroupBox;
|
---|
| 15 | lblMargin: TLabel;
|
---|
| 16 | lblLength: TLabel;
|
---|
| 17 | txtRightMargin: TMaskEdit;
|
---|
| 18 | txtPageLength: TMaskEdit;
|
---|
| 19 | cboDevice: TORComboBox;
|
---|
| 20 | cmdOK: TButton;
|
---|
| 21 | cmdCancel: TButton;
|
---|
| 22 | dlgWinPrinter: TPrintDialog;
|
---|
| 23 | chkDefault: TCheckBox;
|
---|
| 24 | procedure cboDeviceChange(Sender: TObject);
|
---|
| 25 | procedure cboDeviceNeedData(Sender: TObject; const StartFrom: String;
|
---|
| 26 | Direction, InsertAt: Integer);
|
---|
| 27 | procedure cmdOKClick(Sender: TObject);
|
---|
| 28 | procedure cmdCancelClick(Sender: TObject);
|
---|
[830] | 29 | procedure FindVType;
|
---|
[456] | 30 | private
|
---|
| 31 | { Private declarations }
|
---|
[830] | 32 | FReports: String;
|
---|
[456] | 33 | FDaysBack: Integer;
|
---|
| 34 | FReportText: TRichEdit;
|
---|
| 35 | procedure DisplaySelectDevice;
|
---|
| 36 | public
|
---|
| 37 | { Public declarations }
|
---|
| 38 | end;
|
---|
| 39 |
|
---|
| 40 | var
|
---|
| 41 | frmLabPrint: TfrmLabPrint;
|
---|
| 42 |
|
---|
[830] | 43 | procedure PrintLabs(AReports: String; const ALabTitle: string; ADaysBack: Integer); //Lontint
|
---|
| 44 | function StringPad(aString: string; aStringCount, aPadCount: integer): String;
|
---|
[456] | 45 |
|
---|
| 46 | implementation
|
---|
| 47 |
|
---|
| 48 | {$R *.DFM}
|
---|
| 49 |
|
---|
[830] | 50 | uses ORFn, rCore, uCore, fLabs, rLabs, Printers, rReports, fFrame, uReports;
|
---|
[456] | 51 |
|
---|
| 52 | const
|
---|
| 53 | TX_NODEVICE = 'A device must be selected to print, or press ''Cancel'' to not print.';
|
---|
| 54 | TX_NODEVICE_CAP = 'Device Not Selected';
|
---|
| 55 | TX_ERR_CAP = 'Print Error';
|
---|
| 56 | PAGE_BREAK = '**PAGE BREAK**';
|
---|
[830] | 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;
|
---|
[456] | 66 |
|
---|
[830] | 67 | procedure PrintLabs(AReports: String; const ALabTitle: string; ADaysBack: Integer);
|
---|
[456] | 68 | { displays a form that prompts for a device and then prints the report }
|
---|
| 69 | var
|
---|
| 70 | frmLabPrint: TfrmLabPrint;
|
---|
| 71 | DefPrt: string;
|
---|
| 72 | begin
|
---|
| 73 | frmLabPrint := TfrmLabPrint.Create(Application);
|
---|
| 74 | try
|
---|
| 75 | ResizeAnchoredFormToFont(frmLabPrint);
|
---|
| 76 | with frmLabPrint do
|
---|
| 77 | begin
|
---|
| 78 | lblLabTitle.Text := ALabTitle;
|
---|
| 79 | FReports := AReports;
|
---|
| 80 | FDaysBack := ADaysBack;
|
---|
| 81 | DefPrt := GetDefaultPrinter(User.Duz, Encounter.Location);
|
---|
| 82 | if User.CurrentPrinter = '' then User.CurrentPrinter := DefPrt;
|
---|
| 83 | with cboDevice do
|
---|
| 84 | begin
|
---|
| 85 | if Printer.Printers.Count > 0 then
|
---|
| 86 | begin
|
---|
| 87 | Items.Add('WIN;Windows Printer^Windows Printer');
|
---|
| 88 | Items.Add('^--------------------VistA Printers----------------------');
|
---|
| 89 | end;
|
---|
| 90 | if User.CurrentPrinter <> '' then
|
---|
| 91 | begin
|
---|
| 92 | InitLongList(Piece(User.CurrentPrinter, ';', 2));
|
---|
| 93 | SelectByID(User.CurrentPrinter);
|
---|
| 94 | end
|
---|
| 95 | else
|
---|
| 96 | InitLongList('');
|
---|
| 97 | end;
|
---|
| 98 | if (DefPrt = 'WIN;Windows Printer') and
|
---|
| 99 | (User.CurrentPrinter = DefPrt) then
|
---|
| 100 | cmdOKClick(frmLabPrint)
|
---|
| 101 | else
|
---|
| 102 | ShowModal;
|
---|
| 103 | end;
|
---|
| 104 | finally
|
---|
| 105 | frmLabPrint.Release;
|
---|
| 106 | end;
|
---|
| 107 | end;
|
---|
| 108 |
|
---|
| 109 | procedure TfrmLabPrint.DisplaySelectDevice;
|
---|
| 110 | begin
|
---|
| 111 | with cboDevice, lblPrintTo do
|
---|
| 112 | begin
|
---|
| 113 | Caption := 'Print Report on: ' + Piece(ItemID, ';', 2);
|
---|
| 114 | end;
|
---|
| 115 | end;
|
---|
| 116 |
|
---|
| 117 | procedure TfrmLabPrint.cboDeviceChange(Sender: TObject);
|
---|
| 118 | begin
|
---|
| 119 | inherited;
|
---|
| 120 | with cboDevice do if ItemIndex > -1 then
|
---|
| 121 | begin
|
---|
| 122 | txtRightMargin.Text := Piece(Items[ItemIndex], '^', 4);
|
---|
| 123 | txtPageLength.Text := Piece(Items[ItemIndex], '^', 5);
|
---|
| 124 | DisplaySelectDevice;
|
---|
| 125 | end;
|
---|
| 126 | end;
|
---|
| 127 |
|
---|
| 128 | procedure TfrmLabPrint.cboDeviceNeedData(Sender: TObject;
|
---|
| 129 | const StartFrom: String; Direction, InsertAt: Integer);
|
---|
| 130 | begin
|
---|
| 131 | inherited;
|
---|
| 132 | cboDevice.ForDataUse(SubsetOfDevices(StartFrom, Direction));
|
---|
| 133 | end;
|
---|
| 134 |
|
---|
[830] | 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);
|
---|
| 145 | end;
|
---|
| 146 |
|
---|
[456] | 147 | procedure TfrmLabPrint.cmdOKClick(Sender: TObject);
|
---|
| 148 | var
|
---|
| 149 | ADevice, ErrMsg: string;
|
---|
| 150 | daysback: integer;
|
---|
| 151 | date1, date2: TFMDateTime;
|
---|
| 152 | today: TDateTime;
|
---|
| 153 | RemoteSiteID: string; //for Remote site printing
|
---|
| 154 | RemoteQuery: string; //for Remote site printing
|
---|
[830] | 155 | ListItem: TListItem;
|
---|
| 156 | aReport: TStringList;
|
---|
| 157 | aQualifier: string;
|
---|
| 158 | i: integer;
|
---|
| 159 | MoreID: String; //Restores MaxOcc value
|
---|
| 160 | aCaption: string;
|
---|
[456] | 161 | begin
|
---|
| 162 | inherited;
|
---|
[830] | 163 | FReportText := CreateReportTextComponent(Self);
|
---|
[456] | 164 | RemoteSiteID := '';
|
---|
| 165 | RemoteQuery := '';
|
---|
[830] | 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;
|
---|
[456] | 175 | with frmLabs.TabControl1 do
|
---|
| 176 | if TabIndex > 0 then
|
---|
| 177 | begin
|
---|
| 178 | RemoteSiteID := TRemoteSite(Tabs.Objects[TabIndex]).SiteID;
|
---|
| 179 | RemoteQuery := TRemoteSite(Tabs.Objects[TabIndex]).CurrentLabQuery;
|
---|
| 180 | end;
|
---|
| 181 | if cboDevice.ItemID = '' then
|
---|
| 182 | begin
|
---|
| 183 | InfoBox(TX_NODEVICE, TX_NODEVICE_CAP, MB_OK);
|
---|
| 184 | Exit;
|
---|
| 185 | end;
|
---|
| 186 | today := frmLabs.FMToDateTime(floattostr(FMToday));
|
---|
| 187 | if frmLabs.lstDates.ItemIEN > 0 then
|
---|
| 188 | begin
|
---|
| 189 | daysback := frmLabs.lstDates.ItemIEN;
|
---|
| 190 | date1 := FMToday;
|
---|
| 191 | If daysback = 1 then
|
---|
| 192 | date2 := DateTimeToFMDateTime(today)
|
---|
| 193 | Else
|
---|
| 194 | date2 := DateTimeToFMDateTime(today - daysback);
|
---|
| 195 | end
|
---|
| 196 | else
|
---|
| 197 | frmLabs.BeginEndDates(date1,date2,daysback);
|
---|
| 198 | date1 := date1 + 0.2359;
|
---|
| 199 | if Piece(cboDevice.ItemID, ';', 1) = 'WIN' then
|
---|
| 200 | begin
|
---|
| 201 | if dlgWinPrinter.Execute then with FReportText do
|
---|
| 202 | begin
|
---|
[830] | 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;
|
---|
[456] | 319 | end;
|
---|
| 320 | end
|
---|
[830] | 321 | else // if it's not a Win printer
|
---|
[456] | 322 | begin
|
---|
[830] | 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);
|
---|
| 374 | if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
|
---|
| 375 | end;
|
---|
[456] | 376 | end;
|
---|
| 377 | if chkDefault.Checked then SaveDefaultPrinter(Piece(cboDevice.ItemID, ';', 1));
|
---|
| 378 | User.CurrentPrinter := cboDevice.ItemID;
|
---|
[830] | 379 | aReport.Free;
|
---|
| 380 | FReportText.Free;
|
---|
[456] | 381 | Close;
|
---|
| 382 | end;
|
---|
[830] | 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 | aHead := '';
|
---|
| 394 | cnt := 2;
|
---|
| 395 | for i := 0 to uColumns.Count - 1 do
|
---|
| 396 | begin
|
---|
| 397 | if (piece(uColumns[i],'^',7) = '1') and (not(piece(uColumns[i],'^',4) = '1')) then
|
---|
| 398 | begin
|
---|
| 399 | L := StrToIntDef(piece(uColumns[i],'^',6),15);
|
---|
| 400 | if length(piece(uColumns[i],'^',8)) > 0 then
|
---|
| 401 | x := piece(uColumns[i],'^',8)
|
---|
| 402 | else
|
---|
| 403 | x := piece(uColumns[i],'^',1);
|
---|
| 404 | x := StringPad(x, L, L+1);
|
---|
| 405 | if frmLabs.TabControl1.Tabs.Count > 1 then
|
---|
| 406 | aHead := aHead + x
|
---|
| 407 | else
|
---|
| 408 | if i = 0 then
|
---|
| 409 | continue
|
---|
| 410 | else
|
---|
| 411 | aHead := aHead + x;
|
---|
| 412 | end;
|
---|
| 413 | end;
|
---|
| 414 | if length(aHead) > 0 then
|
---|
| 415 | begin
|
---|
| 416 | FReportText.Lines.Add(aHead);
|
---|
| 417 | FReportText.Lines.Add('-------------------------------------------------------------------------------');
|
---|
| 418 | end;
|
---|
| 419 | for i := 0 to frmLabs.lvReports.Items.Count - 1 do
|
---|
| 420 | if frmLabs.lvReports.Items[i].Selected then
|
---|
| 421 | begin
|
---|
| 422 | aData := '';
|
---|
| 423 | aWPFlag := false;
|
---|
| 424 | ListItem := frmLabs.lvReports.Items[i];
|
---|
| 425 | aID := ListItem.SubItems[0];
|
---|
| 426 | if frmLabs.TabControl1.Tabs.Count > 1 then
|
---|
| 427 | begin
|
---|
| 428 | L := StrToIntDef(piece(uColumns[0],'^',6),10);
|
---|
| 429 | x := StringPad(ListItem.Caption, L, L+1);
|
---|
| 430 | aData := x;
|
---|
| 431 | end;
|
---|
[1693] | 432 | for j := 0 to LabRowObjects.ColumnList.Count - 1 do
|
---|
[830] | 433 | begin
|
---|
[1693] | 434 | aCol := TCellObject(LabRowObjects.ColumnList[j]).Handle;
|
---|
| 435 | if piece(aID,':',1) = piece(TCellObject(LabRowObjects.ColumnList[j]).Handle,':',1) then
|
---|
| 436 | if ListItem.Caption = (piece(TCellObject(LabRowObjects.ColumnList[j]).Site,';',1)) then
|
---|
[830] | 437 | begin
|
---|
| 438 | if (piece(uColumns[StrToInt(piece(aCol,':',2))],'^',7) = '1') and
|
---|
| 439 | (not (piece(uColumns[StrToInt(piece(aCol,':',2))],'^',4) = '1')) then
|
---|
| 440 | begin
|
---|
[1693] | 441 | FastAssign(TCellObject(LabRowObjects.ColumnList[j]).Data, aBasket);
|
---|
[830] | 442 | for k := 0 to aBasket.Count - 1 do
|
---|
| 443 | begin
|
---|
| 444 | L := StrToIntDef(piece(uColumns[StrToInt(piece(aCol,':',2))],'^',6),15);
|
---|
| 445 | x := StringPad(aBasket[k], L, L+1);
|
---|
| 446 | aData := aData + x;
|
---|
| 447 | end;
|
---|
| 448 | end;
|
---|
| 449 | end;
|
---|
| 450 | end;
|
---|
| 451 | FReportText.Lines.Add(aData);
|
---|
| 452 | cnt := cnt + 1;
|
---|
| 453 | if cnt > 40 then
|
---|
| 454 | begin
|
---|
| 455 | cnt := 0;
|
---|
| 456 | FReportText.Lines.Add('**PAGE BREAK**');
|
---|
| 457 | end;
|
---|
[1693] | 458 | for j := 0 to LabRowObjects.ColumnList.Count - 1 do
|
---|
[830] | 459 | begin
|
---|
[1693] | 460 | aCol := TCellObject(LabRowObjects.ColumnList[j]).Handle;
|
---|
| 461 | if piece(aID,':',1) = piece(TCellObject(LabRowObjects.ColumnList[j]).Handle,':',1) then
|
---|
| 462 | if ListItem.Caption = (piece(TCellObject(LabRowObjects.ColumnList[j]).Site,';',1)) then
|
---|
[830] | 463 | begin
|
---|
| 464 | if (piece(uColumns[StrToInt(piece(aCol,':',2))],'^',7) = '1') and
|
---|
| 465 | (piece(uColumns[StrToInt(piece(aCol,':',2))],'^',4) = '1') then
|
---|
| 466 | begin
|
---|
| 467 | aWPFlag := true;
|
---|
[1693] | 468 | FastAssign(TCellObject(LabRowObjects.ColumnList[j]).Data, aBasket);
|
---|
| 469 | FReportText.Lines.Add(TCellObject(LabRowObjects.ColumnList[j]).Name);
|
---|
[830] | 470 | cnt := cnt + 1;
|
---|
| 471 | for k := 0 to aBasket.Count - 1 do
|
---|
| 472 | begin
|
---|
[1693] | 473 | FReportText.Lines.Add('' + aBasket[k]);
|
---|
[830] | 474 | cnt := cnt + 1;
|
---|
| 475 | if cnt > 40 then
|
---|
| 476 | begin
|
---|
| 477 | cnt := 0;
|
---|
| 478 | FReportText.Lines.Add('**PAGE BREAK**');
|
---|
| 479 | end;
|
---|
| 480 | end;
|
---|
| 481 | end;
|
---|
| 482 | end;
|
---|
| 483 | end;
|
---|
| 484 | if aWPFlag = true then
|
---|
| 485 | begin
|
---|
| 486 | FReportText.Lines.Add('===============================================================================');
|
---|
| 487 | end;
|
---|
| 488 | end;
|
---|
| 489 | aBasket.Free;
|
---|
| 490 | end;
|
---|
[456] | 491 |
|
---|
| 492 | procedure TfrmLabPrint.cmdCancelClick(Sender: TObject);
|
---|
| 493 | begin
|
---|
| 494 | inherited;
|
---|
| 495 | Close;
|
---|
| 496 | end;
|
---|
| 497 |
|
---|
| 498 | end.
|
---|