This is an old revision of the document!
Obteniendo los PatientID
Lo primero es sacar los Patient ID de cada MRI. Primero saco los sujetos del proyecto y los asocio a los IDs almacenados como label del experimento.
[osotolongo@brick03 mri_face]$ xnatapic list_subjects --project_id unidad --label > xnat_subjects.list
[osotolongo@brick03 mri_face]$ while read -r line; do sbj=$(echo ${line} | awk -F"," '{print $1}'); slbl=$(echo ${line} | awk -F"," '{print $2}'); xpr=$(xnatapic list_experiments --project_id unidad --subject_id ${sbj} --modality MRI --label); echo "${slbl},${xpr}"; done < xnat_subjects.list | awk -F"," '{print $1","$3}' > sbj_ids.csv
[osotolongo@brick03 mri_face]$ head sbj_ids.csv
20211269,D18290542
20211480,D21572561
20211176,D14074193
20151338,D21587192
20211523,D21587226
20211401,D21587147
20211281,D21580074
20210716,D21587448
20081210,D21582920
20211482,D21583488
Bajar PDFs
-
Buscar por PatientID
Salvar el report como pdf con el numero interno
Nota:
Si vas sacando y te pierdes siempre pues hacer, de vez en cuando,
[osotolongo@brick03 mri_face]$ ls reports/*.pdf | sed 's/reports\/\(.*\)\.pdf/\1/' > sbjs_done.txt
[osotolongo@brick03 mri_face]$ grep -v "^`cat sbjs_done.txt`" sbj_ids.csv > sbj_ids_todo.csv
para limpiar la lista de los que faltan
Sacar info
Los convierto a txt,
[osotolongo@brick03 mri_face]$ for x in reports/*.pdf ; do pdftotext ${x}; done
[osotolongo@brick03 mri_face]$ ls reports/
20081210.pdf 20140947.pdf 20151338.pdf 20201297.pdf 20211384.pdf 20211455.pdf 20211475.pdf 20211480.pdf 20211505.pdf 20211523.pdf 20211524.pdf 20211527.pdf 20211611.pdf
20081210.txt 20140947.txt 20151338.txt 20201297.txt 20211384.txt 20211455.txt 20211475.txt 20211480.txt 20211505.txt 20211523.txt 20211524.txt 20211527.txt 20211611.txt
Y voy a hacer un parser rapidito a ver que sale,
- parser0.pl
#!/usr/bin/perl
use strict;
use warnings;
use File::Find::Rule;
use File::Basename qw(basename);
use Data::Dump qw(dump);
my %rois = ('global' => 'ACG',
('parietal' => 'Koedam'),
('tempor' => 'Scheltens'),
('frontal' => 'Kipps')
);
my $parse_dir = shift;
my @txts = find(file => 'name' => "*.txt", in => $parse_dir);
my %info;
dump @txts;
foreach my $report (sort @txts){
my $name = basename $report;
$name =~ s/\.txt$//;
foreach my $roi (sort keys %rois){
if($roi eq 'global'){
$info{$name}{$rois{$roi}} = "NA";
}elsif($roi eq 'frontal'){
$info{$name}{$rois{$roi}.'_F'} = "NA";
$info{$name}{$rois{$roi}.'_A'} = "NA";
$info{$name}{$rois{$roi}.'_P'} = "NA";
}else{
$info{$name}{$rois{$roi}.'_I'} = "NA";
$info{$name}{$rois{$roi}.'_D'} = "NA";
}
}
open IDF, "<$report";
my $this_line;
while(<IDF>) {
if (/^Atr/){
foreach my $roi (sort keys %rois){
if (/$roi/){
if (/gra.*\d\/\d\/\d/ and /frontal/){
my ($fb, $ab, $pb) = /gra.*(\d)\/(\d)\/(\d)/;
$info{$name}{$rois{$roi}.'_F'} = $fb if defined $fb;
$info{$name}{$rois{$roi}.'_A'} = $ab if defined $ab;
$info{$name}{$rois{$roi}.'_P'} = $pb if defined $pb;
}elsif (/\(D\/I\).*\d*-*\d\/\d*-*\d/){
my ($gd,$gi) = /\(D\/I\).*\d*-*(\d)\/\d*-*(\d)/;
$info{$name}{$rois{$roi}.'_I'} = $gi if defined $gi;
$info{$name}{$rois{$roi}.'_D'} = $gd if defined $gd;
}else{
(my $gb) = /\d*-*(\d)/;
unless (/global/) {
$info{$name}{$rois{$roi}.'_I'} = $gb if defined $gb;
$info{$name}{$rois{$roi}.'_D'} = $gb if defined $gb;
}else{
$info{$name}{$rois{$roi}} = $gb if defined $gb;
}
}
}
}
}
}
close IDF;
}
print "Subject";
foreach my $roi (sort keys %rois){
my $ch;
if ($roi eq 'global'){
$ch = ','.$rois{$roi};
}elsif($roi eq 'frontal'){
$ch = ','.$rois{$roi}.'_F,'.$rois{$roi}.'_A,'.$rois{$roi}.'_P';
}else{
$ch = ','.$rois{$roi}.'_I,'.$rois{$roi}.'_D';
}
print "$ch";
}
print "\n";
foreach my $subject (sort keys %info){
print "$subject";
foreach my $roi (sort keys %rois){
if ($roi eq 'global'){
my $ag = exists($info{$subject}{$rois{$roi}})?$info{$subject}{$rois{$roi}}:"NA";
print ",$ag";
}elsif ($roi eq 'frontal'){
my $af = exists($info{$subject}{$rois{$roi}.'_F'})?$info{$subject}{$rois{$roi}.'_F'}:"NA";
my $aa = exists($info{$subject}{$rois{$roi}.'_A'})?$info{$subject}{$rois{$roi}.'_A'}:"NA";
my $ap = exists($info{$subject}{$rois{$roi}.'_P'})?$info{$subject}{$rois{$roi}.'_P'}:"NA";
print ",$af,$aa,$ap";
}else{
my $ad = exists($info{$subject}{$rois{$roi}.'_D'})?$info{$subject}{$rois{$roi}.'_D'}:"NA";
my $ai = exists($info{$subject}{$rois{$roi}.'_I'})?$info{$subject}{$rois{$roi}.'_I'}:"NA";
print ",$ai,$ad";
}
}
print "\n";
}
y entonces,
[osotolongo@brick03 mri_face]$ ./parse0.pl reports
Subject,Kipps_F,Kipps_A,Kipps_P,ACG,Koedam_I,Koedam_D,Scheltens_I,Scheltens_D
20081210,NA,NA,NA,1,1,1,0,0
20140947,1,1,1,2,2,2,0,0
20151338,1,1,1,2,2,2,2,2
20201297,1,1,2,2,2,2,2,2
20211384,NA,NA,NA,1,1,1,3,3
20211455,2,2,2,1,2,2,3,3
20211475,NA,NA,NA,1,1,1,1,1
20211480,2,1,2,2,2,2,1,1
20211505,NA,NA,NA,1,1,1,1,2
20211523,NA,NA,NA,1,1,1,2,2
20211524,NA,NA,NA,2,2,2,1,0
20211527,2,1,1,1,2,2,1,1
20211611,NA,NA,NA,0,0,0,0,0
Y cuando casi eres feliz, te cambian la estructura de los informes 
Ahora la estructura es mas parseable pero ojo, hay que incluir tambien los infromes con el formato antiguo. ¿A que la vida es maravillosa?
Entonces lo que he hecho es rehacer toda la logica desde el principio
- parser1.pl
#!/usr/bin/perl
use strict;
use warnings;
use File::Find::Rule;
use File::Basename qw(basename);
use Data::Dump qw(dump);
use Spreadsheet::Write;
my @rinf = ('GCA_D', 'GCA_I',
'Koedam_D', 'Koedam_I',
'Kipps_F_D', 'Kipps_F_I',
'Kipps_A_D', 'Kipps_A_I',
'Kipps_P_D', 'Kipps_P_I',
'Scheltens_D', 'Scheltens_I',
'Fazekas'
);
my $project = 'unidad';
my $ofile = 'reports_data.xls';
my $parse_dir = shift;
my @txts = find(file => 'name' => "*.txt", in => $parse_dir);
my %info;
#dump @txts;
foreach my $report (sort @txts){
my $name = basename $report;
$name =~ s/\.txt$//;
foreach my $iinf (@rinf){
if($iinf eq 'Fazekas'){
$info{$name}{$iinf} = 0;
}else{
$info{$name}{$iinf} = "NA";
}
}
open IDF, "<$report";
my $this_line;
while(<IDF>) {
if (/Fazekas/i){
my ($fv) = /Fazekas\s*\d*-*(\d)/i;
$info{$name}{'Fazekas'} = $fv if defined $fv;
}
if (/.*GCA.*/ and not /^Temporal/i){
my ($ad, $ai) = /.*\d*-*(\d)\s*\/*.*\d*-*(\d).*GCA.*/;
$info{$name}{'GCA_D'} = $ad if defined $ad;
$info{$name}{'GCA_I'} = $ai if defined $ai;
}elsif(/Kipps/){
if(/frontal/i and /anterior/i and /posterior/i){
my ($af, $aa, $ap) = /.*\d*-*(\d)\/*\d*-*(\d)\/\d*-*(\d).*/;
$info{$name}{'Kipps_F_D'} = $af if defined $af;
$info{$name}{'Kipps_F_I'} = $af if defined $af;
$info{$name}{'Kipps_A_D'} = $aa if defined $aa;
$info{$name}{'Kipps_A_I'} = $aa if defined $aa;
$info{$name}{'Kipps_P_D'} = $ap if defined $ap;
$info{$name}{'Kipps_P_I'} = $ap if defined $ap;
}else{
my ($ad, $ai) = /.*\d*-*(\d)\s*\/*.*\d*-*(\d).*Kipps.*/i;
if(/Frontal/i){
$info{$name}{'Kipps_F_D'} = $ad if defined $ad;
$info{$name}{'Kipps_F_I'} = $ai if defined $ai;
}elsif(/anterior/i){
$info{$name}{'Kipps_A_D'} = $ad if defined $ad;
$info{$name}{'Kipps_A_I'} = $ai if defined $ai;
}elsif(/posterior/i){
$info{$name}{'Kipps_P_D'} = $ad if defined $ad;
$info{$name}{'Kipps_P_I'} = $ai if defined $ai;
}
}
}elsif(/Koedam/i){
if(/.*\d\s*\/*.*\d*-*\d.*/){
my ($ad, $ai) = /.*\d*-*(\d)\s*\/*.*\d*-*(\d).*Koedam.*/i;
$info{$name}{'Koedam_D'} = $ad if defined $ad;
$info{$name}{'Koedam_I'} = $ai if defined $ai;
}else{
my ($ag) = /.*\d*-*(\d).*/;
$info{$name}{'Koedam_D'} = $ag if defined $ag;
$info{$name}{'Koedam_I'} = $ag if defined $ag;
}
}elsif(/Scheltens/i){
if(/bilateral/i){
my ($ag) = /.*\d*-*(\d).*/;
$info{$name}{'Scheltens_D'} = $ag if defined $ag;
$info{$name}{'Scheltens_I'} = $ag if defined $ag;
}else{
if(/.*\d.*Scheltens.*/i){
my ($ad, $ai) = /.*\d*-*(\d)\s*\/*.*\d*-*(\d).*Scheltens.*/i;
$info{$name}{'Scheltens_D'} = $ad if defined $ad;
$info{$name}{'Scheltens_I'} = $ai if defined $ai;
}else{
if(/.*\d*-*\d.*\d*-*\d.*/){
my ($ad, $ai) = /.*Scheltens.*\d*-*(\d).*\d*-*(\d).*/i;
$info{$name}{'Scheltens_D'} = $ad if defined $ad;
$info{$name}{'Scheltens_I'} = $ai if defined $ai;
}else{
my ($ag) = /.*Scheltens.*\d*-*(\d)/i;
$info{$name}{'Scheltens_D'} = $ag if defined $ag;
$info{$name}{'Scheltens_I'} = $ag if defined $ag;
}
}
}
}elsif(/global/i and /cortical/i){
my ($ab) = /.*\d*-*(\d).*/;
$info{$name}{'GCA_D'} = $ab if defined $ab;
$info{$name}{'GCA_I'} = $ab if defined $ab;
}elsif(/tempor/i and /mesial/i){
if(/bilateral/i){
my ($ag) = /.*\d*-*(\d).*/;
$info{$name}{'Scheltens_D'} = $ag if defined $ag;
$info{$name}{'Scheltens_I'} = $ag if defined $ag;
}else{
my ($ad, $ai) = /.*\d*-*(\d).*\d*-*(\d).*/;
$info{$name}{'Scheltens_D'} = $ad if defined $ad;
$info{$name}{'Scheltens_I'} = $ai if defined $ai;
}
}
}
close IDF;
}
###############################################
# Este trozo de aqui es para sacar las fechas #
###############################################
foreach my $subject (sort keys %info){
my $xorder = 'xnatapic list_experiments --project_id '.$project.' --subject_id '.$subject.' --label --date';
my ($xdata) = qx/$xorder/;
$xdata =~ s/.*,(.*),.*/$1/;
chomp $xdata;
$info{$subject}{'date'} = $xdata;
}
##############################################
##############################################
##############################################
# Ahora, en lugar de ir imprimiendo
# voy a armar las filas del output
my @rows;
$rows[0] = "Subject,Date";
foreach my $iinf (sort @rinf){
$rows[0] .= ",$iinf";
}
my $count = 1;
foreach my $subject (sort keys %info){
$rows[$count] = "$subject,$info{$subject}{'date'}";
foreach my $iinf (sort @rinf){
$rows[$count] .= ",$info{$subject}{$iinf}";
}
$count++;
}
# y ahora intento escribir la filas en un xls
my $workbook = Spreadsheet::Write->new(file => $ofile, sheet => 'DATA');
foreach my $row (@rows){
# Fabrico un array temporal porque es lo que entiende el modulo
my @arow = split /,/,$row;
$workbook->addrow(@arow);
# y tambien saco la fila por STDOUT por si quiero generar un CSV
# hacer un grep o cualquier otro tipo de postproc
print "$row\n";
}
$workbook -> close();
y entonces ejecutando algo como,
$ ./parse1.pl reports/ > mri_face_reports.csv
Obtengo los valores en un xls y en un csv,
Subject,Date,Fazekas,GCA_D,GCA_I,Kipps_A_D,Kipps_A_I,Kipps_F_D,Kipps_F_I,Kipps_P_D,Kipps_P_I,Koedam_D,Koedam_I,Scheltens_D,Scheltens_I
20050456,2022-03-06,3,3,3,2,2,2,3,2,2,1,3,2,2
20081210,2021-12-02,1,1,1,NA,NA,NA,NA,NA,NA,1,1,0,0
20090461,2022-01-28,1,1,1,1,2,1,1,1,2,0,3,2,2
20100678,2022-01-16,0,2,2,2,2,2,2,2,2,2,3,3,3
20140947,2021-12-11,1,2,2,1,1,1,1,1,1,2,2,0,0
20150926,2022-01-26,2,2,2,2,2,2,2,3,3,2,3,2,3
20151338,2021-12-04,1,2,2,1,1,1,1,1,1,2,2,2,2
20160418,2021-12-11,3,2,2,2,2,2,2,2,2,1,1,3,3
20170735,2021-12-22,2,1,1,1,1,0,0,1,1,1,1,1,1
Nota:
Se han tomado en cuenta algunas consideraciones extra, por peticion popular,
Si no está Fazekas ponemos 0
Añadimos la fecha de la MRI a la tabla
Guardando todo en XNAT
La logica es la siguiente. Este proyecto continuara hasta alcanzar numeros grandes. Si corro el parser cada vez sobre toda la muestra puede llegar a demorar y va ser difcil de revisar.
Asi que voy a guardar todo lo que pueda en XNAT para almacenarlo y podre ir haciendolo a trozos después.
Lo primero que todo es guardar los informes en PDF para que siempre esten listos para consulta. Para ello creamos un Resource en XNAT para el visual report,
y entonces subimos el informe con algo asi,
$ curl -f -X PUT -u "user:password" "http://detritus.fundacioace.com:8088/data/experiments/XNAT4_EXXXX/resources/RVR/files/report_XUSER.pdf?overwrite=true" -F file="@/path/to/report/XXXXX.pdf"
Ahora quiero guardar los datos extra de cada informe como otro resource. Digamos que tengo un CSV de este estilo,
Subject,ATM_I,ATM_D,ACG,Fazekas
F001,NA,NA,NA,1
F002,2,2,NA,1
F003,0,0,NA,1
F005,NA,0,NA,1
F006,1,0,NA,1
F007,0,1,NA,0
F008,1,0,NA,NA
F009,0,0,NA,2
F010,0,NA,NA,1
pero los campos pueden variar. Lo que hago es importar el csv automagicamente con Text::CSV y crear un archivo json para copiar en cada RVR.
Por partes, importo el csv,
my $ref_vr = csv(in => $vrfile, headers => "auto");
y creo el json en un archivo temporal con todos los campos,
foreach my $mrdata (@$ref_vr){
my $rep_body = '{"ResultSet":{"Result":[{';
my @rep_arr;
foreach my $rk (sort keys %$mrdata){
#if ($rk ne 'Subject' and $rk ne 'Date'){
push @rep_arr, '"'.$rk.'":"'.${$mrdata}{$rk}.'"';
#}
}
$rep_body .= join ',', @rep_arr;
$rep_body .= '}]}}';
my $tvrf = mktemp($tmp_dir.'/rvr_data.XXXXX');
open TDF, ">$tvrf";
print TDF "$rep_body\n";
close TDF;
}
Ahor para subir ese archivo temporal tengo que hacer algo como,
$ curl -f -X PUT -u "user:pass" "connection_site/data/experiments/experimento_evaluado/resources/RVR/files/report_data.json?overwrite=true" -F file="@archivo_temporal"
Asi que dentro del sitio he de hacer,
my $xcurl = 'curl -f -X PUT -u "'.$xconf{'USER'}.':'.$xconf{'PASSWORD'}.'" "'.$xconf{'HOST'}.'/data/experiments/'.$vrdata{${$mrdata}{'Subject'}}.'/resources/RVR/files/report_data.json?overwrite=true" -F file="@'.$tvrf.'"';
print "$xcurl\n";
system($xcurl);
unlink $tvrf;
Subiendo todo
Lo que hago es unir todo esto en un solo script Perl
- xnat_up_rvr.pl
#!/usr/bin/perl
# Put the Visual readings into XNAT resources
# This is made for MRIFACE project but is intended to be use everywhere
# if lucky!
#
# Copyleft 2022 O. Sotolongo <asqwerty@gmail.com>
#
use strict;
use warnings;
use File::Find::Rule;
use File::Basename qw(basename);
use Text::CSV qw(csv);
use File::Temp qw( :mktemp tempdir);
use Data::Dump qw(dump);
my $vrfile;
my $rep_dir;
my $xprj;
while (@ARGV and $ARGV[0] =~ /^-/) {
$_ = shift;
last if /^--$/;
if (/^-i/) {$vrfile = shift; chomp($vrfile);}
if (/^-d/) {$rep_dir = shift; chomp($rep_dir);}
if (/^-x/) {$xprj = shift; chomp($xprj);}
}
die "Should supply reports directory" unless $rep_dir;
die "Should supply XNAT project" unless $xprj;
my $xconf_file = $ENV{'HOME'}.'/.xnatapic/xnat.conf';
my %xconf;
open IDF, "<$xconf_file";
while (<IDF>){
if (/^#.*/ or /^\s*$/) { next; }
my ($n, $v) = /(.*)=(.*)/;
$xconf{$n} = $v;
}
#dump %xconf;
close IDF;
my $tmp_dir = $ENV{TMPDIR};
my %vrdata;
my %rdata;
# get the session ID
my $q = 'curl -f -X POST -u "'.$xconf{'USER'}.':'.$xconf{'PASSWORD'}.'" "'.$xconf{'HOST'}.'/data/JSESSION"';
my $jid = qx/$q/;
my @pdfs = find(file => 'name' => "*.pdf", in => $rep_dir);
foreach my $report (@pdfs) {
my $bnreport = basename $report;
(my $xsbj = $bnreport) =~ s/.pdf//;
my $xorder = 'xnatapic list_experiments --project_id '.$xprj.' --subject_id '.$xsbj.' --modality MRI';
my ($xdata) = qx/$xorder/;
chomp $xdata;
$xdata =~ s/"//g;
$vrdata{$xsbj} = $xdata;
my $xcurl = 'curl -f -X PUT -b JSESSIONID='.$jid.' "'.$xconf{'HOST'}.'/data/experiments/'.$xdata.'/resources/RVR" 2>/dev/null';
system($xcurl);
$xcurl = 'curl -f -X PUT -b JSESSIONID='.$jid.' "'.$xconf{'HOST'}.'/data/experiments/'.$xdata.'/resources/RVR/files/report_'.$xsbj.'.pdf?overwrite=true" -F file="@'.$report.'"';
print "$xcurl\n";
system($xcurl);
}
if ($vrfile) {
my $ref_vr = csv(in => $vrfile, headers => "auto");
foreach my $mrdata (@$ref_vr){
my $rep_body = '{"ResultSet":{"Result":[{';
my @rep_arr;
foreach my $rk (sort keys %$mrdata){
#if ($rk ne 'Subject' and $rk ne 'Date'){
push @rep_arr, '"'.$rk.'":"'.${$mrdata}{$rk}.'"';
#}
}
$rep_body .= join ',', @rep_arr;
$rep_body .= '}]}}';
my $tvrf = mktemp($tmp_dir.'/rvr_data.XXXXX');
open TDF, ">$tvrf";
print TDF "$rep_body\n";
close TDF;
my $xcurl = 'curl -f -X PUT -b JSESSIONID='.$jid.' "'.$xconf{'HOST'}.'/data/experiments/'.$vrdata{${$mrdata}{'Subject'}}.'/resources/RVR/files/report_data.json?overwrite=true" -F file="@'.$tvrf.'"';
print "$xcurl\n";
system($xcurl);
unlink $tvrf;
}
}
que ejecuto como,
[osotolongo@brick03 mri_face]$ ./xnat_up_rvr.pl -i /nas/osotolongo/parsing/atm_v2_rev_again.csv -d /nas/osotolongo/parsing/facehbi_informes_mri/v2/pdfs/ -x f2cehbi
% Total % Received % Xferd Average Speed Time Time Time Current
Dload Upload Total Spent Left Speed
100 32 100 32 0 0 307 0 --:--:-- --:--:-- --:--:-- 310
curl -f -X PUT -b JSESSIONID=EAD2EA07CDEE33D3D5178C11FF4EF514 "http://detritus.fundacioace.com:8088/data/experiments/XNAT5_E00001/resources/RVR/files/report_F001.pdf?overwrite=true" -F file="@/nas/osotolongo/parsing/facehbi_informes_mri/v2/pdfs/F001.pdf"
curl -f -X PUT -b JSESSIONID=EAD2EA07CDEE33D3D5178C11FF4EF514 "http://detritus.fundacioace.com:8088/data/experiments/XNAT5_E00087/resources/RVR/files/report_F002.pdf?overwrite=true" -F file="@/nas/osotolongo/parsing/facehbi_informes_mri/v2/pdfs/F002.pdf"
curl -f -X PUT -b JSESSIONID=EAD2EA07CDEE33D3D5178C11FF4EF514 "http://detritus.fundacioace.com:8088/data/experiments/XNAT5_E00088/resources/RVR/files/report_F003.pdf?overwrite=true" -F file="@/nas/osotolongo/parsing/facehbi_informes_mri/v2/pdfs/F003.pdf"
curl -f -X PUT -b JSESSIONID=EAD2EA07CDEE33D3D5178C11FF4EF514 "http://detritus.fundacioace.com:8088/data/experiments/XNAT5_E00089/resources/RVR/files/report_F005.pdf?overwrite=true" -F file="@/nas/osotolongo/parsing/facehbi_informes_mri/v2/pdfs/F005.pdf"
...
...
...
curl -f -X PUT -b JSESSIONID=EAD2EA07CDEE33D3D5178C11FF4EF514 "http://detritus.fundacioace.com:8088/data/experiments/XNAT5_E00697/resources/RVR/files/report_data.json?overwrite=true" -F file="@/old_nas/osotolongo/tmp/rvr_data.BgByl"
curl -f -X PUT -b JSESSIONID=EAD2EA07CDEE33D3D5178C11FF4EF514 "http://detritus.fundacioace.com:8088/data/experiments/XNAT5_E00698/resources/RVR/files/report_data.json?overwrite=true" -F file="@/old_nas/osotolongo/tmp/rvr_data.SzT2s"
curl -f -X PUT -b JSESSIONID=EAD2EA07CDEE33D3D5178C11FF4EF514 "http://detritus.fundacioace.com:8088/data/experiments/XNAT5_E00699/resources/RVR/files/report_data.json?overwrite=true" -F file="@/old_nas/osotolongo/tmp/rvr_data.vyeh8"
curl -f -X PUT -b JSESSIONID=EAD2EA07CDEE33D3D5178C11FF4EF514 "http://detritus.fundacioace.com:8088/data/experiments/XNAT5_E00700/resources/RVR/files/report_data.json?overwrite=true" -F file="@/old_nas/osotolongo/tmp/rvr_data.zJvbo"
curl -f -X PUT -b JSESSIONID=EAD2EA07CDEE33D3D5178C11FF4EF514 "http://detritus.fundacioace.com:8088/data/experiments/XNAT5_E00701/resources/RVR/files/report_data.json?overwrite=true" -F file="@/old_nas/osotolongo/tmp/rvr_data.55aWS"
curl -f -X PUT -b JSESSIONID=EAD2EA07CDEE33D3D5178C11FF4EF514 "http://detritus.fundacioace.com:8088/data/experiments/XNAT5_E00702/resources/RVR/files/report_data.json?overwrite=true" -F file="@/old_nas/osotolongo/tmp/rvr_data.5m_vZ"
curl -f -X PUT -b JSESSIONID=EAD2EA07CDEE33D3D5178C11FF4EF514 "http://detritus.fundacioace.com:8088/data/experiments/XNAT5_E00703/resources/RVR/files/report_data.json?overwrite=true" -F file="@/old_nas/osotolongo/tmp/rvr_data.KIa5m"
Nota: El script es lo suficientemente abstracto pra ser incluido en el pipeline!!!!!
Datos demograficos
Como he de sacar los datos demograficos de la DB de Ekon, el primer paso es extraer los ID de los sujetos del proyecto de XNAT, estos deben corresponder al NHC en la DB. Esta parte es sencilla,
[osotolongo@brick03 mri_face]$ curl -f -X GET -u "user:pass" "http://detritus.fundacioace.com:8088/data/projects/unidad/subjects?format=csv" > all_subjects.csv
% Total % Received % Xferd Average Speed Time Time Time Current
Dload Upload Total Spent Left Speed
100 10597 0 10597 0 0 56014 0 --:--:-- --:--:-- --:--:-- 56367
[osotolongo@brick03 mri_face]$ head all_subjects.csv
ID,project,label,insert_date,insert_user,URI
XNAT05_S00035,unidad,20211269,2021-12-18 20:49:07.368,osotolongo,/data/subjects/XNAT05_S00035
XNAT05_S00042,unidad,20211480,2021-12-18 23:30:44.428,osotolongo,/data/subjects/XNAT05_S00042
XNAT05_S00062,unidad,20211176,2021-12-21 09:59:53.012,osotolongo,/data/subjects/XNAT05_S00062
XNAT05_S00027,unidad,20151338,2021-12-17 16:24:22.916,osotolongo,/data/subjects/XNAT05_S00027
XNAT05_S00028,unidad,20211523,2021-12-17 16:34:33.423,osotolongo,/data/subjects/XNAT05_S00028
XNAT05_S00030,unidad,20211401,2021-12-18 08:08:35.051,osotolongo,/data/subjects/XNAT05_S00030
XNAT05_S00031,unidad,20211281,2021-12-18 09:22:07.411,osotolongo,/data/subjects/XNAT05_S00031
XNAT05_S00032,unidad,20210716,2021-12-18 14:02:44.009,osotolongo,/data/subjects/XNAT05_S00032
XNAT05_S00033,unidad,20081210,2021-12-18 18:36:35.746,osotolongo,/data/subjects/XNAT05_S00033
Ahora para cada uno de los label, he de ejecutar,
[osotolongo@brick03 mri_face]$ sqlcmd ${connection_chain} -s "," -W -Q "SELECT his_interno, xfecha_nac, xsexo_id FROM [UNIT4_DATA].[imp].[vh_pac_gral] WHERE his_interno = '"${nhc}"';" | grep ${nhc}
20200484,1945-05-27 00:00:00.000,2
Nota: En la DB de Ekon, 1 → male, 2 → female
Entonces con estos datos he de construir un CSV para importar en XNAT.
- make_csv.pl
#!/usr/bin/perl
#
# Copyleft 2022 O. Sotolongo <asqwerty@gmail.com>
#
use strict;
use warnings;
use File::Temp qw(:mktemp tempdir);
use Data::Dump qw(dump);
# Get input
my $xprj = 'unidad';
while (@ARGV and $ARGV[0] =~ /^-/) {
$_ = shift;
last if /^--$/;
if (/^-x/) {$xprj = shift; chomp($xprj);}
}
die "Should supply XNAT project" unless $xprj;
#Read config files
my $xconf_file = $ENV{'HOME'}.'/.xnatapic/xnat.conf';
my %xconf;
open IDF, "<$xconf_file";
while (<IDF>){
if (/^#.*/ or /^\s*$/) { next; }
my ($n, $v) = /(.*)=(.*)/;
$xconf{$n} = $v;
}
close IDF;
my $sqlconf_file = $ENV{'HOME'}.'/.sqlcmd';
my %sqlconf;
open IDF, "<$sqlconf_file";
while (<IDF>){
if (/^#.*/ or /^\s*$/) { next; }
my ($n, $v) = /(.*)=(.*)/;
$sqlconf{$n} = $v;
}
close IDF;
my $tmp_dir = tempdir(TEMPLATE => $ENV{TMPDIR}.'/xnat_data.XXXXXX', CLEANUP => 1);
my $sbj_file = $tmp_dir.'/all_subjects.csv';
# Saco los sujetos del proyecto
my $q = 'curl -f -X GET -u "'.$xconf{'USER'}.':'.$xconf{'PASSWORD'}.'" "'.$xconf{'HOST'}.'/data/projects/unidad/subjects?format=csv" > '.$sbj_file;
system($q);
my %subjects;
open IDF, "<$sbj_file";
while (<IDF>){
if(/^XNAT/){
my ($xid,$xlabel) = /(XNAT.*),.*,(\d*),.*,.*,.*$/;
#print "$xid -> $xlabel\n";
$subjects{$xid}{'label'} = $xlabel;
}
}
close IDF;
foreach my $subject (sort keys %subjects){
my $sconn = 'sqlcmd -U '.$sqlconf{'USER'}.' -P '.$sqlconf{'PASSWORD'}.' -S '.$sqlconf{'HOST'}.' -s "," -W -Q "SELECT his_interno, xfecha_nac, xsexo_id FROM [UNIT4_DATA].[imp].[vh_pac_gral] WHERE his_interno = \'"'.$subjects{$subject}{'label'}.'"\';" | grep '.$subjects{$subject}{'label'};
my $rdata = qx/$sconn/;
my ($xdob, $xgender) = $rdata =~ /${subjects{$subject}{'label'}}\s*,\s*(\d{4}-\d{2}-\d{2}).*,(\d)$/;
if($xdob and $xgender){
$subjects{$subject}{'dob'} = $xdob;
$subjects{$subject}{'gender'} = $xgender==1?'male':'female';
}
}
my $ofile = $xprj.'_dob_gender.csv';
my $sbj_header = 'ID,label,dob,gender';
open ODF, ">$ofile";
print ODF "$sbj_header\n";
foreach my $subject (sort keys %subjects){
if (exists($subjects{$subject}{'dob'}) and exists($subjects{$subject}{'gender'})){
print ODF "$subject,$subjects{$subject}{'label'},$subjects{$subject}{'dob'},$subjects{$subject}{'gender'}\n";
}
}
close ODF;
Y ahora puedo usar este metodo para subir el CSV
Obteniendo los datos de XNAT
