~ubuntu-branches/ubuntu/vivid/mricron/vivid

//function GetCSAImageHeaderInfo (lFilename: string; lStart,lLength: integer; var lMosaicSlices,lMosaicX,lMosaicY: integer; var lv1,lv2,lv3: double): boolean;

199

procedure AplhaNumericStrDICOM (var lStr: kDICOMStr);

200

procedure PartialAcquisitionError;

201

function DICOMstr (i: integer; var lDICOMra: TDICOMrap;lOutname:string): string; overload;

202

function DICOMstr (i: integer; var lDICOMra: TDICOMrap): string; overload;

203

204

implementation

205

206

uses dicom,sysutils,define_types,dialogsx;

207

208

function YearsOld (lDICOM: DICOMdata): single;

209

var

210

dob: TDateTime;

211

lnoon:string;

212

begin

213

result := 0;

214

if length (lDICOM.PatientDoB) < 8 then

215

exit; //YYYYMMDD

216

try

217

lnoon := '120000';

218

dob := StudyDateTime (lDICOM.PatientDoB, lnoon);

219

result := (lDICOM.DateTime-dob)/365.2425;

220

except

221

result := 0;

222

end;

223

end;

224

function DICOMstr (i: integer; var lDICOMra: TDICOMrap;lOutname: string): string; overload;

225

var

226

lS: string;

227

begin

228

if lOutname <> '' then

229

lS := kTab+'SuggestedOutput:'+lOutname

230

else

231

lS := '';

232

233

result := lDICOMra^[i].Filename

234

+kTab+'SeriesNum:'+kTab+inttostr(lDICOMra^[i].SeriesNum)

235

+kTab+'AcquNum:'+inttostr(lDICOMra^[i].AcquNum)

236

+kTab+'ImageNum:'+inttostr(lDICOMra^[i].ImageNum)

237

+kTab+'Name:'+lDICOMra^[i].PatientName

238

+kTab+'DoB:'+lDICOMra^[i].PatientDoB

239

+kTab+'Gender:'+lDICOMra^[i].PatientGender

240

+kTab+'DateTime:'+DateTimeToStr(lDICOMra^[i].DateTime)

241

+kTab+'Age(Years):'+floattostr(YearsOld(lDICOMra^[i]))

242

+lS ;

243

244

end;

245

246

function DICOMstr (i: integer; var lDICOMra: TDICOMrap): string; overload;

247

begin

248

result := DICOMstr (i, lDICOMra,'')

249

end;

250

251

procedure PartialAcquisitionError;

252

begin

253

Msg('* Potential partial acquisition or improper segmentation of files');

254

{$IFDEF GUI}

255

Msg('* Possible solution: check ''Collapse folders'' in Help/Preferences and select directory that contains all images in subfolders');

256

{$ELSE}

257

Msg('* Possible solution: use -c Y and use folder containing subdirectories as input');

258

Msg('* or change .ini file to read: CollapseFolders=1');

259

{$ENDIF}

260

end;

261

262

function PhilipsPreciseVal (lPV, lRS, lRI,lSS: single): single;

263

begin

264

if (lRS*lSS) = 0 then //avoid divide by zero

265

result := 0

266

else

267

result := (lPV * lRS + lRI) / (lRS * lSS);

268

end;

269

270

procedure PhilipsPrecise (lRS, lRI,lSS: single; var lSlope,lIntercept: single; Precise: boolean);

271

var

272

l0,l1: single;

273

begin

274

//# === PIXEL VALUES =============================================================

275

//# PV = pixel value in REC file, FP = floating point value, DV = displayed value on console

276

//# RS = rescale slope, RI = rescale intercept, SS = scale slope

277

//# DV = PV * RS + RI FP = DV / (RS * SS)

278

if not Precise then begin //return DV not FP

279

lSlope := lRS;

280

if lSlope = 0 then

281

lSlope := 1;

282

lIntercept := lRI;

283

exit;

284

end; //if return DV

285

l0 := PhilipsPreciseVal (0, lRS, lRI,lSS);

286

l1 := PhilipsPreciseVal (1, lRS, lRI,lSS);

287

if l0 = l1 then begin

288

lSlope := 1;

289

lIntercept := 0;

290

exit;

291

end;

292

lIntercept := l0;

293

lSlope := l1-l0;

294

end;

295

296

297

function SecSinceMidnight(H,Min,S: integer): integer;

298

//86,400 sec per day

299

begin

300

301

