File Coverage

lib/Convert/Pheno/REDCap.pm
Criterion Covered Total %
statement 166 167 99.4
branch 78 98 79.5
condition 24 41 58.5
subroutine 12 12 100.0
pod 0 1 0.0
total 280 319 87.7


line stmt bran cond sub pod time code
1             package Convert::Pheno::REDCap;
2              
3 6     6   47 use strict;
  6         13  
  6         176  
4 6     6   28 use warnings;
  6         13  
  6         150  
5 6     6   36 use autodie;
  6         20  
  6         36  
6 6     6   34093 use feature qw(say);
  6         43  
  6         494  
7 6     6   39 use List::Util qw(any);
  6         22  
  6         479  
8 6     6   65 use Convert::Pheno::Mapping;
  6         26  
  6         697  
9 6     6   44 use Convert::Pheno::PXF;
  6         23  
  6         305  
10 6     6   72 use Data::Dumper;
  6         32  
  6         350  
11 6     6   43 use Scalar::Util qw(looks_like_number);
  6         40  
  6         370  
12 6     6   41 use Exporter 'import';
  6         36  
  6         15574  
13             our @EXPORT = qw(do_redcap2bff);
14              
15             ################
16             ################
17             # REDCAP2BFF #
18             ################
19             ################
20              
21             sub do_redcap2bff {
22              
23 180     180 0 376 my ( $self, $participant ) = @_;
24 180         299 my $redcap_dict = $self->{data_redcap_dict};
25 180         245 my $mapping_file = $self->{data_mapping_file};
26 180         284 my $sth = $self->{sth};
27              
28             ##############################
29             # <Variable> names in REDCap #
30             ##############################
31             #
32             # REDCap does not enforce any particular variable name.
33             # Extracted from https://www.ctsi.ufl.edu/wordpress/files/2019/02/Project-Creation-User-Guide.pdf
34             # ---
35             # "Variable Names: Variable names are critical in the data analysis process. If you export your data to a
36             # statistical software program, the variable names are what you or your statistician will use to conduct
37             # the analysis"
38             #
39             # "We always recommend reviewing your variable names with a statistician or whoever will be
40             # analyzing your data. This is especially important if this is the first time you are building a
41             # database"
42             #---
43             # If variable names are not consensuated, then we need to do the mapping manually "a posteriori".
44             # This is what we are attempting here:
45              
46             ####################################
47             # START MAPPING TO BEACON V2 TERMS #
48             ####################################
49              
50             # $participant =
51             # {
52             # 'abdominal_mass' => 0,
53             # 'abdominal_pain' => 1,
54             # 'age' => 2,
55             # 'age_first_diagnosis' => 0,
56             # 'alcohol' => 4,
57             # }
58             print Dumper $redcap_dict
59 180 50 33     453 if ( defined $self->{debug} && $self->{debug} > 4 );
60             print Dumper $participant
61 180 50 33     389 if ( defined $self->{debug} && $self->{debug} > 4 );
62              
63             # *** ABOUT REQUIRED PROPERTIES ***
64             # 'id' and 'sex' are required properties in <individuals> entry type
65              
66 180         403 my @redcap_field_types = ( 'Field Label', 'Field Note', 'Field Type' );
67              
68             # Getting the field name from mapping file (note that we add _field suffix)
69 180         309 my $sex_field = $mapping_file->{sex};
70 180         388 my $studyId_field = $mapping_file->{info}{map}{studyId};
71              
72             # **********************
73             # *** IMPORTANT STEP ***
74             # **********************
75             # We need to pass 'sex' info to external array elements from $participant
76             # Thus, we are storing $participant->{sex} in $self !!!
77 180 100       781 if ( defined $participant->{$sex_field} ) {
78             $self->{_info}{ $participant->{study_id} }{$sex_field} =
79 40         316 $participant->{$sex_field}; # Dynamically adding attributes (setter)
80             }
81             $participant->{$sex_field} =
82 180         865 $self->{_info}{ $participant->{$studyId_field} }{$sex_field};
83              
84             # Premature return if fields don't exist
85             return
86             unless ( defined $participant->{$studyId_field}
87 180 50 33     761 && $participant->{$sex_field} );
88              
89             # Data structure (hashref) for each individual
90 180         226 my $individual;
91              
92             # Default ontology for a bunch of required terms
93 180         547 my $default_ontology = { id => 'NCIT:NA0000', label => 'NA' };
94              
95             # More default values
96 180         236 my $default_date = '1900-01-01';
97 180         205 my $default_duration = 'P999Y';
98 180         527 my $default_age = { age => { iso8601duration => 'P999Y' } };
99              
100             # Variable that will allow to perform ad hoc changes for specific projects
101 180         339 my $project_id = $mapping_file->{project}{id};
102              
103             # **********************
104             # *** IMPORTANT STEP ***
105             # **********************
106             # Load the main ontology for the project
107             # <sex> and <ethnicity> project_ontology are fixed,
108             # (can't be changed granulary)
109              
110 180         283 my $project_ontology = $mapping_file->{project}{ontology};
111              
112             # NB: We don't need to initialize (unless required)
113             # e.g.,
114             # $individual->{diseases} = undef;
115             # or
116             # $individual->{diseases} = []
117             # Otherwise the validator may complain about being empty
118              
119             # **********************
120             # *** IMPORTANT STEP ***
121             # **********************
122             # Loading fields that must to be mapped to redcap_dict in bulk
123             my @fields2map =
124 180         254 grep { defined $redcap_dict->{$_}{_labels} } sort keys %{$redcap_dict};
  70555         115350  
  180         42901  
125              
126             # Perform the mapping for this participant
127 180         3372 for my $field (@fields2map) {
128              
129             # *** IMPORTANT ***
130             # First we keep track of the original value (in case need it)
131             # as $field . '_ori'
132 29340         79873 $participant->{ $field . '_ori' } = $participant->{$field};
133              
134             # Now iwe overwrite the original value with the ditionary one
135             $participant->{$field} = map2redcap_dict(
136             {
137             redcap_dict => $redcap_dict,
138             participant => $participant,
139             field => $field,
140             labels => 1
141             }
142 29340 100       71083 ) if defined $participant->{$field};
143             }
144              
145             # ========
146             # diseases
147             # ========
148              
149             #$individual->{diseases} = [];
150             # NB: Inflamatory Bowel Disease --- Note the 2 mm in infla-mm-atory
151              
152             # Load hashref with cursors for mapping
153 180         489 my $mapping = remap_mapping_hash( $mapping_file, 'diseases' );
154              
155             # Start looping over them
156 180         276 for my $field ( @{ $mapping->{fields} } ) {
  180         367  
157 180         242 my $disease;
158              
159             # Load a few more variables from mapping file
160             # Start mapping
161             $disease->{ageOfOnset} =
162             map_age_range( $participant->{ $mapping->{map}{ageOfOnset} } )
163             if ( exists $mapping->{map}{ageOfOnset}
164 180 100 66     1240 && defined $participant->{ $mapping->{map}{ageOfOnset} } );
165             $disease->{diseaseCode} = map_ontology(
166             {
167             query => $field,
168             column => 'label',
169             ontology => $mapping->{ontology},
170 180         1185 self => $self
171             }
172             );
173             $disease->{familyHistory} =
174             convert2boolean( $participant->{ $mapping->{map}{familyHistory} } )
175             if ( exists $mapping->{map}{familyHistory}
176 180 100 66     1225 && defined $participant->{ $mapping->{map}{familyHistory} } );
177              
178             #$disease->{notes} = undef;
179 180         398 $disease->{severity} = $default_ontology;
180 180         276 $disease->{stage} = $default_ontology;
181              
182 180         585 push @{ $individual->{diseases} }, $disease
183 180 50       350 if defined $disease->{diseaseCode};
184             }
185              
186             # =========
187             # ethnicity
188             # =========
189              
190             # Load field name from mapping file
191 180         317 my $ethnicity_field = $mapping_file->{ethnicity};
192             $individual->{ethnicity} = map_ethnicity( $participant->{$ethnicity_field} )
193 180 100       505 if defined $participant->{$ethnicity_field};
194              
195             # =========
196             # exposures
197             # =========
198              
199             #$individual->{exposures} = undef;
200              
201             # Load hashref with cursors for mapping
202 180         385 $mapping = remap_mapping_hash( $mapping_file, 'exposures' );
203              
204 180         262 for my $field ( @{ $mapping->{fields} } ) {
  180         473  
205 1080 100       2148 next unless defined $participant->{$field};
206              
207 85         191 my $exposure;
208             $exposure->{ageAtExposure} =
209             ( exists $mapping->{map}{ageAtExposure}
210             && defined $participant->{ $mapping->{map}{ageAtExposure} } )
211             ? map_age_range( $participant->{ $mapping->{map}{ageAtExposure} } )
212 85 50 33     330 : $default_age;
213             $exposure->{date} =
214             exists $mapping->{map}{date}
215             ? $participant->{ $mapping->{map}{date} }
216 85 50       225 : $default_date;
217             $exposure->{duration} =
218             exists $mapping->{map}{duration}
219             ? $participant->{ $mapping->{map}{duration} }
220 85 50       235 : $default_duration;
221              
222             # Query related
223             my $exposure_query =
224             exists $mapping->{dict}{$field}
225 85 50       245 ? $mapping->{dict}{$field}
226             : $field;
227              
228             $exposure->{exposureCode} = map_ontology(
229             {
230             query => $exposure_query,
231             column => 'label',
232             ontology => $mapping->{ontology},
233 85         447 self => $self
234             }
235             );
236              
237             # We first extract 'unit' that supposedly will be used in in
238             # <measurementValue> and <referenceRange>??
239             # e.g. radio.alcohol ? alcohol
240 85 100       340 my $subkey = exists $mapping->{radio}{$field} ? $field : 'dummy';
241             my $unit = map_ontology(
242             {
243             # order on the ternary operator matters
244             # 1 - Check for subkey
245             # 2 - Check for field
246             query => $subkey ne 'dummy'
247              
248             # radio.alcohol.Never smoked => Never Smoker
249             ? $mapping->{radio}{$field}{ $participant->{$subkey} }
250             : $exposure_query,
251             column => 'label',
252             ontology => $mapping->{ontology},
253 85 100       514 self => $self
254             }
255             );
256 85         204 $exposure->{unit} = $unit;
257 85   100     347 $exposure->{value} = $participant->{ $field . '_ori' } // -1;
258 85         261 push @{ $individual->{exposures} }, $exposure
259 85 50       196 if defined $exposure->{exposureCode};
260             }
261              
262             # ================
263             # geographicOrigin
264             # ================
265              
266             #$individual->{geographicOrigin} = {};
267              
268             # ==
269             # id
270             # ==
271              
272             # Concatenation of the values in @id_fields (mapping file)
273             $individual->{id} = join ':',
274 180         290 map { $participant->{$_} } @{ $mapping_file->{id}{fields} };
  360         1417  
  180         406  
275              
276             # ====
277             # info
278             # ====
279              
280             # Load hashref with cursors for mapping
281 180         496 $mapping = remap_mapping_hash( $mapping_file, 'info' );
282              
283 180         294 for my $field ( @{ $mapping->{fields} } ) {
  180         423  
284 2880 100       5520 if ( defined $participant->{$field} ) {
285              
286             # Ad hoc for 3TR
287 725 50       1093 if ( $project_id eq '3tr_ibd' ) {
288             $individual->{info}{$field} =
289             $field eq 'age' ? map_age_range( $participant->{$field} )
290             : $field =~ m/^consent/ ? {
291             value => dotify_and_coerce_number( $participant->{$field} ),
292 840         3572 map { $_ => $redcap_dict->{$field}{$_} }
293             @redcap_field_types
294             }
295 725 100       2691 : $participant->{$field};
    100          
296             }
297             else {
298 0         0 $individual->{info}{$field} = $participant->{$field};
299             }
300             }
301             }
302              
303             # When we use --test we do not serialize changing (metaData) information
304 180 50       668 $individual->{info}{metaData} = $self->{test} ? undef : get_metaData($self);
305              
306             # =========================
307             # interventionsOrProcedures
308             # =========================
309              
310             #$individual->{interventionsOrProcedures} = [];
311              
312             # Load hashref with cursors for mapping
313 180         391 $mapping = remap_mapping_hash( $mapping_file, 'interventionsOrProcedures' );
314              
315 180         308 for my $field ( @{ $mapping->{fields} } ) {
  180         436  
316 2880 100       5861 if ( $participant->{$field} ) {
317              
318             # Why this
319             next
320             if ( exists $mapping->{map}{dateOfProcedure}
321 415 100 66     1521 && $field eq $mapping->{map}{dateOfProcedure} );
322 330         360 my $intervention;
323              
324             $intervention->{ageAtProcedure} =
325             ( exists $mapping->{map}{ageAtProcedure}
326             && defined $mapping->{map}{ageAtProcedure} )
327             ? map_age_range(
328             $participant->{ $mapping->{map}{ageAtProcedure} } )
329 330 50 33     833 : $default_age;
330              
331             $intervention->{bodySite} =
332 330 50       1111 { "id" => "NCIT:C12736", "label" => "intestine" }
333             if ( $project_id eq '3tr_ibd' );
334              
335             $intervention->{dateOfProcedure} =
336             ( exists $mapping->{map}{dateOfProcedure}
337             && defined $mapping->{map}{dateOfProcedure} )
338             ? dot_date2iso(
339             $participant->{ $mapping->{map}{dateOfProcedure} } )
340 330 50 33     1497 : $default_date;
341              
342             $intervention->{procedureCode} = map_ontology(
343             {
344             query => exists $mapping->{dict}{$field}
345             ? $mapping->{dict}{$field}
346             : $field,
347             column => 'label',
348             ontology => $mapping->{ontology},
349 330 100       2310 self => $self
    50          
350             }
351             ) if defined $field;
352 330         891 push @{ $individual->{interventionsOrProcedures} }, $intervention
353 330 50       1224 if defined $intervention->{procedureCode};
354             }
355             }
356              
357             # =============
358             # karyotypicSex
359             # =============
360              
361             # $individual->{karyotypicSex} = undef;
362              
363             # ========
364             # measures
365             # ========
366              
367 180         359 $individual->{measures} = undef;
368              
369             # Load hashref with cursors for mapping
370 180         388 $mapping = remap_mapping_hash( $mapping_file, 'measures' );
371              
372 180         285 for my $field ( @{ $mapping->{fields} } ) {
  180         374  
373 4140 100       9476 next unless defined $participant->{$field};
374 2785         3023 my $measure;
375              
376             $measure->{assayCode} = map_ontology(
377             {
378             query => exists $mapping->{dict}{$field}
379             ? $mapping->{dict}{$field}
380             : $field,
381             column => 'label',
382             ontology => $mapping->{ontology},
383 2785 100       11145 self => $self,
384             }
385             );
386 2785         5495 $measure->{date} = $default_date;
387              
388             # We first extract 'unit' and %range' for <measurementValue>
389 2785         8394 my $tmp_str = map2redcap_dict(
390             {
391             redcap_dict => $redcap_dict,
392             participant => $participant,
393             field => $field,
394             labels => 0 # will get 'Field Note'
395              
396             }
397             );
398              
399             # We can have $participant->{$field} eq '2 - Mild'
400 2785 100       13531 if ( $participant->{$field} =~ m/ \- / ) {
401 90         340 my ( $tmp_val, $tmp_scale ) = split / \- /, $participant->{$field};
402 90         169 $participant->{$field} =
403             $tmp_val; # should be equal to $participant->{$field.'_ori'}
404 90         149 $tmp_str = $tmp_scale;
405             }
406              
407             my $unit = map_ontology(
408             {
409             query => exists $mapping->{dict}{$tmp_str}
410             ? $mapping->{dict}{$tmp_str}
411             : $tmp_str,
412             column => 'label',
413             ontology => $mapping->{ontology},
414 2785 100       11712 self => $self
415             }
416             );
417             $measure->{measurementValue} = {
418             quantity => {
419             unit => $unit,
420 2785         6723 value => dotify_and_coerce_number( $participant->{$field} ),
421             referenceRange => map_reference_range(
422             {
423             unit => $unit,
424             redcap_dict => $redcap_dict,
425             field => $field
426             }
427             )
428             }
429             };
430             $measure->{notes} = join ' /// ', $field,
431 2785         5868 ( map { qq/$_=$redcap_dict->{$field}{$_}/ } @redcap_field_types );
  8355         26114  
432              
433             #$measure->{observationMoment} = undef; # Age
434             $measure->{procedure} = {
435             procedureCode => map_ontology(
436             {
437             query => $field eq 'calprotectin' ? 'Feces'
438             : $field =~ m/^nancy/ ? 'Histologic'
439             : 'Blood Test Result',
440             column => 'label',
441             ontology => $mapping->{ontology},
442 2785 100       14106 self => $self
    100          
443             }
444             )
445             };
446              
447             # Add to array
448 2785         6912 push @{ $individual->{measures} }, $measure
449 2785 50       6386 if defined $measure->{assayCode};
450             }
451              
452             # =========
453             # pedigrees
454             # =========
455              
456             #$individual->{pedigrees} = [];
457              
458             # disease, id, members, numSubjects
459             #my @pedigrees = @{ $mapping_file->{pedigrees}{fields} };
460             #for my $field (@pedigrees) {
461             #
462             # my $pedigree;
463             # $pedigree->{disease} = {}; # P32Y6M1D
464             # $pedigree->{id} = undef;
465             # $pedigree->{members} = [];
466             # $pedigree->{numSubjects} = 0;
467             #
468             # Add to array
469             #push @{ $individual->{pedigrees} }, $pedigree; # SWITCHED OFF on 072622
470              
471             # }
472              
473             # ==================
474             # phenotypicFeatures
475             # ==================
476              
477             #$individual->{phenotypicFeatures} = [];
478              
479             # Load hashref with cursors for mapping
480 180         524 $mapping = remap_mapping_hash( $mapping_file, 'phenotypicFeatures' );
481              
482 180         272 for my $field ( @{ $mapping->{fields} } ) {
  180         366  
483 3060         2874 my $phenotypicFeature;
484              
485 3060 100 66     7387 if ( defined $participant->{$field} && $participant->{$field} ne '' ) {
486              
487             #$phenotypicFeature->{evidence} = undef; # P32Y6M1D
488 410         1001 my $tmp_var = $redcap_dict->{$field}{'Field Label'};
489              
490             # *** IMPORTANT ***
491             # Ad hoc change for 3TR
492 410 100 66     1971 if ( $project_id eq '3tr_ibd' && $field =~ m/comorb/i ) {
493             ( undef, $tmp_var ) = split / \- /,
494 195         656 $redcap_dict->{$field}{'Field Label'};
495             }
496              
497             # Excluded (or Included) properties
498             # 1 => included ( == not excluded )
499             $phenotypicFeature->{excluded} =
500             $participant->{$field} ? JSON::XS::false : JSON::XS::true
501 410 100       1924 if looks_like_number( $participant->{$field} );
    100          
502              
503             #$phenotypicFeature->{excluded_ori} = $participant->{$field};
504              
505             $phenotypicFeature->{featureType} = map_ontology(
506             {
507             query => exists $mapping->{dict}{$tmp_var}
508             ? $mapping->{dict}{$tmp_var}
509             : $tmp_var,
510             column => 'label',
511             ontology => $mapping->{ontology},
512 410 100       2860 self => $self
513              
514             }
515             );
516              
517             #$phenotypicFeature->{modifiers} = { id => '', label => '' };
518             $phenotypicFeature->{notes} = join ' /// ',
519             (
520             $field,
521 410         964 map { qq/$_=$redcap_dict->{$field}{$_}/ } @redcap_field_types
  1230         4160  
522             );
523              
524             #$phenotypicFeature->{onset} = { id => '', label => '' };
525             #$phenotypicFeature->{resolution} = { id => '', label => '' };
526             #$phenotypicFeature->{severity} = { id => '', label => '' };
527              
528             # Add to array
529 410         1288 push @{ $individual->{phenotypicFeatures} }, $phenotypicFeature
530 410 50       999 if defined $phenotypicFeature->{featureType};
531             }
532             }
533              
534             # ===
535             # sex
536             # ===
537              
538             $individual->{sex} = map_ontology(
539             {
540 180         894 query => $participant->{$sex_field},
541             column => 'label',
542             ontology => $project_ontology,
543             self => $self
544             }
545             );
546              
547             # ==========
548             # treatments
549             # ==========
550              
551             #$individual->{treatments} = undef;
552              
553 180         507 $mapping = remap_mapping_hash( $mapping_file, 'treatments' );
554              
555 180         278 for my $field ( @{ $mapping->{fields} } ) {
  180         364  
556              
557             # Getting the right name for the drug (if any)
558             my $treatment_name =
559             exists $mapping->{dict}{$field}
560 1080 100       2365 ? $mapping->{dict}{$field}
561             : $field;
562              
563             # FOR ROUTES
564 1080         1214 for my $route ( @{ $mapping->{routesOfAdministration} } ) {
  1080         1571  
565              
566             # Ad hoc for 3TR
567 2160         2463 my $tmp_var = $field;
568 2160 50       3046 if ( $project_id eq '3tr_ibd' ) {
569              
570             # Rectal route only happens in some drugs (ad hoc)
571             next
572             if (
573 1980     1980   4805 $route eq 'rectal' && !any { $_ eq $field }
574 2160 100 100     6638 qw(budesonide asa)
575             );
576              
577             # Discarding if drug_route_status is empty
578 1440 100 100     4982 $tmp_var =
579             ( $field eq 'budesonide' || $field eq 'asa' )
580             ? $field . '_' . $route . '_status'
581             : $field . '_status';
582             next
583 1440 100       3363 unless defined $participant->{$tmp_var};
584             }
585              
586             # Initialize field $treatment
587 320         392 my $treatment;
588              
589             $treatment->{_info} = {
590             field => $tmp_var,
591             drug => $field,
592             drug_name => $treatment_name,
593             status => $participant->{$tmp_var},
594             route => $route,
595             value => $participant->{ $tmp_var . '_ori' },
596 320         778 map { $_ => $participant->{ $field . $_ } }
  960         4753  
597             qw(start dose duration)
598             }; # ***** INTERNAL FIELD
599 320         619 $treatment->{ageAtOnset} = $default_age;
600             $treatment->{cumulativeDose} =
601 320         778 { unit => $default_ontology, value => -1 };
602 320         522 $treatment->{doseIntervals} = [];
603             $treatment->{routeOfAdministration} = map_ontology(
604             {
605             query => ucfirst($route)
606             . ' Route of Administration'
607             , # Oral Route of Administration
608             column => 'label',
609             ontology => $mapping->{ontology},
610 320         1882 self => $self
611             }
612             );
613              
614             $treatment->{treatmentCode} = map_ontology(
615             {
616             query => $treatment_name,
617             column => 'label',
618             ontology => $mapping->{ontology},
619 320         1238 self => $self
620             }
621             );
622 320         830 push @{ $individual->{treatments} }, $treatment
623 320 50       790 if defined $treatment->{treatmentCode};
624             }
625             }
626              
627             ##################################
628             # END MAPPING TO BEACON V2 TERMS #
629             ##################################
630              
631 180         3077 return $individual;
632             }
633              
634             1;