diff --git a/uploadNeuroDB/upload b/uploadNeuroDB/upload deleted file mode 100644 index 149687bab..000000000 --- a/uploadNeuroDB/upload +++ /dev/null @@ -1,717 +0,0 @@ -#! /usr/bin/perl -# $Id: upload,v 1.14 2006/12/21 17:58:59 moi Exp $ - -CURRENTLY BROKEN . DO not USE! - - -=pod - This script interacts with the NeuroDB database system. It will connect to/deal with/ modify contents of the - following tables: - session, parameter_file, parameter_type, parameter_type_category, files, mri_staging, notification_spool -=cut - -# fixme Mincinfo_wrapper path -# fixme add a check for all programms that will be used -# fixme add a check for registered protocols... -# fixme the Phantom problem - -use strict; -use Carp; -use Getopt::Tabular; -use FileHandle; -use File::Basename; -use Data::Dumper; -use FindBin; -use Cwd qw/ abs_path /; -use MNI::Startup; - -# These are the NeuroDB modules to be used -use lib "$FindBin::Bin"; -use NeuroDB::File; -use NeuroDB::MRI; -use NeuroDB::DBI; -use NeuroDB::Notify; - -# Turn on autoflush for standard output buffer so that we immediately see the results of print statements. -$|++; - -## Starting the program -my $Debug = 1; # default for now -my $profile = undef; # this should never be set unless you are in a stable production environment -my $reckless = 0; # this is only for playing and testing. Don't set it to 1!!! -my $NewScanner = 1; # This should be the default unless you are a control freak -my $CandID = undef; # fixme -my $xlog = 0; # default should be 0 - - -my @opt_table = ( - @DefaultArgs, - ["Basic options", "section"], - ["-profile","string",1, \$profile, "Specify the name of the config file which resides in ../dicom-archive/.loris_mri"], - - ["Advanced options", "section"], - ["-reckless", "boolean", 1, \$reckless,"Put everything in DB without caring about protocols"], - ["-newScanner", "boolean", 1, \$NewScanner, "By default the uploader will register a new scanner if the data you upload requires it. You can turn this off at your own risk."], - ["-scannerID", "string", 1, \$CandID, "This is PHANTOM data belonging the scanner with the given ID."], - - ["Other options", "section"], - ["-xlog", "boolean", 1, \$xlog, "Open an xterm with a tail on the current log file."], - ); - -my $Help = < [options] - upload -help to list options -USAGE - -&Getopt::Tabular::SetHelp($Help, $Usage); -&Getopt::Tabular::GetOptions(\@opt_table, \@ARGV) || exit 1; - -# input option error checking -{ package Settings; do "$ENV{LORIS_CONFIG}/.loris_mri/$profile" } -if ($profile && !@Settings::db) { print "\n\tERROR: You don't have a configuration file named '$profile' in: $ENV{LORIS_CONFIG}/.loris_mri/ \n\n"; exit 33; } -if(!$ARGV[0] || !$profile) { print "\n\tERROR: You must specify a study directory and a valid profile.\n\n"; exit 33; } - -my $study_dir = abs_path($ARGV[0]); - -##################################################################################################### -# These settings are in a config file (profile) -my $data_dir = $Settings::data_dir; -my $prefix = $Settings::prefix; -my $mail_user = $Settings::mail_user; -my $get_dicom_info = $Settings::get_dicom_info; - -# this should always be defined using the data_dir set above -my $pic_dir = $data_dir.'/pic'; -my $jiv_dir = $data_dir.'/jiv'; - -# create temp dir -if (! -e $TmpDir) { mkdir($TmpDir, 0770); } else { if(! -w $TmpDir) { $TmpDir .= 'a'; mkdir($TmpDir, 0770); } } - -# create logdir(if !exists) and logfile -my @temp = split(/\//, $TmpDir); -my $templog = $temp[$#temp]; -my $LogDir = "$data_dir/logs"; -if (!-d $LogDir) { mkdir($LogDir, 0770); } -my $logfile = "$LogDir/$templog.log"; - -# if xlog is set fork a tail on the actual log file. -my $childPID; -if ($xlog) { - $childPID = fork(); - if($childPID == 0) { exec("xterm -geometry 105x50 -e tail -f $logfile"); exit(0); - } -} - -# log file info -my $message; -my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time); -my $date = sprintf("%4d-%02d-%02d %02d:%02d:%02d\n",$year+1900,$mon+1,$mday,$hour,$min,$sec); -open LOG, ">$logfile"; -LOG->autoflush(1); -print LOG " -##################################################################################################### - - automated DICOM data upload - -##################################################################################################### -"; -print LOG "### Date and time of upload : $date"; -print LOG "### Location of source data : $study_dir\n"; -print LOG "### The following temporary dir has been created : $TmpDir\n"; - -# establish database connection -my $dbh = &NeuroDB::DBI::connect_to_db(@Settings::db); -print LOG "### Successfully connected to database \n\n"; - - -##################################################################################################### -# innomed section -my $exclude = "ocalizer"; # fixme make case independent - - - - -##################################################################################################### - - -# make the notifier object -my $notifier = NeuroDB::Notify->new(\$dbh); - -# convert the dicom data to minc -&dicom_to_minc($study_dir); - -# get list of mincs -my @minc_files = (); -&get_mincs(\@minc_files); - -# fixme this is not necessary anymore once it does dicomTars -# confirm only one study passed in -unless(&confirm_single_study(\@minc_files)) { print LOG "More than one study passed in - stopping\n"; print "More than one study passed in - stopping\n"; exit 1; } - -# concat_mri -&concat_mri(\@minc_files); - -# refresh list of mincs getting rid of everything with less than two slices -# fixme profiles will exclude these since they take care of localizers -&refresh_mincs(\@minc_files); - -my $mcount = $#minc_files + 1; -print "\nNumber of MINC files that will be considered for inserting into the database: $mcount\n"; -# If no good data was found stop processing and write error log. -if ($mcount < 1) { - $message = "\nNo data could be converted into valid MINC files. Scouts will not be considered! \n" ; - &writeErrorLog($logfile, $message, 2); - print $message; - exit 2; -} - -############################################### LOOP through MINCs ########################################### -my $valid_study = 0; -my (@headers, $minc, $acq_date, $psc, $subjectIDsref, $patientName); - -# fixme -my $visitLabel; - -foreach $minc (@minc_files) { - -# create File object - my $file = NeuroDB::File->new(\$dbh); -# load File object - print "\n-- Loading file from disk $minc\n" if $Debug; - $file->loadFileFromDisk($minc); -# map dicom fields - print "\n-- mapping DICOM parameter for $minc\n" if $Debug; - NeuroDB::MRI::mapDicomParameters(\$file); - -# compute the md5 hash - print "\n-- computing md5 hash for MINC body.\n" if $Debug; - my $md5hash = &NeuroDB::MRI::compute_hash(\$file); - print " md5: $md5hash\n\n" if $Debug; - $file->setParameter('md5hash', $md5hash); - next unless NeuroDB::MRI::is_unique_hash(\$file); - -# get PSC information using whatever field contains the site string - print "\n-- getting PSC\n" if $Debug; - my ($center_name, $centerID) = NeuroDB::MRI::getPSC($file->getParameter('patient_id'), \$dbh); - $psc = $center_name; - print " Center name: $center_name\n CenterID: $centerID\n" if $Debug; - -# get ids from the headers lookup PSCID from mincheader in patient:identification - print "\n-- getting subject ids\n" if $Debug; - my $PSCID = $file->getParameter('patient_id'); - - # Fixme - # $PSCID =~ s///; - - #### IF THERE IS NO CandID to be found, the candidate does not exist in your database! - - $CandID = lookupCandIDFromPSCID($PSCID, \$dbh) unless $CandID; - if (!$CandID) { - $message = - "\n The candidate could not be considered for uploading, since s/he is not registered in your database. \n The PSCID is : $PSCID\n The Institution Name is : $instName\n\n"; - &writeErrorLog($logfile, $message, 3); - print $message; - exit 3; - } - -# get the ScannerID - print "\n-- getting scannerID\n" if $Debug; -# Get more info about the scanner and site - my $instName = $file->getParameter('institution_name'); - my $scannerID = NeuroDB::MRI::findScannerID($file->getParameter('manufacturer'), - $file->getParameter('manufacturer_model_name'), - $file->getParameter('device_serial_number'), - $file->getParameter('software_versions'), - $centerID, - \$dbh, - $NewScanner - ); - $file->setParameter('ScannerID', $scannerID); - print " ScannerID: $scannerID\n" if $Debug; - - -# fixme This will actually insert a new session every time - if(!defined($visitLabel)) { - $visitLabel = lookupNextVisitLabel($CandID, \$dbh); - } - - $patientName = $PSCID . "_" . $CandID . "_" . $visitLabel; - $subjectIDsref = NeuroDB::MRI::getSubjectIDs($patientName, $scannerID, \$dbh); - print " Identified CandID : $subjectIDsref->{'CandID'}\n"; - print " Visit label : $subjectIDsref->{'visitLabel'}\n"; - - # print Dumper($subjectIDsref) if $Debug; - -# get Subproject ID -# fixme ask Jon -# This will only work for nihpd: my $objective = NeuroDB::MRI::getObjective($subjectIDsref, \$dbh); - print "\n-- getting subproject ID\n" if $Debug; - my $objective = 1; - print " subproject: $objective\n" if $Debug; - - # get session ID - print "\n-- getting session ID\n" if $Debug; - my ($sessionID, $requiresStaging) = NeuroDB::MRI::getSessionID($subjectIDsref, $file->getParameter('study_date'), \$dbh, $objective); - $file->setFileData('SessionID', $sessionID); - $file->setFileData('PendingStaging', $requiresStaging); - - # register into the mri staging table if staging is required - if($requiresStaging) { - my $quotedPatientName = $dbh->quote($patientName); - my $studyDate = $file->getParameter('study_date'); - - my $query = "SELECT COUNT(*) AS counter FROM mri_staging WHERE SessionID=$sessionID AND PatientName=$quotedPatientName AND StudyDate=UNIX_TIMESTAMP('$studyDate') AND Resolution IS NULL"; - my $sth = $dbh->prepare($query); - $sth->execute(); - my $rowhr = $sth->fetchrow_hashref(); - if($rowhr->{'counter'} == 0) { - $query = "INSERT INTO mri_staging SET SessionID=$sessionID, PatientName=$quotedPatientName, StudyDate=UNIX_TIMESTAMP('$studyDate')"; - $dbh->do($query); - $notifier->spool('mri staging required', "Data labelled $quotedPatientName requires staging"); - } - } - - print " SessionID: $sessionID\n Staging: $requiresStaging\n" if $Debug; - - $file->setFileData('CoordinateSpace', 'native'); - $file->setFileData('OutputType', 'native'); - $file->setFileData('FileType', 'mnc'); - - # get acquisition protocol (identify the volume) - print "-- getting acquisition protocol\n" if $Debug; - my $acquisitionProtocol = &NeuroDB::MRI::identify_scan_db($center_name, $objective, \$file, \$dbh); - - ##################### Register only selected scans into the database ##################################### - - if ($reckless || $acquisitionProtocol eq 't1' or $acquisitionProtocol eq 't2' or $acquisitionProtocol eq 'pd') { - - # convert the textual scan_type into the scan_type id - my $acquisitionProtocolID = &NeuroDB::MRI::scan_type_text_to_id($acquisitionProtocol, \$dbh); - $file->setFileData('AcquisitionProtocolID', $acquisitionProtocolID); - - print "Acq protocol: $acquisitionProtocol ID: $acquisitionProtocolID\n" if $Debug; - - # set Date_taken = last modification timestamp (can't seem to get creation timestamp) - my $Date_taken = (stat($minc))[9]; - - # set acq_date for notification and so on - $acq_date = $file->getParameter('study_date'); - - # rename and move files - my $minc_protocol_identified = &move_minc(\$minc, $subjectIDsref, $acquisitionProtocol); - print "new NAME: ".$minc_protocol_identified ."\n" if $Debug; - $file->setFileData('File', $minc); - - # register into the db - print "Registering file into db\n" if $Debug; - my $fileID; - $fileID = &NeuroDB::MRI::register_db(\$file); - - - print "FileID: $fileID\n" if $Debug; - - # update mri_acquisition_dates table - &update_mri_acquisition_dates($sessionID, $acq_date, \$dbh); - - # jivify - print "Making JIV\n" if $Debug; - &NeuroDB::MRI::make_jiv(\$file, $data_dir, $jiv_dir); - - # make the browser pics - print "Making browser pics\n" if $Debug; - &NeuroDB::MRI::make_pics(\$file,$data_dir, $pic_dir); - - # mark the study as valid because at least one volume converted successfully. - $valid_study = 1; - - } ##################### end if clause to exclude non identified scans. ############################ - else { - print "\n\n ############# File was a $acquisitionProtocol and had to be discarded! ############# \n"; - } - - # add series notificatin - $notifier->spool('mri new series', $file->getParameter('patient_id') . "\tacquired " . $file->getParameter('acquisition_date') . "\t" . $file->getParameter('series_description'), $centerID); - - print "Finished file\n" if $Debug; - -} # end foreach $minc - -# &move_dicoms(\%minc_ids, $study_dir, $psc); -# Fixme dicoms are no longer moved. They stay wherever they came from. Function will be removed - -# fixme notify people -# ¬ify($study_dir, \%minc_ids, \@headers, $acq_date, $psc, $valid_study); - -if($valid_study) { - # spool a new study message - $notifier->spool('mri new study', $patientName. "\tacquired ". $acq_date); -} else { - # spool a failure message - $notifier->spool('mri invalid study', $patientName. " acquired ". $acq_date ." was deemed invalid\n\n". $study_dir); -} - -# make final logfile name -my $final_logfile = $psc."_".$acq_date.'_'.$subjectIDsref->{'CandID'}; -unless($acq_date && $subjectIDsref->{'CandID'}) { $final_logfile .= '_'.$temp[$#temp]; } -$final_logfile .= '.log.gz'; - -# if there are leftovers, dump them in the trashbin -my @leftovers = `\\ls -1 $TmpDir`; -if(scalar(@leftovers) > 0) { - my $trashdir = $data_dir . '/trashbin/' . $temp[$#temp]; - print LOG "LEFTOVERS: ".scalar(@leftovers)."\nMoving leftovers to $trashdir\n"; - `mkdir -p -m 770 $trashdir`; - `mv $TmpDir/* $trashdir`; - - open MAIL, "| mail $mail_user"; - print MAIL "Subject: [URGENT Automated] upload NeuroDB leftovers!\n"; - print MAIL "Moved some leftovers to $trashdir\n"; - print MAIL "Log of process in $data_dir/logs/$final_logfile\n"; - print MAIL "Files left over:\n".join("", @leftovers)."\n"; - close MAIL; -} - -print LOG "Done! Removing $TmpDir.\n"; -close LOG; - -`gzip -9 $logfile`; -my $cmd = "mv $logfile.gz $data_dir/logs/$final_logfile"; -`$cmd`; - -# kill the xterm with the tail on log -if ($xlog) { -# `kill -9 $childPID`; - kill 1, $childPID; -} - -############################################################################## -#### FUNCTIONS USED BY ABOVE EVENTUALLY MOVE TO SEPARATE LIBRARY ############# -############################################################################## -# this is a useful function that will close the log and write error messages in case of abnormal program termination -sub writeErrorLog { - my ($logfile, $message, $failStatus, ) = @_; - print LOG $message; - print LOG "program exit status: $failStatus"; - `cat $logfile >> $LogDir/error.log`; - close LOG; - `rm -f $logfile`; -} - -# this function is a workaround in order not to change too much in MRI.pm because there is no -# CandID for every study. -sub lookupCandIDFromPSCID { - my ($pscid, $dbhr) = @_; - my $candid = 0; - - my $sth = $${dbhr}->prepare("SELECT CandID FROM candidate WHERE PSCID=".$${dbhr}->quote($pscid)); - $sth->execute(); - if($sth->rows > 0) { - my @row = $sth->fetchrow_array(); - $candid = int($row[0]); - } - - return $candid; -} - - -sub lookupNextVisitLabel { - my ($CandID, $dbhr) = @_; - my $visitLabel = 1; - - my $sth = $${dbhr}->prepare("SELECT Visit_label FROM session WHERE CandID=$CandID ORDER BY ID DESC LIMIT 1"); - $sth->execute(); - if($sth->rows > 0) { - my @row = $sth->fetchrow_array(); - $visitLabel = $row[0] + 1; - } - - return $visitLabel; -} - - -sub update_mri_acquisition_dates { - my ($sessionID, $acq_date, $dbhr) = @_; - $dbh = $$dbhr; - - # get the registered acquisition date for this session - my $query = "SELECT s.ID, m.AcquisitionDate from session AS s left outer join mri_acquisition_dates AS m on (s.ID=m.SessionID) WHERE s.ID='$sessionID' and (m.AcquisitionDate > '$acq_date' OR m.AcquisitionDate is null) AND '$acq_date'>0"; - my $sth = $dbh->prepare($query); - $sth->execute(); - - # if we found a session, it needs updating or inserting, so we use replace into. - if($sth->rows > 0) { - my $query = "REPLACE INTO mri_acquisition_dates SET AcquisitionDate='$acq_date', SessionID='$sessionID'"; - $dbh->do($query); - } -} - -sub confirm_single_study { - my ($minc_files_ref) = @_; - - my %hash; - foreach my $minc_file (@$minc_files_ref) { - my $cmd = "Mincinfo_wrapper -quiet -tab -attvalue dicom_0x0020:el_0x000d -attvalue patient:full_name $minc_file"; - my $key = `$cmd`; - $hash{$key} = 1; - } - if(scalar(keys(%hash)) > 1) { return 0; } - return 1; -} - - -sub which_directory -{ - my ($subjectIDsref) = @_; - - my %subjectIDs = %$subjectIDsref; - my $dir = $data_dir; - - if($subjectIDs{'pscid'}) { - $dir = "$dir/assembly/$subjectIDs{'CandID'}/$subjectIDs{'visitNo'}/mri"; - } else { - $dir = "$dir/assembly/$subjectIDs{'CandID'}/$subjectIDs{'visitLabel'}/mri"; - } - - $dir =~ s/ //; - return $dir; -} - -## get_acqusitions($study_dir, \@acquisitions) -> puts list of acq dirs in @acquisitions -sub get_acquisitions -{ - my ($study_dir, $acquisitions) = @_; - @$acquisitions = split("\n", `find $study_dir -type d -name \\*.ACQ`); - - print LOG "Acquisitions: ".join("\n", @$acquisitions)."\n"; - -} - -## dicom_to_minc($study_dir) -> converts the dicoms to mincs -## the old version of this was : -# my $d2m_cmd = "find $study_dir -type f | $get_dicom_info -studyuid -series -echo -image -file -stdin | sort -n -k1 -k2 -k3 -k4 | cut -f 5 | dcm2mnc -dname \'\' -stdin -clobber -cmd \"gzip\" $TmpDir"; -# you can do it either way. I found it to be more useful to exclude scouts and localizers since they get discarded anyhow... and there was the Kupio problem with -sub dicom_to_minc -{ - my ($study_dir) = @_; - - ### 1 2 3 4 5 6 - my $d2m_cmd = "find $study_dir -type f | $get_dicom_info -studyuid -series -echo -image -file -series_description -stdin | sort -n -k2 -k6 -k3 -k4 | grep -v $exclude |cut -f 5 | dcm2mnc -dname '' -stdin -clobber $TmpDir"; - my $d2m_log = `$d2m_cmd`; - - if($? > 0) { - my $exit_code = $? >> 8; - # dicom_to_minc failed... don't keep going, just email. - open MAIL, "| mail $mail_user"; - print MAIL "Subject: [URGENT Automated] uploadNeuroDB: dicom->minc failed\n"; - print MAIL "Exit code $exit_code received from:\n$d2m_cmd\n"; - close MAIL; - - croak("dicom_to_minc failure, exit code $exit_code"); - } - print LOG "### Dicom to MINC:\n$d2m_log"; -} - -# returns a sorted list of mincfiles fixme @dates_list -sub get_mincs -{ - my ($minc_files) = @_; - - @$minc_files = (); - opendir TMPDIR, $TmpDir; - my @files = readdir TMPDIR; - closedir TMPDIR; - - my @files_list; - my @dates_list; - foreach my $file (@files) { - next unless $file =~ /\.mnc(\.gz)?$/; - push @files_list, `Mincinfo_wrapper -quiet -tab -file -date $TmpDir/$file`; - } - open SORTER, "|sort -nk2 | cut -f1 > $TmpDir/sortlist"; - print SORTER join("", @files_list); - close SORTER; - - open SORTLIST, "<$TmpDir/sortlist"; - while(my $line = ) { - chomp($line); - push @$minc_files, $line; - } - close SORTLIST; - - `rm -f $TmpDir/sortlist`; - print LOG "\n### These MINC files have been created: \n".join("\n", @$minc_files)."\n"; -} - -# fixme this is the place where you can exclude things... from uploading -sub refresh_mincs -{ - my ($minc_files) = @_; - - @$minc_files = (); - opendir TMPDIR, $TmpDir; - my @files = readdir TMPDIR; - closedir TMPDIR; - - my @files_list; - my @dates_list; - foreach my $file (@files) { - next unless $file =~ /\.mnc(\.gz)?$/; - next unless `mincinfo -dimlength xspace $TmpDir/$file` > 5; - next unless `mincinfo -dimlength yspace $TmpDir/$file` > 5; - next unless `mincinfo -dimlength zspace $TmpDir/$file` > 5; - push @files_list, `Mincinfo_wrapper -quiet -tab -file -date $TmpDir/$file`; - } - open SORTER, "|sort -nk2 | cut -f1 > $TmpDir/sortlist"; - print SORTER join("", @files_list); - close SORTER; - - open SORTLIST, "<$TmpDir/sortlist"; - while(my $line = ) { - chomp($line); - push @$minc_files, $line; - } - close SORTLIST; - - `rm -f $TmpDir/sortlist`; - print LOG "\n### The following MINC files will have a mincinfo -dimlength > 5 for x,y and z: \n".join("\n", @$minc_files)."\n"; -} - -## concat_mri(\@minc_files, $psc) -> concats & removes pre-concat mincs -sub concat_mri -{ - my ($minc_files) = @_; - - mkdir("$TmpDir/concat", 0770); - my $cmd = "concat_mri.pl -maxslicesep 3.1 -compress -postfix _concat -targetdir $TmpDir/concat ".join(' ', @$minc_files); - my $log = `$cmd`; - - # fixme print LOG "Concat:\n $cmd\n$log\n" if $Debug; - - my $concat_count = `\\ls -1 $TmpDir/concat | wc -l`+0; - - if($concat_count > 0) - { - `mv $TmpDir/concat/*.mnc.gz $TmpDir`; - } - - `rmdir $TmpDir/concat`; - - print LOG "### Count for concatenated MINCs: $concat_count new files created\n"; -} - -## move_minc(\$minc, \%minc_ids, $minc_type) -> renames and moves $minc -sub move_minc -{ - my ($minc, $subjectIDsref, $minc_type) = @_; - - my ($new_name, $version); - my %subjectIDs = %$subjectIDsref; - - # figure out where to put the files - my $dir = which_directory($subjectIDsref); - - `mkdir -p -m 770 $dir/native`; - - # figure out what to call files - my @exts = split(/\./, $$minc); - shift @exts; - my $extension = join('.', @exts); - - my $concat = ""; - $concat = '_concat' if $minc =~ /_concat/; - - my $new_dir = "$dir/native"; - - $version = 1; - $new_name = $prefix."_".$subjectIDs{'CandID'}."_".$subjectIDs{'visitLabel'}."_".$minc_type."_".$version.$concat.".$extension"; - $new_name =~ s/ //; - - while(-e "$new_dir/$new_name") - { - $version = $version + 1; - - $new_name = $prefix."_".$subjectIDs{'CandID'}."_".$subjectIDs{'visitLabel'}."_".$minc_type."_".$version.$concat.".$extension"; - $new_name =~ s/ //; - } - - $new_name = "$new_dir/$new_name"; - - my $cmd = "mv $$minc $new_name"; - `$cmd`; - - print LOG "File $$minc \n moved to:\n $new_name\n"; - - $$minc = $new_name; - return $new_name; -} - -## jivify($minc, \%minc_ids) -> create jiv files and put them in the right place -sub jivify -{ - my ($minc, $minc_ids_ref) = @_; - print Dumper($minc_ids_ref); - my (@fileparts, $mincbase, @jiv_files, $file, $log, $cmd, $dispid, $visitNo); - - if($$minc_ids_ref{'pscid'} eq 'phantom' || $$minc_ids_ref{'pscid'} eq 'living_phantom' || $$minc_ids_ref{'pscid'} eq 'mri_test' || $$minc_ids_ref{'pscid'} =~ /test/i) { - $dispid = $$minc_ids_ref{'dccid'}.'_'.$$minc_ids_ref{'pscid'}; - $visitNo = $acq_date; - } else { - $dispid = $$minc_ids_ref{'dccid'}; - $visitNo = $$minc_ids_ref{'visitNo'}; - } - - my $jiv = "$data_dir/jiv/$dispid/$visitNo/native"; - $jiv =~ s/ //g; - `mkdir -p -m 770 $jiv`; - - $log = `minc2jiv.pl -quiet -force -slices -output_path $jiv $minc`; - - # make jpgs - my $pik = "$data_dir/pic/$dispid/$visitNo/native"; - $pik =~ s/ //g; - `mkdir -p -m 770 $pik`; - - @fileparts = split(/\//, $minc); - $mincbase = $fileparts[$#fileparts]; - @fileparts = split(/\./, $mincbase); - $mincbase = $fileparts[0]; - $mincbase =~ s/ //g; - print LOG $cmd = "mincpik -axial $minc $pik/".$mincbase."_axial.jpg"; `$cmd`; - print LOG "\n"; - print LOG $cmd = "mincpik -sagittal $minc $pik/".$mincbase."_sagittal.jpg"; `$cmd`; - print LOG "\n"; - print LOG $cmd = "mincpik -coronal $minc $pik/".$mincbase."_coronal.jpg"; `$cmd`; - print LOG "\n"; - - print LOG "JIVified $minc into $jiv\n"; -} - -## Fixme: This has to become archive DICOM -## move_dicoms($study_dir, $psc, $valid_study, $acq_date) -> moves dicoms to incoming -#sub move_dicoms -#{ -# my ($subjectIDsref, $study_dir) = @_; -# -# my $dir = which_directory($subjectIDsref); -# $dir .= '/incoming'; -# `mkdir -p -m 770 $dir`; -# -# my $study = basename($study_dir); -# -# my $cmd = "cd $study_dir/.. ; tar -cvf $dir/$study.tar $study"; -## my $cmd = "cp -R $study_dir $dir"; -# print LOG "\nCopy DICOMs: \n$cmd\n" if $Debug; -# -# `$cmd`; -#}