result := 3600*(H) + 60* Min + S;//H not H-1 as our clock runs from 0..23 not 1..24

302

end;

303

304

function BogusDateTime: TDateTime;

305

begin

306

result := EncodeDate(1989,3,23) + (SecSinceMidnight(12,0,0) / 86400);

307

end;

308

309

function EncodeDateTime (Y,M,D,H,Min,S: integer): TDateTime;

310

begin

311

312

try

313

result := EncodeDate(Y,M,D) + (SecSinceMidnight(H,Min,S) / 86400);

314

except //impossible date - set to cold fusion date

315

result := BogusDateTime;

316

end;

317

end;

318

319

procedure DecodeDateTime (lDateTime: TDateTime; var Y,M,D,H,Min,S: word);

320

var

321

secs: integer;

322

begin

323

try

324

DecodeDate(lDateTime, Y, M, D);

325

except //unable to decode date - use cold fusion values

326

Y := 1989;

327

M := 3;

328

D := 23;

329

end;

330

Secs := round(Frac(lDateTime)*86400);

331

S := secs mod 60;

332

Min := (secs div 60) mod 60;

333

H := (secs div 3600);

334

end;

335

336

function StudyDateTime2Str (lDateTime: TDateTime):string;

337

var

338

Y,M,D,H,Min,S: word;

339

begin

340

DecodeDateTime (lDateTime,Y,M,D,H,Min,S);

341

result := PadStr (Y, 4)+ PadStr (M, 2)+PadStr (D, 2)+'_'+PadStr (H, 2)+ PadStr (Min, 2)+PadStr (S, 2);

342

end;

343

344

function StudyDateTime (lInStudyDate, lInStudyTime: kDICOMStr): TDateTime;

345

var lStr,lStudyDate, lStudyTime: string;

346

Y,M,D,H,Min,S: integer;

347

begin

348

result := 0;

349

if (length(lInStudyDate) < 8){YYYYMMDD} or (length(lInStudyTime) < 6) {hhmmss} then

350

exit;

351

//next compress string, e.g. Elscint saves time as 16:54:21

352

lStudyDate :='';

353

for S := 1 to length (lInStudyDate) do

354

if lInStudyDate[S] in ['0'..'9'] then

355

lStudyDate := lStudyDate + lInStudyDate[S];

356

lStudyTime :='';

357

for S := 1 to length (lInStudyTime) do

358

if lInStudyTime[S] in ['0'..'9'] then

359

lStudyTime := lStudyTime + lInStudyTime[S];

360

361

if (length(lStudyDate) < 8){YYYYMMDD} or (length(lStudyTime) < 6) {hhmmss} then

362

exit;

363

lStr := lStudyDate[1]+lStudyDate[2]+lStudyDate[3]+lStudyDate[4];

364

Y := strtoint(lStr);

365

lStr := lStudyDate[5]+lStudyDate[6];

366

M := strtoint(lStr);

367

lStr := lStudyDate[7]+lStudyDate[8];

368

D := strtoint(lStr);

369

lStr := lStudyTime[1]+lStudyTime[2];

370

H := strtoint(lStr);

371

lStr := lStudyTime[3]+lStudyTime[4];

372

Min := strtoint(lStr);

373

lStr := lStudyTime[5]+lStudyTime[6];

374

S := strtoint(lStr);

375

result := EncodeDateTime (Y,M,D,H,Min,S);

376

end;

377

378

procedure AplhaNumericStrDICOM (var lStr: kDICOMStr);

379

var

380

S: integer;

381

lOutStr: string;

382

begin

383

if length(lStr) < 1 then exit;

384

lOutStr := '';

385

386

for S := 1 to length (lStr) do

387

if lStr[S] in ['0'..'9','A'..'Z','a'..'z'] then

388

lOutStr := lOutStr+ lStr[S];

389

lStr := lOutStr;

390

end;

391

392

function GetCSAImageHeaderInfoRaw (lIsDTI: boolean; lFilename: string; lStart,lLength: integer; var li1,li2,li3: integer; var lf1,lf2,lf3: double): boolean;

393

//returns true if mosaic

394

//will return false for non-mosaics - even if the have DTI information!

395

//valid DTI signified by bval >= 0

396

const

397

kMaxFloats = 6;

398

var

399

//lZ: integer;

400

lByteRA: Bytep;

401

lNumarisTag: string;

402

lInFile: file;

403

lFloatRA: array [1..kMaxFloats] of double;

404

405

