Convert-Pheno

 view release on metacpan or  search on metacpan

lib/Convert/Pheno/CSV.pm  view on Meta::CPAN

    # Intialize parameters for most subs
    my $param_sub = {
        source               => $data_mapping_file->{project}{source},
        project_id           => $data_mapping_file->{project}{id},
        project_ontology     => $data_mapping_file->{project}{ontology},
        data_mapping_file    => $data_mapping_file,
        participant          => $participant,
        record               => $record,
        self                 => $self,
        individual           => $individual,
        term_mapping_cursor  => undef,
        participant_id_field => undef,
        participant_id       => undef
    };

    $param_sub->{lock_keys} = [ 'lock_keys', keys %$param_sub ];
    lock_keys %$param_sub, @{ $param_sub->{lock_keys} };

    # *** ABOUT REQUIRED PROPERTIES ***
    # 'id' and 'sex' are required properties in <individuals> entry type
    my ( $sex_field, $id_field ) = get_required_terms($param_sub);

lib/Convert/Pheno/IO/CSVHandler.pm  view on Meta::CPAN

    # Iterate over the elements of the array reference
    foreach my $element ( @{$array_ref} ) {
        $hash{$element} = 1;
    }
    return \%hash;
}

sub convert_table_aoh_to_hoh {
    my ( $data, $table, $self ) = @_;

    my %table_cursor =
      map { $_ => $data->{$_} } qw(CONCEPT PERSON VISIT_OCCURRENCE);
    my %table_id = (
        CONCEPT          => 'concept_id',
        PERSON           => 'person_id',
        VISIT_OCCURRENCE => 'visit_occurrence_id'
    );
    my $array_ref = $table_cursor{$table};
    my $id        = $table_id{$table};

    ###########
    # CONCEPT #
    ###########

    # $VAR1 = [
    #          {
    #            'concept_class_id' => '4-char billing code',
    #            'concept_code' => 'K92.2',

lib/Convert/Pheno/Mapping/BFF/Individuals/Tabular.pm  view on Meta::CPAN

      : $mapping_file_data->{project}{ontology};

    $hash_out{routeOfAdministration} =
      $mapping_file_data->{$term}{routeOfAdministration}
      if $term eq 'treatments';

    return \%hash_out;
}

sub resolve_field_query {
    my ( $term_mapping_cursor, $field ) = @_;

    return
      exists $term_mapping_cursor->{terminology}{$field}
      ? $term_mapping_cursor->{terminology}{$field}
      : exists $term_mapping_cursor->{fieldTermLabels}{$field}
      ? $term_mapping_cursor->{fieldTermLabels}{$field}
      : $field;
}

sub resolve_value_query {
    my ( $term_mapping_cursor, $value ) = @_;

    return
      exists $term_mapping_cursor->{terminology}{$value}
      ? $term_mapping_cursor->{terminology}{$value}
      : exists $term_mapping_cursor->{valueTermLabels}{$value}
      ? $term_mapping_cursor->{valueTermLabels}{$value}
      : $value;
}

sub resolve_term_query {
    my ( $term_mapping_cursor, $field, $participant_field ) = @_;

    return defined $term_mapping_cursor->{useHeaderAsTermLabel_hash}{$field}
      ? resolve_field_query( $term_mapping_cursor, $field )
      : resolve_value_query( $term_mapping_cursor, $participant_field );
}

sub get_required_terms {
    my $arg               = shift;
    my $data_mapping_file = $arg->{data_mapping_file};
    return ( $data_mapping_file->{sex}{fields},
        $data_mapping_file->{id}{targetFields}{primaryKey} );
}

sub propagate_fields {

lib/Convert/Pheno/Mapping/BFF/Individuals/Tabular.pm  view on Meta::CPAN

    return 1;
}