function Str2FloatLastNum ( lStr: string): boolean;

406

var

407

lFStr: string;

408

lP: integer;

409

begin

410

lFloatRA[1] := 1;

411

result := false;

412

if (length(lStr) < 1) then

413

exit;

414

lFStr := '';

415

lP := length(lStr);

416

while (lP > 0) and ((lFStr = '') or (lStr[lP] in ['+','-','0'..'9','.','e','E'])) do begin

417

if lStr[lP] in ['+','-','0'..'9','.','e','E'] then

418

lFStr := lStr[lP]+lFStr;

419

dec(lP);

420

end;

421

if (lFStr = '') then

422

exit;

423

try

424

lFloatRA[1] := strtofloat(lFStr);

425

except on EConvertError do

426

lFloatRA[1] := 1;

427

end;//except

428

result := true;

429

end; //function Str2Float

430

431

function NumarisPos (lStr: string; lStart: integer): integer; //read 16 bit short integer

432

var

433

lP,lLen,lMax,lMatch: integer;

434

begin

435

result := 0;

436

lLen := length(lStr);

437

lMax := lLength-lLen;

438

if (lStart < 1) or (lMax < 1) or (lLen < 1) then

439

exit;

440

for lP := lStart to lMax do begin

441

lMatch := 0;

442

while (lMatch < lLen) and (lStr[lMatch+1] = char( lByteRA[lP+lMatch]) ) do

443

inc(lMatch);

444

if lMatch = lLen then begin

445

if (lP < lMax) and (char( lByteRA[lP+lMatch]) = '"') then begin

446

lMatch := 0;//We want DiffusionGradientDirection, but not "DiffusionGradientDirection"

447

end else begin

448

result := lP;

449

exit;

450

end;

451

end;

452

end;

453

end; //function NumarisPos

454

455

function Str2FloatNum ( lStr: string; lnFloats: integer): boolean;

456

var

457

lFStr: string;

458

lP,lnF: integer;

459

begin

460

result := false;

461

if (length(lStr) < 1) or (lnFloats < 1) or (lnFloats > kMaxFloats) then

462

exit;

463

for lnF := 1 to lnFloats do

464

lFloatRA[lnF] := 1;

465

lStr := lStr + ' '; //terminator

466

lFStr := '';

467

lP := 1;

468

lnF:= 0;

469

while lP <= length(lStr) do begin

470

if lStr[lP] in ['+','-','0'..'9','.','e','E'] then

471

lFStr := lFStr + lStr[lP]

472

else if (lFStr <> '') then begin

473

inc(lnF);

474

try

475

lFloatRA[lnF] := strtofloat(lFStr);

476

except on EConvertError do

477

Msg('Unable to interpret '+lNumarisTag+ ' in '+extractfilename(lFilename));

478

end;//except

479

if lnF = lnFloats then begin

480

result := true;

481

exit;

482

end;

483

lFStr := '';

484

end;

485

inc(lP);

486

end;

487

end; //function Str2Float

488

489

function NumarisStr (lStr,lIDStr: string): string;

490

var

491

lP,lI: integer;

492

lPrevNum : boolean;

493

begin

494

result := '';

495

lP := NumarisPos(lStr,1);

496

if lP <1 then exit;

497

if length(lIDstr) > 0 then begin

498

lP := NumarisPos(lIDstr,lP);

499

if lP <1 then exit;

500

end;

501

result := '';

502

lI := lP + length(lStr);

503

lPrevNum := false;

504

While (lI < (lLength)) and (lByteRA^[lI] <> $CD) do begin

505

if char(lByteRA[lI]) in ['-','0'..'9','.','p','*'] then begin

506

result := result + char(lByteRA[lI]);

507

lPrevNum := true;

508

end else begin

509

if lPrevNum then result := result + ' ';

510

lPrevNum := false;

511

end;

512

inc(lI);

513

end;

514

end;

515

516

function NumarisInt1 (lStr,lIDStr: string; var lI1: integer): boolean;

517

begin

518

result := Str2FloatLastNum (NumarisStr(lStr,lIDStr));

519

if not result then exit;

520

lI1 := round(lFloatRA[1] );

521

end;

522

523

function NumarisFloat3 (lStr,lIDStr: string; var lF1,lF2,lF3: double): boolean;

524

begin

525

//showmessage(lStr+' '+NumarisStr(lStr,lIDStr));

526

result := Str2FloatNum (NumarisStr(lStr,lIDStr),3);

527

if not result then exit;

528

529

lF1 := (lFloatRA[1]);

530

lF2 := (lFloatRA[2]);

531

lF3 := (lFloatRA[3]);

532

end; //function NumarisFloat3

533

534

function NumarisInt2PStar (lStr,lIDStr: string; var lI1,lI2: integer): boolean;

535

var

536

lLen,lPos,lStarPos: integer;

537

lvStr,lpStarStr: string;

538

begin //a 96x96 mosaic is usually saved as '64*64', but in B13 you can see '96p*96' or '.95 96p*96'

539

result := false;

540

lvStr := NumarisStr(lStr,lIDStr);

541

lLen := length(lvStr);

542

if lLen < 4 then exit;//not found

543

lStarPos := 0;

544

for lPos := 1 to (lLen-1) do

545

if (lvStr[lPos] = '*') then

546

lStarPos := lPos;

547

if lStarPos = 0 then exit;

548

lpStarStr := '';

549

lPos := lStarPos -1;

550

while (lPos >= 1) and ((lpStarStr = '') or (lvStr[lPos] in ['0'..'9'])) do begin

551

lpStarStr := lvStr[lPos] + lpStarStr;

552

dec(lPos);

553

end;

554

lpStarStr := lpStarStr + ' ';

555

lPos := lStarPos+1;

556

while (lPos < lLen) and ((lpStarStr = '') or (lvStr[lPos] in ['0'..'9'])) do begin

557

lpStarStr := lpStarStr+lvStr[lPos];

558

inc(lPos);

559

end;

560

result := Str2FloatNum (lpStarStr,2);

561

562

if not result then exit;

563

lI1 := round(lFloatRA[1]);

564

lI2 := round(lFloatRA[2]);

565

//Msg(lvStr+' '+floattostr( lI1)+'x'+inttostr(lI2));

566

end;

567

568

begin // GetCSAImageHeaderInfoRaw

569

result := false;

570

if (lLength < 1) then

571

exit;

572

if FSize(lFilename) <= (lStart+lLength) then

573

exit;

574

li1 := -1; //impossible - should be >=0

575

li2 := 0;

576

li3 := 0;

577

lf1 := 0;//impossible, therefore not DTI - should be -1..1

578

lf2 := 0;//impossible, therefore not DTI

579

lf3 := 0;//impossible, therefore not DTI

580

GetMem(lByteRA,lLength);

581

AssignFile(lInFile, lFileName);

582

//Msg('fz '+lFilename);

583

FileMode := 0; //Set file access to read only

584

Reset(lInFile, 1);

585

seek(lInFile,lStart);

586

BlockRead(lInFile, lByteRA^[1], lLength);

587

CloseFile(lInFile);

588

FileMode := 2;

589

if lIsDTI then begin

590

591

result := NumarisInt1 ('B_value','IS',li1);

592

//result := NumarisInt1 ('B_value','LO',li1);

593

if li1 > 0 then begin

594

NumarisFloat3('DiffusionGradientDirection','FD',lf1,lf2,lf3);

595

//vx(lf1,lf2,lf3,123);

596

end;

597

end else begin //get mosaic info

598

//fx(lStart,lLength);

599

result := NumarisInt1 ('NumberOfImagesInMosaic','US',li1);

600

if result then begin

601

NumarisInt2pStar ('AcquisitionMatrixText','SH', li2,li3);

602

NumarisFloat3('SliceNormalVector','FD',lf1,lf2,lf3);

603

end;

604

end;

605

FreeMem(lByteRA);

606

end;//GetCSAImageHeaderInfoRaw

607

608

function GetCSAImageHeaderInfoDTI (lFilename: string; lStart,lLength: integer; var lBval: integer; var ldti1,ldti2,ldti3: double): boolean;

609

var

610

li2,li3: integer; //not used

611

begin

612

result := GetCSAImageHeaderInfoRaw (TRUE,lFilename, lStart,lLength, lBval,li2,li3, ldti1,ldti2,ldti3);

613

end;

614

615

function GetCSAImageHeaderInfo (lFilename: string; lStart,lLength: integer; var lMosaicSlices,lMosaicX,lMosaicY: integer; var lv1,lv2,lv3: double): boolean;

616

begin

617

result := GetCSAImageHeaderInfoRaw (FALSE,lFilename, lStart,lLength, lMosaicSlices,lMosaicX,lMosaicY, lv1,lv2,lv3);

618

end; *)

619

620

621