sub map_diseases {
    my $arg               = shift;
    my $data_mapping_file = $arg->{data_mapping_file};
    my $participant       = $arg->{participant};
    my $self              = $arg->{self};
    my $individual        = $arg->{individual};

    my $term_mapping_cursor =
      remap_mapping_hash_term( $data_mapping_file, 'diseases' );
    $arg->{term_mapping_cursor} = $term_mapping_cursor;

    for my $field ( @{ $term_mapping_cursor->{fields} } ) {
        next unless defined raw_value( $arg, $field );

        my $disease;
        $disease->{ageOfOnset} =
          exists $term_mapping_cursor->{ageOfOnset}{$field}
          ? map_age_range(
            source_value( $arg, $term_mapping_cursor->{ageOfOnset}{$field} ) )
          : $DEFAULT->{age};

        my $disease_query =
          resolve_term_query( $term_mapping_cursor, $field,
            source_value( $arg, $field ) );

        next unless defined $disease_query;

        $disease->{diseaseCode} = map_ontology_term(
            {
                query    => $disease_query,
                column   => 'label',
                ontology => $term_mapping_cursor->{ontology},
                self     => $self
            }
        );

        if ( exists $term_mapping_cursor->{familyHistory}{$field}
            && defined
            raw_value( $arg, $term_mapping_cursor->{familyHistory}{$field} ) )
        {
            $disease->{familyHistory} = convert2boolean(
                source_value( $arg, $term_mapping_cursor->{familyHistory}{$field} )
            );
        }

        _add_visit( $disease, $arg );

        $disease->{severity} = $DEFAULT->{ontology_term};
        $disease->{stage}    = $DEFAULT->{ontology_term};

        push @{ $individual->{diseases} }, $disease;
    }

lib/Convert/Pheno/Mapping/BFF/Individuals/Tabular.pm  view on Meta::CPAN

sub map_ethnicity {
    my $arg               = shift;
    my $data_mapping_file = $arg->{data_mapping_file};
    my $participant       = $arg->{participant};
    my $self              = $arg->{self};
    my $individual        = $arg->{individual};

    my $ethnicity_field = $data_mapping_file->{ethnicity}{fields};
    if ( defined raw_value( $arg, $ethnicity_field ) ) {
        my $term_mapping_cursor =
          remap_mapping_hash_term( $data_mapping_file, 'ethnicity' );
        $arg->{term_mapping_cursor} = $term_mapping_cursor;

        my $ethnicity_query =
          resolve_term_query( $term_mapping_cursor, $ethnicity_field,
            source_value( $arg, $ethnicity_field ) );

        $individual->{ethnicity} = map_ontology_term(
            {
                query    => $ethnicity_query,
                column   => 'label',
                ontology => $term_mapping_cursor->{ontology},
                self     => $self
            }
        );
    }
    return 1;
}

sub map_exposures {
    my $arg = shift;

    my $data_mapping_file = $arg->{data_mapping_file};
    my $participant       = $arg->{participant};
    my $self              = $arg->{self};
    my $individual        = $arg->{individual};

    my $term_mapping_cursor =
      remap_mapping_hash_term( $data_mapping_file, 'exposures' );
    $arg->{term_mapping_cursor} = $term_mapping_cursor;

    for my $field ( @{ $term_mapping_cursor->{fields} } ) {
        next unless defined raw_value( $arg, $field );
        next
          if ( source_value( $arg, $field ) eq 'No'
            || source_value( $arg, $field ) eq 'False' );

        my $exposure;

        my $subkey_ageAtExposure =
          ( exists $term_mapping_cursor->{fieldRules}{$field}
              && defined $term_mapping_cursor->{fieldRules}{$field} )
          ? $term_mapping_cursor->{fieldRules}{$field}{ageAtExposure}
          : undef;

        $exposure->{ageAtExposure} =
          defined $subkey_ageAtExposure
          ? map_age_range( source_value( $arg, $subkey_ageAtExposure ) )
          : $DEFAULT->{age};

        for my $item (qw/date duration/) {
            $exposure->{$item} =
              exists $term_mapping_cursor->{targetFields}{$item}
              ? source_value( $arg, $term_mapping_cursor->{targetFields}{$item} )
              : $DEFAULT->{$item};
        }

        # Exposure codes come from the field/header concept (for example
        # smoking -> Smoking), while fieldRules below map the recorded value
        # (for example Never smoked -> Never Smoker).
        my $exposure_query =
          resolve_field_query( $term_mapping_cursor, $field );

        $exposure->{exposureCode} = map_ontology_term(
            {
                query    => $exposure_query,
                column   => 'label',
                ontology => $term_mapping_cursor->{ontology},
                self     => $self
            }
        );

        $exposure->{_info} = $field;

        my $subkey =
          ( lc( $data_mapping_file->{project}{source} ) eq 'redcap'
              && exists $term_mapping_cursor->{fieldRules}{$field} )
          ? $field
          : undef;

        my $unit_query = defined $subkey
          ? $term_mapping_cursor->{fieldRules}{$field}{ source_value( $arg, $subkey ) }
          : source_value( $arg, $field );

        my $unit = map_ontology_term(
            {
                query    => $unit_query,
                column   => 'label',
                ontology => $term_mapping_cursor->{ontology},
                self     => $self
            }
        );
        $exposure->{unit} = $unit;
        $exposure->{value} =
          looks_like_number( source_value( $arg, $field ) )
          ? source_value( $arg, $field )
          : -1;

        _add_visit( $exposure, $arg );

lib/Convert/Pheno/Mapping/BFF/Individuals/Tabular.pm  view on Meta::CPAN

}

sub map_info {
    my $arg               = shift;
    my $data_mapping_file = $arg->{data_mapping_file};
    my $participant       = $arg->{participant};
    my $self              = $arg->{self};
    my $individual        = $arg->{individual};
    my $source            = $arg->{source};

    my $term_mapping_cursor =
      remap_mapping_hash_term( $data_mapping_file, 'info' );

    for my $field ( @{ $term_mapping_cursor->{fields} } ) {
        next unless defined raw_value( $arg, $field );

        $individual->{info}{$field} = source_value( $arg, $field );

        my $meta = field_meta( $arg, $field );
        if ( defined $meta && exists $meta->{'Field Label'} ) {
            $individual->{info}{objects}{ $field . '_obj' } = {
                value => dotify_and_coerce_number( source_value( $arg, $field ) ),
                map { $_ => $meta->{$_} } @redcap_field_types
            };
        }
    }

    if ( exists $term_mapping_cursor->{targetFields}{age} ) {
        my $age_range = map_age_range(
            source_value( $arg, $term_mapping_cursor->{targetFields}{age} ) );
        $individual->{info}{ageRange} = $age_range->{ageRange};
    }

    unless ( $self->{test} ) {
        $individual->{info}{convertPheno} = $self->{convertPheno};
    }

    $individual->{info}{project}{$_} = $data_mapping_file->{project}{$_}
      for (qw/id source ontology version description/);

lib/Convert/Pheno/Mapping/BFF/Individuals/Tabular.pm  view on Meta::CPAN

}

sub map_interventionsOrProcedures {
    my $arg               = shift;
    my $data_mapping_file = $arg->{data_mapping_file};
    my $participant       = $arg->{participant};
    my $self              = $arg->{self};
    my $individual        = $arg->{individual};
    my $source            = $arg->{source};

    my $term_mapping_cursor =
      remap_mapping_hash_term( $data_mapping_file,
        'interventionsOrProcedures' );

    $arg->{term_mapping_cursor} = $term_mapping_cursor;

    for my $field ( @{ $term_mapping_cursor->{fields} } ) {
        next unless defined raw_value( $arg, $field );

        my $intervention;

        $intervention->{ageAtProcedure} =
          exists $term_mapping_cursor->{ageAtProcedure}{$field}
          ? map_age_range(
            source_value( $arg, $term_mapping_cursor->{ageAtProcedure}{$field} ) )
          : $DEFAULT->{age};

        $intervention->{bodySite} =
          exists $term_mapping_cursor->{bodySite}{$field}
          ? map_ontology_term(
            {
                query    => $term_mapping_cursor->{bodySite}{$field},
                column   => 'label',
                ontology => $term_mapping_cursor->{ontology},
                self     => $self
            }
          )
          : $DEFAULT->{ontology_term};

        $intervention->{dateOfProcedure} =
          exists $term_mapping_cursor->{dateOfProcedure}{$field}
          ? convert_date_to_iso8601(
            source_value( $arg, $term_mapping_cursor->{dateOfProcedure}{$field} ) )
          : $DEFAULT->{date};

        $intervention->{_info} = $field;

        my $subkey =
          exists $term_mapping_cursor->{fieldRules}{$field} ? $field : undef;

        my $intervention_query =
          defined $subkey
          ? $term_mapping_cursor->{fieldRules}{$subkey}{ source_value( $arg, $field ) }
          : resolve_term_query(
            $term_mapping_cursor, $field, source_value( $arg, $field ) );

        $intervention->{procedureCode} = map_ontology_term(
            {
                query    => $intervention_query,
                column   => 'label',
                ontology => $term_mapping_cursor->{ontology},
                self     => $self
            }
        );
        _add_visit( $intervention, $arg );
        push @{ $individual->{interventionsOrProcedures} }, $intervention
          if defined $intervention->{procedureCode};
    }
    return 1;
}

sub map_measures {
    my $arg               = shift;
    my $data_mapping_file = $arg->{data_mapping_file};
    my $participant       = $arg->{participant};
    my $self              = $arg->{self};
    my $individual        = $arg->{individual};
    my $source            = $arg->{source};

    my $term_mapping_cursor =
      remap_mapping_hash_term( $data_mapping_file, 'measures' );

    $arg->{term_mapping_cursor} = $term_mapping_cursor;

    for my $field ( @{ $term_mapping_cursor->{fields} } ) {
        next unless defined raw_value( $arg, $field );
        my $measure;

        $measure->{assayCode} = map_ontology_term(
            {
                query =>
                  resolve_field_query( $term_mapping_cursor, $field ),
                column   => 'label',
                ontology => $term_mapping_cursor->{ontology},
                self     => $self,
            }
        );

        $measure->{date} = $DEFAULT->{date};

        my ( $tmp_unit, $unit_cursor );
        my $measure_value = raw_value( $arg, $field );

        if ( lc($source) eq 'redcap' ) {
            $tmp_unit = field_note( $arg, $field );

            if ( $measure_value =~ m/ \- / ) {
                my ( $tmp_val, $tmp_scale ) = split / \- /,
                  $measure_value;
                $measure_value = $tmp_val;
                $tmp_unit              = $tmp_scale;
            }
        }
        else {
            $unit_cursor = $term_mapping_cursor->{unit}{$field};
            $tmp_unit =
              exists $unit_cursor->{label} ? $unit_cursor->{label} : undef;
        }

        my $unit = map_ontology_term(
            {
                query =>
                  resolve_value_query( $term_mapping_cursor, $tmp_unit ),
                column   => 'label',
                ontology => $term_mapping_cursor->{ontology},
                self     => $self
            }
        );
        my $reference_range =
          lc($source) eq 'csv' && exists $unit_cursor->{referenceRange}
          ? map_reference_range_csv( $unit, $unit_cursor->{referenceRange} )
          : map_reference_range(
            {
                unit        => $unit,
                redcap_dict => $arg->{redcap_dict},
                field       => $field,
                source      => $source
            }
          );

        $measure->{measurementValue} = {

lib/Convert/Pheno/Mapping/BFF/Individuals/Tabular.pm  view on Meta::CPAN

        };
        if ( lc($source) eq 'redcap' ) {
            my $meta = field_meta( $arg, $field ) || {};
            $measure->{notes} = join ' /// ', $field,
              ( map { qq/$_=$meta->{$_}/ } @redcap_field_types );
        }

        $measure->{procedure} = {
            procedureCode => map_ontology_term(
                {
                    query => exists $unit_cursor->{procedureCodeLabel}
                    ? $unit_cursor->{procedureCodeLabel}
                    : $field eq 'calprotectin' ? 'Feces'
                    : $field =~ m/^nancy/      ? 'Histologic'
                    : 'Blood Test Result',
                    column   => 'label',
                    ontology => $term_mapping_cursor->{ontology},
                    self     => $self
                }
            )
        };
        _add_visit( $measure, $arg );

        push @{ $individual->{measures} }, $measure
          if defined $measure->{assayCode};
    }
    return 1;

lib/Convert/Pheno/Mapping/BFF/Individuals/Tabular.pm  view on Meta::CPAN

}

sub map_phenotypicFeatures {
    my $arg               = shift;
    my $data_mapping_file = $arg->{data_mapping_file};
    my $participant       = $arg->{participant};
    my $self              = $arg->{self};
    my $individual        = $arg->{individual};
    my $source            = $arg->{source};

    my $term_mapping_cursor =
      remap_mapping_hash_term( $data_mapping_file, 'phenotypicFeatures' );
    $arg->{term_mapping_cursor} = $term_mapping_cursor;

    for my $field ( @{ $term_mapping_cursor->{fields} } ) {
        my $phenotypicFeature;

        next
          unless ( defined raw_value( $arg, $field )
            && raw_value( $arg, $field ) ne '' );

        $phenotypicFeature->{excluded_ori} =
          dotify_and_coerce_number( raw_value( $arg, $field ) );

        my $is_boolean = 0;
        if ( looks_like_number( raw_value( $arg, $field ) ) ) {
            $phenotypicFeature->{excluded} =
              raw_value( $arg, $field ) ? JSON::XS::false : JSON::XS::true;
            $is_boolean++;
        }
        else {
            $phenotypicFeature->{excluded} = JSON::XS::false;
        }

        my $subkey =
          exists $term_mapping_cursor->{fieldRules}{$field} ? $field : undef;

        my $participant_field = $is_boolean ? $field : source_value( $arg, $field );

        my $phenotypicFeature_query =
          defined $subkey
          ? $term_mapping_cursor->{fieldRules}{$subkey}{$participant_field}
          : resolve_term_query(
            $term_mapping_cursor, $field, source_value( $arg, $field ) );

        $phenotypicFeature->{featureType} = map_ontology_term(
            {
                query    => $phenotypicFeature_query,
                column   => 'label',
                ontology => $term_mapping_cursor->{ontology},
                self     => $self
            }
        );

        $field =~ s/___\w+$// if $field =~ m/___\w+$/;
        if ( lc($source) eq 'redcap' ) {
            my $meta = field_meta( $arg, $field ) || {};
            $phenotypicFeature->{notes} = join ' /// ',
              ( $field, map { qq/$_=$meta->{$_}/ } @redcap_field_types );
        }

lib/Convert/Pheno/Mapping/BFF/Individuals/Tabular.pm  view on Meta::CPAN

sub map_sex {
    my $arg               = shift;
    my $data_mapping_file = $arg->{data_mapping_file};
    my $participant       = $arg->{participant};
    my $self              = $arg->{self};
    my $individual        = $arg->{individual};
    my $project_ontology  = $arg->{project_ontology};

    my $sex_field = $data_mapping_file->{sex}{fields};

    my $term_mapping_cursor =
      remap_mapping_hash_term( $data_mapping_file, 'sex' );

    my $sex_query =
      resolve_term_query(
        $term_mapping_cursor, $sex_field, source_value( $arg, $sex_field ) );

    $individual->{sex} = map_ontology_term(
        {
            query    => $sex_query,
            column   => 'label',
            ontology => $project_ontology,
            self     => $self
        }
    );
    return 1;
}

sub map_treatments {
    my $arg = shift;

    my $data_mapping_file = $arg->{data_mapping_file};
    my $participant       = $arg->{participant};
    my $self              = $arg->{self};
    my $individual        = $arg->{individual};

    my $term_mapping_cursor =
      remap_mapping_hash_term( $data_mapping_file, 'treatments' );

    $arg->{term_mapping_cursor} = $term_mapping_cursor;

    for my $field ( @{ $term_mapping_cursor->{fields} } ) {
        next unless defined raw_value( $arg, $field );

        my $treatment;

        my $treatment_name =
          resolve_term_query(
            $term_mapping_cursor, $field, source_value( $arg, $field ) );

        $treatment->{ageAtOnset} = $DEFAULT->{age};

        $treatment->{doseIntervals} = [];
        my $dose_interval;
        my $duration =
          exists $term_mapping_cursor->{duration}{$field}
          ? $term_mapping_cursor->{duration}{$field}
          : undef;
        my $drug_dose =
          exists $term_mapping_cursor->{drugDose}{$field}
          ? $term_mapping_cursor->{drugDose}{$field}
          : undef;
        my $duration_unit =
          exists $term_mapping_cursor->{durationUnit}{$field}
          ? map_ontology_term(
            {
                query    => $term_mapping_cursor->{durationUnit}{$field},
                column   => 'label',
                ontology => $term_mapping_cursor->{ontology},
                self     => $self
            }
          )
          : $DEFAULT->{ontology_term};
        if ( defined $duration ) {
            my $duration_value =
              defined source_value( $arg, $duration )
              ? dotify_and_coerce_number( source_value( $arg, $duration ) )
              : -1;
            my $drug_dose_value =
              defined $drug_dose && defined source_value( $arg, $drug_dose )
              ? dotify_and_coerce_number( source_value( $arg, $drug_dose ) )
              : -1;

            $treatment->{cumulativeDose} = {
                unit  => $duration_unit,
                value => $duration_value
            };
            my $drug_unit =
              exists $term_mapping_cursor->{drugUnit}{$field}
              ? map_ontology_term(
                {
                    query    => $term_mapping_cursor->{drugUnit}{$field},
                    column   => 'label',
                    ontology => $term_mapping_cursor->{ontology},
                    self     => $self
                }
              )
              : $DEFAULT->{ontology_term};
            $dose_interval->{interval} = $DEFAULT->{interval};

            # Duration and amount are modeled separately. Keep the duration in
            # cumulativeDose, and emit the actual administered amount from the
            # dedicated dose field when the mapping provides one.
            $dose_interval->{quantity}{value} = $drug_dose_value;
            $dose_interval->{quantity}{unit}  = $drug_unit;
            $dose_interval->{quantity}{referenceRange} =
              $DEFAULT->{referenceRange};

            $dose_interval->{scheduleFrequency} = $DEFAULT->{ontology_term};
            push @{ $treatment->{doseIntervals} }, $dose_interval;
        }

        my $route =
          exists $term_mapping_cursor->{routeOfAdministration}
          { source_value( $arg, $field ) }
          ? $term_mapping_cursor->{routeOfAdministration}
          { source_value( $arg, $field ) }
          : 'oral';
        my $route_query = ucfirst($route) . ' Route of Administration';
        $treatment->{_info} = {
            field     => $field,
            value     => source_value( $arg, $field ),
            drug_name => $treatment_name,
            route     => $route
        };

        $treatment->{routeOfAdministration} = map_ontology_term(
            {
                query    => $route_query,
                column   => 'label',
                ontology => $term_mapping_cursor->{ontology},
                self     => $self
            }
        );

        $treatment->{treatmentCode} = map_ontology_term(
            {
                query    => $treatment_name,
                column   => 'label',
                ontology => $term_mapping_cursor->{ontology},
                self     => $self
            }
        );
        _add_visit( $treatment, $arg );
        push @{ $individual->{treatments} }, $treatment
          if defined $treatment->{treatmentCode};
    }
    return 1;
}

sub _add_visit {
    my ( $item, $p ) = @_;
    my $cursor = $p->{term_mapping_cursor}
      or return;
    my $vf = $cursor->{visitId}
      or return;
    my $visit_val = $p->{participant}{$vf};
    $item->{_visit}{id} = dotify_and_coerce_number($visit_val);

    my $pid       = $p->{participant_id} // q{};
    my $composite = join '.', grep { length } $pid, $visit_val;
    my $self      = $p->{self};
    $item->{_visit}{composite}     = $composite;
    # Tabular imports synthesize visit ids from source labels. A cached
    # surrogate integer is enough for referential integrity and much cheaper

lib/Convert/Pheno/OpenEHR/ToBFF.pm  view on Meta::CPAN

}

sub _find_first_element_value {
    my ( $node, @names ) = @_;
    my %wanted = map { $_ => 1 } @names;
    my $found;

    _walk_nodes(
        $node,
        sub {
            my ($cursor) = @_;
            return if defined $found;
            return unless ref($cursor) eq 'HASH';
            return unless ( $cursor->{_type} || '' ) eq 'ELEMENT';

            my $name = _node_name($cursor);
            return unless defined $name && $wanted{$name};

            $found = _term_from_value( $cursor->{value}, $cursor );
        }
    );

    return $found;
}

sub _find_first_text_value {
    my ( $node, @names ) = @_;
    my %wanted = map { $_ => 1 } @names;
    my $found;

    _walk_nodes(
        $node,
        sub {
            my ($cursor) = @_;
            return if defined $found;
            return unless ref($cursor) eq 'HASH';
            return unless ( $cursor->{_type} || '' ) eq 'ELEMENT';

            my $name = _node_name($cursor);
            return unless defined $name && $wanted{$name};
            return unless ref( $cursor->{value} ) eq 'HASH';
            return unless defined $cursor->{value}{value};

            $found = $cursor->{value}{value};
        }
    );

    return $found;
}

sub _find_first_quantity_value {
    my ( $node, @names ) = @_;
    my %wanted = map { $_ => 1 } @names;
    my $found;

    _walk_nodes(
        $node,
        sub {
            my ($cursor) = @_;
            return if defined $found;
            return unless ref($cursor) eq 'HASH';
            return unless ( $cursor->{_type} || '' ) eq 'ELEMENT';

            my $name = _node_name($cursor);
            return unless defined $name && $wanted{$name};
            return unless ref( $cursor->{value} ) eq 'HASH';
            return unless ( $cursor->{value}{_type} || '' ) eq 'DV_QUANTITY';

            $found = _quantity_from_dv_quantity( $cursor->{value} );
        }
    );

    return $found;
}

sub _find_first_named_cluster_code {
    my ( $node, $cluster_name ) = @_;
    my $found;

    _walk_nodes(
        $node,
        sub {
            my ($cursor) = @_;
            return if defined $found;
            return unless ref($cursor) eq 'HASH';
            return unless ( $cursor->{_type} || '' ) eq 'CLUSTER';
            return unless defined _node_name($cursor) && _node_name($cursor) eq $cluster_name;

            if ( ref( $cursor->{items} ) eq 'ARRAY' ) {
                for my $item ( @{ $cursor->{items} } ) {
                    next unless ref($item) eq 'HASH';
                    my $name = $item->{name};
                    next unless ref($name) eq 'HASH';
                    next unless ( $name->{_type} || '' ) eq 'DV_CODED_TEXT';
                    $found = _term_from_value( $name, $item );
                    last if defined $found;
                }
            }
        }
    );

lib/Convert/Pheno/OpenEHR/ToBFF.pm  view on Meta::CPAN

    return $found;
}

sub _find_first_datetime_value {
    my ($node) = @_;
    my $found;

    _walk_nodes(
        $node,
        sub {
            my ($cursor) = @_;
            return if defined $found;
            return unless ref($cursor) eq 'HASH';

            if ( exists $cursor->{time}
                && ref( $cursor->{time} ) eq 'HASH'
                && defined $cursor->{time}{value} )
            {
                $found = $cursor->{time}{value};
                return;
            }

            if ( exists $cursor->{origin}
                && ref( $cursor->{origin} ) eq 'HASH'
                && defined $cursor->{origin}{value} )
            {
                $found = $cursor->{origin}{value};
                return;
            }
        }
    );

    return $found;
}

sub _term_from_value {
    my ( $value, $source_node ) = @_;

lib/Convert/Pheno/REDCap.pm  view on Meta::CPAN

    my $param_sub = {
        source              => $data_mapping_file->{project}{source},
        project_id          => $data_mapping_file->{project}{id},
        project_ontology    => $data_mapping_file->{project}{ontology},
        redcap_dict         => $redcap_dict,
        data_mapping_file   => $data_mapping_file,
        participant         => $participant,
        record              => $record,
        self                => $self,
        individual          => $individual,
        term_mapping_cursor => undef,
    };

    my ( $sex_field, $id_field ) = get_required_terms($param_sub);

    propagate_fields( $id_field, $param_sub );

    return
      unless ( defined $participant->{$id_field}
        && $participant->{$sex_field} );