procedure clear_dicom_data (var lDicomdata:Dicomdata);

622

var

623

lI: integer;

624

begin

625

with lDicomData do begin

626

lDicomData.CSAImageHeaderInfoPos := 0;

627

lDicomData.CSAImageHeaderInfoSz := 0;

628

for lI := 1 to 6 do

629

Orient[lI] := 0;

630

DateTime := BogusDateTime;

631

ManufacturerID := 0;

632

kV := 0;

633

//ImplementationVersion := 0;

634

Vers0018_1020 := 0;

635

AngulationFH := 0;

636

AngulationRL := 0;

637

AngulationAP := 0;

638

nDTIdir := 0;

639

nOrder := 0;

640

PhilipsSliceOrient := 'NA';

641

PhaseEncoding := 'NA';

642

PatientPos := 'NA';

643

for lI := 1 to kMaxDTIdir do begin

644

DTI[lI].Bval := -1;

645

DTI[lI].v1 := 0;

646

DTI[lI].v2 := 0;

647

DTI[lI].v3 := 0;

648

(* DTI[lDICOMdata.nDTIdir].Bval := -1;

649

DTI[lDICOMdata.nDTIdir].v1 := 0;

650

DTI[lDICOMdata.nDTIdir].v2 := 0;

651

DTI[lDICOMdata.nDTIdir].v3 := 0; *)

652

end;

653

SiemensDICOMDTI := true;

654

SiemensDICOMDTICSA := false;

655

file4D := false;

656

PatientName := 'NO NAME';

657

PatientDoB := 'NO DOB';

658

PatientGender := 'NA';

659

//PatientID := 'NO ID';

660

StudyDate := '';

661

StudyTime := '';

662

SecSinceMidnight := 0;

663

//AcqTime := '';

664

//ImgTime := '';

665

TR := 0;

666

TE := 0;

667

//Echo := 0;

668

//kV := 0;

669

//mA := 0;

670

//Rotate180deg := false;

671

//MaxIntensity := 0;

672

//MinIntensity := 0;

673

//MinIntensitySet := false;

674

FloatData := false;

675

ImageNum := -1;

676

SlicesPer3DVol := 0;

677

SiemensInterleaved := 2; //0=no,1=yes,2=undefined

678

SiemensSlices := 0;

679

SiemensMosaicX := 1;

680

SiemensMosaicY := 1;

681

IntenScale := 1;

682

IntenIntercept := 0;

683

SeriesNum := 1;

684

AcquNum := 0;

685

ImageNum := 1;

686

//Accession := 1;

687

PlanarConfig:= 0; //only used in RGB values

688

//runlengthencoding := false;

689

//CompressSz := 0;

690

//CompressOffset := 0;

691

SamplesPerPixel := 1;

692

//WindowCenter := 0;

693

//WindowWidth := 0;

694

XYZmm[1] := 1;

695

XYZmm[2] := 1;

696

XYZmm[3] := 1;

697

XYZdim[1] := 1;

698

XYZdim[2] := 1;

699

XYZdim[3] := 1;

700

XYZdim[4] := 1;

701

lDicomData.XYZori[1] := 0;

702

lDicomData.XYZori[2] := 0;

703

lDicomData.XYZori[3] := 0;

704

ImageStart := 0;

705

Little_Endian := 0;

706

Allocbits_per_pixel := 16;//bits

707

//Storedbits_per_pixel:= Allocbits_per_pixel;

708

//StudyDatePos := 0;

709

//Spacing:=0;

710

//Thickness:= 0;//1391

711

Location:=0;

712

//Modality:='MR';

713

//ProtocolName := '';

714

//serietag:='';

715

PatientPosX := 0;//1392

716

PatientPosY := 0;//1392

717

PatientPosZ := 0;//1392

718

JPEGLossyCpt := false;

719

JPEGLosslessCpt := false;

720

SignedData := true;

721

CompressOffset := 0;

722

CompresssZ := 0;

723

end;

724

end;

725

726

function DICOMinterslicedistance(var lDicomdata1,lDicomdata2:Dicomdata): single;//1392

727

begin

728

result := sqrt(sqr(lDICOMdata1.PatientPosX-lDICOMdata2.PatientPosX)

729

+sqr(lDICOMdata1.PatientPosY-lDICOMdata2.PatientPosY)

730

+sqr(lDICOMdata1.PatientPosZ-lDICOMdata2.PatientPosZ));

731

732

end;

733

734

end.

735

Older »