line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# UMLS::Interface::CuiFinder |
2
|
|
|
|
|
|
|
# (Last Updated $Id: CuiFinder.pm,v 1.80 2016/01/07 22:49:33 btmcinnes Exp $) |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# Perl module that provides a perl interface to the |
5
|
|
|
|
|
|
|
# Unified Medical Language System (UMLS) |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
# Copyright (c) 2004-2011, |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
# Bridget T. McInnes, University of Minnesota, Twin Cities |
10
|
|
|
|
|
|
|
# bthomson at cs.umn.edu |
11
|
|
|
|
|
|
|
# |
12
|
|
|
|
|
|
|
# Siddharth Patwardhan, University of Utah, Salt Lake City |
13
|
|
|
|
|
|
|
# sidd at cs.utah.edu |
14
|
|
|
|
|
|
|
# |
15
|
|
|
|
|
|
|
# Serguei Pakhomov, University of Minnesota, Twin Cities |
16
|
|
|
|
|
|
|
# pakh0002 at umn.edu |
17
|
|
|
|
|
|
|
# |
18
|
|
|
|
|
|
|
# Ted Pedersen, University of Minnesota, Duluth |
19
|
|
|
|
|
|
|
# tpederse at d.umn.edu |
20
|
|
|
|
|
|
|
# |
21
|
|
|
|
|
|
|
# Ying Liu, University of Minnesota, Twin Cities |
22
|
|
|
|
|
|
|
# liux0935 at umn.edu |
23
|
|
|
|
|
|
|
# |
24
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or |
25
|
|
|
|
|
|
|
# modify it under the terms of the GNU General Public License |
26
|
|
|
|
|
|
|
# as published by the Free Software Foundation; either version 2 |
27
|
|
|
|
|
|
|
# of the License, or (at your option) any later version. |
28
|
|
|
|
|
|
|
# |
29
|
|
|
|
|
|
|
# This program is distributed in the hope that it will be useful, |
30
|
|
|
|
|
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
31
|
|
|
|
|
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
32
|
|
|
|
|
|
|
# GNU General Public License for more details. |
33
|
|
|
|
|
|
|
# |
34
|
|
|
|
|
|
|
# You should have received a copy of the GNU General Public License |
35
|
|
|
|
|
|
|
# along with this program; if not, write to |
36
|
|
|
|
|
|
|
# |
37
|
|
|
|
|
|
|
# The Free Software Foundation, Inc., |
38
|
|
|
|
|
|
|
# 59 Temple Place - Suite 330, |
39
|
|
|
|
|
|
|
# Boston, MA 02111-1307, USA. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
package UMLS::Interface::CuiFinder; |
42
|
|
|
|
|
|
|
|
43
|
24
|
|
|
24
|
|
122
|
use Fcntl; |
|
24
|
|
|
|
|
43
|
|
|
24
|
|
|
|
|
7050
|
|
44
|
24
|
|
|
24
|
|
125
|
use strict; |
|
24
|
|
|
|
|
45
|
|
|
24
|
|
|
|
|
516
|
|
45
|
24
|
|
|
24
|
|
119
|
use warnings; |
|
24
|
|
|
|
|
43
|
|
|
24
|
|
|
|
|
862
|
|
46
|
24
|
|
|
24
|
|
121
|
use DBI; |
|
24
|
|
|
|
|
37
|
|
|
24
|
|
|
|
|
1013
|
|
47
|
24
|
|
|
24
|
|
115
|
use bytes; |
|
24
|
|
|
|
|
43
|
|
|
24
|
|
|
|
|
111
|
|
48
|
|
|
|
|
|
|
|
49
|
24
|
|
|
24
|
|
18192
|
use Digest::SHA1 qw(sha1 sha1_hex sha1_base64); |
|
24
|
|
|
|
|
18602
|
|
|
24
|
|
|
|
|
673504
|
|
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# error handling variables |
52
|
|
|
|
|
|
|
my $errorhandler = ""; |
53
|
|
|
|
|
|
|
my $pkg = "UMLS::Interface::CuiFinder"; |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
# debug variables |
56
|
|
|
|
|
|
|
local(*DEBUG_FILE); |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
# global variables |
59
|
|
|
|
|
|
|
my $debug = 0; |
60
|
|
|
|
|
|
|
my $umlsRoot = "C0000000"; |
61
|
|
|
|
|
|
|
my $version = ""; |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# list of allowable sources |
64
|
|
|
|
|
|
|
my $sources = ""; |
65
|
|
|
|
|
|
|
my %sabHash = (); |
66
|
|
|
|
|
|
|
my %sabnamesHash = (); |
67
|
|
|
|
|
|
|
my $sabstring = ""; |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# list of allowable relations |
70
|
|
|
|
|
|
|
my $relations = ""; |
71
|
|
|
|
|
|
|
my $childRelations = ""; |
72
|
|
|
|
|
|
|
my $parentRelations = ""; |
73
|
|
|
|
|
|
|
my $relstring = ""; |
74
|
|
|
|
|
|
|
my $relastring = ""; |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# upper level taxonomy |
77
|
|
|
|
|
|
|
my %parentTaxonomyArray = (); |
78
|
|
|
|
|
|
|
my %childTaxonomyArray = (); |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# list of interested cuis - default is |
81
|
|
|
|
|
|
|
# all given the specified set of sources |
82
|
|
|
|
|
|
|
# and relations. |
83
|
|
|
|
|
|
|
my %cuiListHash = (); |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
# initialize the semantic groups and relations hash |
86
|
|
|
|
|
|
|
my %semanticGroups = (); |
87
|
|
|
|
|
|
|
my %semanticRelations = (); |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
# database |
90
|
|
|
|
|
|
|
my $indexDB = "umlsinterfaceindex"; |
91
|
|
|
|
|
|
|
my $umlsinterface = $ENV{UMLSINTERFACE_CONFIGFILE_DIR}; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# table names |
94
|
|
|
|
|
|
|
my $tableName = ""; |
95
|
|
|
|
|
|
|
my $intrinsicTable = ""; |
96
|
|
|
|
|
|
|
my $parentTable = ""; |
97
|
|
|
|
|
|
|
my $childTable = ""; |
98
|
|
|
|
|
|
|
my $tableFile = ""; |
99
|
|
|
|
|
|
|
my $intrinsicTableHuman= ""; |
100
|
|
|
|
|
|
|
my $parentTableHuman = ""; |
101
|
|
|
|
|
|
|
my $childTableHuman = ""; |
102
|
|
|
|
|
|
|
my $tableNameHuman = ""; |
103
|
|
|
|
|
|
|
my $configFile = ""; |
104
|
|
|
|
|
|
|
my $childFile = ""; |
105
|
|
|
|
|
|
|
my $parentFile = ""; |
106
|
|
|
|
|
|
|
my $infoTable = ""; |
107
|
|
|
|
|
|
|
my $infoTableHuman = ""; |
108
|
|
|
|
|
|
|
my $cacheTable = ""; |
109
|
|
|
|
|
|
|
my $cacheTableHuman = ""; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# flags and options |
112
|
|
|
|
|
|
|
my $umlsall = 0; |
113
|
|
|
|
|
|
|
my $sabdef_umlsall = 0; |
114
|
|
|
|
|
|
|
my $option_verbose = 0; |
115
|
|
|
|
|
|
|
my $option_cuilist = 0; |
116
|
|
|
|
|
|
|
my $option_t = 0; |
117
|
|
|
|
|
|
|
my $option_config = 0; |
118
|
|
|
|
|
|
|
my $defflag = 0; |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# definition containers |
121
|
|
|
|
|
|
|
my $sabdefsources = ""; |
122
|
|
|
|
|
|
|
my %relDefHash = (); |
123
|
|
|
|
|
|
|
my %sabDefHash = (); |
124
|
|
|
|
|
|
|
my $reldefstring = ""; |
125
|
|
|
|
|
|
|
my $sabdefstring = ""; |
126
|
|
|
|
|
|
|
my $reladefchildren = ""; |
127
|
|
|
|
|
|
|
my $reladefparents = ""; |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
my %parameters = (); |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
###################################################################### |
132
|
|
|
|
|
|
|
# functions to initialize the package |
133
|
|
|
|
|
|
|
###################################################################### |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
# method to create a new UMLS::Interface object |
136
|
|
|
|
|
|
|
# input : $parameters <- reference to a hash |
137
|
|
|
|
|
|
|
# output: $self |
138
|
|
|
|
|
|
|
sub new { |
139
|
|
|
|
|
|
|
|
140
|
22
|
|
|
22
|
0
|
60
|
my $self = {}; |
141
|
22
|
|
|
|
|
53
|
my $className = shift; |
142
|
22
|
|
|
|
|
45
|
my $params = shift; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# bless the object. |
145
|
22
|
|
|
|
|
51
|
bless($self, $className); |
146
|
|
|
|
|
|
|
|
147
|
22
|
|
|
|
|
111
|
$self->_initializeGlobalVariables(); |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
# initialize error handler |
150
|
22
|
|
|
|
|
94
|
$errorhandler = UMLS::Interface::ErrorHandler->new(); |
151
|
22
|
50
|
|
|
|
103
|
if(! defined $errorhandler) { |
152
|
0
|
|
|
|
|
0
|
print STDERR "The error handler did not get passed properly.\n"; |
153
|
0
|
|
|
|
|
0
|
exit; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# initialize the object. |
157
|
22
|
|
|
|
|
97
|
$self->_initialize($params); |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
# set the semantic groups |
160
|
0
|
|
|
|
|
0
|
$self->_setSemanticGroups(); |
161
|
|
|
|
|
|
|
|
162
|
0
|
|
|
|
|
0
|
return $self; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# method to re-initialize the UMLS::Interface parameters |
166
|
|
|
|
|
|
|
sub _reConfig { |
167
|
|
|
|
|
|
|
|
168
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
169
|
0
|
|
|
|
|
0
|
my $params = shift; |
170
|
|
|
|
|
|
|
|
171
|
0
|
|
|
|
|
0
|
my $function = "_reConfig"; |
172
|
0
|
|
|
|
|
0
|
&_debug($function); |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
# re initialize the global variables |
175
|
0
|
|
|
|
|
0
|
$self->_initializeGlobalVariables(); |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
# initialize the object. |
178
|
0
|
|
|
|
|
0
|
$self->_initialize($params); |
179
|
|
|
|
|
|
|
|
180
|
0
|
|
|
|
|
0
|
return $self; |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
# method to initialize the UMLS::Interface global variables |
185
|
|
|
|
|
|
|
sub _initializeGlobalVariables { |
186
|
|
|
|
|
|
|
|
187
|
22
|
|
|
22
|
|
53
|
my $self = shift; |
188
|
|
|
|
|
|
|
|
189
|
22
|
|
|
|
|
64
|
my $function = "_initializeGlobalVariables"; |
190
|
22
|
|
|
|
|
98
|
&_debug($function); |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
# global variables |
193
|
22
|
|
|
|
|
40
|
$debug = 0; |
194
|
22
|
|
|
|
|
60
|
$version = ""; |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
# list of allowable sources |
197
|
22
|
|
|
|
|
58
|
$sources = ""; |
198
|
22
|
|
|
|
|
54
|
%sabHash = (); |
199
|
22
|
|
|
|
|
59
|
%sabnamesHash = (); |
200
|
22
|
|
|
|
|
56
|
$sabstring = ""; |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# list of allowable relations |
203
|
22
|
|
|
|
|
52
|
$relations = ""; |
204
|
22
|
|
|
|
|
48
|
$childRelations = ""; |
205
|
22
|
|
|
|
|
47
|
$parentRelations = ""; |
206
|
22
|
|
|
|
|
47
|
$relstring = ""; |
207
|
22
|
|
|
|
|
47
|
$relastring = ""; |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# upper level taxonomy |
210
|
22
|
|
|
|
|
58
|
%parentTaxonomyArray = (); |
211
|
22
|
|
|
|
|
54
|
%childTaxonomyArray = (); |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
# list of interested cuis - default is |
214
|
|
|
|
|
|
|
# all given the specified set of sources |
215
|
|
|
|
|
|
|
# and relations. |
216
|
22
|
|
|
|
|
52
|
%cuiListHash = (); |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
# table names |
220
|
22
|
|
|
|
|
53
|
$tableName = ""; |
221
|
22
|
|
|
|
|
47
|
$parentTable = ""; |
222
|
22
|
|
|
|
|
57
|
$intrinsicTable = ""; |
223
|
22
|
|
|
|
|
59
|
$childTable = ""; |
224
|
22
|
|
|
|
|
49
|
$tableFile = ""; |
225
|
22
|
|
|
|
|
42
|
$intrinsicTableHuman= ""; |
226
|
22
|
|
|
|
|
46
|
$parentTableHuman = ""; |
227
|
22
|
|
|
|
|
50
|
$childTableHuman = ""; |
228
|
22
|
|
|
|
|
44
|
$tableNameHuman = ""; |
229
|
22
|
|
|
|
|
52
|
$configFile = ""; |
230
|
22
|
|
|
|
|
54
|
$childFile = ""; |
231
|
22
|
|
|
|
|
42
|
$parentFile = ""; |
232
|
22
|
|
|
|
|
45
|
$infoTable = ""; |
233
|
22
|
|
|
|
|
49
|
$infoTableHuman = ""; |
234
|
22
|
|
|
|
|
47
|
$cacheTable = ""; |
235
|
22
|
|
|
|
|
45
|
$cacheTableHuman = ""; |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
# flags and options |
238
|
22
|
|
|
|
|
46
|
$umlsall = 0; |
239
|
22
|
|
|
|
|
44
|
$option_verbose = 0; |
240
|
22
|
|
|
|
|
38
|
$option_cuilist = 0; |
241
|
22
|
|
|
|
|
40
|
$option_t = 0; |
242
|
22
|
|
|
|
|
41
|
$option_config = 0; |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
# definition containers |
245
|
22
|
|
|
|
|
50
|
$sabdefsources = ""; |
246
|
22
|
|
|
|
|
57
|
%relDefHash = (); |
247
|
22
|
|
|
|
|
52
|
%sabDefHash = (); |
248
|
22
|
|
|
|
|
50
|
$reldefstring = ""; |
249
|
22
|
|
|
|
|
51
|
$sabdefstring = ""; |
250
|
22
|
|
|
|
|
43
|
$reladefchildren = ""; |
251
|
22
|
|
|
|
|
50
|
$reladefparents = ""; |
252
|
22
|
|
|
|
|
56
|
%parameters = (); |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
# method to initialize the UMLS::Interface object. |
257
|
|
|
|
|
|
|
# input : $parameters <- reference to a hash |
258
|
|
|
|
|
|
|
# output: |
259
|
|
|
|
|
|
|
sub _initialize { |
260
|
|
|
|
|
|
|
|
261
|
22
|
|
|
22
|
|
49
|
my $self = shift; |
262
|
22
|
|
|
|
|
54
|
my $params = shift; |
263
|
|
|
|
|
|
|
|
264
|
22
|
|
|
|
|
43
|
my $function = "_initialize"; |
265
|
22
|
|
|
|
|
70
|
&_debug($function); |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
# check self |
268
|
22
|
50
|
33
|
|
|
196
|
if(!defined $self || !ref $self) { |
269
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
|
273
|
22
|
50
|
|
|
|
81
|
$params = {} if(!defined $params); |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
# get some of the parameters |
276
|
22
|
|
|
|
|
60
|
my $config = $params->{'config'}; |
277
|
22
|
|
|
|
|
54
|
my $cuilist = $params->{'cuilist'}; |
278
|
22
|
|
|
|
|
50
|
my $database = $params->{'database'}; |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
# to store the database object |
281
|
22
|
|
|
|
|
117
|
my $db = $self->_setDatabase($params); |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
# set up the options |
284
|
0
|
|
|
|
|
0
|
$self->_setOptions($params); |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
# check that all of the tables required exist in the db |
287
|
0
|
|
|
|
|
0
|
$self->_checkTablesExist(); |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
# set the version information |
290
|
0
|
|
|
|
|
0
|
$self->_setVersion(); |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
# set the configuration |
293
|
0
|
|
|
|
|
0
|
$self->_config($config); |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
# set the umls interface configuration variable |
296
|
0
|
|
|
|
|
0
|
$self->_setEnvironmentVariable(); |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
# set the table and file names for indexing |
299
|
0
|
|
|
|
|
0
|
$self->_setConfigurationFile(); |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
# set the configfile |
302
|
0
|
|
|
|
|
0
|
$self->_setConfigFile(); |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
# load the cuilist if it has been defined |
305
|
0
|
|
|
|
|
0
|
$self->_loadCuiList($cuilist); |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
# create the index database |
308
|
0
|
|
|
|
|
0
|
$self->_createIndexDB(); |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
# connect to the index database |
311
|
0
|
|
|
|
|
0
|
$self->_connectIndexDB(); |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
# set the upper level taxonomy |
314
|
0
|
|
|
|
|
0
|
$self->_setUpperLevelTaxonomy(); |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
# set the cache tables |
317
|
0
|
|
|
|
|
0
|
$self->_setCacheTable(); |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
# this function returns the umls root |
321
|
|
|
|
|
|
|
# input : |
322
|
|
|
|
|
|
|
# output: $string <- string containing the root |
323
|
|
|
|
|
|
|
sub _root { |
324
|
|
|
|
|
|
|
|
325
|
0
|
|
|
0
|
|
0
|
return $umlsRoot; |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
# this function sets the upper level taxonomy between |
329
|
|
|
|
|
|
|
# the sources and the root UMLS node |
330
|
|
|
|
|
|
|
# input : |
331
|
|
|
|
|
|
|
# output: |
332
|
|
|
|
|
|
|
sub _setCacheTable { |
333
|
|
|
|
|
|
|
|
334
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
335
|
|
|
|
|
|
|
|
336
|
0
|
|
|
|
|
0
|
my $function = "_setCacheTable"; |
337
|
0
|
|
|
|
|
0
|
&_debug($function); |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
# check self |
340
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
341
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
# set the sourceDB handler |
345
|
0
|
|
|
|
|
0
|
my $sdb = $self->{'sdb'}; |
346
|
0
|
0
|
|
|
|
0
|
if(!$sdb) { $errorhandler->_error($pkg, $function, "Error with sdb.", 3); } |
|
0
|
|
|
|
|
0
|
|
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
# check if the cache table exists |
349
|
|
|
|
|
|
|
# if does just return otherwise create it |
350
|
0
|
0
|
|
|
|
0
|
if($self->_checkTableExists($cacheTable)) { |
351
|
0
|
|
|
|
|
0
|
return; |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
else { |
354
|
|
|
|
|
|
|
# create cache table |
355
|
0
|
|
|
|
|
0
|
$sdb->do("CREATE TABLE IF NOT EXISTS $cacheTable (CUI1 char(8), CUI2 char(8), LENGTH char(8))"); |
356
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
357
|
|
|
|
|
|
|
# store the name in the table index |
358
|
0
|
|
|
|
|
0
|
$sdb->do("INSERT INTO tableindex (TABLENAME, HEX) VALUES ('$cacheTableHuman', '$cacheTable')"); |
359
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
# this function sets the upper level taxonomy between |
364
|
|
|
|
|
|
|
# the sources and the root UMLS node |
365
|
|
|
|
|
|
|
# input : |
366
|
|
|
|
|
|
|
# output: |
367
|
|
|
|
|
|
|
sub _setUpperLevelTaxonomy { |
368
|
|
|
|
|
|
|
|
369
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
370
|
|
|
|
|
|
|
|
371
|
0
|
|
|
|
|
0
|
my $function = "_setUpperLevelTaxonomy"; |
372
|
0
|
|
|
|
|
0
|
&_debug($function); |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
# check self |
375
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
376
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
# set the sourceDB handler |
380
|
0
|
|
|
|
|
0
|
my $sdb = $self->{'sdb'}; |
381
|
0
|
0
|
|
|
|
0
|
if(!$sdb) { $errorhandler->_error($pkg, $function, "Error with sdb.", 3); } |
|
0
|
|
|
|
|
0
|
|
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
# check if the taxonomy is already set |
384
|
0
|
|
|
|
|
0
|
my $ckeys = keys %childTaxonomyArray; |
385
|
0
|
|
|
|
|
0
|
my $pkeys = keys %parentTaxonomyArray; |
386
|
0
|
0
|
|
|
|
0
|
if($pkeys > 0) { return; } |
|
0
|
|
|
|
|
0
|
|
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
# check if the parent and child tables exist and |
389
|
|
|
|
|
|
|
# if they do just return otherwise create them |
390
|
0
|
0
|
0
|
|
|
0
|
if($self->_checkTableExists($childTable) and |
391
|
|
|
|
|
|
|
$self->_checkTableExists($parentTable)) { |
392
|
0
|
|
|
|
|
0
|
$self->_loadTaxonomyArrays(); |
393
|
0
|
|
|
|
|
0
|
return; |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
else { |
396
|
0
|
|
|
|
|
0
|
$self->_createTaxonomyTables(); |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
# if the parent and child files exist just load them into the database |
400
|
0
|
0
|
0
|
|
|
0
|
if( (-e $childFile) and (-e $parentFile) ) { |
401
|
0
|
|
|
|
|
0
|
$self->_loadTaxonomyTables(); |
402
|
|
|
|
|
|
|
} |
403
|
|
|
|
|
|
|
# otherwise we need to create them |
404
|
|
|
|
|
|
|
else { |
405
|
0
|
|
|
|
|
0
|
$self->_createUpperLevelTaxonomy(); |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
# this function creates the upper level taxonomy between the |
410
|
|
|
|
|
|
|
# the sources and the root UMLS node |
411
|
|
|
|
|
|
|
# this function creates the upper level taxonomy between the |
412
|
|
|
|
|
|
|
# the sources and the root UMLS node |
413
|
|
|
|
|
|
|
# input : |
414
|
|
|
|
|
|
|
# output: |
415
|
|
|
|
|
|
|
sub _createUpperLevelTaxonomy { |
416
|
|
|
|
|
|
|
|
417
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
418
|
|
|
|
|
|
|
|
419
|
0
|
|
|
|
|
0
|
my $function = "_createUpperLevelTaxonomy"; |
420
|
0
|
|
|
|
|
0
|
&_debug($function); |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
# check self |
423
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
424
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
# set the index DB handler |
428
|
0
|
|
|
|
|
0
|
my $sdb = $self->{'sdb'}; |
429
|
0
|
0
|
|
|
|
0
|
if(!$sdb) { $errorhandler->_error($pkg, $function, "Error with sdb.", 3); } |
|
0
|
|
|
|
|
0
|
|
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
# set up the database |
432
|
0
|
|
|
|
|
0
|
my $db = $self->{'db'}; |
433
|
0
|
0
|
|
|
|
0
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
0
|
|
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
# open the parent and child files to store the upper level |
436
|
|
|
|
|
|
|
# taxonomy information if the verbose option is defined |
437
|
0
|
0
|
|
|
|
0
|
if($option_verbose) { |
438
|
0
|
0
|
|
|
|
0
|
open(CHD, ">$childFile") || die "Could not open $childFile\n"; |
439
|
0
|
0
|
|
|
|
0
|
open(PAR, ">$parentFile") || die "Could not open $parentFile\n"; |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
|
442
|
0
|
|
|
|
|
0
|
foreach my $sab (sort keys %sabnamesHash) { |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
# get the sab's cui |
445
|
0
|
|
|
|
|
0
|
my $sab_cui = $self->_getSabCui($sab); |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
# select all the CUIs from MRREL |
448
|
0
|
|
|
|
|
0
|
my $allCuis = $self->_getCuis($sab); |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
# select all the CUI1s from MRREL that have a parent link |
451
|
|
|
|
|
|
|
# if a parent relation exists |
452
|
0
|
|
|
|
|
0
|
my $parCuis = ""; |
453
|
0
|
|
|
|
|
0
|
my %parCuisHash = (); |
454
|
0
|
0
|
|
|
|
0
|
if( !($parentRelations=~/\(\)/) ) { |
455
|
0
|
|
|
|
|
0
|
$parCuis = $db->selectcol_arrayref("select CUI1 from MRREL where ($parentRelations) and (SAB=\'$sab\') and SUPPRESS='N'"); |
456
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
# load the cuis that have a parent into a temporary hash |
459
|
0
|
|
|
|
|
0
|
foreach my $cui (@{$parCuis}) { $parCuisHash{$cui}++; } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
# load the cuis that do not have a parent into the parent |
463
|
|
|
|
|
|
|
# and chilren taxonomy for the upper level |
464
|
0
|
|
|
|
|
0
|
foreach my $cui (@{$allCuis}) { |
|
0
|
|
|
|
|
0
|
|
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
# if the cui has a parent move on |
467
|
0
|
0
|
|
|
|
0
|
if(exists $parCuisHash{$cui}) { next; } |
|
0
|
|
|
|
|
0
|
|
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
# already seen this cui so move on |
470
|
0
|
0
|
|
|
|
0
|
if(exists $parentTaxonomyArray{$cui}) { next; } |
|
0
|
|
|
|
|
0
|
|
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
|
473
|
0
|
0
|
|
|
|
0
|
if($sab_cui eq $cui) { next; } |
|
0
|
|
|
|
|
0
|
|
474
|
|
|
|
|
|
|
|
475
|
0
|
|
|
|
|
0
|
push @{$parentTaxonomyArray{$cui}}, $sab_cui; |
|
0
|
|
|
|
|
0
|
|
476
|
0
|
|
|
|
|
0
|
push @{$childTaxonomyArray{$sab_cui}}, $cui; |
|
0
|
|
|
|
|
0
|
|
477
|
|
|
|
|
|
|
|
478
|
0
|
|
|
|
|
0
|
$sdb->do("INSERT INTO $parentTable (CUI1, CUI2) VALUES ('$cui', '$sab_cui')"); |
479
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
480
|
|
|
|
|
|
|
|
481
|
0
|
|
|
|
|
0
|
$sdb->do("INSERT INTO $childTable (CUI1, CUI2) VALUES ('$sab_cui', '$cui')"); |
482
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
# print this information to the parent and child |
485
|
|
|
|
|
|
|
# file is the verbose option has been set |
486
|
0
|
0
|
|
|
|
0
|
if($option_verbose) { |
487
|
0
|
|
|
|
|
0
|
print PAR "$cui $sab_cui\n"; |
488
|
0
|
|
|
|
|
0
|
print CHD "$sab_cui $cui\n"; |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
# add the sab cuis to the parent and children Taxonomy |
493
|
0
|
|
|
|
|
0
|
push @{$parentTaxonomyArray{$sab_cui}}, $umlsRoot; |
|
0
|
|
|
|
|
0
|
|
494
|
0
|
|
|
|
|
0
|
push @{$childTaxonomyArray{$umlsRoot}}, $sab_cui; |
|
0
|
|
|
|
|
0
|
|
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
# print it to the table if the verbose option is set |
497
|
0
|
0
|
|
|
|
0
|
if($option_verbose) { |
498
|
0
|
|
|
|
|
0
|
print PAR "$sab_cui $umlsRoot\n"; |
499
|
0
|
|
|
|
|
0
|
print CHD "$umlsRoot $sab_cui\n"; |
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
# store this information in the database |
503
|
0
|
|
|
|
|
0
|
$sdb->do("INSERT INTO $parentTable (CUI1, CUI2) VALUES ('$sab_cui', '$umlsRoot')"); |
504
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
505
|
|
|
|
|
|
|
|
506
|
0
|
|
|
|
|
0
|
$sdb->do("INSERT INTO $childTable (CUI1, CUI2) VALUES ('$umlsRoot', '$sab_cui')"); |
507
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
# close the parent and child tables if opened |
511
|
0
|
0
|
|
|
|
0
|
if($option_verbose) { close PAR; close CHD; } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
# print out some information |
514
|
0
|
|
|
|
|
0
|
my $pkey = keys %parentTaxonomyArray; |
515
|
0
|
|
|
|
|
0
|
my $ckey = keys %childTaxonomyArray; |
516
|
|
|
|
|
|
|
|
517
|
0
|
0
|
|
|
|
0
|
if($debug) { |
518
|
0
|
|
|
|
|
0
|
print STDERR "Taxonomy is set:\n"; |
519
|
0
|
|
|
|
|
0
|
print STDERR " parentTaxonomyArray: $pkey\n"; |
520
|
0
|
|
|
|
|
0
|
print STDERR " childTaxonomyArray: $ckey\n\n"; |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
# this function creates the taxonomy tables if they don't |
525
|
|
|
|
|
|
|
# already exist in the umlsinterfaceindex database |
526
|
|
|
|
|
|
|
# input : |
527
|
|
|
|
|
|
|
# output: |
528
|
|
|
|
|
|
|
sub _createTaxonomyTables { |
529
|
|
|
|
|
|
|
|
530
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
531
|
|
|
|
|
|
|
|
532
|
0
|
|
|
|
|
0
|
my $function = "_createTaxonomyTables"; |
533
|
0
|
|
|
|
|
0
|
&_debug($function); |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
# check self |
536
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
537
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
# set the index DB handler |
541
|
0
|
|
|
|
|
0
|
my $sdb = $self->{'sdb'}; |
542
|
0
|
0
|
|
|
|
0
|
if(!$sdb) { $errorhandler->_error($pkg, $function, "Error with sdb.", 3); } |
|
0
|
|
|
|
|
0
|
|
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
# create intrinsic table |
545
|
0
|
|
|
|
|
0
|
$sdb->do("CREATE TABLE IF NOT EXISTS $intrinsicTable (CUI char(8), LEAVES int, SUBSUMERS int, INDEX(CUI))"); |
546
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
# create parent table |
549
|
0
|
|
|
|
|
0
|
$sdb->do("CREATE TABLE IF NOT EXISTS $parentTable (CUI1 char(8), CUI2 char(8))"); |
550
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
# create child table |
553
|
0
|
|
|
|
|
0
|
$sdb->do("CREATE TABLE IF NOT EXISTS $childTable (CUI1 char(8), CUI2 char(8))"); |
554
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
# create info table |
557
|
0
|
|
|
|
|
0
|
$sdb->do("CREATE TABLE IF NOT EXISTS $infoTable (ITEM char(8), INFO char(8))"); |
558
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
# create the index table if it doesn't already exist |
561
|
0
|
|
|
|
|
0
|
$sdb->do("CREATE TABLE IF NOT EXISTS tableindex (TABLENAME blob(1000000), HEX char(41))"); |
562
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
# add them to the index table |
565
|
0
|
|
|
|
|
0
|
$sdb->do("INSERT INTO tableindex (TABLENAME, HEX) VALUES ('$intrinsicTableHuman', '$intrinsicTable')"); |
566
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
567
|
0
|
|
|
|
|
0
|
$sdb->do("INSERT INTO tableindex (TABLENAME, HEX) VALUES ('$parentTableHuman', '$parentTable')"); |
568
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
569
|
0
|
|
|
|
|
0
|
$sdb->do("INSERT INTO tableindex (TABLENAME, HEX) VALUES ('$childTableHuman', '$childTable')"); |
570
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
571
|
0
|
|
|
|
|
0
|
$sdb->do("INSERT INTO tableindex (TABLENAME, HEX) VALUES ('$infoTableHuman', '$infoTable')"); |
572
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
# this function loads the taxonomy tables if the |
576
|
|
|
|
|
|
|
# configuration files exist for them |
577
|
|
|
|
|
|
|
# input : |
578
|
|
|
|
|
|
|
# output: |
579
|
|
|
|
|
|
|
sub _loadTaxonomyTables { |
580
|
|
|
|
|
|
|
|
581
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
582
|
|
|
|
|
|
|
|
583
|
0
|
|
|
|
|
0
|
my $function = "_loadTaxonomyTables"; |
584
|
0
|
|
|
|
|
0
|
&_debug($function); |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
# check self |
587
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
588
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
589
|
|
|
|
|
|
|
} |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
# set the index DB handler |
592
|
0
|
|
|
|
|
0
|
my $sdb = $self->{'sdb'}; |
593
|
0
|
0
|
|
|
|
0
|
if(!$sdb) { $errorhandler->_error($pkg, $function, "Error with sdb.", 3); } |
|
0
|
|
|
|
|
0
|
|
594
|
|
|
|
|
|
|
|
595
|
0
|
0
|
|
|
|
0
|
open(PAR, $parentFile) || die "Could not open $parentFile\n"; |
596
|
0
|
0
|
|
|
|
0
|
open(CHD, $childFile) || die "Could not open $childFile\n"; |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
# load parent table |
599
|
0
|
|
|
|
|
0
|
while() { |
600
|
0
|
|
|
|
|
0
|
chomp; |
601
|
0
|
0
|
|
|
|
0
|
if($_=~/^\s*$/) { next; } |
|
0
|
|
|
|
|
0
|
|
602
|
0
|
|
|
|
|
0
|
my ($cui1, $cui2) = split/\s+/; |
603
|
|
|
|
|
|
|
|
604
|
0
|
|
|
|
|
0
|
my $arrRef = $sdb->do("INSERT INTO $parentTable (CUI1, CUI2) VALUES ('$cui1', '$cui2')"); |
605
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
606
|
|
|
|
|
|
|
} |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
# load child table |
609
|
0
|
|
|
|
|
0
|
while() { |
610
|
0
|
|
|
|
|
0
|
chomp; |
611
|
0
|
0
|
|
|
|
0
|
if($_=~/^\s*$/) { next; } |
|
0
|
|
|
|
|
0
|
|
612
|
0
|
|
|
|
|
0
|
my ($cui1, $cui2) = split/\s+/; |
613
|
0
|
|
|
|
|
0
|
my $arrRef = $sdb->do("INSERT INTO $childTable (CUI1, CUI2) VALUES ('$cui1', '$cui2')"); |
614
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
615
|
|
|
|
|
|
|
} |
616
|
0
|
|
|
|
|
0
|
close PAR; close CHD; |
|
0
|
|
|
|
|
0
|
|
617
|
|
|
|
|
|
|
} |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
# this function sets the taxonomy arrays |
620
|
|
|
|
|
|
|
# input : |
621
|
|
|
|
|
|
|
# output: |
622
|
|
|
|
|
|
|
sub _loadTaxonomyArrays { |
623
|
|
|
|
|
|
|
|
624
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
625
|
|
|
|
|
|
|
|
626
|
0
|
|
|
|
|
0
|
my $function = "_loadTaxonomyArrays"; |
627
|
0
|
|
|
|
|
0
|
&_debug($function); |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
# check self |
630
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
631
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
632
|
|
|
|
|
|
|
} |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
# set the index DB handler |
635
|
0
|
|
|
|
|
0
|
my $sdb = $self->{'sdb'}; |
636
|
0
|
0
|
|
|
|
0
|
if(!$sdb) { $errorhandler->_error($pkg, $function, "Error with sdb.", 3); } |
|
0
|
|
|
|
|
0
|
|
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
# set the parent taxonomy |
639
|
0
|
|
|
|
|
0
|
my $sql = qq{ SELECT CUI1, CUI2 FROM $parentTable}; |
640
|
0
|
|
|
|
|
0
|
my $sth = $sdb->prepare( $sql ); |
641
|
0
|
|
|
|
|
0
|
$sth->execute(); |
642
|
0
|
|
|
|
|
0
|
my($cui1, $cui2); |
643
|
0
|
|
|
|
|
0
|
$sth->bind_columns( undef, \$cui1, \$cui2 ); |
644
|
0
|
|
|
|
|
0
|
while( $sth->fetch() ) { |
645
|
0
|
|
|
|
|
0
|
push @{$parentTaxonomyArray{$cui1}}, $cui2; |
|
0
|
|
|
|
|
0
|
|
646
|
|
|
|
|
|
|
} |
647
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sth); |
648
|
0
|
|
|
|
|
0
|
$sth->finish(); |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
# set the child taxonomy |
651
|
0
|
|
|
|
|
0
|
$sql = qq{ SELECT CUI1, CUI2 FROM $childTable}; |
652
|
0
|
|
|
|
|
0
|
$sth = $sdb->prepare( $sql ); |
653
|
0
|
|
|
|
|
0
|
$sth->execute(); |
654
|
0
|
|
|
|
|
0
|
$sth->bind_columns( undef, \$cui1, \$cui2 ); |
655
|
0
|
|
|
|
|
0
|
while( $sth->fetch() ) { |
656
|
0
|
|
|
|
|
0
|
push @{$childTaxonomyArray{$cui1}}, $cui2; |
|
0
|
|
|
|
|
0
|
|
657
|
|
|
|
|
|
|
} |
658
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sth); |
659
|
0
|
|
|
|
|
0
|
$sth->finish(); |
660
|
|
|
|
|
|
|
} |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
# function checks to see if a given table exists |
663
|
|
|
|
|
|
|
# input : $table <- string |
664
|
|
|
|
|
|
|
# output: 0 | 1 <- integers |
665
|
|
|
|
|
|
|
sub _checkTableExists { |
666
|
|
|
|
|
|
|
|
667
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
668
|
0
|
|
|
|
|
0
|
my $table = shift; |
669
|
|
|
|
|
|
|
|
670
|
0
|
|
|
|
|
0
|
my $function = "_checkTableExists"; |
671
|
0
|
|
|
|
|
0
|
&_debug($function); |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
# check self |
674
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
675
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
|
678
|
0
|
0
|
|
|
|
0
|
if(!defined $table) { |
679
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "Error with input variable \$table.", 4); |
680
|
|
|
|
|
|
|
} |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
# check that the database exists |
683
|
0
|
|
|
|
|
0
|
my $sdb = $self->{'sdb'}; |
684
|
0
|
0
|
|
|
|
0
|
if(!$sdb) { $errorhandler->_error($pkg, $function, "Error with sdb.", 3); } |
|
0
|
|
|
|
|
0
|
|
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
# set an execute the query to show all of the tables |
687
|
0
|
|
|
|
|
0
|
my $sth = $sdb->prepare("show tables"); |
688
|
0
|
|
|
|
|
0
|
$sth->execute(); |
689
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sth); |
690
|
|
|
|
|
|
|
|
691
|
0
|
|
|
|
|
0
|
my $t = ""; |
692
|
0
|
|
|
|
|
0
|
my %tables = (); |
693
|
0
|
|
|
|
|
0
|
while(($t) = $sth->fetchrow()) { |
694
|
0
|
|
|
|
|
0
|
$tables{lc($t)} = 1; |
695
|
|
|
|
|
|
|
} |
696
|
0
|
|
|
|
|
0
|
$sth->finish(); |
697
|
|
|
|
|
|
|
|
698
|
0
|
0
|
|
|
|
0
|
if(! (exists$tables{lc($table)})) { return 0; } |
|
0
|
|
|
|
|
0
|
|
699
|
0
|
|
|
|
|
0
|
else { return 1; } |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
} |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
# connect the database to the source db that holds |
704
|
|
|
|
|
|
|
# the path tables for user specified source(s) and |
705
|
|
|
|
|
|
|
# relation(s) |
706
|
|
|
|
|
|
|
# input : |
707
|
|
|
|
|
|
|
# output: $sdb <- reference to the database |
708
|
|
|
|
|
|
|
sub _connectIndexDB { |
709
|
|
|
|
|
|
|
|
710
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
711
|
|
|
|
|
|
|
|
712
|
0
|
|
|
|
|
0
|
my $function = "_connectIndexDB"; |
713
|
0
|
|
|
|
|
0
|
&_debug($function); |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
# check self |
716
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
717
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
718
|
|
|
|
|
|
|
} |
719
|
|
|
|
|
|
|
|
720
|
0
|
|
|
|
|
0
|
my $sdb = ""; |
721
|
0
|
0
|
|
|
|
0
|
if(defined $self->{'username'}) { |
722
|
|
|
|
|
|
|
|
723
|
0
|
|
|
|
|
0
|
my $username = $self->{'username'}; |
724
|
0
|
|
|
|
|
0
|
my $password = $self->{'password'}; |
725
|
0
|
|
|
|
|
0
|
my $hostname = $self->{'hostname'}; |
726
|
0
|
|
|
|
|
0
|
my $socket = $self->{'socket'}; |
727
|
|
|
|
|
|
|
|
728
|
0
|
|
|
|
|
0
|
eval{$sdb = DBI->connect("DBI:mysql:database=$indexDB;mysql_socket=$socket;host=$hostname", |
|
0
|
|
|
|
|
0
|
|
729
|
|
|
|
|
|
|
$username, $password, |
730
|
|
|
|
|
|
|
{RaiseError => 1, PrintError => 1, AutoCommit => 0 });}; |
731
|
|
|
|
|
|
|
|
732
|
0
|
0
|
|
|
|
0
|
if($@) { $errorhandler->_error($pkg, $function, "No database to connect to", 1); } |
|
0
|
|
|
|
|
0
|
|
733
|
|
|
|
|
|
|
} |
734
|
|
|
|
|
|
|
else { |
735
|
0
|
|
|
|
|
0
|
my $dsn = "DBI:mysql:$indexDB;mysql_read_default_group=client;"; |
736
|
0
|
|
|
|
|
0
|
eval{$sdb = DBI->connect($dsn);}; |
|
0
|
|
|
|
|
0
|
|
737
|
0
|
0
|
|
|
|
0
|
if($@) { $errorhandler->_error($pkg, $function, "No database to connect to", 1); } |
|
0
|
|
|
|
|
0
|
|
738
|
|
|
|
|
|
|
} |
739
|
|
|
|
|
|
|
|
740
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
# set database parameters |
743
|
0
|
|
|
|
|
0
|
$sdb->{'mysql_enable_utf8'} = 1; |
744
|
0
|
|
|
|
|
0
|
$sdb->do('SET NAMES utf8'); |
745
|
0
|
|
|
|
|
0
|
$sdb->{mysql_auto_reconnect} = 1; |
746
|
|
|
|
|
|
|
|
747
|
0
|
|
|
|
|
0
|
$self->{'sdb'} = $sdb; |
748
|
|
|
|
|
|
|
|
749
|
0
|
|
|
|
|
0
|
return $sdb; |
750
|
|
|
|
|
|
|
} |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
# return the database connection to the umlsinterfaceindex |
753
|
|
|
|
|
|
|
# input : |
754
|
|
|
|
|
|
|
# output: $sdb <- database handler |
755
|
|
|
|
|
|
|
sub _getIndexDB { |
756
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
757
|
|
|
|
|
|
|
|
758
|
0
|
|
|
|
|
0
|
my $function = "_getIndexDB"; |
759
|
0
|
|
|
|
|
0
|
&_debug($function); |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
# check self |
762
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
763
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
764
|
|
|
|
|
|
|
} |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
# get the databawse |
767
|
0
|
|
|
|
|
0
|
my $sdb = $self->{'sdb'}; |
768
|
0
|
0
|
|
|
|
0
|
if(!$sdb) { $errorhandler->_error($pkg, $function, "Error with sdb.", 3); } |
|
0
|
|
|
|
|
0
|
|
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
# return the database |
771
|
0
|
|
|
|
|
0
|
return $sdb; |
772
|
|
|
|
|
|
|
} |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
# return the database connection to the umls database |
775
|
|
|
|
|
|
|
# input : |
776
|
|
|
|
|
|
|
# output: $db <- database handler |
777
|
|
|
|
|
|
|
sub _getDB { |
778
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
779
|
|
|
|
|
|
|
|
780
|
0
|
|
|
|
|
0
|
my $function = "_getDB"; |
781
|
0
|
|
|
|
|
0
|
&_debug($function); |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
# check self |
784
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
785
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
786
|
|
|
|
|
|
|
} |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
# get the databawse |
789
|
0
|
|
|
|
|
0
|
my $db = $self->{'db'}; |
790
|
0
|
0
|
|
|
|
0
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
0
|
|
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
# return the database |
793
|
0
|
|
|
|
|
0
|
return $db; |
794
|
|
|
|
|
|
|
} |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
# this function creates the umlsinterfaceindex database connection |
797
|
|
|
|
|
|
|
# input : |
798
|
|
|
|
|
|
|
# output: |
799
|
|
|
|
|
|
|
sub _createIndexDB { |
800
|
|
|
|
|
|
|
|
801
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
802
|
|
|
|
|
|
|
|
803
|
0
|
|
|
|
|
0
|
my $function = "_createIndexDB"; |
804
|
0
|
|
|
|
|
0
|
&_debug($function); |
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
# check self |
807
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
808
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
809
|
|
|
|
|
|
|
} |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
# check that the database exists |
812
|
0
|
|
|
|
|
0
|
my $db = $self->{'db'}; |
813
|
0
|
0
|
|
|
|
0
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
0
|
|
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
# show all of the databases |
816
|
0
|
|
|
|
|
0
|
my $sth = $db->prepare("show databases"); |
817
|
0
|
|
|
|
|
0
|
$sth->execute(); |
818
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sth); |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
# get all the databases in mysql |
821
|
0
|
|
|
|
|
0
|
my $database = ""; |
822
|
0
|
|
|
|
|
0
|
my %databases = (); |
823
|
0
|
|
|
|
|
0
|
while(($database) = $sth->fetchrow()) { |
824
|
0
|
|
|
|
|
0
|
$databases{$database}++; |
825
|
|
|
|
|
|
|
} |
826
|
0
|
|
|
|
|
0
|
$sth->finish(); |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
# removing any spaces that may have been |
829
|
|
|
|
|
|
|
# introduced in while creating its name |
830
|
0
|
|
|
|
|
0
|
$indexDB=~s/\s+//g; |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
# if the database doesn't exist create it |
833
|
0
|
0
|
|
|
|
0
|
if(! (exists $databases{$indexDB})) { |
834
|
0
|
|
|
|
|
0
|
$db->do("create database $indexDB"); |
835
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
836
|
|
|
|
|
|
|
} |
837
|
|
|
|
|
|
|
} |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
# gets the DUI of a given CUI |
840
|
|
|
|
|
|
|
# input: $concept -> string containing the cui |
841
|
|
|
|
|
|
|
# output: $dui -> string containing the dui |
842
|
|
|
|
|
|
|
sub _getDUI { |
843
|
|
|
|
|
|
|
|
844
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
845
|
0
|
|
|
|
|
0
|
my $concept = shift; |
846
|
|
|
|
|
|
|
|
847
|
0
|
|
|
|
|
0
|
my $function = "_getDUI"; |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
# check input values |
850
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
851
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
852
|
|
|
|
|
|
|
} |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
# check parameters |
855
|
0
|
0
|
|
|
|
0
|
if(!defined $concept) { |
856
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
857
|
|
|
|
|
|
|
} |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
# set the database |
860
|
0
|
|
|
|
|
0
|
my $db = $self->{'db'}; |
861
|
0
|
0
|
|
|
|
0
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
0
|
|
862
|
|
|
|
|
|
|
|
863
|
0
|
|
|
|
|
0
|
my $duis = $db->selectcol_arrayref("select SDUI from MRCONSO where CUI=\'$concept\' and SAB=\'MSH\'"); |
864
|
|
|
|
|
|
|
|
865
|
0
|
|
|
|
|
0
|
my $dui = shift @{$duis}; |
|
0
|
|
|
|
|
0
|
|
866
|
|
|
|
|
|
|
|
867
|
0
|
|
|
|
|
0
|
return $dui; |
868
|
|
|
|
|
|
|
} |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
# checks to see if a concept is in the CuiList |
872
|
|
|
|
|
|
|
# input : $concept -> string containing the cui |
873
|
|
|
|
|
|
|
# output: 1|0 -> indicating if the cui is in the cuilist |
874
|
|
|
|
|
|
|
sub _inCuiList { |
875
|
|
|
|
|
|
|
|
876
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
877
|
0
|
|
|
|
|
0
|
my $concept = shift; |
878
|
|
|
|
|
|
|
|
879
|
0
|
|
|
|
|
0
|
my $function = "_inCuiList"; |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
# check input vluaes |
882
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
883
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
884
|
|
|
|
|
|
|
} |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
# check parameters |
887
|
0
|
0
|
|
|
|
0
|
if(!defined $concept) { |
888
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
889
|
|
|
|
|
|
|
} |
890
|
|
|
|
|
|
|
|
891
|
0
|
0
|
|
|
|
0
|
if(exists $cuiListHash{$concept}) { return 1; } |
|
0
|
|
|
|
|
0
|
|
892
|
0
|
|
|
|
|
0
|
else { return 0; } |
893
|
|
|
|
|
|
|
} |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
# if the cuilist option is specified load the information |
897
|
|
|
|
|
|
|
# input : $cuilist <- file containing the list of cuis |
898
|
|
|
|
|
|
|
# output: |
899
|
|
|
|
|
|
|
sub _loadCuiList { |
900
|
|
|
|
|
|
|
|
901
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
902
|
0
|
|
|
|
|
0
|
my $cuilist = shift; |
903
|
|
|
|
|
|
|
|
904
|
0
|
|
|
|
|
0
|
my $function = "_loadCuiList"; |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
# check the input values |
907
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
908
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
909
|
|
|
|
|
|
|
} |
910
|
|
|
|
|
|
|
|
911
|
0
|
0
|
|
|
|
0
|
if(defined $cuilist) { |
912
|
0
|
0
|
|
|
|
0
|
open(CUILIST, $cuilist) || die "Could not open the cuilist file: $cuilist\n"; |
913
|
0
|
|
|
|
|
0
|
while() { |
914
|
0
|
|
|
|
|
0
|
chomp; |
915
|
|
|
|
|
|
|
|
916
|
0
|
0
|
|
|
|
0
|
if(! ($errorhandler->_validCui($_)) ) { |
917
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "Incorrect input value ($_) in cuilist.", 6); |
918
|
|
|
|
|
|
|
} |
919
|
|
|
|
|
|
|
|
920
|
0
|
|
|
|
|
0
|
$cuiListHash{$_}++; |
921
|
|
|
|
|
|
|
} |
922
|
|
|
|
|
|
|
} |
923
|
|
|
|
|
|
|
} |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
# create the configuration file |
926
|
|
|
|
|
|
|
# input : |
927
|
|
|
|
|
|
|
# output: |
928
|
|
|
|
|
|
|
sub _setConfigFile { |
929
|
|
|
|
|
|
|
|
930
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
931
|
|
|
|
|
|
|
|
932
|
0
|
0
|
|
|
|
0
|
if($option_verbose) { |
933
|
|
|
|
|
|
|
|
934
|
0
|
|
|
|
|
0
|
my $function = "_setConfigFile"; |
935
|
0
|
|
|
|
|
0
|
&_debug($function); |
936
|
|
|
|
|
|
|
|
937
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
938
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
939
|
|
|
|
|
|
|
} |
940
|
|
|
|
|
|
|
|
941
|
0
|
0
|
|
|
|
0
|
if(! (-e $configFile)) { |
942
|
|
|
|
|
|
|
|
943
|
0
|
0
|
|
|
|
0
|
open(CONFIG, ">$configFile") || |
944
|
|
|
|
|
|
|
die "Could not open configuration file: $configFile\n"; |
945
|
|
|
|
|
|
|
|
946
|
0
|
|
|
|
|
0
|
my @sarray = (); |
947
|
0
|
|
|
|
|
0
|
my @rarray = (); |
948
|
|
|
|
|
|
|
|
949
|
0
|
|
|
|
|
0
|
print CONFIG "SAB :: include "; |
950
|
0
|
|
|
|
|
0
|
while($sources=~/=\'(.*?)\'/g) { push @sarray, $1; } |
|
0
|
|
|
|
|
0
|
|
951
|
0
|
|
|
|
|
0
|
my $slist = join ", ", @sarray; |
952
|
0
|
|
|
|
|
0
|
print CONFIG "$slist\n"; |
953
|
|
|
|
|
|
|
|
954
|
0
|
|
|
|
|
0
|
print CONFIG "REL :: include "; |
955
|
0
|
|
|
|
|
0
|
while($relations=~/=\'(.*?)\'/g) { push @rarray, $1; } |
|
0
|
|
|
|
|
0
|
|
956
|
0
|
|
|
|
|
0
|
my $rlist = join ", ", @rarray; |
957
|
0
|
|
|
|
|
0
|
print CONFIG "$rlist\n"; |
958
|
|
|
|
|
|
|
|
959
|
0
|
|
|
|
|
0
|
close CONFIG; |
960
|
|
|
|
|
|
|
|
961
|
0
|
|
|
|
|
0
|
my $temp = chmod 0777, $configFile; |
962
|
|
|
|
|
|
|
} |
963
|
|
|
|
|
|
|
} |
964
|
|
|
|
|
|
|
} |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
# set the table and file names that store the upper level taxonomy and path information |
968
|
|
|
|
|
|
|
# input : |
969
|
|
|
|
|
|
|
# output: |
970
|
|
|
|
|
|
|
sub _setConfigurationFile { |
971
|
|
|
|
|
|
|
|
972
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
973
|
|
|
|
|
|
|
|
974
|
0
|
|
|
|
|
0
|
my $function = "_setConfigurationFile"; |
975
|
0
|
|
|
|
|
0
|
&_debug($function); |
976
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
# check self |
978
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
979
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
980
|
|
|
|
|
|
|
} |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
# get the database name that we are using |
983
|
0
|
|
|
|
|
0
|
my $database = $self->{'database'}; |
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
# set appropriate version output |
986
|
0
|
|
|
|
|
0
|
my $ver = $version; |
987
|
0
|
|
|
|
|
0
|
$ver=~s/-/_/g; |
988
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
# set table and upper level relations files as well the |
990
|
|
|
|
|
|
|
# output of the configuration information for the user |
991
|
0
|
|
|
|
|
0
|
$childFile = "$umlsinterface/$ver"; |
992
|
0
|
|
|
|
|
0
|
$parentFile = "$umlsinterface/$ver"; |
993
|
0
|
|
|
|
|
0
|
$tableFile = "$umlsinterface/$ver"; |
994
|
|
|
|
|
|
|
|
995
|
0
|
|
|
|
|
0
|
$configFile = "$umlsinterface/$ver"; |
996
|
|
|
|
|
|
|
|
997
|
0
|
|
|
|
|
0
|
$tableName = "$ver"; |
998
|
0
|
|
|
|
|
0
|
$intrinsicTable= "$ver"; |
999
|
0
|
|
|
|
|
0
|
$parentTable = "$ver"; |
1000
|
0
|
|
|
|
|
0
|
$childTable = "$ver"; |
1001
|
0
|
|
|
|
|
0
|
$infoTable = "$ver"; |
1002
|
0
|
|
|
|
|
0
|
$cacheTable = "$ver"; |
1003
|
|
|
|
|
|
|
|
1004
|
0
|
|
|
|
|
0
|
my $output = ""; |
1005
|
0
|
|
|
|
|
0
|
$output .= "UMLS-Interface Configuration Information\n"; |
1006
|
|
|
|
|
|
|
|
1007
|
0
|
|
|
|
|
0
|
my $saboutput = ""; |
1008
|
0
|
|
|
|
|
0
|
my %sabs = (); |
1009
|
0
|
0
|
|
|
|
0
|
if($defflag == 1) { |
1010
|
0
|
|
|
|
|
0
|
$output .= " Sources (SABDEF):\n"; |
1011
|
0
|
|
|
|
|
0
|
foreach my $sab (sort keys %sabDefHash) { $saboutput .= " $sab\n"; } |
|
0
|
|
|
|
|
0
|
|
1012
|
|
|
|
|
|
|
} |
1013
|
|
|
|
|
|
|
else { |
1014
|
0
|
|
|
|
|
0
|
$output .= " Sources (SAB):\n"; |
1015
|
0
|
|
|
|
|
0
|
foreach my $sab (sort keys %sabnamesHash) { $saboutput .= " $sab\n"; } |
|
0
|
|
|
|
|
0
|
|
1016
|
|
|
|
|
|
|
} |
1017
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
|
1019
|
0
|
|
|
|
|
0
|
foreach my $sab (sort keys %sabnamesHash) { |
1020
|
0
|
|
|
|
|
0
|
$tableFile .= "_$sab"; |
1021
|
0
|
|
|
|
|
0
|
$childFile .= "_$sab"; |
1022
|
0
|
|
|
|
|
0
|
$parentFile .= "_$sab"; |
1023
|
0
|
|
|
|
|
0
|
$configFile .= "_$sab"; |
1024
|
0
|
|
|
|
|
0
|
$tableName .= "_$sab"; |
1025
|
0
|
|
|
|
|
0
|
$intrinsicTable.= "_$sab"; |
1026
|
0
|
|
|
|
|
0
|
$parentTable .= "_$sab"; |
1027
|
0
|
|
|
|
|
0
|
$childTable .= "_$sab"; |
1028
|
0
|
|
|
|
|
0
|
$cacheTable .= "_$sab"; |
1029
|
0
|
|
|
|
|
0
|
$infoTable .= "_$sab"; |
1030
|
|
|
|
|
|
|
} |
1031
|
|
|
|
|
|
|
|
1032
|
0
|
0
|
|
|
|
0
|
if($umlsall) { |
1033
|
0
|
|
|
|
|
0
|
$output .= " UMLS_ALL\n"; |
1034
|
|
|
|
|
|
|
} |
1035
|
|
|
|
|
|
|
else { |
1036
|
0
|
|
|
|
|
0
|
$output .= $saboutput; |
1037
|
|
|
|
|
|
|
} |
1038
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
# seperate the RELs and the RELAs from $relations |
1040
|
0
|
|
|
|
|
0
|
my %rels = (); my %relas = (); |
|
0
|
|
|
|
|
0
|
|
1041
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
|
1043
|
0
|
0
|
|
|
|
0
|
if($defflag == 1) { |
1044
|
0
|
|
|
|
|
0
|
$output .= " Relations (RELDEF):\n"; |
1045
|
0
|
|
|
|
|
0
|
foreach my $rel (sort keys %relDefHash) { $rels{$rel}++; } |
|
0
|
|
|
|
|
0
|
|
1046
|
|
|
|
|
|
|
} |
1047
|
|
|
|
|
|
|
else { |
1048
|
0
|
|
|
|
|
0
|
$output .= " Relations (REL):\n"; |
1049
|
0
|
|
|
|
|
0
|
while($relations=~/=\'(.*?)\'/g) { |
1050
|
0
|
|
|
|
|
0
|
my $rel = $1; |
1051
|
0
|
0
|
|
|
|
0
|
if($rel=~/[a-z\_]+/) { $relas{$rel}++; } |
|
0
|
|
|
|
|
0
|
|
1052
|
0
|
|
|
|
|
0
|
else { $rels{$rel}++; } |
1053
|
|
|
|
|
|
|
} |
1054
|
|
|
|
|
|
|
} |
1055
|
|
|
|
|
|
|
|
1056
|
0
|
|
|
|
|
0
|
foreach my $rel (sort keys %rels) { |
1057
|
0
|
|
|
|
|
0
|
$tableFile .= "_$rel"; |
1058
|
0
|
|
|
|
|
0
|
$childFile .= "_$rel"; |
1059
|
0
|
|
|
|
|
0
|
$parentFile .= "_$rel"; |
1060
|
0
|
|
|
|
|
0
|
$configFile .= "_$rel"; |
1061
|
0
|
|
|
|
|
0
|
$tableName .= "_$rel"; |
1062
|
0
|
|
|
|
|
0
|
$intrinsicTable.= "_$rel"; |
1063
|
0
|
|
|
|
|
0
|
$parentTable .= "_$rel"; |
1064
|
0
|
|
|
|
|
0
|
$childTable .= "_$rel"; |
1065
|
0
|
|
|
|
|
0
|
$cacheTable .= "_$rel"; |
1066
|
0
|
|
|
|
|
0
|
$infoTable .= "_$rel"; |
1067
|
|
|
|
|
|
|
|
1068
|
0
|
|
|
|
|
0
|
$output .= " $rel\n"; |
1069
|
|
|
|
|
|
|
} |
1070
|
|
|
|
|
|
|
|
1071
|
0
|
|
|
|
|
0
|
my $rak = keys %relas; |
1072
|
0
|
0
|
|
|
|
0
|
if($rak > 0) { |
1073
|
0
|
0
|
|
|
|
0
|
if($defflag == 1) { |
1074
|
0
|
|
|
|
|
0
|
$output .= " Relations (RELADEF):\n"; |
1075
|
|
|
|
|
|
|
} |
1076
|
|
|
|
|
|
|
else { |
1077
|
0
|
|
|
|
|
0
|
$output .= " Relations (RELA):\n"; |
1078
|
|
|
|
|
|
|
} |
1079
|
|
|
|
|
|
|
} |
1080
|
0
|
|
|
|
|
0
|
foreach my $rel (sort keys %relas) { |
1081
|
0
|
|
|
|
|
0
|
$tableFile .= "_$rel"; |
1082
|
0
|
|
|
|
|
0
|
$childFile .= "_$rel"; |
1083
|
0
|
|
|
|
|
0
|
$parentFile .= "_$rel"; |
1084
|
0
|
|
|
|
|
0
|
$configFile .= "_$rel"; |
1085
|
0
|
|
|
|
|
0
|
$tableName .= "_$rel"; |
1086
|
0
|
|
|
|
|
0
|
$intrinsicTable.= "_$rel"; |
1087
|
0
|
|
|
|
|
0
|
$parentTable .= "_$rel"; |
1088
|
0
|
|
|
|
|
0
|
$childTable .= "_$rel"; |
1089
|
0
|
|
|
|
|
0
|
$cacheTable .= "_$rel"; |
1090
|
0
|
|
|
|
|
0
|
$infoTable .= "_$rel"; |
1091
|
|
|
|
|
|
|
|
1092
|
0
|
|
|
|
|
0
|
$output .= " $rel\n"; |
1093
|
|
|
|
|
|
|
} |
1094
|
|
|
|
|
|
|
|
1095
|
0
|
|
|
|
|
0
|
$tableFile .= "_table"; |
1096
|
0
|
|
|
|
|
0
|
$childFile .= "_child"; |
1097
|
0
|
|
|
|
|
0
|
$parentFile .= "_parent"; |
1098
|
0
|
|
|
|
|
0
|
$configFile .= "_config"; |
1099
|
0
|
|
|
|
|
0
|
$tableName .= "_table"; |
1100
|
0
|
|
|
|
|
0
|
$intrinsicTable.= "_intrinsic"; |
1101
|
0
|
|
|
|
|
0
|
$parentTable .= "_parent"; |
1102
|
0
|
|
|
|
|
0
|
$childTable .= "_child"; |
1103
|
0
|
|
|
|
|
0
|
$cacheTable .= "_cache"; |
1104
|
0
|
|
|
|
|
0
|
$infoTable .= "_info"; |
1105
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
# convert the databases to the hex name |
1107
|
|
|
|
|
|
|
# and store the human readable form |
1108
|
0
|
|
|
|
|
0
|
$tableNameHuman = $tableName; |
1109
|
0
|
|
|
|
|
0
|
$intrinsicTableHuman = $intrinsicTable; |
1110
|
0
|
|
|
|
|
0
|
$childTableHuman = $childTable; |
1111
|
0
|
|
|
|
|
0
|
$cacheTableHuman = $cacheTable; |
1112
|
0
|
|
|
|
|
0
|
$parentTableHuman = $parentTable; |
1113
|
0
|
|
|
|
|
0
|
$infoTableHuman = $infoTable; |
1114
|
|
|
|
|
|
|
|
1115
|
0
|
|
|
|
|
0
|
$tableName = "a" . sha1_hex($tableNameHuman); |
1116
|
0
|
|
|
|
|
0
|
$intrinsicTable = "a" . sha1_hex($intrinsicTableHuman); |
1117
|
0
|
|
|
|
|
0
|
$childTable = "a" . sha1_hex($childTableHuman); |
1118
|
0
|
|
|
|
|
0
|
$parentTable = "a" . sha1_hex($parentTableHuman); |
1119
|
0
|
|
|
|
|
0
|
$infoTable = "a" . sha1_hex($infoTableHuman); |
1120
|
0
|
|
|
|
|
0
|
$cacheTable = "a" . sha1_hex($cacheTableHuman); |
1121
|
|
|
|
|
|
|
|
1122
|
0
|
0
|
|
|
|
0
|
if($option_verbose) { |
1123
|
0
|
|
|
|
|
0
|
$output .= " Configuration file:\n"; |
1124
|
0
|
|
|
|
|
0
|
$output .= " $configFile\n"; |
1125
|
|
|
|
|
|
|
} |
1126
|
|
|
|
|
|
|
|
1127
|
0
|
|
|
|
|
0
|
$output .= " Database: \n"; |
1128
|
0
|
|
|
|
|
0
|
$output .= " $database ($version)\n\n"; |
1129
|
|
|
|
|
|
|
|
1130
|
0
|
0
|
|
|
|
0
|
if($option_t == 0) { |
1131
|
0
|
0
|
|
|
|
0
|
if($option_config) { |
1132
|
0
|
|
|
|
|
0
|
print STDERR "$output\n"; |
1133
|
|
|
|
|
|
|
} |
1134
|
|
|
|
|
|
|
else { |
1135
|
0
|
|
|
|
|
0
|
print STDERR "UMLS-Interface Configuration Information:\n"; |
1136
|
0
|
|
|
|
|
0
|
print STDERR "(Default Information - no config file)\n\n"; |
1137
|
0
|
|
|
|
|
0
|
print STDERR " Sources (SAB):\n"; |
1138
|
0
|
|
|
|
|
0
|
print STDERR " MSH\n"; |
1139
|
0
|
|
|
|
|
0
|
print STDERR " Relations (REL):\n"; |
1140
|
0
|
|
|
|
|
0
|
print STDERR " PAR\n"; |
1141
|
0
|
|
|
|
|
0
|
print STDERR " CHD\n\n"; |
1142
|
0
|
|
|
|
|
0
|
print STDERR " Sources (SABDEF):\n"; |
1143
|
0
|
|
|
|
|
0
|
print STDERR " UMLS_ALL\n"; |
1144
|
0
|
|
|
|
|
0
|
print STDERR " Relations (RELDEF):\n"; |
1145
|
0
|
|
|
|
|
0
|
print STDERR " UMLS_ALL\n"; |
1146
|
|
|
|
|
|
|
} |
1147
|
|
|
|
|
|
|
} |
1148
|
|
|
|
|
|
|
} |
1149
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
# set the configuration environment variable |
1151
|
|
|
|
|
|
|
# input : |
1152
|
|
|
|
|
|
|
# output: |
1153
|
|
|
|
|
|
|
sub _setEnvironmentVariable { |
1154
|
|
|
|
|
|
|
|
1155
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1156
|
|
|
|
|
|
|
|
1157
|
0
|
|
|
|
|
0
|
my $function = "_setEnvironmentVariable"; |
1158
|
0
|
|
|
|
|
0
|
&_debug($function); |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
# check self |
1161
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
1162
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
1163
|
|
|
|
|
|
|
} |
1164
|
|
|
|
|
|
|
|
1165
|
0
|
0
|
|
|
|
0
|
if($option_verbose) { |
1166
|
0
|
0
|
|
|
|
0
|
if(! (defined $umlsinterface) ) { |
1167
|
0
|
|
|
|
|
0
|
my $answerFlag = 0; |
1168
|
0
|
|
|
|
|
0
|
my $interfaceFlag = 0; |
1169
|
|
|
|
|
|
|
|
1170
|
0
|
|
|
|
|
0
|
while(! ($interfaceFlag) ) { |
1171
|
|
|
|
|
|
|
|
1172
|
0
|
|
|
|
|
0
|
print STDERR "The UMLSINTERFACE_CONFIGFILE_DIR environment\n"; |
1173
|
0
|
|
|
|
|
0
|
print STDERR "variable has not been defined yet. Please \n"; |
1174
|
0
|
|
|
|
|
0
|
print STDERR "enter a location that the UMLS-Interface can\n"; |
1175
|
0
|
|
|
|
|
0
|
print STDERR "use to store its configuration files:\n"; |
1176
|
|
|
|
|
|
|
|
1177
|
0
|
|
|
|
|
0
|
$umlsinterface = ; chomp $umlsinterface; |
|
0
|
|
|
|
|
0
|
|
1178
|
|
|
|
|
|
|
|
1179
|
0
|
|
|
|
|
0
|
while(! ($answerFlag)) { |
1180
|
0
|
|
|
|
|
0
|
print STDERR " Is $umlsinterface the correct location? "; |
1181
|
0
|
|
|
|
|
0
|
my $answer = ; chomp $answer; |
|
0
|
|
|
|
|
0
|
|
1182
|
0
|
0
|
|
|
|
0
|
if($answer=~/[Yy]/) { |
1183
|
0
|
|
|
|
|
0
|
$answerFlag = 1; |
1184
|
0
|
|
|
|
|
0
|
$interfaceFlag = 1; |
1185
|
|
|
|
|
|
|
} |
1186
|
|
|
|
|
|
|
else { |
1187
|
0
|
|
|
|
|
0
|
print STDERR "Please entire in location:\n"; |
1188
|
0
|
|
|
|
|
0
|
$umlsinterface = ; chomp $umlsinterface; |
|
0
|
|
|
|
|
0
|
|
1189
|
|
|
|
|
|
|
} |
1190
|
|
|
|
|
|
|
} |
1191
|
|
|
|
|
|
|
|
1192
|
0
|
0
|
|
|
|
0
|
if(! (-e $umlsinterface) ) { |
1193
|
0
|
|
|
|
|
0
|
system "mkdir -m 777 $umlsinterface"; |
1194
|
|
|
|
|
|
|
} |
1195
|
|
|
|
|
|
|
|
1196
|
0
|
|
|
|
|
0
|
print STDERR "Please set the UMLSINTERFACE_CONFIGFILE_DIR variable:\n\n"; |
1197
|
0
|
|
|
|
|
0
|
print STDERR "It can be set in csh as follows:\n\n"; |
1198
|
0
|
|
|
|
|
0
|
print STDERR " setenv UMLSINTERFACE_CONFIGFILE_DIR $umlsinterface\n\n"; |
1199
|
0
|
|
|
|
|
0
|
print STDERR "And in bash shell:\n\n"; |
1200
|
0
|
|
|
|
|
0
|
print STDERR " export UMLSINTERFACE_CONFIGFILE_DIR=$umlsinterface\n\n"; |
1201
|
0
|
|
|
|
|
0
|
print STDERR "Thank you!\n\n"; |
1202
|
|
|
|
|
|
|
} |
1203
|
|
|
|
|
|
|
} |
1204
|
|
|
|
|
|
|
} |
1205
|
|
|
|
|
|
|
else { |
1206
|
0
|
|
|
|
|
0
|
$umlsinterface = ""; |
1207
|
|
|
|
|
|
|
} |
1208
|
|
|
|
|
|
|
} |
1209
|
|
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
# sets the relations, parentRelations and childRelations |
1211
|
|
|
|
|
|
|
# variables from the information in the config file |
1212
|
|
|
|
|
|
|
# input : $includerelkeys <- integer |
1213
|
|
|
|
|
|
|
# : $excluderelkeys <- integer |
1214
|
|
|
|
|
|
|
# : $includerel <- reference to hash |
1215
|
|
|
|
|
|
|
# : $excluderel <- reference to hash |
1216
|
|
|
|
|
|
|
# output: |
1217
|
|
|
|
|
|
|
sub _setRelations { |
1218
|
|
|
|
|
|
|
|
1219
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1220
|
0
|
|
|
|
|
0
|
my $includerelkeys = shift; |
1221
|
0
|
|
|
|
|
0
|
my $excluderelkeys = shift; |
1222
|
0
|
|
|
|
|
0
|
my $includerel = shift; |
1223
|
0
|
|
|
|
|
0
|
my $excluderel = shift; |
1224
|
|
|
|
|
|
|
|
1225
|
0
|
|
|
|
|
0
|
my $function = "_setRelations"; |
1226
|
0
|
|
|
|
|
0
|
&_debug($function); |
1227
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
# check self |
1229
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
1230
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
1231
|
|
|
|
|
|
|
} |
1232
|
|
|
|
|
|
|
|
1233
|
|
|
|
|
|
|
# check the parameters |
1234
|
0
|
0
|
0
|
|
|
0
|
if(!(defined $includerelkeys) || !(defined $excluderelkeys) || |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1235
|
|
|
|
|
|
|
!(defined $includerel) || !(defined $excluderel)) { |
1236
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "REL variables not defined.", 4); |
1237
|
|
|
|
|
|
|
} |
1238
|
|
|
|
|
|
|
|
1239
|
0
|
0
|
0
|
|
|
0
|
if($includerelkeys <= 0 && $excluderelkeys <=0) { return; } |
|
0
|
|
|
|
|
0
|
|
1240
|
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
|
# if the umls all option is set clear out the the includerel hash and |
1242
|
|
|
|
|
|
|
# add the umlsall to the exclude. This way all should be included since |
1243
|
|
|
|
|
|
|
# there will never be a source called UMLS_ALL - this is a bit of a dirty |
1244
|
|
|
|
|
|
|
# swap but I think it will simplify the code and work |
1245
|
0
|
0
|
|
|
|
0
|
if(exists ${$includerel}{"UMLS_ALL"}) { |
|
0
|
|
|
|
|
0
|
|
1246
|
0
|
|
|
|
|
0
|
$includerel = ""; $includerelkeys = 0; |
|
0
|
|
|
|
|
0
|
|
1247
|
0
|
|
|
|
|
0
|
${$excluderel}{"UMLS_ALL"} = 1; $excluderelkeys = 1; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1248
|
|
|
|
|
|
|
|
1249
|
|
|
|
|
|
|
} |
1250
|
|
|
|
|
|
|
|
1251
|
|
|
|
|
|
|
# set the database |
1252
|
0
|
|
|
|
|
0
|
my $db = $self->{'db'}; |
1253
|
0
|
0
|
|
|
|
0
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
0
|
|
1254
|
|
|
|
|
|
|
|
1255
|
0
|
|
|
|
|
0
|
$parentRelations = "("; |
1256
|
0
|
|
|
|
|
0
|
$childRelations = "("; |
1257
|
0
|
|
|
|
|
0
|
$relations = "("; |
1258
|
|
|
|
|
|
|
|
1259
|
|
|
|
|
|
|
# get the relations |
1260
|
0
|
|
|
|
|
0
|
my @array = (); |
1261
|
0
|
0
|
|
|
|
0
|
if($includerelkeys > 0) { |
1262
|
0
|
|
|
|
|
0
|
@array = keys %{$includerel}; |
|
0
|
|
|
|
|
0
|
|
1263
|
|
|
|
|
|
|
} |
1264
|
|
|
|
|
|
|
else { |
1265
|
|
|
|
|
|
|
|
1266
|
0
|
|
|
|
|
0
|
my $arrRef = $db->selectcol_arrayref("select distinct REL from MRREL"); |
1267
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
1268
|
0
|
|
|
|
|
0
|
@array = @{$arrRef}; |
|
0
|
|
|
|
|
0
|
|
1269
|
|
|
|
|
|
|
} |
1270
|
|
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
|
1272
|
0
|
|
|
|
|
0
|
my $relcount = 0; |
1273
|
0
|
|
|
|
|
0
|
my @parents = (); |
1274
|
0
|
|
|
|
|
0
|
my @children = (); |
1275
|
0
|
|
|
|
|
0
|
foreach my $rel (@array) { |
1276
|
|
|
|
|
|
|
|
1277
|
0
|
|
|
|
|
0
|
$relcount++; |
1278
|
|
|
|
|
|
|
|
1279
|
|
|
|
|
|
|
# if we are excluding check to see if this one should be excluded |
1280
|
0
|
0
|
0
|
|
|
0
|
if( ($excluderelkeys > 0) and (exists ${$excluderel}{$rel}) ) { next; } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1281
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
# otherwise store the relation in the relations variable |
1283
|
0
|
0
|
|
|
|
0
|
if($relcount == ($#array+1)) { $relations .= "REL=\'$rel\'"; } |
|
0
|
|
|
|
|
0
|
|
1284
|
0
|
|
|
|
|
0
|
else { $relations .= "REL=\'$rel\' or "; } |
1285
|
|
|
|
|
|
|
|
1286
|
|
|
|
|
|
|
# put it in its proper parent or child array |
1287
|
0
|
0
|
|
|
|
0
|
if ($rel=~/(PAR|RB)/) { push @parents, $rel; } |
|
0
|
0
|
|
|
|
0
|
|
1288
|
0
|
|
|
|
|
0
|
elsif($rel=~/(CHD|RN)/) { push @children, $rel; } |
1289
|
0
|
|
|
|
|
0
|
else { push @parents, $rel; push @children, $rel; } |
|
0
|
|
|
|
|
0
|
|
1290
|
|
|
|
|
|
|
|
1291
|
|
|
|
|
|
|
} |
1292
|
|
|
|
|
|
|
|
1293
|
|
|
|
|
|
|
# set the parentRelations and childRelations variables |
1294
|
0
|
0
|
|
|
|
0
|
if($#parents >= 0) { |
1295
|
0
|
|
|
|
|
0
|
for my $i (0..($#parents-1)) { |
1296
|
0
|
|
|
|
|
0
|
$parentRelations .= "REL=\'$parents[$i]\' or "; |
1297
|
0
|
|
|
|
|
0
|
} $parentRelations .= "REL=\'$parents[$#parents]\'"; |
1298
|
|
|
|
|
|
|
} |
1299
|
0
|
0
|
|
|
|
0
|
if($#children >= 0) { |
1300
|
0
|
|
|
|
|
0
|
for my $i (0..($#children-1)) { |
1301
|
0
|
|
|
|
|
0
|
$childRelations .= "REL=\'$children[$i]\' or "; |
1302
|
0
|
|
|
|
|
0
|
} $childRelations .= "REL=\'$children[$#children]\'"; |
1303
|
|
|
|
|
|
|
} |
1304
|
|
|
|
|
|
|
|
1305
|
0
|
|
|
|
|
0
|
$parentRelations .= ") "; |
1306
|
0
|
|
|
|
|
0
|
$childRelations .= ") "; |
1307
|
0
|
|
|
|
|
0
|
$relations .= ") "; |
1308
|
|
|
|
|
|
|
|
1309
|
|
|
|
|
|
|
} |
1310
|
|
|
|
|
|
|
|
1311
|
|
|
|
|
|
|
# sets the source variables from the information in the config file |
1312
|
|
|
|
|
|
|
# input : $includesabdefkeys <- integer |
1313
|
|
|
|
|
|
|
# : $excludesabdefkeys <- integer |
1314
|
|
|
|
|
|
|
# : $includedefsab <- reference to hash |
1315
|
|
|
|
|
|
|
# : $excludedefsab <- reference to hash |
1316
|
|
|
|
|
|
|
# output: |
1317
|
|
|
|
|
|
|
sub _setSabDef { |
1318
|
|
|
|
|
|
|
|
1319
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1320
|
0
|
|
|
|
|
0
|
my $includesabdefkeys = shift; |
1321
|
0
|
|
|
|
|
0
|
my $excludesabdefkeys = shift; |
1322
|
0
|
|
|
|
|
0
|
my $includesabdef = shift; |
1323
|
0
|
|
|
|
|
0
|
my $excludesabdef = shift; |
1324
|
|
|
|
|
|
|
|
1325
|
0
|
|
|
|
|
0
|
my $function = "_setSabDef"; |
1326
|
0
|
|
|
|
|
0
|
&_debug($function); |
1327
|
|
|
|
|
|
|
|
1328
|
|
|
|
|
|
|
# check self |
1329
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
1330
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
1331
|
|
|
|
|
|
|
} |
1332
|
|
|
|
|
|
|
|
1333
|
|
|
|
|
|
|
# check the parameters are defined |
1334
|
0
|
0
|
0
|
|
|
0
|
if(!(defined $includesabdefkeys) || !(defined $excludesabdefkeys) || |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1335
|
|
|
|
|
|
|
!(defined $includesabdef) || !(defined $excludesabdef)) { |
1336
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "SAB variables not defined", 4); |
1337
|
|
|
|
|
|
|
} |
1338
|
|
|
|
|
|
|
|
1339
|
0
|
0
|
0
|
|
|
0
|
if($includesabdefkeys <= 0 && $excludesabdefkeys <=0) { return; } |
|
0
|
|
|
|
|
0
|
|
1340
|
|
|
|
|
|
|
|
1341
|
0
|
|
|
|
|
0
|
$sabdef_umlsall = 0; |
1342
|
|
|
|
|
|
|
|
1343
|
|
|
|
|
|
|
# if the umls all option is set clear out the the includesabdef hash and |
1344
|
|
|
|
|
|
|
# add the umlsall to the exclude. This way all should be included since |
1345
|
|
|
|
|
|
|
# there will never be a source called UMLS_ALL - this is a bit of a dirty |
1346
|
|
|
|
|
|
|
# swap but I think it will simplify the code and work |
1347
|
0
|
0
|
|
|
|
0
|
if(exists ${$includesabdef}{"UMLS_ALL"}) { |
|
0
|
|
|
|
|
0
|
|
1348
|
0
|
|
|
|
|
0
|
$includesabdef = ""; $includesabdefkeys = 0; |
|
0
|
|
|
|
|
0
|
|
1349
|
0
|
|
|
|
|
0
|
${$excludesabdef}{"UMLS_ALL"} = 1; $excludesabdefkeys = 1; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1350
|
0
|
|
|
|
|
0
|
$sabdef_umlsall = 1; |
1351
|
|
|
|
|
|
|
} |
1352
|
|
|
|
|
|
|
|
1353
|
|
|
|
|
|
|
# check that the db is defined |
1354
|
0
|
|
|
|
|
0
|
my $db = $self->{'db'}; |
1355
|
0
|
0
|
|
|
|
0
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
0
|
|
1356
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
# get the sabs |
1358
|
0
|
|
|
|
|
0
|
my @array = (); |
1359
|
0
|
0
|
|
|
|
0
|
if($includesabdefkeys > 0) { |
1360
|
0
|
|
|
|
|
0
|
@array = keys %{$includesabdef}; |
|
0
|
|
|
|
|
0
|
|
1361
|
|
|
|
|
|
|
} |
1362
|
|
|
|
|
|
|
else { |
1363
|
0
|
|
|
|
|
0
|
my $arrRef = $db->selectcol_arrayref("select distinct SAB from MRREL"); |
1364
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
1365
|
0
|
|
|
|
|
0
|
@array = @{$arrRef}; |
|
0
|
|
|
|
|
0
|
|
1366
|
|
|
|
|
|
|
} |
1367
|
|
|
|
|
|
|
|
1368
|
|
|
|
|
|
|
# get the sabs |
1369
|
0
|
|
|
|
|
0
|
my $sabcount = 0; my @sabarray = (); |
|
0
|
|
|
|
|
0
|
|
1370
|
0
|
|
|
|
|
0
|
foreach my $sab (@array) { |
1371
|
0
|
|
|
|
|
0
|
$sabcount++; |
1372
|
|
|
|
|
|
|
|
1373
|
|
|
|
|
|
|
# if we are excluding check to see if this sab can be included |
1374
|
0
|
0
|
0
|
|
|
0
|
if(($excludesabdefkeys > 0) and (exists ${$excludesabdef}{$sab})) { next; } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1375
|
|
|
|
|
|
|
|
1376
|
|
|
|
|
|
|
# otherwise store it in the sabdef hash and store it in the array |
1377
|
0
|
|
|
|
|
0
|
push @sabarray, "SAB=\'$sab\'"; |
1378
|
|
|
|
|
|
|
|
1379
|
0
|
|
|
|
|
0
|
$sabDefHash{$sab}++; |
1380
|
|
|
|
|
|
|
} |
1381
|
|
|
|
|
|
|
|
1382
|
0
|
0
|
|
|
|
0
|
if(!$sabdef_umlsall) { |
1383
|
0
|
|
|
|
|
0
|
my $string = join " or ", @sabarray; |
1384
|
0
|
|
|
|
|
0
|
$sabdefsources = "( $string )"; |
1385
|
|
|
|
|
|
|
} |
1386
|
|
|
|
|
|
|
} |
1387
|
|
|
|
|
|
|
|
1388
|
|
|
|
|
|
|
# sets the relations, parentRelations and childRelations |
1389
|
|
|
|
|
|
|
# variables from the information in the config file |
1390
|
|
|
|
|
|
|
# input : $includereldefkeys <- integer |
1391
|
|
|
|
|
|
|
# : $excludereldefkeys <- integer |
1392
|
|
|
|
|
|
|
# : $includereldef <- reference to hash |
1393
|
|
|
|
|
|
|
# : $excludereldef <- reference to hash |
1394
|
|
|
|
|
|
|
# output: |
1395
|
|
|
|
|
|
|
sub _setRelDef { |
1396
|
|
|
|
|
|
|
|
1397
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1398
|
0
|
|
|
|
|
0
|
my $includereldefkeys = shift; |
1399
|
0
|
|
|
|
|
0
|
my $excludereldefkeys = shift; |
1400
|
0
|
|
|
|
|
0
|
my $includereldef = shift; |
1401
|
0
|
|
|
|
|
0
|
my $excludereldef = shift; |
1402
|
|
|
|
|
|
|
|
1403
|
0
|
|
|
|
|
0
|
my $function = "_setRelDef"; |
1404
|
0
|
|
|
|
|
0
|
&_debug($function); |
1405
|
|
|
|
|
|
|
|
1406
|
|
|
|
|
|
|
# check self |
1407
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
1408
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
1409
|
|
|
|
|
|
|
} |
1410
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
# check the parameters are defined |
1412
|
0
|
0
|
0
|
|
|
0
|
if(!(defined $includereldefkeys) || !(defined $excludereldefkeys) || |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1413
|
|
|
|
|
|
|
!(defined $includereldef) || !(defined $excludereldef)) { |
1414
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "RELDEF variables not defined.", 4); |
1415
|
|
|
|
|
|
|
} |
1416
|
|
|
|
|
|
|
|
1417
|
0
|
0
|
0
|
|
|
0
|
if($includereldefkeys <= 0 && $excludereldefkeys <=0) { return; } |
|
0
|
|
|
|
|
0
|
|
1418
|
|
|
|
|
|
|
|
1419
|
|
|
|
|
|
|
# if the umls all option is set clear out the the includereldef hash and |
1420
|
|
|
|
|
|
|
# add the umlsall to the exclude. This way all should be included since |
1421
|
|
|
|
|
|
|
# there will never be a source called UMLS_ALL - this is a bit of a dirty |
1422
|
|
|
|
|
|
|
# swap but I think it will simplify the code and work |
1423
|
0
|
0
|
|
|
|
0
|
if(exists ${$includereldef}{"UMLS_ALL"}) { |
|
0
|
|
|
|
|
0
|
|
1424
|
0
|
|
|
|
|
0
|
$includereldef = ""; $includereldefkeys = 0; |
|
0
|
|
|
|
|
0
|
|
1425
|
0
|
|
|
|
|
0
|
${$excludereldef}{"UMLS_ALL"} = 1; $excludereldefkeys = 1; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1426
|
|
|
|
|
|
|
} |
1427
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
# set the database |
1429
|
0
|
|
|
|
|
0
|
my $db = $self->{'db'}; |
1430
|
0
|
0
|
|
|
|
0
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
0
|
|
1431
|
|
|
|
|
|
|
|
1432
|
|
|
|
|
|
|
# get the relations |
1433
|
0
|
|
|
|
|
0
|
my @array = (); |
1434
|
0
|
0
|
|
|
|
0
|
if($includereldefkeys > 0) { |
1435
|
0
|
|
|
|
|
0
|
@array = keys %{$includereldef}; |
|
0
|
|
|
|
|
0
|
|
1436
|
|
|
|
|
|
|
} |
1437
|
|
|
|
|
|
|
else { |
1438
|
|
|
|
|
|
|
|
1439
|
0
|
|
|
|
|
0
|
my $arrRef = $db->selectcol_arrayref("select distinct REL from MRREL"); |
1440
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
1441
|
0
|
|
|
|
|
0
|
@array = @{$arrRef}; |
|
0
|
|
|
|
|
0
|
|
1442
|
|
|
|
|
|
|
} |
1443
|
|
|
|
|
|
|
|
1444
|
0
|
|
|
|
|
0
|
my $relcount = 0; |
1445
|
|
|
|
|
|
|
|
1446
|
0
|
|
|
|
|
0
|
foreach my $rel (@array) { |
1447
|
|
|
|
|
|
|
|
1448
|
0
|
|
|
|
|
0
|
$relcount++; |
1449
|
|
|
|
|
|
|
|
1450
|
|
|
|
|
|
|
# if we are excluding check to see if this one should be excluded |
1451
|
0
|
0
|
0
|
|
|
0
|
if( ($excludereldefkeys > 0) and (exists ${$excludereldef}{$rel}) ) { next; } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1452
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
# otherwise store the relation in the reldef hash |
1454
|
0
|
|
|
|
|
0
|
$relDefHash{$rel}++; |
1455
|
|
|
|
|
|
|
} |
1456
|
|
|
|
|
|
|
|
1457
|
|
|
|
|
|
|
|
1458
|
|
|
|
|
|
|
# now add the TERM and CUI which are not actual relations but should be in |
1459
|
|
|
|
|
|
|
# the relDefHash if in the includereldef or not in the excludereldef or |
1460
|
|
|
|
|
|
|
# nothing has been defined |
1461
|
0
|
0
|
|
|
|
0
|
if($includereldefkeys > 0) { |
|
|
0
|
|
|
|
|
|
1462
|
0
|
0
|
|
|
|
0
|
if(exists ${$includereldef}{"TERM"}) { $relDefHash{"TERM"}++; } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1463
|
0
|
0
|
|
|
|
0
|
if(exists ${$includereldef}{"CUI"}) { $relDefHash{"CUI"}++; } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1464
|
0
|
0
|
|
|
|
0
|
if(exists ${$includereldef}{"ST"}) { $relDefHash{"ST"}++; } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1465
|
|
|
|
|
|
|
} |
1466
|
|
|
|
|
|
|
elsif($excludereldefkeys > 0) { |
1467
|
0
|
0
|
|
|
|
0
|
if(! exists ${$excludereldef}{"TERM"}) { $relDefHash{"TERM"}++; } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1468
|
0
|
0
|
|
|
|
0
|
if(! exists ${$excludereldef}{"CUI"}) { $relDefHash{"CUI"}++; } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1469
|
0
|
0
|
|
|
|
0
|
if(! exists ${$excludereldef}{"ST"}) { $relDefHash{"ST"}++; } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1470
|
|
|
|
|
|
|
} |
1471
|
|
|
|
|
|
|
else { |
1472
|
0
|
|
|
|
|
0
|
$relDefHash{"TERM"}++; $relDefHash{"CUI"}++; $relDefHash{"ST"}++; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1473
|
|
|
|
|
|
|
} |
1474
|
|
|
|
|
|
|
} |
1475
|
|
|
|
|
|
|
|
1476
|
|
|
|
|
|
|
# sets the variables for using the entire umls rather than just a subset |
1477
|
|
|
|
|
|
|
# input : |
1478
|
|
|
|
|
|
|
# output: |
1479
|
|
|
|
|
|
|
sub _setSabUmlsAll { |
1480
|
|
|
|
|
|
|
|
1481
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1482
|
|
|
|
|
|
|
|
1483
|
0
|
|
|
|
|
0
|
my $function = "_setSabUmlsAll"; |
1484
|
0
|
|
|
|
|
0
|
&_debug($function); |
1485
|
|
|
|
|
|
|
|
1486
|
|
|
|
|
|
|
# check input value |
1487
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
1488
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
1489
|
|
|
|
|
|
|
} |
1490
|
|
|
|
|
|
|
|
1491
|
|
|
|
|
|
|
# set the database |
1492
|
0
|
|
|
|
|
0
|
my $db = $self->{'db'}; |
1493
|
0
|
0
|
|
|
|
0
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
0
|
|
1494
|
|
|
|
|
|
|
|
1495
|
0
|
|
|
|
|
0
|
my $arrRef = $db->selectcol_arrayref("select distinct SAB from MRREL where $relations"); |
1496
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
1497
|
|
|
|
|
|
|
|
1498
|
0
|
|
|
|
|
0
|
foreach my $sab (@{$arrRef}) { |
|
0
|
|
|
|
|
0
|
|
1499
|
0
|
|
|
|
|
0
|
my $cui = $self->_getSabCui($sab); |
1500
|
|
|
|
|
|
|
|
1501
|
0
|
|
|
|
|
0
|
$sabnamesHash{$sab}++; |
1502
|
0
|
|
|
|
|
0
|
$sabHash{$cui}++; |
1503
|
|
|
|
|
|
|
} |
1504
|
|
|
|
|
|
|
} |
1505
|
|
|
|
|
|
|
|
1506
|
|
|
|
|
|
|
# sets the source variables from the information in the config file |
1507
|
|
|
|
|
|
|
# input : $includesabkeys <- integer |
1508
|
|
|
|
|
|
|
# : $excludesabkeys <- integer |
1509
|
|
|
|
|
|
|
# : $includesab <- reference to hash |
1510
|
|
|
|
|
|
|
# : $excludesab <- reference to hash |
1511
|
|
|
|
|
|
|
# output: |
1512
|
|
|
|
|
|
|
sub _setSabs { |
1513
|
|
|
|
|
|
|
|
1514
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1515
|
0
|
|
|
|
|
0
|
my $includesabkeys = shift; |
1516
|
0
|
|
|
|
|
0
|
my $excludesabkeys = shift; |
1517
|
0
|
|
|
|
|
0
|
my $includesab = shift; |
1518
|
0
|
|
|
|
|
0
|
my $excludesab = shift; |
1519
|
|
|
|
|
|
|
|
1520
|
0
|
|
|
|
|
0
|
my $function = "_setSabs"; |
1521
|
0
|
|
|
|
|
0
|
&_debug($function); |
1522
|
|
|
|
|
|
|
|
1523
|
|
|
|
|
|
|
# check input value |
1524
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
1525
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
1526
|
|
|
|
|
|
|
} |
1527
|
|
|
|
|
|
|
|
1528
|
|
|
|
|
|
|
# check the parameters are defined |
1529
|
0
|
0
|
0
|
|
|
0
|
if(!(defined $includesabkeys) || !(defined $excludesabkeys) || |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1530
|
|
|
|
|
|
|
!(defined $includesab) || !(defined $excludesab)) { |
1531
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "SAB variables not defined.", 4); |
1532
|
|
|
|
|
|
|
} |
1533
|
|
|
|
|
|
|
|
1534
|
|
|
|
|
|
|
# return if no sab or rel options were in the config file |
1535
|
0
|
0
|
0
|
|
|
0
|
if($includesabkeys <= 0 && $excludesabkeys <=0) { return; } |
|
0
|
|
|
|
|
0
|
|
1536
|
|
|
|
|
|
|
|
1537
|
|
|
|
|
|
|
# initialize the sources |
1538
|
0
|
|
|
|
|
0
|
$sources = ""; |
1539
|
|
|
|
|
|
|
|
1540
|
|
|
|
|
|
|
# if the umls all option is set clear out the the includesab hash and |
1541
|
|
|
|
|
|
|
# add the umlsall to the exclude. This way all should be included since |
1542
|
|
|
|
|
|
|
# there will never be a source called UMLS_ALL - this is a bit of a dirty |
1543
|
|
|
|
|
|
|
# swap but I think it will simplify the code and work |
1544
|
0
|
0
|
|
|
|
0
|
if(exists ${$includesab}{"UMLS_ALL"}) { |
|
0
|
|
|
|
|
0
|
|
1545
|
0
|
|
|
|
|
0
|
$includesab = ""; $includesabkeys = 0; |
|
0
|
|
|
|
|
0
|
|
1546
|
0
|
|
|
|
|
0
|
${$excludesab}{"UMLS_ALL"} = 1; $excludesabkeys = 1; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1547
|
0
|
|
|
|
|
0
|
$umlsall = 1; |
1548
|
0
|
|
|
|
|
0
|
$sources = "UMLS_ALL"; |
1549
|
|
|
|
|
|
|
} |
1550
|
|
|
|
|
|
|
|
1551
|
|
|
|
|
|
|
# check that the db is defined |
1552
|
|
|
|
|
|
|
# set the database |
1553
|
0
|
|
|
|
|
0
|
my $db = $self->{'db'}; |
1554
|
0
|
0
|
|
|
|
0
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
0
|
|
1555
|
|
|
|
|
|
|
|
1556
|
|
|
|
|
|
|
# get the sabs |
1557
|
0
|
|
|
|
|
0
|
my @array = (); |
1558
|
0
|
0
|
|
|
|
0
|
if($includesabkeys > 0) { |
1559
|
0
|
|
|
|
|
0
|
@array = keys %{$includesab}; |
|
0
|
|
|
|
|
0
|
|
1560
|
|
|
|
|
|
|
} |
1561
|
|
|
|
|
|
|
else { |
1562
|
0
|
|
|
|
|
0
|
my $arrRef = $db->selectcol_arrayref("select distinct SAB from MRREL where $relations"); |
1563
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
1564
|
0
|
|
|
|
|
0
|
@array = @{$arrRef}; |
|
0
|
|
|
|
|
0
|
|
1565
|
|
|
|
|
|
|
} |
1566
|
|
|
|
|
|
|
|
1567
|
0
|
|
|
|
|
0
|
my $sabcount = 0; |
1568
|
0
|
|
|
|
|
0
|
foreach my $sab (@array) { |
1569
|
|
|
|
|
|
|
|
1570
|
0
|
|
|
|
|
0
|
$sabcount++; |
1571
|
|
|
|
|
|
|
|
1572
|
|
|
|
|
|
|
# if we are excluding check to see if this sab can be included |
1573
|
0
|
0
|
0
|
|
|
0
|
if(($excludesabkeys > 0) and (exists ${$excludesab}{$sab})) { next; } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1574
|
|
|
|
|
|
|
|
1575
|
|
|
|
|
|
|
# include the sab in the sources variable |
1576
|
0
|
0
|
|
|
|
0
|
if($sabcount == ($#array+1)) { $sources .="SAB=\'$sab\'"; } |
|
0
|
|
|
|
|
0
|
|
1577
|
0
|
|
|
|
|
0
|
else { $sources .="SAB=\'$sab\' or "; } |
1578
|
|
|
|
|
|
|
|
1579
|
|
|
|
|
|
|
# get the sabs cui |
1580
|
0
|
|
|
|
|
0
|
my $cui = $self->_getSabCui($sab); |
1581
|
|
|
|
|
|
|
|
1582
|
|
|
|
|
|
|
# store the sabs cui and name information |
1583
|
0
|
|
|
|
|
0
|
$sabnamesHash{$sab}++; |
1584
|
0
|
|
|
|
|
0
|
$sabHash{$cui}++; |
1585
|
|
|
|
|
|
|
} |
1586
|
|
|
|
|
|
|
} |
1587
|
|
|
|
|
|
|
|
1588
|
|
|
|
|
|
|
# sets the rela variables from the information in the config file |
1589
|
|
|
|
|
|
|
# input : $includerelakeys <- integer |
1590
|
|
|
|
|
|
|
# : $excluderelakeys <- integer |
1591
|
|
|
|
|
|
|
# : $includerela <- reference to hash |
1592
|
|
|
|
|
|
|
# : $excluderela <- reference to hash |
1593
|
|
|
|
|
|
|
# output: |
1594
|
|
|
|
|
|
|
sub _setRelas { |
1595
|
|
|
|
|
|
|
|
1596
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1597
|
0
|
|
|
|
|
0
|
my $includerelakeys = shift; |
1598
|
0
|
|
|
|
|
0
|
my $excluderelakeys = shift; |
1599
|
0
|
|
|
|
|
0
|
my $includerela = shift; |
1600
|
0
|
|
|
|
|
0
|
my $excluderela = shift; |
1601
|
|
|
|
|
|
|
|
1602
|
0
|
|
|
|
|
0
|
my $function = "_setRelas"; |
1603
|
0
|
|
|
|
|
0
|
&_debug($function); |
1604
|
|
|
|
|
|
|
|
1605
|
|
|
|
|
|
|
# check the input values |
1606
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
1607
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
1608
|
|
|
|
|
|
|
} |
1609
|
|
|
|
|
|
|
|
1610
|
|
|
|
|
|
|
# check the parameters are defined |
1611
|
0
|
0
|
0
|
|
|
0
|
if(!(defined $includerelakeys) || !(defined $excluderelakeys) || |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1612
|
|
|
|
|
|
|
!(defined $includerela) || !(defined $excluderela)) { |
1613
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "RELA variables not defined.", 4); |
1614
|
|
|
|
|
|
|
} |
1615
|
|
|
|
|
|
|
|
1616
|
|
|
|
|
|
|
# if no relas were specified just return |
1617
|
0
|
0
|
0
|
|
|
0
|
if($includerelakeys <= 0 && $excluderelakeys <=0) { return } |
|
0
|
|
|
|
|
0
|
|
1618
|
|
|
|
|
|
|
|
1619
|
|
|
|
|
|
|
# set the database |
1620
|
0
|
|
|
|
|
0
|
my $db = $self->{'db'}; |
1621
|
0
|
0
|
|
|
|
0
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
0
|
|
1622
|
|
|
|
|
|
|
|
1623
|
|
|
|
|
|
|
# initalize the hash tables that will hold children and parent relas |
1624
|
0
|
|
|
|
|
0
|
my %childrelas = (); |
1625
|
0
|
|
|
|
|
0
|
my %parentrelas = (); |
1626
|
|
|
|
|
|
|
|
1627
|
|
|
|
|
|
|
# set the parent relations |
1628
|
0
|
|
|
|
|
0
|
my $prelations = ""; |
1629
|
0
|
0
|
|
|
|
0
|
if($relations=~/PAR/) { |
|
|
0
|
|
|
|
|
|
1630
|
0
|
0
|
|
|
|
0
|
if($relations=~/RB/) { |
1631
|
0
|
|
|
|
|
0
|
$prelations = "(REL='PAR') or (REL='RB')"; |
1632
|
0
|
|
|
|
|
0
|
} else { $prelations = "(REL='PAR')"; } |
1633
|
0
|
|
|
|
|
0
|
} elsif($relations=~/RB/) { $prelations = "(REL='RB')"; } |
1634
|
|
|
|
|
|
|
|
1635
|
|
|
|
|
|
|
# set the child relations |
1636
|
0
|
|
|
|
|
0
|
my $crelations = ""; |
1637
|
0
|
0
|
|
|
|
0
|
if($relations=~/CHD/) { |
|
|
0
|
|
|
|
|
|
1638
|
0
|
0
|
|
|
|
0
|
if($relations=~/RN/) { |
1639
|
0
|
|
|
|
|
0
|
$crelations = "(REL='CHD') or (REL='RN')"; |
1640
|
0
|
|
|
|
|
0
|
} else { $crelations = "(REL='CHD')"; } |
1641
|
0
|
|
|
|
|
0
|
} elsif($relations=~/RB/) { $crelations = "(REL='RN')"; } |
1642
|
|
|
|
|
|
|
|
1643
|
|
|
|
|
|
|
# get the rela relations that exist for the given set of sources and |
1644
|
|
|
|
|
|
|
# relations for the children relations that are specified in the config |
1645
|
0
|
|
|
|
|
0
|
my $sth = ""; |
1646
|
0
|
0
|
|
|
|
0
|
if($umlsall) { |
1647
|
0
|
|
|
|
|
0
|
$sth = $db->prepare("select distinct RELA from MRREL where $crelations"); |
1648
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
1649
|
|
|
|
|
|
|
} |
1650
|
|
|
|
|
|
|
else { |
1651
|
0
|
|
|
|
|
0
|
$sth = $db->prepare("select distinct RELA from MRREL where $crelations and ($sources)"); |
1652
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
1653
|
|
|
|
|
|
|
} |
1654
|
0
|
|
|
|
|
0
|
$sth->execute(); |
1655
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sth); |
1656
|
|
|
|
|
|
|
|
1657
|
|
|
|
|
|
|
# get all the relas for the children |
1658
|
0
|
|
|
|
|
0
|
my $crela = ""; |
1659
|
0
|
|
|
|
|
0
|
while(($crela) = $sth->fetchrow()) { |
1660
|
0
|
0
|
|
|
|
0
|
if(defined $crela) { |
1661
|
0
|
0
|
|
|
|
0
|
if($crela ne "NULL") { |
1662
|
0
|
|
|
|
|
0
|
$childrelas{$crela}++; |
1663
|
|
|
|
|
|
|
} |
1664
|
|
|
|
|
|
|
} |
1665
|
|
|
|
|
|
|
} |
1666
|
0
|
|
|
|
|
0
|
$sth->finish(); |
1667
|
|
|
|
|
|
|
|
1668
|
0
|
|
|
|
|
0
|
my $crelakeys = keys %childrelas; |
1669
|
0
|
0
|
|
|
|
0
|
if($crelakeys <= 0) { |
1670
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, |
1671
|
|
|
|
|
|
|
$function, |
1672
|
|
|
|
|
|
|
"There are no RELA relations for the given sources/relations.", |
1673
|
|
|
|
|
|
|
5); |
1674
|
|
|
|
|
|
|
} |
1675
|
|
|
|
|
|
|
|
1676
|
|
|
|
|
|
|
|
1677
|
|
|
|
|
|
|
# get the rela relations that exist for the given set of sources and |
1678
|
|
|
|
|
|
|
# relations for the children relations that are specified in the config |
1679
|
0
|
0
|
|
|
|
0
|
if($umlsall) { |
1680
|
0
|
|
|
|
|
0
|
$sth = $db->prepare("select distinct RELA from MRREL where $prelations"); |
1681
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
1682
|
|
|
|
|
|
|
} |
1683
|
|
|
|
|
|
|
else { |
1684
|
0
|
|
|
|
|
0
|
$sth = $db->prepare("select distinct RELA from MRREL where $prelations and ($sources)"); |
1685
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
1686
|
|
|
|
|
|
|
} |
1687
|
0
|
|
|
|
|
0
|
$sth->execute(); |
1688
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sth); |
1689
|
|
|
|
|
|
|
|
1690
|
|
|
|
|
|
|
# get all the relas for the parents |
1691
|
0
|
|
|
|
|
0
|
my $prela = ""; |
1692
|
0
|
|
|
|
|
0
|
while(($prela) = $sth->fetchrow()) { |
1693
|
0
|
0
|
|
|
|
0
|
if(defined $prela) { |
1694
|
0
|
0
|
|
|
|
0
|
if($prela ne "NULL") { |
1695
|
0
|
|
|
|
|
0
|
$parentrelas{$prela}++; |
1696
|
|
|
|
|
|
|
} |
1697
|
|
|
|
|
|
|
} |
1698
|
|
|
|
|
|
|
} |
1699
|
0
|
|
|
|
|
0
|
$sth->finish(); |
1700
|
|
|
|
|
|
|
|
1701
|
0
|
|
|
|
|
0
|
my $prelakeys = keys %parentrelas; |
1702
|
0
|
0
|
|
|
|
0
|
if($prelakeys <= 0) { |
1703
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, |
1704
|
|
|
|
|
|
|
$function, |
1705
|
|
|
|
|
|
|
"There are no RELA relations for the given sources.", |
1706
|
|
|
|
|
|
|
5); |
1707
|
|
|
|
|
|
|
} |
1708
|
|
|
|
|
|
|
|
1709
|
|
|
|
|
|
|
# uses the relas that are set in the includrelakeys or excluderelakeys |
1710
|
0
|
|
|
|
|
0
|
my @array = (); |
1711
|
0
|
0
|
|
|
|
0
|
if($includerelakeys > 0) { |
1712
|
0
|
|
|
|
|
0
|
@array = keys %{$includerela}; |
|
0
|
|
|
|
|
0
|
|
1713
|
|
|
|
|
|
|
} |
1714
|
|
|
|
|
|
|
else { |
1715
|
|
|
|
|
|
|
|
1716
|
0
|
|
|
|
|
0
|
my $arrRef = |
1717
|
|
|
|
|
|
|
$db->selectcol_arrayref("select distinct RELA from MRREL where ($sources) and $prelations and $crelations"); |
1718
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
1719
|
0
|
|
|
|
|
0
|
@array = @{$arrRef}; |
|
0
|
|
|
|
|
0
|
|
1720
|
0
|
|
|
|
|
0
|
shift @array; |
1721
|
|
|
|
|
|
|
} |
1722
|
|
|
|
|
|
|
|
1723
|
0
|
|
|
|
|
0
|
my @crelas = (); |
1724
|
0
|
|
|
|
|
0
|
my @prelas = (); |
1725
|
0
|
|
|
|
|
0
|
my $relacount = 0; |
1726
|
|
|
|
|
|
|
|
1727
|
0
|
|
|
|
|
0
|
my @newrelations = (); |
1728
|
|
|
|
|
|
|
|
1729
|
0
|
|
|
|
|
0
|
foreach my $r (@array) { |
1730
|
|
|
|
|
|
|
|
1731
|
0
|
|
|
|
|
0
|
$relacount++; |
1732
|
|
|
|
|
|
|
|
1733
|
0
|
0
|
0
|
|
|
0
|
if( ($excluderelakeys > 0) and (exists ${$excluderela}{$r}) ) { next; } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1734
|
|
|
|
|
|
|
|
1735
|
0
|
|
|
|
|
0
|
push @newrelations, "RELA=\'$r\'"; |
1736
|
|
|
|
|
|
|
|
1737
|
0
|
0
|
|
|
|
0
|
if(exists $childrelas{$r}) { push @crelas, "RELA=\'$r\'"; } |
|
0
|
0
|
|
|
|
0
|
|
1738
|
0
|
|
|
|
|
0
|
elsif(exists $parentrelas{$r}) { push @prelas, "RELA=\'$r\'"; } |
1739
|
|
|
|
|
|
|
else { |
1740
|
0
|
|
|
|
|
0
|
my $errorstring = "RELA relation ($r) does not exist for the given sources/relations."; |
1741
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, $errorstring, 5); |
1742
|
|
|
|
|
|
|
} |
1743
|
|
|
|
|
|
|
} |
1744
|
|
|
|
|
|
|
|
1745
|
0
|
0
|
|
|
|
0
|
if($#newrelations >= 0) { |
1746
|
0
|
|
|
|
|
0
|
my $string = join " or ", @newrelations; |
1747
|
|
|
|
|
|
|
|
1748
|
0
|
|
|
|
|
0
|
$relations .= "and ( $string )"; |
1749
|
|
|
|
|
|
|
|
1750
|
0
|
|
|
|
|
0
|
my $crelasline = join " or ", @crelas; |
1751
|
0
|
|
|
|
|
0
|
my $prelasline = join " or ", @prelas; |
1752
|
|
|
|
|
|
|
|
1753
|
|
|
|
|
|
|
# set the parent relations |
1754
|
0
|
0
|
|
|
|
0
|
if($parentRelations=~/PAR/) { |
1755
|
0
|
|
|
|
|
0
|
$parentRelations=~s/REL='PAR'/\(REL='PAR' and \($prelasline\)\)/g; |
1756
|
0
|
|
|
|
|
0
|
$relations=~s/REL='PAR'/\(REL='PAR' and \($prelasline\)\)/g; |
1757
|
|
|
|
|
|
|
} |
1758
|
0
|
0
|
|
|
|
0
|
if($parentRelations=~/RB/) { |
1759
|
0
|
|
|
|
|
0
|
$parentRelations=~s/REL='RB'/\(REL='RB' and \($prelasline\)\)/g; |
1760
|
0
|
|
|
|
|
0
|
$relations=~s/REL='RB'/\(REL='RB' and \($prelasline\)\)/g; |
1761
|
|
|
|
|
|
|
} |
1762
|
|
|
|
|
|
|
# set the child relations |
1763
|
0
|
0
|
|
|
|
0
|
if($childRelations=~/CHD/) { |
1764
|
0
|
|
|
|
|
0
|
$childRelations=~s/REL='CHD'/\(REL='CHD' and \($crelasline\)\)/g; |
1765
|
0
|
|
|
|
|
0
|
$relations=~s/REL='CHD'/\(REL='CHD' and \($crelasline\)\)/g; |
1766
|
|
|
|
|
|
|
} |
1767
|
0
|
0
|
|
|
|
0
|
if($childRelations=~/RN/) { |
1768
|
0
|
|
|
|
|
0
|
$childRelations=~s/REL='RN'/\(REL='RN' and \($crelasline\)\)/g; |
1769
|
0
|
|
|
|
|
0
|
$relations=~s/REL='RN'/\(REL='RN' and \($crelasline\)\)/g; |
1770
|
|
|
|
|
|
|
} |
1771
|
|
|
|
|
|
|
} |
1772
|
|
|
|
|
|
|
} |
1773
|
|
|
|
|
|
|
|
1774
|
|
|
|
|
|
|
# sets the reladef variables from the information in the config file |
1775
|
|
|
|
|
|
|
# input : $includereladefkeys <- integer |
1776
|
|
|
|
|
|
|
# : $excludereladefkeys <- integer |
1777
|
|
|
|
|
|
|
# : $includereladef <- reference to hash |
1778
|
|
|
|
|
|
|
# : $excludereladef <- reference to hash |
1779
|
|
|
|
|
|
|
# output: |
1780
|
|
|
|
|
|
|
sub _setRelaDef { |
1781
|
|
|
|
|
|
|
|
1782
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1783
|
0
|
|
|
|
|
0
|
my $includereladefkeys = shift; |
1784
|
0
|
|
|
|
|
0
|
my $excludereladefkeys = shift; |
1785
|
0
|
|
|
|
|
0
|
my $includereladef = shift; |
1786
|
0
|
|
|
|
|
0
|
my $excludereladef = shift; |
1787
|
|
|
|
|
|
|
|
1788
|
0
|
|
|
|
|
0
|
my $function = "_setRelaDef"; |
1789
|
0
|
|
|
|
|
0
|
&_debug($function); |
1790
|
|
|
|
|
|
|
|
1791
|
|
|
|
|
|
|
# check the input values |
1792
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
1793
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
1794
|
|
|
|
|
|
|
} |
1795
|
|
|
|
|
|
|
|
1796
|
|
|
|
|
|
|
# check the parameters are defined |
1797
|
0
|
0
|
0
|
|
|
0
|
if(!(defined $includereladefkeys) || !(defined $excludereladefkeys) || |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1798
|
|
|
|
|
|
|
!(defined $includereladef) || !(defined $excludereladef)) { |
1799
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "RELADEF variables not defined.", 4); |
1800
|
|
|
|
|
|
|
} |
1801
|
|
|
|
|
|
|
|
1802
|
|
|
|
|
|
|
# if no relas were specified just return |
1803
|
0
|
0
|
0
|
|
|
0
|
if($includereladefkeys <= 0 && $excludereladefkeys <=0) { return; } |
|
0
|
|
|
|
|
0
|
|
1804
|
|
|
|
|
|
|
|
1805
|
|
|
|
|
|
|
# set the database |
1806
|
0
|
|
|
|
|
0
|
my $db = $self->{'db'}; |
1807
|
0
|
0
|
|
|
|
0
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
0
|
|
1808
|
|
|
|
|
|
|
|
1809
|
|
|
|
|
|
|
# initalize the hash tables that will hold children and parent relas |
1810
|
0
|
|
|
|
|
0
|
my %childrelas = (); |
1811
|
0
|
|
|
|
|
0
|
my %parentrelas = (); |
1812
|
|
|
|
|
|
|
|
1813
|
|
|
|
|
|
|
# set the parent relations |
1814
|
0
|
|
|
|
|
0
|
my $prelations = ""; |
1815
|
0
|
0
|
|
|
|
0
|
if($reldefstring=~/PAR/) { |
|
|
0
|
|
|
|
|
|
1816
|
0
|
0
|
|
|
|
0
|
if($reldefstring=~/RB/) { |
1817
|
0
|
|
|
|
|
0
|
$prelations = "(REL='PAR') or (REL='RB')"; |
1818
|
0
|
|
|
|
|
0
|
} else { $prelations = "(REL='PAR')"; } |
1819
|
0
|
|
|
|
|
0
|
} elsif($reldefstring=~/RB/) { $prelations = "(REL='RB')"; } |
1820
|
|
|
|
|
|
|
|
1821
|
|
|
|
|
|
|
# set the child relations |
1822
|
0
|
|
|
|
|
0
|
my $crelations = ""; |
1823
|
0
|
0
|
|
|
|
0
|
if($reldefstring=~/CHD/) { |
|
|
0
|
|
|
|
|
|
1824
|
0
|
0
|
|
|
|
0
|
if($reldefstring=~/RN/) { |
1825
|
0
|
|
|
|
|
0
|
$crelations = "(REL='CHD') or (REL='RN')"; |
1826
|
0
|
|
|
|
|
0
|
} else { $crelations = "(REL='CHD')"; } |
1827
|
0
|
|
|
|
|
0
|
} elsif($reldefstring=~/RB/) { $crelations = "(REL='RN')"; } |
1828
|
|
|
|
|
|
|
|
1829
|
|
|
|
|
|
|
# get the rela relations that exist for the given set of sources and |
1830
|
|
|
|
|
|
|
# relations for the children relations that are specified in the config |
1831
|
0
|
|
|
|
|
0
|
my $sth = ""; |
1832
|
0
|
0
|
|
|
|
0
|
if($umlsall) { |
1833
|
0
|
|
|
|
|
0
|
$sth = $db->prepare("select distinct RELA from MRREL where $crelations"); |
1834
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
1835
|
|
|
|
|
|
|
} |
1836
|
|
|
|
|
|
|
else { |
1837
|
0
|
|
|
|
|
0
|
$sth = $db->prepare("select distinct RELA from MRREL where $crelations and ($sabdefsources)"); |
1838
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
1839
|
|
|
|
|
|
|
} |
1840
|
0
|
|
|
|
|
0
|
$sth->execute(); |
1841
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sth); |
1842
|
|
|
|
|
|
|
|
1843
|
|
|
|
|
|
|
# get all the relas for the children |
1844
|
0
|
|
|
|
|
0
|
my $crela = ""; |
1845
|
0
|
|
|
|
|
0
|
while(($crela) = $sth->fetchrow()) { |
1846
|
0
|
0
|
|
|
|
0
|
if(defined $crela) { |
1847
|
0
|
0
|
|
|
|
0
|
if($crela ne "NULL") { |
1848
|
0
|
|
|
|
|
0
|
$childrelas{$crela}++; |
1849
|
|
|
|
|
|
|
} |
1850
|
|
|
|
|
|
|
} |
1851
|
|
|
|
|
|
|
} |
1852
|
0
|
|
|
|
|
0
|
$sth->finish(); |
1853
|
|
|
|
|
|
|
|
1854
|
0
|
|
|
|
|
0
|
my $crelakeys = keys %childrelas; |
1855
|
0
|
0
|
|
|
|
0
|
if($crelakeys <= 0) { |
1856
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, |
1857
|
|
|
|
|
|
|
$function, |
1858
|
|
|
|
|
|
|
"There are no RELA relations for the given sources/relations.", |
1859
|
|
|
|
|
|
|
5); |
1860
|
|
|
|
|
|
|
} |
1861
|
|
|
|
|
|
|
|
1862
|
|
|
|
|
|
|
# get the rela relations that exist for the given set of sources and |
1863
|
|
|
|
|
|
|
# relations for the children relations that are specified in the config |
1864
|
0
|
0
|
|
|
|
0
|
if($umlsall) { |
1865
|
0
|
|
|
|
|
0
|
$sth = $db->prepare("select distinct RELA from MRREL where $prelations"); |
1866
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
1867
|
|
|
|
|
|
|
} |
1868
|
|
|
|
|
|
|
else { |
1869
|
0
|
|
|
|
|
0
|
$sth = $db->prepare("select distinct RELA from MRREL where $prelations and ($sabdefsources)"); |
1870
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
1871
|
|
|
|
|
|
|
} |
1872
|
0
|
|
|
|
|
0
|
$sth->execute(); |
1873
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sth); |
1874
|
|
|
|
|
|
|
|
1875
|
|
|
|
|
|
|
# get all the relas for the parents |
1876
|
0
|
|
|
|
|
0
|
my $prela = ""; |
1877
|
0
|
|
|
|
|
0
|
while(($prela) = $sth->fetchrow()) { |
1878
|
0
|
0
|
|
|
|
0
|
if(defined $prela) { |
1879
|
0
|
0
|
|
|
|
0
|
if($prela ne "NULL") { |
1880
|
0
|
|
|
|
|
0
|
$parentrelas{$prela}++; |
1881
|
|
|
|
|
|
|
} |
1882
|
|
|
|
|
|
|
} |
1883
|
|
|
|
|
|
|
} |
1884
|
0
|
|
|
|
|
0
|
$sth->finish(); |
1885
|
|
|
|
|
|
|
|
1886
|
0
|
|
|
|
|
0
|
my $prelakeys = keys %parentrelas; |
1887
|
0
|
0
|
|
|
|
0
|
if($prelakeys <= 0) { |
1888
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, |
1889
|
|
|
|
|
|
|
$function, |
1890
|
|
|
|
|
|
|
"There are no RELA relations for the given sources.", |
1891
|
|
|
|
|
|
|
5); |
1892
|
|
|
|
|
|
|
} |
1893
|
|
|
|
|
|
|
|
1894
|
|
|
|
|
|
|
# uses the relas that are set in the includrelakeys or excludereladefkeys |
1895
|
0
|
|
|
|
|
0
|
my @array = (); |
1896
|
0
|
0
|
|
|
|
0
|
if($includereladefkeys > 0) { |
1897
|
0
|
|
|
|
|
0
|
@array = keys %{$includereladef}; |
|
0
|
|
|
|
|
0
|
|
1898
|
|
|
|
|
|
|
} |
1899
|
|
|
|
|
|
|
else { |
1900
|
|
|
|
|
|
|
|
1901
|
0
|
|
|
|
|
0
|
my $arrRef = |
1902
|
|
|
|
|
|
|
$db->selectcol_arrayref("select distinct RELA from MRREL where ($sources) and $prelations and $crelations"); |
1903
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
1904
|
0
|
|
|
|
|
0
|
@array = @{$arrRef}; |
|
0
|
|
|
|
|
0
|
|
1905
|
0
|
|
|
|
|
0
|
shift @array; |
1906
|
|
|
|
|
|
|
} |
1907
|
|
|
|
|
|
|
|
1908
|
0
|
|
|
|
|
0
|
my @crelas = (); |
1909
|
0
|
|
|
|
|
0
|
my @prelas = (); |
1910
|
0
|
|
|
|
|
0
|
my $relacount = 0; |
1911
|
|
|
|
|
|
|
|
1912
|
0
|
|
|
|
|
0
|
my @newrelations = (); |
1913
|
|
|
|
|
|
|
|
1914
|
0
|
|
|
|
|
0
|
foreach my $r (@array) { |
1915
|
|
|
|
|
|
|
|
1916
|
0
|
|
|
|
|
0
|
$relacount++; |
1917
|
|
|
|
|
|
|
|
1918
|
0
|
0
|
0
|
|
|
0
|
if( ($excludereladefkeys > 0) and (exists ${$excludereladef}{$r}) ) { next; } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1919
|
|
|
|
|
|
|
|
1920
|
0
|
|
|
|
|
0
|
push @newrelations, "RELA=\'$r\'"; |
1921
|
|
|
|
|
|
|
|
1922
|
0
|
0
|
|
|
|
0
|
if(exists $childrelas{$r}) { push @crelas, "RELA=\'$r\'"; } |
|
0
|
0
|
|
|
|
0
|
|
1923
|
0
|
|
|
|
|
0
|
elsif(exists $parentrelas{$r}) { push @prelas, "RELA=\'$r\'"; } |
1924
|
|
|
|
|
|
|
else { |
1925
|
0
|
|
|
|
|
0
|
my $errorstring = "RELA relation ($r) does not exist for the given sources/relations."; |
1926
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, $errorstring, 5); |
1927
|
|
|
|
|
|
|
} |
1928
|
|
|
|
|
|
|
} |
1929
|
|
|
|
|
|
|
|
1930
|
0
|
0
|
|
|
|
0
|
if($#newrelations >= 0) { |
1931
|
0
|
|
|
|
|
0
|
my $string = join " or ", @newrelations; |
1932
|
|
|
|
|
|
|
|
1933
|
0
|
|
|
|
|
0
|
$relations .= "and ( $string )"; |
1934
|
|
|
|
|
|
|
|
1935
|
0
|
|
|
|
|
0
|
$reladefchildren = join " or ", @crelas; |
1936
|
0
|
|
|
|
|
0
|
$reladefparents = join " or ", @prelas; |
1937
|
|
|
|
|
|
|
} |
1938
|
|
|
|
|
|
|
} |
1939
|
|
|
|
|
|
|
|
1940
|
|
|
|
|
|
|
# This sets the sources that are to be used. These sources |
1941
|
|
|
|
|
|
|
# are found in the config file. The defaults are: |
1942
|
|
|
|
|
|
|
# input : $file <- string |
1943
|
|
|
|
|
|
|
# output: |
1944
|
|
|
|
|
|
|
sub _config { |
1945
|
|
|
|
|
|
|
|
1946
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1947
|
0
|
|
|
|
|
0
|
my $file = shift; |
1948
|
|
|
|
|
|
|
|
1949
|
0
|
|
|
|
|
0
|
my $function = "_config"; |
1950
|
0
|
|
|
|
|
0
|
&_debug($function); |
1951
|
|
|
|
|
|
|
|
1952
|
|
|
|
|
|
|
# check self |
1953
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
1954
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
1955
|
|
|
|
|
|
|
} |
1956
|
|
|
|
|
|
|
|
1957
|
0
|
|
|
|
|
0
|
my %includesab = (); my %excludesab = (); |
|
0
|
|
|
|
|
0
|
|
1958
|
0
|
|
|
|
|
0
|
my %includerel = (); my %excluderel = (); |
|
0
|
|
|
|
|
0
|
|
1959
|
0
|
|
|
|
|
0
|
my %includerela = (); my %excluderela = (); |
|
0
|
|
|
|
|
0
|
|
1960
|
0
|
|
|
|
|
0
|
my %includereldef = (); my %excludereldef = (); |
|
0
|
|
|
|
|
0
|
|
1961
|
0
|
|
|
|
|
0
|
my %includesabdef = (); my %excludesabdef = (); |
|
0
|
|
|
|
|
0
|
|
1962
|
0
|
|
|
|
|
0
|
my %includereladef = (); my %excludereladef = (); |
|
0
|
|
|
|
|
0
|
|
1963
|
|
|
|
|
|
|
|
1964
|
0
|
|
|
|
|
0
|
my %check = (); |
1965
|
|
|
|
|
|
|
|
1966
|
0
|
0
|
|
|
|
0
|
if(defined $file) { |
1967
|
0
|
0
|
|
|
|
0
|
open(FILE, $file) || die "Could not open configuration file: $file\n"; |
1968
|
0
|
|
|
|
|
0
|
while() { |
1969
|
0
|
|
|
|
|
0
|
chomp; |
1970
|
|
|
|
|
|
|
# if blank line skip |
1971
|
0
|
0
|
|
|
|
0
|
if($_=~/^\s*$/) { next; } |
|
0
|
|
|
|
|
0
|
|
1972
|
|
|
|
|
|
|
|
1973
|
0
|
0
|
|
|
|
0
|
if($_=~/([A-Z]+)\s*\:\:\s*(include|exclude)\s+(.*)/) { |
1974
|
|
|
|
|
|
|
|
1975
|
0
|
|
|
|
|
0
|
my $type = $1; |
1976
|
0
|
|
|
|
|
0
|
my $det = $2; |
1977
|
0
|
|
|
|
|
0
|
my $list = $3; |
1978
|
|
|
|
|
|
|
|
1979
|
|
|
|
|
|
|
# catch what types are in the config file for checking |
1980
|
|
|
|
|
|
|
# right now the checking is pretty simple but I think |
1981
|
|
|
|
|
|
|
# in the future as others get added it might be more |
1982
|
|
|
|
|
|
|
# extensive |
1983
|
0
|
|
|
|
|
0
|
$check{$type}++; |
1984
|
|
|
|
|
|
|
|
1985
|
0
|
|
|
|
|
0
|
my @array = split/\s*\,\s*/, $list; |
1986
|
0
|
|
|
|
|
0
|
foreach my $element (@array) { |
1987
|
|
|
|
|
|
|
|
1988
|
0
|
|
|
|
|
0
|
$element=~s/^\s+//g; $element=~s/\s+$//g; |
|
0
|
|
|
|
|
0
|
|
1989
|
0
|
0
|
0
|
|
|
0
|
if( $type eq "SAB" and $det eq "include") { $includesab{$element}++; |
|
0
|
0
|
0
|
|
|
0
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
1990
|
0
|
|
|
|
|
0
|
$sabstring = $_; |
1991
|
0
|
|
|
|
|
0
|
$parameters{"SAB"}++; |
1992
|
|
|
|
|
|
|
} |
1993
|
0
|
|
|
|
|
0
|
elsif($type eq "SAB" and $det eq "exclude") { $excludesab{$element}++; |
1994
|
0
|
|
|
|
|
0
|
$sabstring = $_; |
1995
|
0
|
|
|
|
|
0
|
$parameters{"SAB"}++; |
1996
|
|
|
|
|
|
|
} |
1997
|
0
|
|
|
|
|
0
|
elsif($type eq "REL" and $det eq "include") { $includerel{$element}++; |
1998
|
0
|
|
|
|
|
0
|
$relstring = $_; |
1999
|
0
|
|
|
|
|
0
|
$parameters{"REL"}++; |
2000
|
|
|
|
|
|
|
} |
2001
|
0
|
|
|
|
|
0
|
elsif($type eq "REL" and $det eq "exclude") { $excluderel{$element}++; |
2002
|
0
|
|
|
|
|
0
|
$relstring = $_; |
2003
|
0
|
|
|
|
|
0
|
$parameters{"REL"}++; |
2004
|
|
|
|
|
|
|
} |
2005
|
0
|
|
|
|
|
0
|
elsif($type eq "RELA" and $det eq "include") { $includerela{$element}++; |
2006
|
0
|
|
|
|
|
0
|
$relastring = $_; |
2007
|
0
|
|
|
|
|
0
|
$parameters{"RELA"}++; |
2008
|
|
|
|
|
|
|
} |
2009
|
0
|
|
|
|
|
0
|
elsif($type eq "RELA" and $det eq "exclude") { $excluderela{$element}++; |
2010
|
0
|
|
|
|
|
0
|
$relastring = $_; |
2011
|
0
|
|
|
|
|
0
|
$parameters{"RELA"}++; |
2012
|
|
|
|
|
|
|
} |
2013
|
0
|
|
|
|
|
0
|
elsif($type eq "RELDEF" and $det eq "include") { $includereldef{$element}++; |
2014
|
0
|
|
|
|
|
0
|
$reldefstring = $_; |
2015
|
0
|
|
|
|
|
0
|
$parameters{"RELDEF"}++; |
2016
|
|
|
|
|
|
|
} |
2017
|
0
|
|
|
|
|
0
|
elsif($type eq "RELDEF" and $det eq "exclude") { $excludereldef{$element}++; |
2018
|
0
|
|
|
|
|
0
|
$reldefstring = $_; |
2019
|
0
|
|
|
|
|
0
|
$parameters{"RELDEF"}++; |
2020
|
|
|
|
|
|
|
} |
2021
|
0
|
|
|
|
|
0
|
elsif($type eq "SABDEF" and $det eq "include") { $includesabdef{$element}++; |
2022
|
0
|
|
|
|
|
0
|
$sabdefstring = $_; |
2023
|
0
|
|
|
|
|
0
|
$parameters{"SABDEF"}++; |
2024
|
|
|
|
|
|
|
} |
2025
|
0
|
|
|
|
|
0
|
elsif($type eq "SABDEF" and $det eq "exclude") { $excludesabdef{$element}++; |
2026
|
0
|
|
|
|
|
0
|
$sabdefstring = $_; |
2027
|
0
|
|
|
|
|
0
|
$parameters{"SABDEF"}++; |
2028
|
|
|
|
|
|
|
} |
2029
|
0
|
|
|
|
|
0
|
elsif($type eq "RELADEF" and $det eq "include"){ $includereladef{$element}++; |
2030
|
0
|
|
|
|
|
0
|
$parameters{"RELADEF"}++; |
2031
|
|
|
|
|
|
|
} |
2032
|
0
|
|
|
|
|
0
|
elsif($type eq "RELADEF" and $det eq "exclude"){ $excludereladef{$element}++; |
2033
|
0
|
|
|
|
|
0
|
$parameters{"RELADEF"}++; |
2034
|
|
|
|
|
|
|
} |
2035
|
|
|
|
|
|
|
} |
2036
|
|
|
|
|
|
|
} |
2037
|
|
|
|
|
|
|
else { |
2038
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "Format not correct ($_)", 5); |
2039
|
|
|
|
|
|
|
} |
2040
|
|
|
|
|
|
|
} |
2041
|
|
|
|
|
|
|
} |
2042
|
|
|
|
|
|
|
|
2043
|
|
|
|
|
|
|
|
2044
|
|
|
|
|
|
|
|
2045
|
|
|
|
|
|
|
# check about the UMLS_ALL option in RELA and RELADEF |
2046
|
|
|
|
|
|
|
# this is the default so just remove them - it is here |
2047
|
|
|
|
|
|
|
# for the user not really for us |
2048
|
0
|
0
|
|
|
|
0
|
if(exists $includerela{"UMLS_ALL"}) { %includerela = (); } |
|
0
|
|
|
|
|
0
|
|
2049
|
0
|
0
|
|
|
|
0
|
if(exists $includereladef{"UMLS_ALL"}) { %includereladef = (); } |
|
0
|
|
|
|
|
0
|
|
2050
|
|
|
|
|
|
|
|
2051
|
0
|
|
|
|
|
0
|
my $includesabkeys = keys %includesab; |
2052
|
0
|
|
|
|
|
0
|
my $excludesabkeys = keys %excludesab; |
2053
|
0
|
|
|
|
|
0
|
my $includerelkeys = keys %includerel; |
2054
|
0
|
|
|
|
|
0
|
my $excluderelkeys = keys %excluderel; |
2055
|
0
|
|
|
|
|
0
|
my $includerelakeys = keys %includerela; |
2056
|
0
|
|
|
|
|
0
|
my $excluderelakeys = keys %excluderela; |
2057
|
0
|
|
|
|
|
0
|
my $includereldefkeys = keys %includereldef; |
2058
|
0
|
|
|
|
|
0
|
my $excludereldefkeys = keys %excludereldef; |
2059
|
0
|
|
|
|
|
0
|
my $includesabdefkeys = keys %includesabdef; |
2060
|
0
|
|
|
|
|
0
|
my $excludesabdefkeys = keys %excludesabdef; |
2061
|
0
|
|
|
|
|
0
|
my $includereladefkeys = keys %includereladef; |
2062
|
0
|
|
|
|
|
0
|
my $excludereladefkeys = keys %excludereladef; |
2063
|
|
|
|
|
|
|
|
2064
|
|
|
|
|
|
|
# check for errors |
2065
|
0
|
0
|
0
|
|
|
0
|
if( (!exists $check{"SAB"} && exists $check{"REL"}) || |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2066
|
|
|
|
|
|
|
(!exists $check{"REL"} && exists $check{"SAB"}) ) { |
2067
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, |
2068
|
|
|
|
|
|
|
$function, |
2069
|
|
|
|
|
|
|
"Configuration file must include both REL and SAB information.", |
2070
|
|
|
|
|
|
|
5); |
2071
|
|
|
|
|
|
|
} |
2072
|
0
|
0
|
0
|
|
|
0
|
if( (!exists $check{"SABDEF"} && exists $check{"RELDEF"}) || |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2073
|
|
|
|
|
|
|
(!exists $check{"RELDEF"} && exists $check{"SABDEF"}) ) { |
2074
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, |
2075
|
|
|
|
|
|
|
$function, |
2076
|
|
|
|
|
|
|
"Configuration file must include both RELDEF and SABDEF information.", |
2077
|
|
|
|
|
|
|
5); |
2078
|
|
|
|
|
|
|
} |
2079
|
0
|
0
|
0
|
|
|
0
|
if($includesabkeys > 0 && $excludesabkeys > 0) { |
2080
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, |
2081
|
|
|
|
|
|
|
$function, |
2082
|
|
|
|
|
|
|
"Configuration file can not have an include and exclude list of sources.", |
2083
|
|
|
|
|
|
|
5); |
2084
|
|
|
|
|
|
|
} |
2085
|
0
|
0
|
0
|
|
|
0
|
if($includerelkeys > 0 && $excluderelkeys > 0) { |
2086
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, |
2087
|
|
|
|
|
|
|
$function, |
2088
|
|
|
|
|
|
|
"Configuration file can not have an include and exclude list of relations.", |
2089
|
|
|
|
|
|
|
5); |
2090
|
|
|
|
|
|
|
} |
2091
|
0
|
0
|
0
|
|
|
0
|
if( ($includerelkeys <= 0 && $excluderelkeys <= 0) && |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2092
|
|
|
|
|
|
|
($includerelakeys > 0 || $excluderelakeys > 0) ) { |
2093
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, |
2094
|
|
|
|
|
|
|
$function, |
2095
|
|
|
|
|
|
|
"The relations (REL) must be specified if using the rela relations (RELA).", |
2096
|
|
|
|
|
|
|
5); |
2097
|
|
|
|
|
|
|
} |
2098
|
0
|
0
|
0
|
|
|
0
|
if( ($includereldefkeys <= 0 && $excludereldefkeys <= 0) && |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2099
|
|
|
|
|
|
|
($includereladefkeys > 0 || $excludereladefkeys > 0) ) { |
2100
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, |
2101
|
|
|
|
|
|
|
$function, |
2102
|
|
|
|
|
|
|
"The relations (RELDEF) must be specified if using the rela relations (RELADEF).", |
2103
|
|
|
|
|
|
|
5); |
2104
|
|
|
|
|
|
|
} |
2105
|
|
|
|
|
|
|
|
2106
|
|
|
|
|
|
|
|
2107
|
|
|
|
|
|
|
# set the defaults |
2108
|
0
|
0
|
0
|
|
|
0
|
if($includerelkeys <= 0 && $excluderelkeys <= 0) { |
2109
|
0
|
|
|
|
|
0
|
$includesab{"MSH"}++; |
2110
|
0
|
|
|
|
|
0
|
$includerel{"PAR"}++; |
2111
|
0
|
|
|
|
|
0
|
$includerel{"CHD"}++; |
2112
|
|
|
|
|
|
|
|
2113
|
0
|
|
|
|
|
0
|
$sabstring = "SAB :: include MSH"; |
2114
|
0
|
|
|
|
|
0
|
$relstring = "REL :: include CHD, PAR"; |
2115
|
|
|
|
|
|
|
|
2116
|
0
|
|
|
|
|
0
|
$includerelkeys = keys %includerel; |
2117
|
0
|
|
|
|
|
0
|
$includesabkeys = keys %includesab; |
2118
|
|
|
|
|
|
|
} |
2119
|
|
|
|
|
|
|
|
2120
|
|
|
|
|
|
|
# set the defaults |
2121
|
0
|
0
|
0
|
|
|
0
|
if($includereldefkeys <= 0 && $excludereldefkeys <= 0) { |
2122
|
|
|
|
|
|
|
|
2123
|
0
|
|
|
|
|
0
|
$includesabdef{"UMLS_ALL"}++; |
2124
|
0
|
|
|
|
|
0
|
$includereldef{"UMLS_ALL"}++; |
2125
|
|
|
|
|
|
|
|
2126
|
0
|
|
|
|
|
0
|
$sabdefstring = "SAB :: include UMLS_ALL"; |
2127
|
0
|
|
|
|
|
0
|
$reldefstring = "REL :: include UMLS_ALL"; |
2128
|
|
|
|
|
|
|
|
2129
|
0
|
|
|
|
|
0
|
$includereldefkeys = keys %includereldef; |
2130
|
0
|
|
|
|
|
0
|
$includesabdefkeys = keys %includesabdef; |
2131
|
|
|
|
|
|
|
|
2132
|
|
|
|
|
|
|
} |
2133
|
|
|
|
|
|
|
else { |
2134
|
0
|
|
|
|
|
0
|
$defflag = 1; |
2135
|
|
|
|
|
|
|
} |
2136
|
|
|
|
|
|
|
|
2137
|
|
|
|
|
|
|
# The order matters here so don't mess with it! The relations have to be set |
2138
|
|
|
|
|
|
|
# prior to the sabs and both need to be set prior to the relas. |
2139
|
|
|
|
|
|
|
|
2140
|
|
|
|
|
|
|
# set the relations |
2141
|
0
|
|
|
|
|
0
|
$self->_setRelations($includerelkeys, $excluderelkeys, \%includerel, \%excluderel); |
2142
|
|
|
|
|
|
|
|
2143
|
|
|
|
|
|
|
# set the sabs |
2144
|
0
|
|
|
|
|
0
|
$self->_setSabs($includesabkeys, $excludesabkeys, \%includesab, \%excludesab); |
2145
|
|
|
|
|
|
|
|
2146
|
|
|
|
|
|
|
# set the relas as long as there exists a PAR/CHD or RB/RN relation |
2147
|
0
|
0
|
|
|
|
0
|
if($relations=~/(PAR|CHD|RB|RN)/) { |
2148
|
0
|
|
|
|
|
0
|
$self->_setRelas($includerelakeys, $excluderelakeys, \%includerela, \%excluderela); |
2149
|
|
|
|
|
|
|
} |
2150
|
|
|
|
|
|
|
else { |
2151
|
0
|
0
|
0
|
|
|
0
|
if(($includerelkeys > 0 || $excluderelkeys > 0) && |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2152
|
|
|
|
|
|
|
($includerelakeys > 0 || $excluderelakeys > 0) ) { |
2153
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, |
2154
|
|
|
|
|
|
|
$function, |
2155
|
|
|
|
|
|
|
"The rela relations (RELA) can only be used with the PAR/CHD or RB/RN relations (REL).", |
2156
|
|
|
|
|
|
|
5); |
2157
|
|
|
|
|
|
|
} |
2158
|
|
|
|
|
|
|
} |
2159
|
|
|
|
|
|
|
|
2160
|
|
|
|
|
|
|
# set the sabs for the CUI and extended definitions |
2161
|
0
|
|
|
|
|
0
|
$self->_setSabDef($includesabdefkeys, $excludesabdefkeys, \%includesabdef, \%excludesabdef); |
2162
|
|
|
|
|
|
|
|
2163
|
|
|
|
|
|
|
# set the rels for the extended definition |
2164
|
0
|
|
|
|
|
0
|
$self->_setRelDef($includereldefkeys, $excludereldefkeys, \%includereldef, \%excludereldef); |
2165
|
|
|
|
|
|
|
|
2166
|
|
|
|
|
|
|
# set the relas for the extended definition |
2167
|
0
|
0
|
|
|
|
0
|
if($reldefstring=~/(PAR|CHD|RB|RN)/) { |
2168
|
0
|
|
|
|
|
0
|
$self->_setRelaDef($includereladefkeys, $excludereladefkeys, \%includereladef, \%excludereladef); |
2169
|
|
|
|
|
|
|
} |
2170
|
|
|
|
|
|
|
else { |
2171
|
0
|
0
|
0
|
|
|
0
|
if(($includereldefkeys > 0 || $excludereldefkeys > 0) && |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2172
|
|
|
|
|
|
|
($includereladefkeys > 0 || $excludereladefkeys > 0) ) { |
2173
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, |
2174
|
|
|
|
|
|
|
$function, |
2175
|
|
|
|
|
|
|
"The rela relations (RELADEF) can only be used with the PAR/CHD or RB/RN relations (RELDEF).", |
2176
|
|
|
|
|
|
|
5); |
2177
|
|
|
|
|
|
|
} |
2178
|
|
|
|
|
|
|
} |
2179
|
|
|
|
|
|
|
|
2180
|
|
|
|
|
|
|
# now at this point everything that is set with the names are set |
2181
|
|
|
|
|
|
|
# if though SABDEF has been set without SAB then use SABDEF |
2182
|
|
|
|
|
|
|
# similarity if SABREL has been set without REL then use SABREL |
2183
|
|
|
|
|
|
|
# set the relations - this is done right now to extract terms and |
2184
|
|
|
|
|
|
|
# and such from the umls - I don't really like how this is done but |
2185
|
|
|
|
|
|
|
# it will be okay for right now. It would be nice to have them |
2186
|
|
|
|
|
|
|
# completely seperate. Doing it this way though allows for the REL, |
2187
|
|
|
|
|
|
|
# SAB, RELDEF and SABDEF to all be specified - again order matters here. |
2188
|
|
|
|
|
|
|
|
2189
|
|
|
|
|
|
|
#if($includerelkeys == 0 && $excluderelkeys == 0) { |
2190
|
|
|
|
|
|
|
# $self->_setRelations($includereldefkeys, $excludereldefkeys, \%includereldef, \%excludereldef); |
2191
|
|
|
|
|
|
|
#} |
2192
|
|
|
|
|
|
|
#if($includesabkeys == 0 && $excludesabkeys == 0) { |
2193
|
|
|
|
|
|
|
# $self->_setSabs($includesabdefkeys, $excludesabdefkeys, \%includesabdef, \%excludesabdef); |
2194
|
|
|
|
|
|
|
#} |
2195
|
|
|
|
|
|
|
#if($includerelkeys == 0 && $excluderelkeys == 0) { |
2196
|
|
|
|
|
|
|
# if($relations=~/(PAR|CHD|RB|RN)/) { |
2197
|
|
|
|
|
|
|
# $self->_setRelas($includereladefkeys, $excludereladefkeys, \%includereladef, \%excludereladef); |
2198
|
|
|
|
|
|
|
# } |
2199
|
|
|
|
|
|
|
#} |
2200
|
|
|
|
|
|
|
|
2201
|
0
|
0
|
|
|
|
0
|
if($debug) { |
2202
|
0
|
0
|
|
|
|
0
|
if($umlsall) { print STDERR "SOURCE : UMLS_ALL\n"; } |
|
0
|
|
|
|
|
0
|
|
2203
|
0
|
|
|
|
|
0
|
else { print STDERR "SOURCE : $sources\n"; } |
2204
|
0
|
|
|
|
|
0
|
print STDERR "RELATIONS: $relations\n"; |
2205
|
0
|
|
|
|
|
0
|
print STDERR "PARENTS : $parentRelations\n"; |
2206
|
0
|
|
|
|
|
0
|
print STDERR "CHILDREN : $childRelations\n\n"; |
2207
|
0
|
0
|
|
|
|
0
|
if($sabdefsources eq "") { |
2208
|
0
|
|
|
|
|
0
|
print STDERR "SABDEF : UMLS_ALL\n"; |
2209
|
|
|
|
|
|
|
} |
2210
|
|
|
|
|
|
|
else { |
2211
|
0
|
|
|
|
|
0
|
print STDERR "SABDEF : $sabdefsources\n"; |
2212
|
|
|
|
|
|
|
} |
2213
|
0
|
|
|
|
|
0
|
my $reldefrelations = "UMLS_ALL"; |
2214
|
0
|
0
|
|
|
|
0
|
if($reldefstring ne "") { |
2215
|
0
|
|
|
|
|
0
|
$reldefstring=~/RELDEF :: include ([A-Z0-9\, ]+)/; |
2216
|
0
|
|
|
|
|
0
|
$reldefrelations = $1; |
2217
|
|
|
|
|
|
|
} |
2218
|
0
|
|
|
|
|
0
|
print STDERR "RELDEF : $reldefrelations\n"; |
2219
|
0
|
|
|
|
|
0
|
print STDERR "SAB : $sources\n"; |
2220
|
0
|
|
|
|
|
0
|
print STDERR "REL : $relations\n"; |
2221
|
|
|
|
|
|
|
} |
2222
|
|
|
|
|
|
|
} |
2223
|
|
|
|
|
|
|
|
2224
|
|
|
|
|
|
|
# returns the SAB from the configuratino file |
2225
|
|
|
|
|
|
|
# input : |
2226
|
|
|
|
|
|
|
# output: $string <- containing SAB line from config file |
2227
|
|
|
|
|
|
|
sub _getSabString { |
2228
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
2229
|
|
|
|
|
|
|
|
2230
|
0
|
|
|
|
|
0
|
return $sabstring; |
2231
|
|
|
|
|
|
|
} |
2232
|
|
|
|
|
|
|
|
2233
|
|
|
|
|
|
|
# returns the REL from the configuratino file |
2234
|
|
|
|
|
|
|
# input : |
2235
|
|
|
|
|
|
|
# output: $string <- containing REL line from config file |
2236
|
|
|
|
|
|
|
sub _getRelString { |
2237
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
2238
|
|
|
|
|
|
|
|
2239
|
0
|
|
|
|
|
0
|
return $relstring; |
2240
|
|
|
|
|
|
|
} |
2241
|
|
|
|
|
|
|
|
2242
|
|
|
|
|
|
|
# returns the RELA from the configuratino file |
2243
|
|
|
|
|
|
|
# input : |
2244
|
|
|
|
|
|
|
# output: $string <- containing RELA line from config file |
2245
|
|
|
|
|
|
|
sub _getRelaString { |
2246
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
2247
|
|
|
|
|
|
|
|
2248
|
0
|
|
|
|
|
0
|
return $relastring; |
2249
|
|
|
|
|
|
|
} |
2250
|
|
|
|
|
|
|
|
2251
|
|
|
|
|
|
|
# returns the SABDEF from the configuratino file |
2252
|
|
|
|
|
|
|
# input : |
2253
|
|
|
|
|
|
|
# output: $string <- containing SABDEF line from config file |
2254
|
|
|
|
|
|
|
sub _getSabDefString { |
2255
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
2256
|
|
|
|
|
|
|
|
2257
|
0
|
|
|
|
|
0
|
return $sabdefstring; |
2258
|
|
|
|
|
|
|
} |
2259
|
|
|
|
|
|
|
|
2260
|
|
|
|
|
|
|
# returns the RELDEF from the configuratino file |
2261
|
|
|
|
|
|
|
# input : |
2262
|
|
|
|
|
|
|
# output: $string <- containing RELDEF line from config file |
2263
|
|
|
|
|
|
|
sub _getRelDefString { |
2264
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
2265
|
|
|
|
|
|
|
|
2266
|
0
|
|
|
|
|
0
|
return $reldefstring; |
2267
|
|
|
|
|
|
|
} |
2268
|
|
|
|
|
|
|
|
2269
|
|
|
|
|
|
|
|
2270
|
|
|
|
|
|
|
|
2271
|
|
|
|
|
|
|
# set the version |
2272
|
|
|
|
|
|
|
# input : |
2273
|
|
|
|
|
|
|
# output: |
2274
|
|
|
|
|
|
|
sub _setVersion { |
2275
|
|
|
|
|
|
|
|
2276
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
2277
|
|
|
|
|
|
|
|
2278
|
0
|
|
|
|
|
0
|
my $function = "_setVersion"; |
2279
|
0
|
|
|
|
|
0
|
&_debug($function); |
2280
|
|
|
|
|
|
|
|
2281
|
|
|
|
|
|
|
# check self |
2282
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
2283
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
2284
|
|
|
|
|
|
|
} |
2285
|
|
|
|
|
|
|
|
2286
|
|
|
|
|
|
|
# set the database |
2287
|
0
|
|
|
|
|
0
|
my $db = $self->{'db'}; |
2288
|
0
|
0
|
|
|
|
0
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
0
|
|
2289
|
|
|
|
|
|
|
|
2290
|
|
|
|
|
|
|
# get the verstion information |
2291
|
0
|
|
|
|
|
0
|
my $arrRef = $db->selectcol_arrayref("select EXPL from MRDOC where VALUE = \'mmsys.version\'"); |
2292
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
2293
|
|
|
|
|
|
|
|
2294
|
|
|
|
|
|
|
# check that it was returned |
2295
|
0
|
0
|
|
|
|
0
|
if(scalar(@{$arrRef}) < 1) { |
|
0
|
|
|
|
|
0
|
|
2296
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "No version info in table MRDOC.", 7); |
2297
|
|
|
|
|
|
|
} |
2298
|
|
|
|
|
|
|
|
2299
|
0
|
|
|
|
|
0
|
($version) = @{$arrRef}; |
|
0
|
|
|
|
|
0
|
|
2300
|
|
|
|
|
|
|
} |
2301
|
|
|
|
|
|
|
|
2302
|
|
|
|
|
|
|
|
2303
|
|
|
|
|
|
|
# check if the UMLS tables required all exist |
2304
|
|
|
|
|
|
|
# input : |
2305
|
|
|
|
|
|
|
# output: |
2306
|
|
|
|
|
|
|
sub _checkTablesExist { |
2307
|
|
|
|
|
|
|
|
2308
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
2309
|
|
|
|
|
|
|
|
2310
|
0
|
|
|
|
|
0
|
my $function = "_checkTablesExist"; |
2311
|
0
|
|
|
|
|
0
|
&_debug($function); |
2312
|
|
|
|
|
|
|
|
2313
|
|
|
|
|
|
|
# check self |
2314
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
2315
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
2316
|
|
|
|
|
|
|
} |
2317
|
|
|
|
|
|
|
|
2318
|
|
|
|
|
|
|
# set up the database |
2319
|
0
|
|
|
|
|
0
|
my $db = $self->{'db'}; |
2320
|
0
|
0
|
|
|
|
0
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
0
|
|
2321
|
|
|
|
|
|
|
|
2322
|
|
|
|
|
|
|
# check if the tables exist... |
2323
|
0
|
|
|
|
|
0
|
my $sth = $db->prepare("show tables"); |
2324
|
0
|
|
|
|
|
0
|
$sth->execute(); |
2325
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $sth); |
2326
|
|
|
|
|
|
|
|
2327
|
0
|
|
|
|
|
0
|
my $table = ""; |
2328
|
0
|
|
|
|
|
0
|
my %tables = (); |
2329
|
0
|
|
|
|
|
0
|
while(($table) = $sth->fetchrow()) { |
2330
|
0
|
|
|
|
|
0
|
$tables{$table} = 1; |
2331
|
|
|
|
|
|
|
} |
2332
|
0
|
|
|
|
|
0
|
$sth->finish(); |
2333
|
|
|
|
|
|
|
|
2334
|
0
|
0
|
0
|
|
|
0
|
if(!defined $tables{"MRCONSO"} and !defined $tables{"mrconso"}) { |
2335
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "Table MRCONSO not found in database", 7); |
2336
|
|
|
|
|
|
|
} |
2337
|
0
|
0
|
0
|
|
|
0
|
if(!defined $tables{"MRDEF"} and !defined $tables{"mrdef"}) { |
2338
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "Table MRDEF not found in database", 7); |
2339
|
|
|
|
|
|
|
} |
2340
|
0
|
0
|
0
|
|
|
0
|
if(!defined $tables{"SRDEF"} and !defined $tables{"srdef"}) { |
2341
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "Table SRDEF not found in database", 7); |
2342
|
|
|
|
|
|
|
} |
2343
|
0
|
0
|
0
|
|
|
0
|
if(!defined $tables{"MRREL"} and !defined $tables{"mrrel"}) { |
2344
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "Table MRREL not found in database", 7); |
2345
|
|
|
|
|
|
|
} |
2346
|
0
|
0
|
0
|
|
|
0
|
if(!defined $tables{"MRDOC"} and !defined $tables{"mrdoc"}) { |
2347
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "Table MRDEC not found in database", 7); |
2348
|
|
|
|
|
|
|
} |
2349
|
0
|
0
|
0
|
|
|
0
|
if(!defined $tables{"MRSAB"} and !defined $tables{"mrsab"}) { |
2350
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "Table MRSAB not found in database", 7); |
2351
|
|
|
|
|
|
|
} |
2352
|
|
|
|
|
|
|
} |
2353
|
|
|
|
|
|
|
|
2354
|
|
|
|
|
|
|
# method to set the global parameter options |
2355
|
|
|
|
|
|
|
# input : $params <- reference to a hash |
2356
|
|
|
|
|
|
|
# output: |
2357
|
|
|
|
|
|
|
sub _setOptions { |
2358
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
2359
|
0
|
|
|
|
|
0
|
my $params = shift; |
2360
|
|
|
|
|
|
|
|
2361
|
0
|
|
|
|
|
0
|
my $function = "_setOptions"; |
2362
|
0
|
|
|
|
|
0
|
&_debug($function); |
2363
|
|
|
|
|
|
|
|
2364
|
|
|
|
|
|
|
# check self |
2365
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
2366
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
2367
|
|
|
|
|
|
|
} |
2368
|
|
|
|
|
|
|
|
2369
|
|
|
|
|
|
|
# check the params |
2370
|
0
|
0
|
|
|
|
0
|
$params = {} if(!defined $params); |
2371
|
|
|
|
|
|
|
|
2372
|
|
|
|
|
|
|
# get all the parameters |
2373
|
0
|
|
|
|
|
0
|
my $verbose = $params->{'verbose'}; |
2374
|
0
|
|
|
|
|
0
|
my $cuilist = $params->{'cuilist'}; |
2375
|
0
|
|
|
|
|
0
|
my $t = $params->{'t'}; |
2376
|
0
|
|
|
|
|
0
|
my $debugoption = $params->{'debug'}; |
2377
|
0
|
|
|
|
|
0
|
my $config = $params->{'config'}; |
2378
|
|
|
|
|
|
|
|
2379
|
0
|
0
|
|
|
|
0
|
if(defined $t) { |
2380
|
0
|
|
|
|
|
0
|
$option_t = 1; |
2381
|
|
|
|
|
|
|
} |
2382
|
|
|
|
|
|
|
|
2383
|
0
|
|
|
|
|
0
|
my $output = ""; |
2384
|
|
|
|
|
|
|
|
2385
|
0
|
0
|
0
|
|
|
0
|
if(defined $verbose || defined $cuilist || |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2386
|
|
|
|
|
|
|
defined $debugoption || defined $config) { |
2387
|
0
|
|
|
|
|
0
|
$output .= "\nCuiFinder User Options: \n"; |
2388
|
|
|
|
|
|
|
} |
2389
|
|
|
|
|
|
|
|
2390
|
|
|
|
|
|
|
# check the debug option |
2391
|
0
|
0
|
|
|
|
0
|
if(defined $debugoption) { |
2392
|
0
|
|
|
|
|
0
|
$debug = 1; |
2393
|
0
|
|
|
|
|
0
|
$output .= " --debug"; |
2394
|
|
|
|
|
|
|
} |
2395
|
|
|
|
|
|
|
|
2396
|
|
|
|
|
|
|
# check if verbose run has been identified |
2397
|
0
|
0
|
|
|
|
0
|
if(defined $verbose) { |
2398
|
0
|
|
|
|
|
0
|
$option_verbose = 1; |
2399
|
0
|
|
|
|
|
0
|
$output .= " --verbose option set\n"; |
2400
|
|
|
|
|
|
|
} |
2401
|
|
|
|
|
|
|
|
2402
|
|
|
|
|
|
|
|
2403
|
|
|
|
|
|
|
# check if the cuilist option has been set |
2404
|
0
|
0
|
|
|
|
0
|
if(defined $cuilist) { |
2405
|
0
|
|
|
|
|
0
|
$option_cuilist = 1; |
2406
|
0
|
|
|
|
|
0
|
$output .= " --cuilist option set\n"; |
2407
|
|
|
|
|
|
|
} |
2408
|
|
|
|
|
|
|
|
2409
|
|
|
|
|
|
|
# check if the config file is set |
2410
|
0
|
0
|
|
|
|
0
|
if(defined $config) { |
2411
|
0
|
|
|
|
|
0
|
$option_config = 1; |
2412
|
0
|
|
|
|
|
0
|
$output .= " --config option set\n"; |
2413
|
|
|
|
|
|
|
} |
2414
|
|
|
|
|
|
|
|
2415
|
0
|
0
|
|
|
|
0
|
if($option_t == 0) { |
2416
|
0
|
|
|
|
|
0
|
print STDERR "$output\n\n"; |
2417
|
|
|
|
|
|
|
} |
2418
|
|
|
|
|
|
|
} |
2419
|
|
|
|
|
|
|
|
2420
|
|
|
|
|
|
|
# method to set the umlsinterface index database |
2421
|
|
|
|
|
|
|
# input : $params <- reference to a hash |
2422
|
|
|
|
|
|
|
# output: |
2423
|
|
|
|
|
|
|
sub _setDatabase { |
2424
|
|
|
|
|
|
|
|
2425
|
22
|
|
|
22
|
|
46
|
my $self = shift; |
2426
|
22
|
|
|
|
|
49
|
my $params = shift; |
2427
|
|
|
|
|
|
|
|
2428
|
22
|
|
|
|
|
44
|
my $function = "_setDatabase"; |
2429
|
22
|
|
|
|
|
76
|
&_debug($function); |
2430
|
|
|
|
|
|
|
|
2431
|
|
|
|
|
|
|
# check self |
2432
|
22
|
50
|
33
|
|
|
166
|
if(!defined $self || !ref $self) { |
2433
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
2434
|
|
|
|
|
|
|
} |
2435
|
|
|
|
|
|
|
|
2436
|
|
|
|
|
|
|
# check the params |
2437
|
22
|
50
|
|
|
|
126
|
$params = {} if(!defined $params); |
2438
|
|
|
|
|
|
|
|
2439
|
|
|
|
|
|
|
# get the database connection parameters |
2440
|
22
|
|
|
|
|
59
|
my $database = $params->{'database'}; |
2441
|
22
|
|
|
|
|
55
|
my $hostname = $params->{'hostname'}; |
2442
|
22
|
|
|
|
|
63
|
my $socket = $params->{'socket'}; |
2443
|
22
|
|
|
|
|
57
|
my $port = $params->{'port'}; |
2444
|
22
|
|
|
|
|
49
|
my $username = $params->{'username'}; |
2445
|
22
|
|
|
|
|
64
|
my $password = $params->{'password'}; |
2446
|
|
|
|
|
|
|
|
2447
|
|
|
|
|
|
|
# set up defaults if the options were not passed |
2448
|
22
|
50
|
|
|
|
83
|
if(! defined $database) { $database = "umls"; } |
|
22
|
|
|
|
|
58
|
|
2449
|
22
|
50
|
|
|
|
103
|
if(! defined $socket) { $socket = "/var/run/mysqld/mysqld.sock"; } |
|
22
|
|
|
|
|
57
|
|
2450
|
22
|
50
|
|
|
|
94
|
if(! defined $hostname) { $hostname = "localhost"; } |
|
22
|
|
|
|
|
56
|
|
2451
|
|
|
|
|
|
|
|
2452
|
|
|
|
|
|
|
# initialize the database handler |
2453
|
22
|
|
|
|
|
54
|
my $db = ""; |
2454
|
|
|
|
|
|
|
|
2455
|
|
|
|
|
|
|
# create the database object... |
2456
|
22
|
50
|
33
|
|
|
141
|
if(defined $username and defined $password) { |
2457
|
0
|
0
|
|
|
|
0
|
if($debug) { print STDERR "Connecting with username and password\n"; } |
|
0
|
|
|
|
|
0
|
|
2458
|
0
|
|
|
|
|
0
|
$db = DBI->connect("DBI:mysql:database=$database;mysql_socket=$socket;host=$hostname",$username, $password, {RaiseError => 0}); |
2459
|
|
|
|
|
|
|
} |
2460
|
|
|
|
|
|
|
else { |
2461
|
22
|
50
|
|
|
|
96
|
if($debug) { print STDERR "Connecting using the my.cnf file\n"; } |
|
0
|
|
|
|
|
0
|
|
2462
|
22
|
|
|
|
|
54
|
my $dsn = "DBI:mysql:umls;mysql_read_default_group=client;"; |
2463
|
22
|
|
|
|
|
213
|
$db = DBI->connect($dsn); |
2464
|
|
|
|
|
|
|
} |
2465
|
|
|
|
|
|
|
|
2466
|
|
|
|
|
|
|
# check if there is an error |
2467
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
2468
|
|
|
|
|
|
|
|
2469
|
|
|
|
|
|
|
# check that the db exists |
2470
|
0
|
0
|
|
|
|
0
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
0
|
|
2471
|
|
|
|
|
|
|
|
2472
|
|
|
|
|
|
|
# set database parameters |
2473
|
0
|
|
|
|
|
0
|
$db->{'mysql_enable_utf8'} = 1; |
2474
|
0
|
|
|
|
|
0
|
$db->do('SET NAMES utf8'); |
2475
|
0
|
|
|
|
|
0
|
$db->{mysql_auto_reconnect} = 1; |
2476
|
|
|
|
|
|
|
|
2477
|
|
|
|
|
|
|
# set the self parameters |
2478
|
0
|
|
|
|
|
0
|
$self->{'db'} = $db; |
2479
|
0
|
|
|
|
|
0
|
$self->{'username'} = $username; |
2480
|
0
|
|
|
|
|
0
|
$self->{'password'} = $password; |
2481
|
0
|
|
|
|
|
0
|
$self->{'hostname'} = $hostname; |
2482
|
0
|
|
|
|
|
0
|
$self->{'socket'} = $socket; |
2483
|
0
|
|
|
|
|
0
|
$self->{'database'} = $database; |
2484
|
|
|
|
|
|
|
|
2485
|
|
|
|
|
|
|
# return the database handler |
2486
|
0
|
|
|
|
|
0
|
return $db; |
2487
|
|
|
|
|
|
|
} |
2488
|
|
|
|
|
|
|
|
2489
|
|
|
|
|
|
|
# returns the parameters set in the configuration file |
2490
|
|
|
|
|
|
|
# input: |
2491
|
|
|
|
|
|
|
# output : $hash <- reference to hash containing parameters in the |
2492
|
|
|
|
|
|
|
# configuration file - if there was not config |
2493
|
|
|
|
|
|
|
# file the hash is empty and defaults are being |
2494
|
|
|
|
|
|
|
# use |
2495
|
|
|
|
|
|
|
sub _getConfigParameters { |
2496
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
2497
|
|
|
|
|
|
|
|
2498
|
0
|
|
|
|
|
0
|
my $function = "_getConfigParameters"; |
2499
|
|
|
|
|
|
|
|
2500
|
0
|
|
|
|
|
0
|
return \%parameters; |
2501
|
|
|
|
|
|
|
} |
2502
|
|
|
|
|
|
|
|
2503
|
|
|
|
|
|
|
# returns all of the cuis given the specified set of sources |
2504
|
|
|
|
|
|
|
# and relations defined in the configuration file |
2505
|
|
|
|
|
|
|
# input : $sab <- string containing a source |
2506
|
|
|
|
|
|
|
# output: $array <- reference to array of cuis |
2507
|
|
|
|
|
|
|
sub _getCuis { |
2508
|
|
|
|
|
|
|
|
2509
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
2510
|
0
|
|
|
|
|
0
|
my $sab = shift; |
2511
|
|
|
|
|
|
|
|
2512
|
0
|
|
|
|
|
0
|
my $function = "_getCuis"; |
2513
|
|
|
|
|
|
|
#&_debug($function); |
2514
|
|
|
|
|
|
|
|
2515
|
|
|
|
|
|
|
# check self |
2516
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
2517
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
2518
|
|
|
|
|
|
|
} |
2519
|
|
|
|
|
|
|
|
2520
|
|
|
|
|
|
|
# check input variables |
2521
|
0
|
0
|
|
|
|
0
|
if(!$sab) { $errorhandler->_error($pkg, $function, "Error with input variable \$sab.", 4); } |
|
0
|
|
|
|
|
0
|
|
2522
|
|
|
|
|
|
|
|
2523
|
|
|
|
|
|
|
# set up the database |
2524
|
0
|
|
|
|
|
0
|
my $db = $self->{'db'}; |
2525
|
0
|
0
|
|
|
|
0
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
0
|
|
2526
|
|
|
|
|
|
|
|
2527
|
|
|
|
|
|
|
# NOTE: it is quicker to get all the CUI1s and then all of the CUI2 and then merge |
2528
|
|
|
|
|
|
|
# rather than try to get them all together in a single query. |
2529
|
|
|
|
|
|
|
# get all of the CUI1s |
2530
|
0
|
|
|
|
|
0
|
my $allCui1 = $db->selectcol_arrayref("select CUI1 from MRREL where ($relations) and (SAB=\'$sab\') and SUPPRESS='N'\;"); |
2531
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
2532
|
|
|
|
|
|
|
|
2533
|
|
|
|
|
|
|
# get all of the CUI1s |
2534
|
0
|
|
|
|
|
0
|
my $allCui2 = $db->selectcol_arrayref("select CUI2 from MRREL where ($relations) and (SAB=\'$sab\')and SUPPRESS='N'"); |
2535
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
2536
|
|
|
|
|
|
|
|
2537
|
|
|
|
|
|
|
# merge and return them |
2538
|
0
|
|
|
|
|
0
|
my @allCuis = (@{$allCui1}, @{$allCui2}); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
2539
|
|
|
|
|
|
|
|
2540
|
0
|
|
|
|
|
0
|
return \@allCuis; |
2541
|
|
|
|
|
|
|
} |
2542
|
|
|
|
|
|
|
|
2543
|
|
|
|
|
|
|
# Takes as input a SAB and returns its corresponding |
2544
|
|
|
|
|
|
|
# UMLS CUI. Keep in mind this is the root cui not |
2545
|
|
|
|
|
|
|
# the version cui that is returned. The information |
2546
|
|
|
|
|
|
|
# for this is obtained from the MRSAB table |
2547
|
|
|
|
|
|
|
# input : $sab <- string containing source |
2548
|
|
|
|
|
|
|
# output: $cui <- string containing cui |
2549
|
|
|
|
|
|
|
sub _getSabCui { |
2550
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
2551
|
0
|
|
|
|
|
0
|
my $sab = shift; |
2552
|
|
|
|
|
|
|
|
2553
|
0
|
|
|
|
|
0
|
my $function = "_getSabCui"; |
2554
|
|
|
|
|
|
|
|
2555
|
|
|
|
|
|
|
# check self |
2556
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
2557
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
2558
|
|
|
|
|
|
|
} |
2559
|
|
|
|
|
|
|
|
2560
|
|
|
|
|
|
|
# check input variables |
2561
|
0
|
0
|
|
|
|
0
|
if(!$sab) { $errorhandler->_error($pkg, $function, "Error with input variable \$sab.", 4); } |
|
0
|
|
|
|
|
0
|
|
2562
|
|
|
|
|
|
|
|
2563
|
|
|
|
|
|
|
# set up the database |
2564
|
0
|
|
|
|
|
0
|
my $db = $self->{'db'}; |
2565
|
0
|
0
|
|
|
|
0
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
0
|
|
2566
|
|
|
|
|
|
|
|
2567
|
|
|
|
|
|
|
# if the sab is umls all |
2568
|
0
|
0
|
|
|
|
0
|
if($sab eq "UMLS_ALL") { |
2569
|
0
|
|
|
|
|
0
|
return $umlsRoot; |
2570
|
|
|
|
|
|
|
} |
2571
|
|
|
|
|
|
|
|
2572
|
0
|
|
|
|
|
0
|
my $arrRef = $db->selectcol_arrayref("select distinct RCUI from MRSAB where RSAB='$sab' and SABIN='Y'"); |
2573
|
0
|
|
|
|
|
0
|
$errorhandler->_checkDbError($pkg, $function, $db); |
2574
|
|
|
|
|
|
|
|
2575
|
0
|
0
|
|
|
|
0
|
if(scalar(@{$arrRef}) < 1) { |
|
0
|
|
|
|
|
0
|
|
2576
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "SAB ($sab) does not exist in your current UMLS view.", 7); |
2577
|
|
|
|
|
|
|
} |
2578
|
|
|
|
|
|
|
|
2579
|
0
|
0
|
|
|
|
0
|
if(scalar(@{$arrRef}) > 1) { |
|
0
|
|
|
|
|
0
|
|
2580
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "Internal error: Duplicate concept rows.", 7); |
2581
|
|
|
|
|
|
|
} |
2582
|
|
|
|
|
|
|
|
2583
|
0
|
|
|
|
|
0
|
return (pop @{$arrRef}); |
|
0
|
|
|
|
|
0
|
|
2584
|
|
|
|
|
|
|
} |
2585
|
|
|
|
|
|
|
|
2586
|
|
|
|
|
|
|
|
2587
|
|
|
|
|
|
|
# method to destroy the created object. |
2588
|
|
|
|
|
|
|
# input : |
2589
|
|
|
|
|
|
|
# output: |
2590
|
|
|
|
|
|
|
sub _disconnect { |
2591
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
2592
|
|
|
|
|
|
|
|
2593
|
0
|
|
|
|
|
0
|
my $function = "_disconnect"; |
2594
|
|
|
|
|
|
|
|
2595
|
|
|
|
|
|
|
# check self |
2596
|
0
|
0
|
0
|
|
|
0
|
if(!defined $self || !ref $self) { |
2597
|
0
|
|
|
|
|
0
|
$errorhandler->_error($pkg, $function, "", 2); |
2598
|
|
|
|
|
|
|
} |
2599
|
|
|
|
|
|
|
|
2600
|
0
|
0
|
|
|
|
0
|
if($self) { |
2601
|
0
|
|
|
|
|
0
|
my $db = $self->{'db'}; |
2602
|
0
|
0
|
|
|
|
0
|
$db->disconnect() if($db); |
2603
|
|
|
|
|
|
|
} |
2604
|
|
|
|
|
|
|
} |
2605
|
|
|
|
|
|
|
|
2606
|
|
|
|
|
|
|
# returns the version of the UMLS currently being used |
2607
|
|
|
|
|
|
|
# input : |
2608
|
|
|
|
|
|
|
# output: $version <- string containing version |
2609
|
|
|
|
|
|
|
sub _version { |
2610
|
|
|
|
|
|
|
|
2611
|
0
|
|
|
0
|
|
0
|
return $version; |
2612
|
|
|
|
|
|
|
} |
2613
|
|
|
|
|
|
|
|
2614
|
|
|
|
|
|
|
# print out the function name to standard error |
2615
|
|
|
|
|
|
|
# input : $function <- string containing function name |
2616
|
|
|
|
|
|
|
# output: |
2617
|
|
|
|
|
|
|
sub _debug { |
2618
|
66
|
|
|
66
|
|
126
|
my $function = shift; |
2619
|
66
|
50
|
|
|
|
208
|
if($debug) { print STDERR "In UMLS::Interface::CuiFinder::$function\n"; } |
|
0
|
|
|
|
|
|
|
2620
|
|
|
|
|
|
|
} |
2621
|
|
|
|
|
|
|
|
2622
|
|
|
|
|
|
|
###################################################################### |
2623
|
|
|
|
|
|
|
# functions to obtain information about the cuis |
2624
|
|
|
|
|
|
|
###################################################################### |
2625
|
|
|
|
|
|
|
|
2626
|
|
|
|
|
|
|
# Method to check if a concept ID exists in the database. |
2627
|
|
|
|
|
|
|
# input : $concept <- string containing a cui |
2628
|
|
|
|
|
|
|
# output: $bool <- string indicating if the cui exists |
2629
|
|
|
|
|
|
|
sub _exists { |
2630
|
|
|
|
|
|
|
|
2631
|
0
|
|
|
0
|
|
|
my $self = shift; |
2632
|
0
|
|
|
|
|
|
my $concept = shift; |
2633
|
|
|
|
|
|
|
|
2634
|
0
|
|
|
|
|
|
my $function = "_exists"; |
2635
|
|
|
|
|
|
|
|
2636
|
|
|
|
|
|
|
# check self |
2637
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
2638
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
2639
|
|
|
|
|
|
|
} |
2640
|
|
|
|
|
|
|
|
2641
|
|
|
|
|
|
|
# check parameter exists |
2642
|
0
|
0
|
|
|
|
|
if(!defined $concept) { |
2643
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
2644
|
|
|
|
|
|
|
} |
2645
|
|
|
|
|
|
|
|
2646
|
|
|
|
|
|
|
# check if valid concept |
2647
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept)) ) { |
2648
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept) is not valid.", 6); |
2649
|
|
|
|
|
|
|
} |
2650
|
|
|
|
|
|
|
|
2651
|
|
|
|
|
|
|
# check if root |
2652
|
0
|
0
|
|
|
|
|
if($concept eq $umlsRoot) { return 1; } |
|
0
|
|
|
|
|
|
|
2653
|
|
|
|
|
|
|
|
2654
|
|
|
|
|
|
|
# check if a sab |
2655
|
0
|
0
|
|
|
|
|
if(exists $sabHash{$concept}) { return 1; } |
|
0
|
|
|
|
|
|
|
2656
|
|
|
|
|
|
|
|
2657
|
|
|
|
|
|
|
# set up database |
2658
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
2659
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
2660
|
|
|
|
|
|
|
|
2661
|
|
|
|
|
|
|
# get the concept |
2662
|
0
|
|
|
|
|
|
my $arrRef = ""; |
2663
|
0
|
0
|
|
|
|
|
if($umlsall) { |
2664
|
0
|
|
|
|
|
|
$arrRef = $db->selectcol_arrayref("select distinct CUI from MRCONSO where CUI='$concept'"); |
2665
|
|
|
|
|
|
|
} |
2666
|
|
|
|
|
|
|
else { |
2667
|
0
|
|
|
|
|
|
$arrRef = $db->selectcol_arrayref("select distinct CUI from MRCONSO where CUI='$concept' and $sources"); |
2668
|
|
|
|
|
|
|
} |
2669
|
|
|
|
|
|
|
|
2670
|
|
|
|
|
|
|
# check the database for errors |
2671
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
2672
|
|
|
|
|
|
|
|
2673
|
|
|
|
|
|
|
# get the count |
2674
|
0
|
|
|
|
|
|
my $count = scalar(@{$arrRef}); |
|
0
|
|
|
|
|
|
|
2675
|
|
|
|
|
|
|
|
2676
|
0
|
0
|
|
|
|
|
return 1 if($count); return 0; |
|
0
|
|
|
|
|
|
|
2677
|
|
|
|
|
|
|
} |
2678
|
|
|
|
|
|
|
|
2679
|
|
|
|
|
|
|
# method that returns a list of concepts (@concepts) related |
2680
|
|
|
|
|
|
|
# to a concept $concept through a relation $rel |
2681
|
|
|
|
|
|
|
# input : $concept <- string containing cui |
2682
|
|
|
|
|
|
|
# $rel <- string containing a relation |
2683
|
|
|
|
|
|
|
# output: $array <- reference to an array of cuis |
2684
|
|
|
|
|
|
|
sub _getRelated { |
2685
|
|
|
|
|
|
|
|
2686
|
0
|
|
|
0
|
|
|
my $self = shift; |
2687
|
0
|
|
|
|
|
|
my $concept = shift; |
2688
|
0
|
|
|
|
|
|
my $rel = shift; |
2689
|
|
|
|
|
|
|
|
2690
|
0
|
|
|
|
|
|
my $function = "_getRelated"; |
2691
|
0
|
|
|
|
|
|
&_debug($function); |
2692
|
|
|
|
|
|
|
|
2693
|
|
|
|
|
|
|
# check self |
2694
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
2695
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
2696
|
|
|
|
|
|
|
} |
2697
|
|
|
|
|
|
|
|
2698
|
|
|
|
|
|
|
# check parameter exists |
2699
|
0
|
0
|
|
|
|
|
if(!defined $concept) { |
2700
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
2701
|
|
|
|
|
|
|
} |
2702
|
|
|
|
|
|
|
|
2703
|
0
|
0
|
|
|
|
|
if(!defined $rel) { |
2704
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$rel.", 4); |
2705
|
|
|
|
|
|
|
} |
2706
|
|
|
|
|
|
|
|
2707
|
|
|
|
|
|
|
# check if valid concept |
2708
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept)) ) { |
2709
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept) is not valid.", 6); |
2710
|
|
|
|
|
|
|
} |
2711
|
|
|
|
|
|
|
|
2712
|
|
|
|
|
|
|
# set up database |
2713
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
2714
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
2715
|
|
|
|
|
|
|
|
2716
|
|
|
|
|
|
|
# return all the relations 'rel' for cui 'concept' |
2717
|
0
|
|
|
|
|
|
my $arrRef = ""; |
2718
|
0
|
0
|
|
|
|
|
if($umlsall) { |
2719
|
0
|
|
|
|
|
|
$arrRef = $db->selectcol_arrayref("select distinct CUI2 from MRREL where CUI1='$concept' and REL='$rel' and CUI2!='$concept'"); |
2720
|
|
|
|
|
|
|
} |
2721
|
|
|
|
|
|
|
else { |
2722
|
0
|
|
|
|
|
|
$arrRef = $db->selectcol_arrayref("select distinct CUI2 from MRREL where CUI1='$concept' and REL='$rel' and ($sources) and CUI2!='$concept'"); |
2723
|
|
|
|
|
|
|
} |
2724
|
|
|
|
|
|
|
|
2725
|
|
|
|
|
|
|
# check for errors |
2726
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
2727
|
|
|
|
|
|
|
|
2728
|
0
|
|
|
|
|
|
return $arrRef; |
2729
|
|
|
|
|
|
|
} |
2730
|
|
|
|
|
|
|
|
2731
|
|
|
|
|
|
|
# method that returns the preferred term of a cui from the UMLS |
2732
|
|
|
|
|
|
|
# input : $concept <- string containing cui |
2733
|
|
|
|
|
|
|
# output: $string <- string containing the preferred term |
2734
|
|
|
|
|
|
|
sub _getAllPreferredTerm { |
2735
|
0
|
|
|
0
|
|
|
my $self = shift; |
2736
|
0
|
|
|
|
|
|
my $concept = shift; |
2737
|
|
|
|
|
|
|
|
2738
|
0
|
|
|
|
|
|
my $function = "_getAllPreferredTerm"; |
2739
|
|
|
|
|
|
|
|
2740
|
|
|
|
|
|
|
# check self |
2741
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
2742
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
2743
|
|
|
|
|
|
|
} |
2744
|
|
|
|
|
|
|
|
2745
|
|
|
|
|
|
|
# check parameter exists |
2746
|
0
|
0
|
|
|
|
|
if(!defined $concept) { |
2747
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
2748
|
|
|
|
|
|
|
} |
2749
|
|
|
|
|
|
|
|
2750
|
|
|
|
|
|
|
# check if valid concept |
2751
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept)) ) { |
2752
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept) is not valid.", 6); |
2753
|
|
|
|
|
|
|
} |
2754
|
|
|
|
|
|
|
|
2755
|
|
|
|
|
|
|
# set the return hash |
2756
|
0
|
|
|
|
|
|
my %retHash = (); |
2757
|
|
|
|
|
|
|
|
2758
|
|
|
|
|
|
|
# if the concept is the root return the root string |
2759
|
0
|
0
|
|
|
|
|
if($concept eq $umlsRoot) { |
2760
|
0
|
|
|
|
|
|
$retHash{"**UMLS ROOT**"}++; |
2761
|
0
|
|
|
|
|
|
my @array = keys(%retHash); |
2762
|
0
|
|
|
|
|
|
return \@array; |
2763
|
|
|
|
|
|
|
} |
2764
|
|
|
|
|
|
|
|
2765
|
|
|
|
|
|
|
# set the database |
2766
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
2767
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
2768
|
|
|
|
|
|
|
|
2769
|
|
|
|
|
|
|
# get the strings associated to the CUI |
2770
|
0
|
|
|
|
|
|
my $arrRef = $db->selectcol_arrayref("select distinct STR from MRCONSO where CUI='$concept' and TS='P' and LAT='ENG'"); |
2771
|
|
|
|
|
|
|
|
2772
|
|
|
|
|
|
|
# check the database for errors |
2773
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
2774
|
|
|
|
|
|
|
|
2775
|
|
|
|
|
|
|
# clean up the strings a bit and lower case them |
2776
|
0
|
|
|
|
|
|
my $term = ""; |
2777
|
0
|
|
|
|
|
|
foreach my $tr (@{$arrRef}) { |
|
0
|
|
|
|
|
|
|
2778
|
0
|
|
|
|
|
|
$tr =~ s/^\s+//; |
2779
|
0
|
|
|
|
|
|
$tr =~ s/\s+$//; |
2780
|
0
|
|
|
|
|
|
$tr =~ s/\s+/ /g; |
2781
|
0
|
|
|
|
|
|
$term = $tr; |
2782
|
|
|
|
|
|
|
} |
2783
|
|
|
|
|
|
|
|
2784
|
|
|
|
|
|
|
# return the strings |
2785
|
0
|
|
|
|
|
|
return $term; |
2786
|
|
|
|
|
|
|
} |
2787
|
|
|
|
|
|
|
|
2788
|
|
|
|
|
|
|
# method that returns the preferred term of a cui from |
2789
|
|
|
|
|
|
|
# sources specified in the configuration file |
2790
|
|
|
|
|
|
|
# input : $concept <- string containing cui |
2791
|
|
|
|
|
|
|
# output: $string <- string containing the preferred term |
2792
|
|
|
|
|
|
|
sub _getPreferredTerm { |
2793
|
0
|
|
|
0
|
|
|
my $self = shift; |
2794
|
0
|
|
|
|
|
|
my $concept = shift; |
2795
|
|
|
|
|
|
|
|
2796
|
0
|
|
|
|
|
|
my $function = "_getPreferredTerm"; |
2797
|
|
|
|
|
|
|
|
2798
|
|
|
|
|
|
|
# check self |
2799
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
2800
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
2801
|
|
|
|
|
|
|
} |
2802
|
|
|
|
|
|
|
|
2803
|
|
|
|
|
|
|
# check parameter exists |
2804
|
0
|
0
|
|
|
|
|
if(!defined $concept) { |
2805
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
2806
|
|
|
|
|
|
|
} |
2807
|
|
|
|
|
|
|
|
2808
|
|
|
|
|
|
|
# check if valid concept |
2809
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept)) ) { |
2810
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept) is not valid.", 6); |
2811
|
|
|
|
|
|
|
} |
2812
|
|
|
|
|
|
|
|
2813
|
|
|
|
|
|
|
# set the return hash |
2814
|
0
|
|
|
|
|
|
my %retHash = (); |
2815
|
|
|
|
|
|
|
|
2816
|
|
|
|
|
|
|
# if the concept is the root return the root string |
2817
|
0
|
0
|
|
|
|
|
if($concept eq $umlsRoot) { |
2818
|
0
|
|
|
|
|
|
$retHash{"**UMLS ROOT**"}++; |
2819
|
0
|
|
|
|
|
|
my @array = keys(%retHash); |
2820
|
0
|
|
|
|
|
|
return \@array; |
2821
|
|
|
|
|
|
|
} |
2822
|
|
|
|
|
|
|
|
2823
|
|
|
|
|
|
|
# set the database |
2824
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
2825
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
2826
|
|
|
|
|
|
|
|
2827
|
|
|
|
|
|
|
# get the strings associated to the CUI |
2828
|
0
|
|
|
|
|
|
my $arrRef = ""; |
2829
|
0
|
0
|
|
|
|
|
if($umlsall) { |
2830
|
0
|
|
|
|
|
|
$arrRef = $db->selectcol_arrayref("select distinct STR from MRCONSO where CUI='$concept' and TS='P' and LAT='ENG'"); |
2831
|
|
|
|
|
|
|
} |
2832
|
|
|
|
|
|
|
else { |
2833
|
0
|
|
|
|
|
|
$arrRef = $db->selectcol_arrayref("select distinct STR from MRCONSO where CUI='$concept' and TS='P' and ($sources or SAB='SRC') and LAT='ENG'"); |
2834
|
|
|
|
|
|
|
} |
2835
|
|
|
|
|
|
|
|
2836
|
|
|
|
|
|
|
# check the database for errors |
2837
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
2838
|
|
|
|
|
|
|
|
2839
|
|
|
|
|
|
|
|
2840
|
|
|
|
|
|
|
# clean up the strings a bit and lower case them |
2841
|
0
|
|
|
|
|
|
my $term = ""; |
2842
|
0
|
|
|
|
|
|
foreach my $tr (@{$arrRef}) { |
|
0
|
|
|
|
|
|
|
2843
|
0
|
|
|
|
|
|
$tr =~ s/^\s+//; |
2844
|
0
|
|
|
|
|
|
$tr =~ s/\s+$//; |
2845
|
0
|
|
|
|
|
|
$tr =~ s/\s+/ /g; |
2846
|
0
|
|
|
|
|
|
$term = $tr; |
2847
|
|
|
|
|
|
|
} |
2848
|
|
|
|
|
|
|
|
2849
|
|
|
|
|
|
|
# return the strings |
2850
|
0
|
|
|
|
|
|
return $term; |
2851
|
|
|
|
|
|
|
} |
2852
|
|
|
|
|
|
|
|
2853
|
|
|
|
|
|
|
|
2854
|
|
|
|
|
|
|
|
2855
|
|
|
|
|
|
|
# method that maps terms to cuis in the sources specified in |
2856
|
|
|
|
|
|
|
# in the configuration file by the user using the SAB parameter |
2857
|
|
|
|
|
|
|
# input : $concept <- string containing cui |
2858
|
|
|
|
|
|
|
# output: $array <- reference to an array of terms (strings) |
2859
|
|
|
|
|
|
|
sub _getTermList { |
2860
|
0
|
|
|
0
|
|
|
my $self = shift; |
2861
|
0
|
|
|
|
|
|
my $concept = shift; |
2862
|
|
|
|
|
|
|
|
2863
|
0
|
|
|
|
|
|
my $function = "_getTermList"; |
2864
|
|
|
|
|
|
|
|
2865
|
|
|
|
|
|
|
# check self |
2866
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
2867
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
2868
|
|
|
|
|
|
|
} |
2869
|
|
|
|
|
|
|
|
2870
|
|
|
|
|
|
|
# check parameter exists |
2871
|
0
|
0
|
|
|
|
|
if(!defined $concept) { |
2872
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
2873
|
|
|
|
|
|
|
} |
2874
|
|
|
|
|
|
|
|
2875
|
|
|
|
|
|
|
# check if valid concept |
2876
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept)) ) { |
2877
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept) is not valid.", 6); |
2878
|
|
|
|
|
|
|
} |
2879
|
|
|
|
|
|
|
|
2880
|
|
|
|
|
|
|
# set the return hash |
2881
|
0
|
|
|
|
|
|
my %retHash = (); |
2882
|
|
|
|
|
|
|
|
2883
|
|
|
|
|
|
|
# if the concept is the root return the root string |
2884
|
0
|
0
|
|
|
|
|
if($concept eq $umlsRoot) { |
2885
|
0
|
|
|
|
|
|
$retHash{"**UMLS ROOT**"}++; |
2886
|
0
|
|
|
|
|
|
my @array = keys(%retHash); |
2887
|
0
|
|
|
|
|
|
return \@array; |
2888
|
|
|
|
|
|
|
} |
2889
|
|
|
|
|
|
|
|
2890
|
|
|
|
|
|
|
# set the database |
2891
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
2892
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
2893
|
|
|
|
|
|
|
|
2894
|
|
|
|
|
|
|
# get the strings associated to the CUI |
2895
|
0
|
|
|
|
|
|
my $arrRef = ""; |
2896
|
0
|
0
|
|
|
|
|
if($umlsall) { |
2897
|
0
|
|
|
|
|
|
$arrRef = $db->selectcol_arrayref("select distinct STR from MRCONSO where CUI='$concept'"); |
2898
|
|
|
|
|
|
|
} |
2899
|
|
|
|
|
|
|
else { |
2900
|
0
|
|
|
|
|
|
$arrRef = $db->selectcol_arrayref("select distinct STR from MRCONSO where CUI='$concept' and ($sources or SAB='SRC')"); |
2901
|
|
|
|
|
|
|
} |
2902
|
|
|
|
|
|
|
|
2903
|
|
|
|
|
|
|
# check the database for errors |
2904
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
2905
|
|
|
|
|
|
|
|
2906
|
|
|
|
|
|
|
# clean up the strings a bit and lower case them |
2907
|
0
|
|
|
|
|
|
foreach my $tr (@{$arrRef}) { |
|
0
|
|
|
|
|
|
|
2908
|
0
|
|
|
|
|
|
$tr =~ s/^\s+//; |
2909
|
0
|
|
|
|
|
|
$tr =~ s/\s+$//; |
2910
|
0
|
|
|
|
|
|
$tr =~ s/\s+/ /g; |
2911
|
0
|
|
|
|
|
|
$retHash{lc($tr)} = 1; |
2912
|
|
|
|
|
|
|
} |
2913
|
|
|
|
|
|
|
|
2914
|
0
|
|
|
|
|
|
my @array = keys(%retHash); |
2915
|
|
|
|
|
|
|
|
2916
|
|
|
|
|
|
|
# return the strings |
2917
|
0
|
|
|
|
|
|
return \@array; |
2918
|
|
|
|
|
|
|
} |
2919
|
|
|
|
|
|
|
|
2920
|
|
|
|
|
|
|
# method that maps terms to cuis in the sources specified in |
2921
|
|
|
|
|
|
|
# in the configuration file by the user using the SABDEF parameter |
2922
|
|
|
|
|
|
|
# input : $concept <- string containing cui |
2923
|
|
|
|
|
|
|
# output: $array <- reference to an array of terms |
2924
|
|
|
|
|
|
|
sub _getDefTermList { |
2925
|
0
|
|
|
0
|
|
|
my $self = shift; |
2926
|
0
|
|
|
|
|
|
my $concept = shift; |
2927
|
|
|
|
|
|
|
|
2928
|
0
|
|
|
|
|
|
my $function = "_getTermList"; |
2929
|
|
|
|
|
|
|
|
2930
|
|
|
|
|
|
|
# check self |
2931
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
2932
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
2933
|
|
|
|
|
|
|
} |
2934
|
|
|
|
|
|
|
|
2935
|
|
|
|
|
|
|
# check parameter exists |
2936
|
0
|
0
|
|
|
|
|
if(!defined $concept) { |
2937
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
2938
|
|
|
|
|
|
|
} |
2939
|
|
|
|
|
|
|
|
2940
|
|
|
|
|
|
|
# check if valid concept |
2941
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept)) ) { |
2942
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept) is not valid.", 6); |
2943
|
|
|
|
|
|
|
} |
2944
|
|
|
|
|
|
|
|
2945
|
|
|
|
|
|
|
# set the return hash |
2946
|
0
|
|
|
|
|
|
my %retHash = (); |
2947
|
|
|
|
|
|
|
|
2948
|
|
|
|
|
|
|
# if the concept is the root return the root string |
2949
|
0
|
0
|
|
|
|
|
if($concept eq $umlsRoot) { |
2950
|
0
|
|
|
|
|
|
$retHash{"**UMLS ROOT**"}++; |
2951
|
0
|
|
|
|
|
|
my @array = keys(%retHash); |
2952
|
0
|
|
|
|
|
|
return \@array; |
2953
|
|
|
|
|
|
|
} |
2954
|
|
|
|
|
|
|
|
2955
|
|
|
|
|
|
|
# set the database |
2956
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
2957
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
2958
|
|
|
|
|
|
|
|
2959
|
|
|
|
|
|
|
# get the strings associated to the CUI |
2960
|
0
|
|
|
|
|
|
my $arrRef = ""; |
2961
|
0
|
0
|
|
|
|
|
if($sabdef_umlsall) { |
2962
|
0
|
|
|
|
|
|
$arrRef = $db->selectcol_arrayref("select distinct STR from MRCONSO where CUI='$concept'"); |
2963
|
|
|
|
|
|
|
} |
2964
|
|
|
|
|
|
|
else { |
2965
|
0
|
|
|
|
|
|
$arrRef = $db->selectcol_arrayref("select distinct STR from MRCONSO where CUI='$concept' and ($sabdefsources or SAB='SRC')"); |
2966
|
|
|
|
|
|
|
} |
2967
|
|
|
|
|
|
|
|
2968
|
|
|
|
|
|
|
# check the database for errors |
2969
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
2970
|
|
|
|
|
|
|
|
2971
|
|
|
|
|
|
|
# clean up the strings a bit and lower case them |
2972
|
0
|
|
|
|
|
|
foreach my $tr (@{$arrRef}) { |
|
0
|
|
|
|
|
|
|
2973
|
0
|
|
|
|
|
|
$tr =~ s/^\s+//; |
2974
|
0
|
|
|
|
|
|
$tr =~ s/\s+$//; |
2975
|
0
|
|
|
|
|
|
$tr =~ s/\s+/ /g; |
2976
|
0
|
|
|
|
|
|
$retHash{lc($tr)} = 1; |
2977
|
|
|
|
|
|
|
} |
2978
|
|
|
|
|
|
|
|
2979
|
|
|
|
|
|
|
# return the strings |
2980
|
0
|
|
|
|
|
|
my @array = keys(%retHash); |
2981
|
0
|
|
|
|
|
|
return \@array; |
2982
|
|
|
|
|
|
|
} |
2983
|
|
|
|
|
|
|
|
2984
|
|
|
|
|
|
|
# method that maps terms to cuis in the sources specified in |
2985
|
|
|
|
|
|
|
# in the configuration file by the user |
2986
|
|
|
|
|
|
|
# input : $concept <- string containing cui |
2987
|
|
|
|
|
|
|
# output: $array <- reference to an array of terms and their sources |
2988
|
|
|
|
|
|
|
sub _getTermSabList { |
2989
|
0
|
|
|
0
|
|
|
my $self = shift; |
2990
|
0
|
|
|
|
|
|
my $concept = shift; |
2991
|
|
|
|
|
|
|
|
2992
|
0
|
|
|
|
|
|
my $function = "_getTermSabList"; |
2993
|
0
|
|
|
|
|
|
&_debug($function); |
2994
|
|
|
|
|
|
|
|
2995
|
|
|
|
|
|
|
# check self |
2996
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
2997
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
2998
|
|
|
|
|
|
|
} |
2999
|
|
|
|
|
|
|
|
3000
|
|
|
|
|
|
|
# check parameter exists |
3001
|
0
|
0
|
|
|
|
|
if(!defined $concept) { |
3002
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
3003
|
|
|
|
|
|
|
} |
3004
|
|
|
|
|
|
|
|
3005
|
|
|
|
|
|
|
# check if valid concept |
3006
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept)) ) { |
3007
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept) is not valid.", 6); |
3008
|
|
|
|
|
|
|
} |
3009
|
|
|
|
|
|
|
|
3010
|
|
|
|
|
|
|
# initialize the return hash |
3011
|
0
|
|
|
|
|
|
my %retHash = (); |
3012
|
|
|
|
|
|
|
|
3013
|
|
|
|
|
|
|
# if the concept is the root return the root string |
3014
|
0
|
0
|
|
|
|
|
if($concept eq $umlsRoot) { |
3015
|
0
|
|
|
|
|
|
$retHash{"**UMLS ROOT**"}++; |
3016
|
0
|
|
|
|
|
|
my @array = keys(%retHash); |
3017
|
0
|
|
|
|
|
|
return \@array; |
3018
|
|
|
|
|
|
|
} |
3019
|
|
|
|
|
|
|
|
3020
|
|
|
|
|
|
|
# otherwise, set up the db |
3021
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
3022
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
3023
|
|
|
|
|
|
|
# get all of the strings with their corresponding sab |
3024
|
0
|
|
|
|
|
|
my %strhash = (); my $sql = ""; |
|
0
|
|
|
|
|
|
|
3025
|
0
|
0
|
|
|
|
|
if($sabdef_umlsall) { |
3026
|
0
|
|
|
|
|
|
$sql = qq{ select STR, SAB from MRCONSO where CUI='$concept' }; |
3027
|
|
|
|
|
|
|
} |
3028
|
|
|
|
|
|
|
else { |
3029
|
0
|
|
|
|
|
|
$sql = qq{select STR, SAB from MRCONSO where CUI='$concept' and ($sabdefsources or SAB='SRC') }; |
3030
|
|
|
|
|
|
|
} |
3031
|
0
|
|
|
|
|
|
my $sth = $db->prepare( $sql ); |
3032
|
0
|
|
|
|
|
|
$sth->execute(); |
3033
|
0
|
|
|
|
|
|
my($str, $sab); |
3034
|
0
|
|
|
|
|
|
$sth->bind_columns( undef, \$str, \$sab ); |
3035
|
0
|
|
|
|
|
|
while( $sth->fetch() ) { |
3036
|
0
|
|
|
|
|
|
$str =~ s/^\s+//; |
3037
|
0
|
|
|
|
|
|
$str =~ s/\s+$//; |
3038
|
0
|
|
|
|
|
|
$str =~ s/\s+/ /g; |
3039
|
0
|
|
|
|
|
|
$str = lc($str); |
3040
|
0
|
|
|
|
|
|
my $item = "$sab : $str"; |
3041
|
0
|
|
|
|
|
|
$retHash{$item}++; |
3042
|
|
|
|
|
|
|
} |
3043
|
|
|
|
|
|
|
|
3044
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $sth); |
3045
|
0
|
|
|
|
|
|
$sth->finish(); |
3046
|
|
|
|
|
|
|
|
3047
|
|
|
|
|
|
|
# return keys |
3048
|
0
|
|
|
|
|
|
my @array = keys(%retHash); |
3049
|
0
|
|
|
|
|
|
return \@array; |
3050
|
|
|
|
|
|
|
} |
3051
|
|
|
|
|
|
|
|
3052
|
|
|
|
|
|
|
|
3053
|
|
|
|
|
|
|
# method to map terms to any concept in the umls |
3054
|
|
|
|
|
|
|
# input : $concept <- string containing cui |
3055
|
|
|
|
|
|
|
# output: $array <- reference to an array containing terms (strings) |
3056
|
|
|
|
|
|
|
sub _getAllTerms { |
3057
|
0
|
|
|
0
|
|
|
my $self = shift; |
3058
|
0
|
|
|
|
|
|
my $concept = shift; |
3059
|
|
|
|
|
|
|
|
3060
|
0
|
|
|
|
|
|
my $function = "_getAllTerms"; |
3061
|
0
|
|
|
|
|
|
&_debug($function); |
3062
|
|
|
|
|
|
|
|
3063
|
|
|
|
|
|
|
# check self |
3064
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
3065
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
3066
|
|
|
|
|
|
|
} |
3067
|
|
|
|
|
|
|
|
3068
|
|
|
|
|
|
|
# check parameter exists |
3069
|
0
|
0
|
|
|
|
|
if(!defined $concept) { |
3070
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
3071
|
|
|
|
|
|
|
} |
3072
|
|
|
|
|
|
|
|
3073
|
|
|
|
|
|
|
# check if valid concept |
3074
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept)) ) { |
3075
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept) is not valid.", 6); |
3076
|
|
|
|
|
|
|
} |
3077
|
|
|
|
|
|
|
|
3078
|
|
|
|
|
|
|
# initialize the return hash |
3079
|
0
|
|
|
|
|
|
my %retHash = (); |
3080
|
|
|
|
|
|
|
|
3081
|
|
|
|
|
|
|
# if the concept is the root return the root string |
3082
|
0
|
0
|
|
|
|
|
if($concept eq $umlsRoot) { |
3083
|
0
|
|
|
|
|
|
$retHash{"**UMLS ROOT**"}++; |
3084
|
0
|
|
|
|
|
|
my @array = keys(%retHash); |
3085
|
0
|
|
|
|
|
|
return \@array; |
3086
|
|
|
|
|
|
|
} |
3087
|
|
|
|
|
|
|
|
3088
|
|
|
|
|
|
|
# otherwise, set up the db |
3089
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
3090
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
3091
|
|
|
|
|
|
|
|
3092
|
|
|
|
|
|
|
# get all of the strings with their corresponding sab |
3093
|
0
|
|
|
|
|
|
my %strhash = (); |
3094
|
0
|
|
|
|
|
|
my $sql = qq{ select STR, SAB from MRCONSO where CUI='$concept' }; |
3095
|
0
|
|
|
|
|
|
my $sth = $db->prepare( $sql ); |
3096
|
0
|
|
|
|
|
|
$sth->execute(); |
3097
|
0
|
|
|
|
|
|
my($str, $sab); |
3098
|
0
|
|
|
|
|
|
$sth->bind_columns( undef, \$str, \$sab ); |
3099
|
0
|
|
|
|
|
|
while( $sth->fetch() ) { |
3100
|
0
|
|
|
|
|
|
$str =~ s/^\s+//; |
3101
|
0
|
|
|
|
|
|
$str =~ s/\s+$//; |
3102
|
0
|
|
|
|
|
|
$str =~ s/\s+/ /g; |
3103
|
0
|
|
|
|
|
|
$str = lc($str); |
3104
|
0
|
|
|
|
|
|
push @{$strhash{$str}}, $sab; |
|
0
|
|
|
|
|
|
|
3105
|
|
|
|
|
|
|
} |
3106
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $sth); |
3107
|
0
|
|
|
|
|
|
$sth->finish(); |
3108
|
|
|
|
|
|
|
|
3109
|
|
|
|
|
|
|
# set the output |
3110
|
0
|
|
|
|
|
|
foreach my $str (sort keys %strhash) { |
3111
|
0
|
|
|
|
|
|
my $sabs = join ", ", @{$strhash{$str}}; |
|
0
|
|
|
|
|
|
|
3112
|
0
|
|
|
|
|
|
my $index = "$str - $sabs"; |
3113
|
0
|
|
|
|
|
|
$retHash{$index}++; |
3114
|
|
|
|
|
|
|
} |
3115
|
|
|
|
|
|
|
|
3116
|
0
|
|
|
|
|
|
my @array = keys(%retHash); |
3117
|
|
|
|
|
|
|
|
3118
|
0
|
|
|
|
|
|
return \@array; |
3119
|
|
|
|
|
|
|
} |
3120
|
|
|
|
|
|
|
|
3121
|
|
|
|
|
|
|
# method to map CUIs to a terms in the sources and the relations |
3122
|
|
|
|
|
|
|
# specified in the configuration file by SAB and REL |
3123
|
|
|
|
|
|
|
# input : $term <- string containing a term |
3124
|
|
|
|
|
|
|
# output: $array <- reference to an array containing cuis |
3125
|
|
|
|
|
|
|
sub _getConceptList { |
3126
|
|
|
|
|
|
|
|
3127
|
0
|
|
|
0
|
|
|
my $self = shift; |
3128
|
0
|
|
|
|
|
|
my $term = shift; |
3129
|
|
|
|
|
|
|
|
3130
|
0
|
|
|
|
|
|
my $function = "_getConceptList"; |
3131
|
0
|
|
|
|
|
|
&_debug($function); |
3132
|
|
|
|
|
|
|
|
3133
|
|
|
|
|
|
|
# check self |
3134
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
3135
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
3136
|
|
|
|
|
|
|
} |
3137
|
|
|
|
|
|
|
|
3138
|
|
|
|
|
|
|
# check parameter exists |
3139
|
0
|
0
|
|
|
|
|
if(!defined $term) { |
3140
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$term.", 4); |
3141
|
|
|
|
|
|
|
} |
3142
|
|
|
|
|
|
|
|
3143
|
|
|
|
|
|
|
# check that the ' are escaped if exist |
3144
|
0
|
|
|
|
|
|
$term=~s/\\?\'/\\\'/; |
3145
|
|
|
|
|
|
|
|
3146
|
|
|
|
|
|
|
# set up the database |
3147
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
3148
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
3149
|
|
|
|
|
|
|
|
3150
|
|
|
|
|
|
|
# get the cuis |
3151
|
0
|
|
|
|
|
|
my $arrRef = ""; |
3152
|
|
|
|
|
|
|
|
3153
|
0
|
0
|
|
|
|
|
if($umlsall) { |
|
|
0
|
|
|
|
|
|
3154
|
0
|
|
|
|
|
|
$arrRef = $db->selectcol_arrayref("select distinct CUI from MRCONSO where STR='$term'"); |
3155
|
|
|
|
|
|
|
} |
3156
|
|
|
|
|
|
|
elsif($sources ne "") { |
3157
|
|
|
|
|
|
|
|
3158
|
0
|
|
|
|
|
|
$arrRef = $db->selectcol_arrayref("select distinct CUI from MRCONSO where STR='$term' and ($sources)"); |
3159
|
|
|
|
|
|
|
} |
3160
|
|
|
|
|
|
|
else { |
3161
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with sources from configuration file.", 5); |
3162
|
|
|
|
|
|
|
} |
3163
|
|
|
|
|
|
|
# check for database errors |
3164
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
3165
|
|
|
|
|
|
|
|
3166
|
0
|
|
|
|
|
|
return $arrRef; |
3167
|
|
|
|
|
|
|
} |
3168
|
|
|
|
|
|
|
|
3169
|
|
|
|
|
|
|
# method to map CUIs to a terms in the sources and the relations |
3170
|
|
|
|
|
|
|
# specified in the configuration file by SABDEF and RELDEF |
3171
|
|
|
|
|
|
|
# input : $term <- string containing a term |
3172
|
|
|
|
|
|
|
# output: $array <- reference to an array containing cuis |
3173
|
|
|
|
|
|
|
sub _getDefConceptList { |
3174
|
|
|
|
|
|
|
|
3175
|
0
|
|
|
0
|
|
|
my $self = shift; |
3176
|
0
|
|
|
|
|
|
my $term = shift; |
3177
|
|
|
|
|
|
|
|
3178
|
0
|
|
|
|
|
|
my $function = "_getDefConceptList"; |
3179
|
|
|
|
|
|
|
|
3180
|
|
|
|
|
|
|
# check self |
3181
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
3182
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
3183
|
|
|
|
|
|
|
} |
3184
|
|
|
|
|
|
|
|
3185
|
|
|
|
|
|
|
# check parameter exists |
3186
|
0
|
0
|
|
|
|
|
if(!defined $term) { |
3187
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$term.", 4); |
3188
|
|
|
|
|
|
|
} |
3189
|
|
|
|
|
|
|
|
3190
|
|
|
|
|
|
|
# check that the ' are escaped if exist |
3191
|
0
|
|
|
|
|
|
$term=~s/\\?\'/\\\'/; |
3192
|
|
|
|
|
|
|
|
3193
|
|
|
|
|
|
|
# set up the database |
3194
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
3195
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
3196
|
|
|
|
|
|
|
|
3197
|
|
|
|
|
|
|
# get the cuis |
3198
|
0
|
|
|
|
|
|
my $arrRef = ""; |
3199
|
|
|
|
|
|
|
|
3200
|
0
|
0
|
|
|
|
|
if($sabdef_umlsall) { |
|
|
0
|
|
|
|
|
|
3201
|
0
|
|
|
|
|
|
$arrRef = $db->selectcol_arrayref("select distinct CUI from MRCONSO where STR='$term'"); |
3202
|
|
|
|
|
|
|
} |
3203
|
|
|
|
|
|
|
elsif($sabdefsources ne "") { |
3204
|
0
|
|
|
|
|
|
$arrRef = $db->selectcol_arrayref("select distinct CUI from MRCONSO where STR='$term' and ($sabdefsources)"); |
3205
|
|
|
|
|
|
|
} |
3206
|
|
|
|
|
|
|
else { |
3207
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with sources from configuration file.", 5); |
3208
|
|
|
|
|
|
|
} |
3209
|
|
|
|
|
|
|
# check for database errors |
3210
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
3211
|
|
|
|
|
|
|
|
3212
|
0
|
|
|
|
|
|
return $arrRef; |
3213
|
|
|
|
|
|
|
} |
3214
|
|
|
|
|
|
|
|
3215
|
|
|
|
|
|
|
# method to map CUIs to a terms using the CUIs in the |
3216
|
|
|
|
|
|
|
# entire UMLS not just the sources in the config file |
3217
|
|
|
|
|
|
|
# input : $term <- string containing a term |
3218
|
|
|
|
|
|
|
# output: $array <- reference to an array containing cuis |
3219
|
|
|
|
|
|
|
sub _getAllConcepts { |
3220
|
|
|
|
|
|
|
|
3221
|
0
|
|
|
0
|
|
|
my $self = shift; |
3222
|
0
|
|
|
|
|
|
my $term = shift; |
3223
|
|
|
|
|
|
|
|
3224
|
0
|
|
|
|
|
|
my $function = "_getAllConcepts"; |
3225
|
|
|
|
|
|
|
|
3226
|
|
|
|
|
|
|
# check self |
3227
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
3228
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
3229
|
|
|
|
|
|
|
} |
3230
|
|
|
|
|
|
|
|
3231
|
|
|
|
|
|
|
# check parameter exists |
3232
|
0
|
0
|
|
|
|
|
if(!defined $term) { |
3233
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$term.", 4); |
3234
|
|
|
|
|
|
|
} |
3235
|
|
|
|
|
|
|
|
3236
|
|
|
|
|
|
|
# check that the ' are escaped if exist |
3237
|
0
|
|
|
|
|
|
$term=~s/\\?\'/\\\'/; |
3238
|
|
|
|
|
|
|
|
3239
|
|
|
|
|
|
|
# set up the database |
3240
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
3241
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
3242
|
|
|
|
|
|
|
|
3243
|
|
|
|
|
|
|
# get the cuis |
3244
|
0
|
|
|
|
|
|
my $arrRef = $db->selectcol_arrayref("select distinct CUI from MRCONSO where STR='$term'"); |
3245
|
|
|
|
|
|
|
|
3246
|
|
|
|
|
|
|
# check for database errors |
3247
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
3248
|
|
|
|
|
|
|
|
3249
|
0
|
|
|
|
|
|
return $arrRef; |
3250
|
|
|
|
|
|
|
} |
3251
|
|
|
|
|
|
|
|
3252
|
|
|
|
|
|
|
# method returns all the compounds in the sources |
3253
|
|
|
|
|
|
|
# specified in the configuration file |
3254
|
|
|
|
|
|
|
# input: |
3255
|
|
|
|
|
|
|
# output: $hash <- reference to a hash containing cuis |
3256
|
|
|
|
|
|
|
sub _getCompounds { |
3257
|
|
|
|
|
|
|
|
3258
|
0
|
|
|
0
|
|
|
my $self = shift; |
3259
|
|
|
|
|
|
|
|
3260
|
0
|
|
|
|
|
|
my $function = "_getCompounds"; |
3261
|
0
|
|
|
|
|
|
&_debug($function); |
3262
|
|
|
|
|
|
|
|
3263
|
|
|
|
|
|
|
# check self |
3264
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
3265
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
3266
|
|
|
|
|
|
|
} |
3267
|
|
|
|
|
|
|
|
3268
|
|
|
|
|
|
|
# set up the database |
3269
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
3270
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
3271
|
|
|
|
|
|
|
|
3272
|
|
|
|
|
|
|
# initialize return hash |
3273
|
0
|
|
|
|
|
|
my %compounds = (); |
3274
|
|
|
|
|
|
|
|
3275
|
|
|
|
|
|
|
# get strings in the MRCONSO table |
3276
|
0
|
0
|
|
|
|
|
if($umlsall) { |
3277
|
|
|
|
|
|
|
# get all the terms from the MRCONSO table |
3278
|
0
|
|
|
|
|
|
my $strs = $db->selectcol_arrayref("select distinct STR from MRCONSO"); |
3279
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
3280
|
|
|
|
|
|
|
|
3281
|
|
|
|
|
|
|
# loop through the terms and add the ones that have more than one word to the hash |
3282
|
0
|
|
|
|
|
|
foreach my $str (@{$strs}) { |
|
0
|
|
|
|
|
|
|
3283
|
0
|
|
|
|
|
|
my @array = split/\s+/, $str; |
3284
|
0
|
0
|
|
|
|
|
if($#array > 0) { |
3285
|
0
|
|
|
|
|
|
$compounds{$str} = 0; |
3286
|
|
|
|
|
|
|
} |
3287
|
|
|
|
|
|
|
} |
3288
|
|
|
|
|
|
|
} |
3289
|
|
|
|
|
|
|
else { |
3290
|
|
|
|
|
|
|
|
3291
|
|
|
|
|
|
|
# for each of the sabs in the configuratinon file get strings |
3292
|
0
|
|
|
|
|
|
foreach my $sab (sort keys %sabnamesHash) { |
3293
|
|
|
|
|
|
|
|
3294
|
|
|
|
|
|
|
# get the cuis for that sab |
3295
|
0
|
|
|
|
|
|
my $strs = $db->selectcol_arrayref("select distinct STR from MRCONSO where SAB=\'$sab\'"); |
3296
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
3297
|
|
|
|
|
|
|
|
3298
|
|
|
|
|
|
|
# loop through the terms and add the ones that have more than one word to the hash |
3299
|
0
|
|
|
|
|
|
foreach my $str (@{$strs}) { |
|
0
|
|
|
|
|
|
|
3300
|
0
|
|
|
|
|
|
my @array = split/\s+/, $str; |
3301
|
0
|
0
|
|
|
|
|
if($#array > 0) { |
3302
|
0
|
|
|
|
|
|
$compounds{$str} = 0; |
3303
|
|
|
|
|
|
|
} |
3304
|
|
|
|
|
|
|
} |
3305
|
|
|
|
|
|
|
} |
3306
|
|
|
|
|
|
|
} |
3307
|
|
|
|
|
|
|
|
3308
|
0
|
|
|
|
|
|
return \%compounds; |
3309
|
|
|
|
|
|
|
} |
3310
|
|
|
|
|
|
|
|
3311
|
|
|
|
|
|
|
|
3312
|
|
|
|
|
|
|
# method returns all of the cuis in the sources |
3313
|
|
|
|
|
|
|
# specified in the configuration file |
3314
|
|
|
|
|
|
|
# input : |
3315
|
|
|
|
|
|
|
# output: $hash <- reference to a hash containing cuis |
3316
|
|
|
|
|
|
|
sub _getCuiList { |
3317
|
|
|
|
|
|
|
|
3318
|
0
|
|
|
0
|
|
|
my $self = shift; |
3319
|
|
|
|
|
|
|
|
3320
|
0
|
|
|
|
|
|
my $function = "_getCuiList"; |
3321
|
0
|
|
|
|
|
|
&_debug($function); |
3322
|
|
|
|
|
|
|
|
3323
|
|
|
|
|
|
|
# check self |
3324
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
3325
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
3326
|
|
|
|
|
|
|
} |
3327
|
|
|
|
|
|
|
|
3328
|
|
|
|
|
|
|
# if this has already been done just return the stored cuiListHash |
3329
|
0
|
|
|
|
|
|
my $elements = keys %cuiListHash; |
3330
|
0
|
0
|
|
|
|
|
if($elements > 0) { |
3331
|
0
|
|
|
|
|
|
return \%cuiListHash; |
3332
|
|
|
|
|
|
|
} |
3333
|
|
|
|
|
|
|
|
3334
|
|
|
|
|
|
|
# otherwise, set up the database |
3335
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
3336
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
3337
|
|
|
|
|
|
|
|
3338
|
|
|
|
|
|
|
# get the sabs in the config file |
3339
|
0
|
|
|
|
|
|
my @sabs = (); |
3340
|
0
|
0
|
|
|
|
|
if($umlsall) { |
3341
|
0
|
|
|
|
|
|
my $s = $db->selectcol_arrayref("select distinct SAB from MRREL"); |
3342
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
3343
|
0
|
|
|
|
|
|
@sabs = @{$s}; |
|
0
|
|
|
|
|
|
|
3344
|
|
|
|
|
|
|
} |
3345
|
|
|
|
|
|
|
else { |
3346
|
0
|
|
|
|
|
|
foreach my $sab (sort keys %sabnamesHash) { push @sabs, $sab; } |
|
0
|
|
|
|
|
|
|
3347
|
|
|
|
|
|
|
} |
3348
|
|
|
|
|
|
|
|
3349
|
|
|
|
|
|
|
# initialize the cui list hash |
3350
|
0
|
|
|
|
|
|
%cuiListHash = (); |
3351
|
|
|
|
|
|
|
|
3352
|
|
|
|
|
|
|
# for each of the sabs in the configuratino file |
3353
|
0
|
|
|
|
|
|
foreach my $sab (@sabs) { |
3354
|
|
|
|
|
|
|
|
3355
|
|
|
|
|
|
|
# get the cuis for that sab |
3356
|
0
|
|
|
|
|
|
my $cuis = $self->_getCuis($sab); |
3357
|
|
|
|
|
|
|
|
3358
|
|
|
|
|
|
|
# add the cuis to the hash |
3359
|
0
|
|
|
|
|
|
foreach my $cui (@{$cuis}) { $cuiListHash{$cui} = 0 }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
3360
|
|
|
|
|
|
|
} |
3361
|
|
|
|
|
|
|
|
3362
|
|
|
|
|
|
|
# add upper level taxonomy |
3363
|
0
|
|
|
|
|
|
foreach my $cui (sort keys %parentTaxonomyArray) { $cuiListHash{$cui} = 0; } |
|
0
|
|
|
|
|
|
|
3364
|
0
|
|
|
|
|
|
foreach my $cui (sort keys %childTaxonomyArray) { $cuiListHash{$cui} = 0; } |
|
0
|
|
|
|
|
|
|
3365
|
|
|
|
|
|
|
|
3366
|
0
|
|
|
|
|
|
return \%cuiListHash; |
3367
|
|
|
|
|
|
|
} |
3368
|
|
|
|
|
|
|
|
3369
|
|
|
|
|
|
|
# returns the cuis from a specified source |
3370
|
|
|
|
|
|
|
# input : $sab <- string contain the sources abbreviation |
3371
|
|
|
|
|
|
|
# output: $array <- reference to an array containing cuis |
3372
|
|
|
|
|
|
|
sub _getCuisFromSource { |
3373
|
|
|
|
|
|
|
|
3374
|
0
|
|
|
0
|
|
|
my $self = shift; |
3375
|
0
|
|
|
|
|
|
my $sab = shift; |
3376
|
|
|
|
|
|
|
|
3377
|
0
|
|
|
|
|
|
my $function = "_getCuisFromSource"; |
3378
|
0
|
|
|
|
|
|
&_debug($function); |
3379
|
|
|
|
|
|
|
|
3380
|
|
|
|
|
|
|
# check self |
3381
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
3382
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
3383
|
|
|
|
|
|
|
} |
3384
|
|
|
|
|
|
|
|
3385
|
|
|
|
|
|
|
# get the cuis from the specified source |
3386
|
0
|
|
|
|
|
|
my $arrRef = $self->_getCuis($sab); |
3387
|
|
|
|
|
|
|
|
3388
|
0
|
|
|
|
|
|
return ($arrRef); |
3389
|
|
|
|
|
|
|
} |
3390
|
|
|
|
|
|
|
|
3391
|
|
|
|
|
|
|
# returns all of the sources specified that contain the given cui |
3392
|
|
|
|
|
|
|
# input : $concept <- string containing the cui |
3393
|
|
|
|
|
|
|
# output: $array <- reference to an array contain the sources (abbreviations) |
3394
|
|
|
|
|
|
|
sub _getSab { |
3395
|
|
|
|
|
|
|
|
3396
|
0
|
|
|
0
|
|
|
my $self = shift; |
3397
|
0
|
|
|
|
|
|
my $concept = shift; |
3398
|
|
|
|
|
|
|
|
3399
|
0
|
|
|
|
|
|
my $function = "_getSab"; |
3400
|
|
|
|
|
|
|
|
3401
|
|
|
|
|
|
|
# check self |
3402
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
3403
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
3404
|
|
|
|
|
|
|
} |
3405
|
|
|
|
|
|
|
|
3406
|
|
|
|
|
|
|
# check parameter exists |
3407
|
0
|
0
|
|
|
|
|
if(!defined $concept) { |
3408
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
3409
|
|
|
|
|
|
|
} |
3410
|
|
|
|
|
|
|
|
3411
|
|
|
|
|
|
|
# check if valid concept |
3412
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept)) ) { |
3413
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept) is not valid.", 6); |
3414
|
|
|
|
|
|
|
} |
3415
|
|
|
|
|
|
|
|
3416
|
|
|
|
|
|
|
# connect to the database |
3417
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
3418
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
3419
|
|
|
|
|
|
|
|
3420
|
|
|
|
|
|
|
# select all the sources from the mrconso table |
3421
|
0
|
|
|
|
|
|
my $arrRef = $db->selectcol_arrayref("select distinct SAB from MRCONSO where CUI='$concept'"); |
3422
|
|
|
|
|
|
|
|
3423
|
|
|
|
|
|
|
# check the database for errors |
3424
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
3425
|
|
|
|
|
|
|
|
3426
|
0
|
|
|
|
|
|
return $arrRef; |
3427
|
|
|
|
|
|
|
} |
3428
|
|
|
|
|
|
|
|
3429
|
|
|
|
|
|
|
# returns the child relations |
3430
|
|
|
|
|
|
|
# input : |
3431
|
|
|
|
|
|
|
# output: $string <- containing the child relations |
3432
|
|
|
|
|
|
|
sub _getChildRelations { |
3433
|
0
|
|
|
0
|
|
|
my $self = shift; |
3434
|
|
|
|
|
|
|
|
3435
|
0
|
|
|
|
|
|
return $childRelations; |
3436
|
|
|
|
|
|
|
} |
3437
|
|
|
|
|
|
|
# returns the parent relations |
3438
|
|
|
|
|
|
|
# input : |
3439
|
|
|
|
|
|
|
# output: $string <- containing the parent relations |
3440
|
|
|
|
|
|
|
sub _getParentRelations { |
3441
|
0
|
|
|
0
|
|
|
my $self = shift; |
3442
|
|
|
|
|
|
|
|
3443
|
0
|
|
|
|
|
|
return $parentRelations; |
3444
|
|
|
|
|
|
|
} |
3445
|
|
|
|
|
|
|
|
3446
|
|
|
|
|
|
|
|
3447
|
|
|
|
|
|
|
# returns the children of a concept - the relations that |
3448
|
|
|
|
|
|
|
# are considered children are predefined by the user. |
3449
|
|
|
|
|
|
|
# the default are the RN and CHD relations |
3450
|
|
|
|
|
|
|
# input : $concept <- string containing a cui |
3451
|
|
|
|
|
|
|
# output: $array <- reference to an array containing a list of cuis |
3452
|
|
|
|
|
|
|
sub _getChildren { |
3453
|
|
|
|
|
|
|
|
3454
|
0
|
|
|
0
|
|
|
my $self = shift; |
3455
|
0
|
|
|
|
|
|
my $concept = shift; |
3456
|
|
|
|
|
|
|
|
3457
|
0
|
|
|
|
|
|
my $function = "_getChildren"; |
3458
|
|
|
|
|
|
|
#&_debug($function); |
3459
|
|
|
|
|
|
|
|
3460
|
|
|
|
|
|
|
# check self |
3461
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
3462
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
3463
|
|
|
|
|
|
|
} |
3464
|
|
|
|
|
|
|
|
3465
|
|
|
|
|
|
|
# check parameter exists |
3466
|
0
|
0
|
|
|
|
|
if(!defined $concept) { |
3467
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
3468
|
|
|
|
|
|
|
} |
3469
|
|
|
|
|
|
|
|
3470
|
|
|
|
|
|
|
# check if valid concept |
3471
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept)) ) { |
3472
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept) is not valid.", 6); |
3473
|
|
|
|
|
|
|
} |
3474
|
|
|
|
|
|
|
|
3475
|
|
|
|
|
|
|
# connect to the database |
3476
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
3477
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
3478
|
|
|
|
|
|
|
|
3479
|
|
|
|
|
|
|
# if the concept is the umls root node cui return |
3480
|
|
|
|
|
|
|
# the source's cuis |
3481
|
0
|
0
|
|
|
|
|
if($concept eq $umlsRoot) { |
3482
|
0
|
|
|
|
|
|
my @array = (keys %sabHash); |
3483
|
0
|
|
|
|
|
|
return \@array; |
3484
|
|
|
|
|
|
|
} |
3485
|
|
|
|
|
|
|
|
3486
|
|
|
|
|
|
|
# otherwise everything is normal so return its children |
3487
|
|
|
|
|
|
|
else { |
3488
|
0
|
|
|
|
|
|
my $arrRef = ""; |
3489
|
0
|
0
|
|
|
|
|
if($umlsall) { |
3490
|
0
|
|
|
|
|
|
$arrRef = $db->selectcol_arrayref("select distinct CUI2 from MRREL where CUI1='$concept' and ($childRelations) and CUI2!='$concept' and SUPPRESS='N'"); |
3491
|
|
|
|
|
|
|
} |
3492
|
|
|
|
|
|
|
else { |
3493
|
0
|
|
|
|
|
|
$arrRef = $db->selectcol_arrayref("select distinct CUI2 from MRREL where CUI1='$concept' and ($childRelations) and ($sources) and CUI2!='$concept' and SUPPRESS='N'"); |
3494
|
|
|
|
|
|
|
} |
3495
|
|
|
|
|
|
|
|
3496
|
|
|
|
|
|
|
# check the database for errors |
3497
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
3498
|
|
|
|
|
|
|
|
3499
|
|
|
|
|
|
|
# add the children in the upper taxonomy |
3500
|
0
|
|
|
|
|
|
my @array = (); |
3501
|
0
|
0
|
|
|
|
|
if(exists $childTaxonomyArray{$concept}) { |
3502
|
0
|
|
|
|
|
|
@array = (@{$childTaxonomyArray{$concept}}, @{$arrRef}); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
3503
|
|
|
|
|
|
|
} |
3504
|
|
|
|
|
|
|
else { |
3505
|
0
|
|
|
|
|
|
@array = @{$arrRef}; |
|
0
|
|
|
|
|
|
|
3506
|
|
|
|
|
|
|
} |
3507
|
0
|
|
|
|
|
|
return \@array; |
3508
|
|
|
|
|
|
|
} |
3509
|
|
|
|
|
|
|
} |
3510
|
|
|
|
|
|
|
|
3511
|
|
|
|
|
|
|
|
3512
|
|
|
|
|
|
|
# returns the parents of a concept - the relations that |
3513
|
|
|
|
|
|
|
# are considered parents are predefined by the user. |
3514
|
|
|
|
|
|
|
# the default are the PAR and RB relations. |
3515
|
|
|
|
|
|
|
# input : $concept <- string containing cui |
3516
|
|
|
|
|
|
|
# outupt: $array <- reference to an array containing a list of cuis |
3517
|
|
|
|
|
|
|
sub _getParents { |
3518
|
|
|
|
|
|
|
|
3519
|
0
|
|
|
0
|
|
|
my $self = shift; |
3520
|
0
|
|
|
|
|
|
my $concept = shift; |
3521
|
|
|
|
|
|
|
|
3522
|
0
|
|
|
|
|
|
my $function = "_getParents"; |
3523
|
|
|
|
|
|
|
|
3524
|
|
|
|
|
|
|
# check self |
3525
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
3526
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
3527
|
|
|
|
|
|
|
} |
3528
|
|
|
|
|
|
|
|
3529
|
|
|
|
|
|
|
# check parameter exists |
3530
|
0
|
0
|
|
|
|
|
if(!defined $concept) { |
3531
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
3532
|
|
|
|
|
|
|
} |
3533
|
|
|
|
|
|
|
|
3534
|
|
|
|
|
|
|
# check if valid concept |
3535
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept)) ) { |
3536
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept) is not valid.", 6); |
3537
|
|
|
|
|
|
|
} |
3538
|
|
|
|
|
|
|
|
3539
|
|
|
|
|
|
|
# connect to the database |
3540
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
3541
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
3542
|
|
|
|
|
|
|
|
3543
|
|
|
|
|
|
|
# if the cui is a root return an empty array |
3544
|
0
|
0
|
0
|
|
|
|
if($concept eq $umlsRoot) { |
|
|
0
|
|
|
|
|
|
3545
|
0
|
|
|
|
|
|
my @returnarray = (); |
3546
|
0
|
|
|
|
|
|
return \@returnarray; # empty array |
3547
|
|
|
|
|
|
|
} |
3548
|
|
|
|
|
|
|
# if the cui is a source cui but not a root return the umls root |
3549
|
|
|
|
|
|
|
elsif( (exists $sabHash{$concept}) and ($concept ne $umlsRoot)) { |
3550
|
0
|
|
|
|
|
|
my @returnarray = (); |
3551
|
0
|
|
|
|
|
|
push @returnarray, $umlsRoot; |
3552
|
0
|
|
|
|
|
|
return \@returnarray; |
3553
|
|
|
|
|
|
|
} |
3554
|
|
|
|
|
|
|
# otherwise everything is normal so return its parents |
3555
|
|
|
|
|
|
|
else { |
3556
|
0
|
|
|
|
|
|
my $arrRef = ""; |
3557
|
0
|
0
|
|
|
|
|
if($umlsall) { |
3558
|
0
|
|
|
|
|
|
$arrRef = $db->selectcol_arrayref("select distinct CUI2 from MRREL where CUI1='$concept' and ($parentRelations) and CUI2!='$concept' and SUPPRESS='N'"); |
3559
|
|
|
|
|
|
|
} |
3560
|
|
|
|
|
|
|
else { |
3561
|
0
|
|
|
|
|
|
$arrRef = $db->selectcol_arrayref("select distinct CUI2 from MRREL where CUI1='$concept' and ($parentRelations) and ($sources) and CUI2!='$concept' and SUPPRESS='N'"); |
3562
|
|
|
|
|
|
|
} |
3563
|
|
|
|
|
|
|
|
3564
|
|
|
|
|
|
|
# check the database for errors |
3565
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
3566
|
|
|
|
|
|
|
|
3567
|
|
|
|
|
|
|
# add the parents in the upper taxonomy |
3568
|
0
|
|
|
|
|
|
my @array = (); |
3569
|
0
|
0
|
|
|
|
|
if(exists $parentTaxonomyArray{$concept}) { |
3570
|
0
|
|
|
|
|
|
@array = (@{$parentTaxonomyArray{$concept}}, @{$arrRef}); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
3571
|
|
|
|
|
|
|
} |
3572
|
|
|
|
|
|
|
else { |
3573
|
0
|
|
|
|
|
|
@array = @{$arrRef}; |
|
0
|
|
|
|
|
|
|
3574
|
|
|
|
|
|
|
} |
3575
|
0
|
|
|
|
|
|
return \@array; |
3576
|
|
|
|
|
|
|
} |
3577
|
|
|
|
|
|
|
} |
3578
|
|
|
|
|
|
|
|
3579
|
|
|
|
|
|
|
# returns the relations of a concept given a specified source |
3580
|
|
|
|
|
|
|
# input : $concept <- string containing a cui |
3581
|
|
|
|
|
|
|
# output: $array <- reference to an array containing strings of relations |
3582
|
|
|
|
|
|
|
sub _getRelations { |
3583
|
|
|
|
|
|
|
|
3584
|
0
|
|
|
0
|
|
|
my $self = shift; |
3585
|
0
|
|
|
|
|
|
my $concept = shift; |
3586
|
|
|
|
|
|
|
|
3587
|
0
|
|
|
|
|
|
my $function = "_getRelations"; |
3588
|
0
|
|
|
|
|
|
&_debug($function); |
3589
|
|
|
|
|
|
|
|
3590
|
|
|
|
|
|
|
# check self |
3591
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
3592
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
3593
|
|
|
|
|
|
|
} |
3594
|
|
|
|
|
|
|
|
3595
|
|
|
|
|
|
|
# check parameter exists |
3596
|
0
|
0
|
|
|
|
|
if(!defined $concept) { |
3597
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
3598
|
|
|
|
|
|
|
} |
3599
|
|
|
|
|
|
|
|
3600
|
|
|
|
|
|
|
# check if valid concept |
3601
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept)) ) { |
3602
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept) is not valid.", 6); |
3603
|
|
|
|
|
|
|
} |
3604
|
|
|
|
|
|
|
|
3605
|
|
|
|
|
|
|
# connect to the database |
3606
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
3607
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
3608
|
|
|
|
|
|
|
|
3609
|
|
|
|
|
|
|
# get the relations |
3610
|
0
|
|
|
|
|
|
my $arrRef = ""; |
3611
|
0
|
0
|
|
|
|
|
if($umlsall) { |
3612
|
0
|
|
|
|
|
|
$arrRef = $db->selectcol_arrayref("select distinct REL from MRREL where (CUI1='$concept' or CUI2='$concept') and CUI1!=CUI2"); |
3613
|
|
|
|
|
|
|
} |
3614
|
|
|
|
|
|
|
else { |
3615
|
0
|
|
|
|
|
|
$arrRef = $db->selectcol_arrayref("select distinct REL from MRREL where (CUI1='$concept' or CUI2='$concept') and ($sources) and CUI1!=CUI2"); |
3616
|
|
|
|
|
|
|
} |
3617
|
|
|
|
|
|
|
|
3618
|
|
|
|
|
|
|
# check the database for errors |
3619
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
3620
|
|
|
|
|
|
|
|
3621
|
0
|
|
|
|
|
|
return $arrRef; |
3622
|
|
|
|
|
|
|
} |
3623
|
|
|
|
|
|
|
|
3624
|
|
|
|
|
|
|
# returns the relations and its source between two concepts |
3625
|
|
|
|
|
|
|
# input : $concept1 <- string containing a cui |
3626
|
|
|
|
|
|
|
# : $concept2 <- string containing a cui |
3627
|
|
|
|
|
|
|
# output: $array <- reference to an array containing the relations |
3628
|
|
|
|
|
|
|
sub _getRelationsBetweenCuis { |
3629
|
|
|
|
|
|
|
|
3630
|
0
|
|
|
0
|
|
|
my $self = shift; |
3631
|
0
|
|
|
|
|
|
my $concept1 = shift; |
3632
|
0
|
|
|
|
|
|
my $concept2 = shift; |
3633
|
|
|
|
|
|
|
|
3634
|
0
|
|
|
|
|
|
my $function = "_getRelationBetweenCuis"; |
3635
|
0
|
|
|
|
|
|
&_debug($function); |
3636
|
|
|
|
|
|
|
|
3637
|
|
|
|
|
|
|
# check self |
3638
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
3639
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
3640
|
|
|
|
|
|
|
} |
3641
|
|
|
|
|
|
|
|
3642
|
|
|
|
|
|
|
# check parameter exists |
3643
|
0
|
0
|
|
|
|
|
if(!defined $concept1) { |
3644
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept1.", 4); |
3645
|
|
|
|
|
|
|
} |
3646
|
0
|
0
|
|
|
|
|
if(!defined $concept2) { |
3647
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept2.", 4); |
3648
|
|
|
|
|
|
|
} |
3649
|
|
|
|
|
|
|
|
3650
|
|
|
|
|
|
|
# check if valid concept |
3651
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept1)) ) { |
3652
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept1) is not valid.", 6); |
3653
|
|
|
|
|
|
|
} |
3654
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept2)) ) { |
3655
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept2) is not valid.", 6); |
3656
|
|
|
|
|
|
|
} |
3657
|
|
|
|
|
|
|
# connect to the database |
3658
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
3659
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
3660
|
|
|
|
|
|
|
|
3661
|
0
|
|
|
|
|
|
my @array = (); |
3662
|
|
|
|
|
|
|
|
3663
|
0
|
0
|
|
|
|
|
if($concept1 eq $umlsRoot) { |
3664
|
0
|
|
|
|
|
|
push @array, "CHD (source)"; |
3665
|
0
|
|
|
|
|
|
return \@array; |
3666
|
|
|
|
|
|
|
} |
3667
|
|
|
|
|
|
|
|
3668
|
|
|
|
|
|
|
# get the relations |
3669
|
0
|
|
|
|
|
|
my $sql = ""; |
3670
|
0
|
0
|
|
|
|
|
if($umlsall) { |
3671
|
0
|
|
|
|
|
|
$sql = qq{ select distinct REL, SAB from MRREL where (CUI1='$concept1' and CUI2='$concept2') and ($relations)}; |
3672
|
|
|
|
|
|
|
} |
3673
|
|
|
|
|
|
|
else { |
3674
|
0
|
|
|
|
|
|
$sql = qq{ select distinct REL, SAB from MRREL where (CUI1='$concept1' and CUI2='$concept2') and ($sources) and ($relations)}; |
3675
|
|
|
|
|
|
|
} |
3676
|
|
|
|
|
|
|
|
3677
|
0
|
|
|
|
|
|
my $sth = $db->prepare( $sql ); |
3678
|
0
|
|
|
|
|
|
$sth->execute(); |
3679
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $sth); |
3680
|
|
|
|
|
|
|
|
3681
|
0
|
|
|
|
|
|
my($rel, $sab); |
3682
|
0
|
|
|
|
|
|
$sth->bind_columns( undef, \$rel, \$sab ); |
3683
|
0
|
|
|
|
|
|
while( $sth->fetch() ) { |
3684
|
0
|
|
|
|
|
|
my $str = "$rel ($sab)"; |
3685
|
0
|
|
|
|
|
|
push @array, $str; |
3686
|
0
|
|
|
|
|
|
} $sth->finish(); |
3687
|
|
|
|
|
|
|
|
3688
|
0
|
|
|
|
|
|
return \@array; |
3689
|
|
|
|
|
|
|
} |
3690
|
|
|
|
|
|
|
|
3691
|
|
|
|
|
|
|
# checks to see a concept is forbidden |
3692
|
|
|
|
|
|
|
# input : $concept <- string containing a cui |
3693
|
|
|
|
|
|
|
# output: $string <- integer indicating true or false |
3694
|
|
|
|
|
|
|
sub _forbiddenConcept { |
3695
|
|
|
|
|
|
|
|
3696
|
0
|
|
|
0
|
|
|
my $self = shift; |
3697
|
0
|
|
|
|
|
|
my $concept = shift; |
3698
|
|
|
|
|
|
|
|
3699
|
0
|
|
|
|
|
|
my $function = "_forbiddenConcept"; |
3700
|
|
|
|
|
|
|
|
3701
|
|
|
|
|
|
|
# check self |
3702
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
3703
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
3704
|
|
|
|
|
|
|
} |
3705
|
|
|
|
|
|
|
|
3706
|
|
|
|
|
|
|
# check parameter exists |
3707
|
0
|
0
|
|
|
|
|
if(!defined $concept) { |
3708
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
3709
|
|
|
|
|
|
|
} |
3710
|
|
|
|
|
|
|
|
3711
|
|
|
|
|
|
|
# check if valid concept |
3712
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept)) ) { |
3713
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept) is not valid.", 6); |
3714
|
|
|
|
|
|
|
} |
3715
|
|
|
|
|
|
|
|
3716
|
|
|
|
|
|
|
# if concept is one of the following just return |
3717
|
|
|
|
|
|
|
#C1274012|Ambiguous concept (inactive concept) |
3718
|
0
|
0
|
|
|
|
|
if($concept=~/C1274012/) { return 1; } |
|
0
|
|
|
|
|
|
|
3719
|
|
|
|
|
|
|
#C1274013|Duplicate concept (inactive concept) |
3720
|
0
|
0
|
|
|
|
|
if($concept=~/C1274013/) { return 1; } |
|
0
|
|
|
|
|
|
|
3721
|
|
|
|
|
|
|
#C1276325|Reason not stated concept (inactive concept) |
3722
|
0
|
0
|
|
|
|
|
if($concept=~/C1276325/) { return 1; } |
|
0
|
|
|
|
|
|
|
3723
|
|
|
|
|
|
|
#C1274014|Outdated concept (inactive concept) |
3724
|
0
|
0
|
|
|
|
|
if($concept=~/C1274014/) { return 1; } |
|
0
|
|
|
|
|
|
|
3725
|
|
|
|
|
|
|
#C1274015|Erroneous concept (inactive concept) |
3726
|
0
|
0
|
|
|
|
|
if($concept=~/C1274015/) { return 1; } |
|
0
|
|
|
|
|
|
|
3727
|
|
|
|
|
|
|
#C1274021|Moved elsewhere (inactive concept) |
3728
|
0
|
0
|
|
|
|
|
if($concept=~/C1274021/) { return 1; } |
|
0
|
|
|
|
|
|
|
3729
|
|
|
|
|
|
|
#C1443286|unapproved attribute |
3730
|
0
|
0
|
|
|
|
|
if($concept=~/C1443286/) { return 1; } |
|
0
|
|
|
|
|
|
|
3731
|
|
|
|
|
|
|
#C1274012|non-current concept - ambiguous |
3732
|
0
|
0
|
|
|
|
|
if($concept=~/C1274012/) { return 1; } |
|
0
|
|
|
|
|
|
|
3733
|
|
|
|
|
|
|
#C2733115|limited status concept |
3734
|
0
|
0
|
|
|
|
|
if($concept=~/C2733115/) { return 1; } |
|
0
|
|
|
|
|
|
|
3735
|
|
|
|
|
|
|
|
3736
|
0
|
|
|
|
|
|
return 0; |
3737
|
|
|
|
|
|
|
} |
3738
|
|
|
|
|
|
|
|
3739
|
|
|
|
|
|
|
# Subroutine to get the semantic type's tui of a concept |
3740
|
|
|
|
|
|
|
# input : $cui <- string containing a concept |
3741
|
|
|
|
|
|
|
# output: $array <- reference to an array containing the semantic |
3742
|
|
|
|
|
|
|
# type's TUIs associated with the concept |
3743
|
|
|
|
|
|
|
sub _getSt { |
3744
|
|
|
|
|
|
|
|
3745
|
0
|
|
|
0
|
|
|
my $self = shift; |
3746
|
0
|
|
|
|
|
|
my $concept = shift; |
3747
|
|
|
|
|
|
|
|
3748
|
0
|
|
|
|
|
|
my $function = "_getSt"; |
3749
|
0
|
|
|
|
|
|
&_debug($function); |
3750
|
|
|
|
|
|
|
|
3751
|
|
|
|
|
|
|
# check self |
3752
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
3753
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
3754
|
|
|
|
|
|
|
} |
3755
|
|
|
|
|
|
|
|
3756
|
|
|
|
|
|
|
# check parameter exists |
3757
|
0
|
0
|
|
|
|
|
if(!defined $concept) { |
3758
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
3759
|
|
|
|
|
|
|
} |
3760
|
|
|
|
|
|
|
|
3761
|
|
|
|
|
|
|
# check if valid concept |
3762
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept)) ) { |
3763
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept) is not valid.", 6); |
3764
|
|
|
|
|
|
|
} |
3765
|
|
|
|
|
|
|
|
3766
|
|
|
|
|
|
|
# set the database |
3767
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
3768
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
3769
|
|
|
|
|
|
|
|
3770
|
|
|
|
|
|
|
# get the TUI |
3771
|
0
|
|
|
|
|
|
my $arrRef = $db->selectcol_arrayref("select TUI from MRSTY where CUI=\'$concept\'"); |
3772
|
|
|
|
|
|
|
|
3773
|
|
|
|
|
|
|
# check for database errors |
3774
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
3775
|
|
|
|
|
|
|
|
3776
|
0
|
|
|
|
|
|
return $arrRef; |
3777
|
|
|
|
|
|
|
} |
3778
|
|
|
|
|
|
|
|
3779
|
|
|
|
|
|
|
# subroutine to get the relation(s) between two semantic types |
3780
|
|
|
|
|
|
|
# input : $st1 <- semantic type abbreviation |
3781
|
|
|
|
|
|
|
# $st2 <- semantic type abbreviation |
3782
|
|
|
|
|
|
|
# output: $array <- reference to an array of semantic relation(s) |
3783
|
|
|
|
|
|
|
sub _getSemanticRelation { |
3784
|
|
|
|
|
|
|
|
3785
|
0
|
|
|
0
|
|
|
my $self = shift; |
3786
|
0
|
|
|
|
|
|
my $st1 = shift; |
3787
|
0
|
|
|
|
|
|
my $st2 = shift; |
3788
|
|
|
|
|
|
|
|
3789
|
0
|
|
|
|
|
|
my $function = "_getSemanticRelation"; |
3790
|
0
|
|
|
|
|
|
&_debug($function); |
3791
|
|
|
|
|
|
|
|
3792
|
|
|
|
|
|
|
# check self |
3793
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
3794
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
3795
|
|
|
|
|
|
|
} |
3796
|
|
|
|
|
|
|
|
3797
|
|
|
|
|
|
|
# check input |
3798
|
0
|
0
|
|
|
|
|
if(!defined $st1) { |
3799
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$st1.", 4); |
3800
|
|
|
|
|
|
|
} |
3801
|
0
|
0
|
|
|
|
|
if(!defined $st2) { |
3802
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$st2.", 4); |
3803
|
|
|
|
|
|
|
} |
3804
|
|
|
|
|
|
|
|
3805
|
|
|
|
|
|
|
# set the database |
3806
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
3807
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
3808
|
|
|
|
|
|
|
|
3809
|
0
|
|
|
|
|
|
my $string1 = $self->_getStString($st1); |
3810
|
0
|
|
|
|
|
|
my $string2 = $self->_getStString($st2); |
3811
|
|
|
|
|
|
|
|
3812
|
|
|
|
|
|
|
# get the string associated with the semantic type |
3813
|
0
|
|
|
|
|
|
my $arrRef = $db->selectcol_arrayref("select distinct RL from SRSTR where STY_RL1=\'$string1\' and STY_RL2=\'$string2\'"); |
3814
|
|
|
|
|
|
|
|
3815
|
|
|
|
|
|
|
# check database errors |
3816
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
3817
|
|
|
|
|
|
|
|
3818
|
0
|
|
|
|
|
|
my @rarray = shift @{$arrRef}; |
|
0
|
|
|
|
|
|
|
3819
|
0
|
|
|
|
|
|
return \@rarray;; |
3820
|
|
|
|
|
|
|
} |
3821
|
|
|
|
|
|
|
|
3822
|
|
|
|
|
|
|
# subroutine to get the name of a semantic type given its abbreviation |
3823
|
|
|
|
|
|
|
# input : $st <- string containing the abbreviation of the semantic type |
3824
|
|
|
|
|
|
|
# output: $string <- string containing the full name of the semantic type |
3825
|
|
|
|
|
|
|
sub _getStString { |
3826
|
|
|
|
|
|
|
|
3827
|
0
|
|
|
0
|
|
|
my $self = shift; |
3828
|
0
|
|
|
|
|
|
my $st = shift; |
3829
|
|
|
|
|
|
|
|
3830
|
0
|
|
|
|
|
|
my $function = "_getStString"; |
3831
|
0
|
|
|
|
|
|
&_debug($function); |
3832
|
|
|
|
|
|
|
|
3833
|
|
|
|
|
|
|
# check self |
3834
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
3835
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
3836
|
|
|
|
|
|
|
} |
3837
|
|
|
|
|
|
|
|
3838
|
|
|
|
|
|
|
# check parameter exists |
3839
|
0
|
0
|
|
|
|
|
if(!defined $st) { |
3840
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$st.", 4); |
3841
|
|
|
|
|
|
|
} |
3842
|
|
|
|
|
|
|
|
3843
|
|
|
|
|
|
|
# set the database |
3844
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
3845
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
3846
|
|
|
|
|
|
|
|
3847
|
|
|
|
|
|
|
# get the string associated with the semantic type |
3848
|
0
|
|
|
|
|
|
my $arrRef = $db->selectcol_arrayref("select STY_RL from SRDEF where ABR=\'$st\'"); |
3849
|
|
|
|
|
|
|
|
3850
|
|
|
|
|
|
|
# check database errors |
3851
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
3852
|
|
|
|
|
|
|
|
3853
|
0
|
|
|
|
|
|
return (shift @{$arrRef}); |
|
0
|
|
|
|
|
|
|
3854
|
|
|
|
|
|
|
} |
3855
|
|
|
|
|
|
|
|
3856
|
|
|
|
|
|
|
|
3857
|
|
|
|
|
|
|
# subroutine to get the name of a semantic type given its TUI (UI) |
3858
|
|
|
|
|
|
|
# input : $tui <- string containing the semantic type's TUI |
3859
|
|
|
|
|
|
|
# output: $string <- string containing the semantic type's abbreviation |
3860
|
|
|
|
|
|
|
sub _getStAbr { |
3861
|
|
|
|
|
|
|
|
3862
|
0
|
|
|
0
|
|
|
my $self = shift; |
3863
|
0
|
|
|
|
|
|
my $tui = shift; |
3864
|
|
|
|
|
|
|
|
3865
|
0
|
|
|
|
|
|
my $function = "_getStAbr"; |
3866
|
0
|
|
|
|
|
|
&_debug($function); |
3867
|
|
|
|
|
|
|
|
3868
|
|
|
|
|
|
|
# check self |
3869
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
3870
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
3871
|
|
|
|
|
|
|
} |
3872
|
|
|
|
|
|
|
|
3873
|
|
|
|
|
|
|
# check parameter exists |
3874
|
0
|
0
|
|
|
|
|
if(!defined $tui) { |
3875
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$tui.", 4); |
3876
|
|
|
|
|
|
|
} |
3877
|
|
|
|
|
|
|
|
3878
|
|
|
|
|
|
|
# if tui is the root return ROOT |
3879
|
0
|
0
|
|
|
|
|
if($tui eq "T000") { |
3880
|
0
|
|
|
|
|
|
return "ST ROOT"; |
3881
|
|
|
|
|
|
|
} |
3882
|
|
|
|
|
|
|
|
3883
|
|
|
|
|
|
|
# set the database |
3884
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
3885
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
3886
|
|
|
|
|
|
|
|
3887
|
|
|
|
|
|
|
# obtain the abbreviation |
3888
|
0
|
|
|
|
|
|
my $arrRef = $db->selectcol_arrayref("select ABR from SRDEF where UI=\'$tui\'"); |
3889
|
|
|
|
|
|
|
|
3890
|
|
|
|
|
|
|
# check database errors |
3891
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
3892
|
|
|
|
|
|
|
|
3893
|
0
|
|
|
|
|
|
return (shift @{$arrRef}); |
|
0
|
|
|
|
|
|
|
3894
|
|
|
|
|
|
|
} |
3895
|
|
|
|
|
|
|
|
3896
|
|
|
|
|
|
|
|
3897
|
|
|
|
|
|
|
# subroutine to get the name of a semantic type's TUI given its abbrevation |
3898
|
|
|
|
|
|
|
# input : $string <- string containing the semantic type's abbreviation |
3899
|
|
|
|
|
|
|
# output: $tui <- string containing the semantic type's TUI |
3900
|
|
|
|
|
|
|
sub _getStTui { |
3901
|
|
|
|
|
|
|
|
3902
|
0
|
|
|
0
|
|
|
my $self = shift; |
3903
|
0
|
|
|
|
|
|
my $abbrev = shift; |
3904
|
|
|
|
|
|
|
|
3905
|
0
|
|
|
|
|
|
my $function = "_getStTui"; |
3906
|
0
|
|
|
|
|
|
&_debug($function); |
3907
|
|
|
|
|
|
|
|
3908
|
|
|
|
|
|
|
# check self |
3909
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
3910
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
3911
|
|
|
|
|
|
|
} |
3912
|
|
|
|
|
|
|
|
3913
|
|
|
|
|
|
|
# check parameter exists |
3914
|
0
|
0
|
|
|
|
|
if(!defined $abbrev) { |
3915
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$abbrev.", 4); |
3916
|
|
|
|
|
|
|
} |
3917
|
|
|
|
|
|
|
|
3918
|
|
|
|
|
|
|
# set the database |
3919
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
3920
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
3921
|
|
|
|
|
|
|
|
3922
|
|
|
|
|
|
|
# obtain the abbreviation |
3923
|
0
|
|
|
|
|
|
my $arrRef = $db->selectcol_arrayref("select UI from SRDEF where ABR=\'$abbrev\'"); |
3924
|
|
|
|
|
|
|
|
3925
|
|
|
|
|
|
|
# check database errors |
3926
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
3927
|
|
|
|
|
|
|
|
3928
|
0
|
|
|
|
|
|
return (shift @{$arrRef}); |
|
0
|
|
|
|
|
|
|
3929
|
|
|
|
|
|
|
} |
3930
|
|
|
|
|
|
|
|
3931
|
|
|
|
|
|
|
|
3932
|
|
|
|
|
|
|
# subroutine to get the definition of a given TUI |
3933
|
|
|
|
|
|
|
# input : $st <- string containing the semantic type's abbreviation |
3934
|
|
|
|
|
|
|
# output: $string <- string containing the semantic type's definition |
3935
|
|
|
|
|
|
|
sub _getStDef { |
3936
|
|
|
|
|
|
|
|
3937
|
0
|
|
|
0
|
|
|
my $self = shift; |
3938
|
0
|
|
|
|
|
|
my $st = shift; |
3939
|
|
|
|
|
|
|
|
3940
|
0
|
|
|
|
|
|
my $function = "_getStDef"; |
3941
|
0
|
|
|
|
|
|
&_debug($function); |
3942
|
|
|
|
|
|
|
|
3943
|
|
|
|
|
|
|
# check self |
3944
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
3945
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
3946
|
|
|
|
|
|
|
} |
3947
|
|
|
|
|
|
|
|
3948
|
|
|
|
|
|
|
# check parameter exists |
3949
|
0
|
0
|
|
|
|
|
if(!defined $st) { |
3950
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$st.", 4); |
3951
|
|
|
|
|
|
|
} |
3952
|
|
|
|
|
|
|
|
3953
|
|
|
|
|
|
|
# set the database |
3954
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
3955
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
3956
|
|
|
|
|
|
|
|
3957
|
|
|
|
|
|
|
# get the definition |
3958
|
0
|
|
|
|
|
|
my $arrRef = $db->selectcol_arrayref("select DEF from SRDEF where ABR=\'$st\'"); |
3959
|
|
|
|
|
|
|
|
3960
|
|
|
|
|
|
|
# check database errors |
3961
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
3962
|
|
|
|
|
|
|
|
3963
|
0
|
|
|
|
|
|
return $arrRef; |
3964
|
|
|
|
|
|
|
} |
3965
|
|
|
|
|
|
|
|
3966
|
|
|
|
|
|
|
# method returns the semantic group(s) associated with the concept |
3967
|
|
|
|
|
|
|
# input : $concept <- string containing a cui |
3968
|
|
|
|
|
|
|
# output: $array <- reference to an array containing semantic groups |
3969
|
|
|
|
|
|
|
sub _getSemanticGroup { |
3970
|
0
|
|
|
0
|
|
|
my $self = shift; |
3971
|
0
|
|
|
|
|
|
my $concept = shift; |
3972
|
|
|
|
|
|
|
|
3973
|
0
|
|
|
|
|
|
my $function = "_getSemanticGroup"; |
3974
|
0
|
|
|
|
|
|
&_debug($function); |
3975
|
|
|
|
|
|
|
|
3976
|
|
|
|
|
|
|
# check self |
3977
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
3978
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
3979
|
|
|
|
|
|
|
} |
3980
|
|
|
|
|
|
|
|
3981
|
|
|
|
|
|
|
# check parameter exists |
3982
|
0
|
0
|
|
|
|
|
if(!defined $concept) { |
3983
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
3984
|
|
|
|
|
|
|
} |
3985
|
|
|
|
|
|
|
|
3986
|
0
|
|
|
|
|
|
my $sts = $self->_getSt($concept); |
3987
|
|
|
|
|
|
|
|
3988
|
0
|
|
|
|
|
|
my %groups = (); |
3989
|
0
|
|
|
|
|
|
foreach my $st (@{$sts}) { |
|
0
|
|
|
|
|
|
|
3990
|
0
|
|
|
|
|
|
my $abr = $self->_getStAbr($st); |
3991
|
0
|
|
|
|
|
|
my $string = $self->_getStString($abr); |
3992
|
0
|
|
|
|
|
|
foreach my $group (@{$semanticGroups{$string}}) { |
|
0
|
|
|
|
|
|
|
3993
|
0
|
|
|
|
|
|
$groups{$group}++; |
3994
|
|
|
|
|
|
|
} |
3995
|
|
|
|
|
|
|
} |
3996
|
|
|
|
|
|
|
|
3997
|
0
|
|
|
|
|
|
my @array = (); |
3998
|
0
|
|
|
|
|
|
foreach my $group (sort keys %groups) { push @array, $group; } |
|
0
|
|
|
|
|
|
|
3999
|
|
|
|
|
|
|
|
4000
|
0
|
|
|
|
|
|
return \@array; |
4001
|
|
|
|
|
|
|
} |
4002
|
|
|
|
|
|
|
|
4003
|
|
|
|
|
|
|
# method returns the semantic group(s) associated with a semantic type |
4004
|
|
|
|
|
|
|
# input : $st <- string containing a st |
4005
|
|
|
|
|
|
|
# output: $array <- reference to an array containing semantic groups |
4006
|
|
|
|
|
|
|
sub _stGetSemanticGroup { |
4007
|
0
|
|
|
0
|
|
|
my $self = shift; |
4008
|
0
|
|
|
|
|
|
my $st = shift; |
4009
|
|
|
|
|
|
|
|
4010
|
0
|
|
|
|
|
|
my $function = "_stGetSemanticGroup"; |
4011
|
0
|
|
|
|
|
|
&_debug($function); |
4012
|
|
|
|
|
|
|
|
4013
|
|
|
|
|
|
|
# check self |
4014
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
4015
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
4016
|
|
|
|
|
|
|
} |
4017
|
0
|
|
|
|
|
|
my %groups = (); |
4018
|
|
|
|
|
|
|
|
4019
|
0
|
|
|
|
|
|
my $string = $self->_getStString($st); |
4020
|
|
|
|
|
|
|
|
4021
|
0
|
|
|
|
|
|
foreach my $group (@{$semanticGroups{$string}}) { |
|
0
|
|
|
|
|
|
|
4022
|
0
|
|
|
|
|
|
$groups{$group}++; |
4023
|
|
|
|
|
|
|
} |
4024
|
|
|
|
|
|
|
|
4025
|
0
|
|
|
|
|
|
my @array = (); |
4026
|
0
|
|
|
|
|
|
foreach my $group (sort keys %groups) { push @array, $group; } |
|
0
|
|
|
|
|
|
|
4027
|
|
|
|
|
|
|
|
4028
|
0
|
|
|
|
|
|
return \@array; |
4029
|
|
|
|
|
|
|
} |
4030
|
|
|
|
|
|
|
|
4031
|
|
|
|
|
|
|
|
4032
|
|
|
|
|
|
|
# method returns the semantic group(s) associated with the concept |
4033
|
|
|
|
|
|
|
# input : $st <- string containing a semantic type abbreviation |
4034
|
|
|
|
|
|
|
# output: $array <- reference to an array containing semantic groups |
4035
|
|
|
|
|
|
|
sub _getSemanticGroupOfSt { |
4036
|
0
|
|
|
0
|
|
|
my $self = shift; |
4037
|
0
|
|
|
|
|
|
my $st = shift; |
4038
|
|
|
|
|
|
|
|
4039
|
0
|
|
|
|
|
|
my $function = "_getSemanticGroupOfSt"; |
4040
|
0
|
|
|
|
|
|
&_debug($function); |
4041
|
|
|
|
|
|
|
|
4042
|
|
|
|
|
|
|
# check self |
4043
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
4044
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
4045
|
|
|
|
|
|
|
} |
4046
|
|
|
|
|
|
|
|
4047
|
|
|
|
|
|
|
# check parameter exists |
4048
|
0
|
0
|
|
|
|
|
if(!defined $st) { |
4049
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$st.", 4); |
4050
|
|
|
|
|
|
|
} |
4051
|
|
|
|
|
|
|
|
4052
|
0
|
|
|
|
|
|
my $string = $self->_getStString($st); |
4053
|
|
|
|
|
|
|
|
4054
|
0
|
|
|
|
|
|
my %groups = (); |
4055
|
0
|
|
|
|
|
|
foreach my $group (@{$semanticGroups{$string}}) { |
|
0
|
|
|
|
|
|
|
4056
|
0
|
|
|
|
|
|
$groups{$group}++; |
4057
|
|
|
|
|
|
|
} |
4058
|
|
|
|
|
|
|
|
4059
|
0
|
|
|
|
|
|
my @array = (); |
4060
|
0
|
|
|
|
|
|
foreach my $group (sort keys %groups) { push @array, $group; } |
|
0
|
|
|
|
|
|
|
4061
|
|
|
|
|
|
|
|
4062
|
0
|
|
|
|
|
|
return \@array; |
4063
|
|
|
|
|
|
|
} |
4064
|
|
|
|
|
|
|
|
4065
|
|
|
|
|
|
|
|
4066
|
|
|
|
|
|
|
# method that returns a list of concepts (@concepts) related |
4067
|
|
|
|
|
|
|
# to a concept $concept through a relation $rel |
4068
|
|
|
|
|
|
|
# input : $concept <- string containing cui |
4069
|
|
|
|
|
|
|
# $rel <- string containing a relation |
4070
|
|
|
|
|
|
|
# output: $array <- reference to an array of cuis |
4071
|
|
|
|
|
|
|
sub _getExtendedRelated { |
4072
|
|
|
|
|
|
|
|
4073
|
0
|
|
|
0
|
|
|
my $self = shift; |
4074
|
0
|
|
|
|
|
|
my $concept = shift; |
4075
|
0
|
|
|
|
|
|
my $rel = shift; |
4076
|
|
|
|
|
|
|
|
4077
|
0
|
|
|
|
|
|
my $function = "_getExtendedRelated"; |
4078
|
0
|
|
|
|
|
|
&_debug($function); |
4079
|
|
|
|
|
|
|
|
4080
|
|
|
|
|
|
|
# check self |
4081
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
4082
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
4083
|
|
|
|
|
|
|
} |
4084
|
|
|
|
|
|
|
|
4085
|
|
|
|
|
|
|
# check parameter exists |
4086
|
0
|
0
|
|
|
|
|
if(!defined $concept) { |
4087
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
4088
|
|
|
|
|
|
|
} |
4089
|
|
|
|
|
|
|
|
4090
|
0
|
0
|
|
|
|
|
if(!defined $rel) { |
4091
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$rel.", 4); |
4092
|
|
|
|
|
|
|
} |
4093
|
|
|
|
|
|
|
|
4094
|
|
|
|
|
|
|
# check if valid concept |
4095
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept)) ) { |
4096
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept) is not valid.", 6); |
4097
|
|
|
|
|
|
|
} |
4098
|
|
|
|
|
|
|
|
4099
|
|
|
|
|
|
|
# set up database |
4100
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
4101
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
4102
|
|
|
|
|
|
|
|
4103
|
|
|
|
|
|
|
# check if sources are specified and it is not umlsall |
4104
|
0
|
|
|
|
|
|
my $optional = ""; |
4105
|
0
|
0
|
|
|
|
|
if(!$umlsall) { |
4106
|
0
|
0
|
|
|
|
|
if($sabdefsources ne "") { |
4107
|
0
|
|
|
|
|
|
$optional = " and ($sabdefsources)"; |
4108
|
|
|
|
|
|
|
} |
4109
|
|
|
|
|
|
|
} |
4110
|
|
|
|
|
|
|
# if the relations is either a parent or a child add the reladefparents if specified |
4111
|
0
|
0
|
0
|
|
|
|
if( ($rel=~/PAR|RB/) && ($reladefparents ne "") ) { |
4112
|
0
|
|
|
|
|
|
$optional .= " and ($reladefparents)"; |
4113
|
|
|
|
|
|
|
} |
4114
|
0
|
0
|
0
|
|
|
|
if( ($rel=~/CHD|RN/) && ($reladefchildren ne "") ) { |
4115
|
0
|
|
|
|
|
|
$optional .= " and ($reladefchildren)"; |
4116
|
|
|
|
|
|
|
} |
4117
|
|
|
|
|
|
|
# return all the relations 'rel' for cui 'concept' |
4118
|
0
|
|
|
|
|
|
my $arrRef = $db->selectcol_arrayref("select distinct CUI2 from MRREL where CUI1='$concept' and REL='$rel' and CUI2!='$concept' $optional"); |
4119
|
|
|
|
|
|
|
|
4120
|
|
|
|
|
|
|
# check for errors |
4121
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $db); |
4122
|
|
|
|
|
|
|
|
4123
|
0
|
|
|
|
|
|
return $arrRef; |
4124
|
|
|
|
|
|
|
} |
4125
|
|
|
|
|
|
|
|
4126
|
|
|
|
|
|
|
# subroutine to get the extended definition of a concept from |
4127
|
|
|
|
|
|
|
# the concept and its surrounding relations as specified in the |
4128
|
|
|
|
|
|
|
# the configuration file. |
4129
|
|
|
|
|
|
|
# input : $concept <- string containing a cui |
4130
|
|
|
|
|
|
|
# output: $array <- reference to an array containing the definitions |
4131
|
|
|
|
|
|
|
sub _getExtendedDefinition { |
4132
|
|
|
|
|
|
|
|
4133
|
0
|
|
|
0
|
|
|
my $self = shift; |
4134
|
0
|
|
|
|
|
|
my $concept = shift; |
4135
|
|
|
|
|
|
|
|
4136
|
0
|
|
|
|
|
|
my $function = "_getExtendedDefinition"; |
4137
|
|
|
|
|
|
|
|
4138
|
|
|
|
|
|
|
# check self |
4139
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
4140
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
4141
|
|
|
|
|
|
|
} |
4142
|
|
|
|
|
|
|
|
4143
|
|
|
|
|
|
|
# check parameter exists |
4144
|
0
|
0
|
|
|
|
|
if(!defined $concept) { |
4145
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
4146
|
|
|
|
|
|
|
} |
4147
|
|
|
|
|
|
|
|
4148
|
|
|
|
|
|
|
# check if valid concept |
4149
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept)) ) { |
4150
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept) is not valid.", 6); |
4151
|
|
|
|
|
|
|
} |
4152
|
|
|
|
|
|
|
|
4153
|
|
|
|
|
|
|
# get database |
4154
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
4155
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
4156
|
|
|
|
|
|
|
|
4157
|
0
|
|
|
|
|
|
my $sabflag = 1; |
4158
|
|
|
|
|
|
|
|
4159
|
0
|
|
|
|
|
|
my @defs = (); |
4160
|
|
|
|
|
|
|
|
4161
|
0
|
|
|
|
|
|
my $dkeys = keys %relDefHash; |
4162
|
|
|
|
|
|
|
|
4163
|
0
|
0
|
0
|
|
|
|
if( ($dkeys <= 0) or (exists $relDefHash{"ST"}) ) { |
4164
|
0
|
|
|
|
|
|
my $sts = $self->_getSt($concept); |
4165
|
0
|
|
|
|
|
|
foreach my $st (@{$sts}) { |
|
0
|
|
|
|
|
|
|
4166
|
0
|
|
|
|
|
|
my $abr = $self->_getStAbr($st); |
4167
|
0
|
|
|
|
|
|
my $def = $self->_getStDef($abr); |
4168
|
0
|
|
|
|
|
|
my $str = "$concept ST $abr STDEF : @{$def}"; |
|
0
|
|
|
|
|
|
|
4169
|
0
|
|
|
|
|
|
push @defs, $str; |
4170
|
|
|
|
|
|
|
} |
4171
|
|
|
|
|
|
|
} |
4172
|
0
|
0
|
0
|
|
|
|
if( ($dkeys <= 0) or (exists $relDefHash{"PAR"}) ) { |
4173
|
0
|
|
|
|
|
|
my $parents = $self->_getExtendedRelated($concept, "PAR"); |
4174
|
0
|
|
|
|
|
|
foreach my $parent (@{$parents}) { |
|
0
|
|
|
|
|
|
|
4175
|
0
|
|
|
|
|
|
my $odefs = $self->_getCuiDef($parent, $sabflag); |
4176
|
0
|
|
|
|
|
|
foreach my $d (@{$odefs}) { |
|
0
|
|
|
|
|
|
|
4177
|
0
|
|
|
|
|
|
my @darray = split/\s+/, $d; |
4178
|
0
|
|
|
|
|
|
my $sab = shift @darray; |
4179
|
0
|
|
|
|
|
|
my $def = "$concept PAR $parent $sab : " . (join " ", @darray); |
4180
|
0
|
|
|
|
|
|
push @defs, $def; |
4181
|
|
|
|
|
|
|
} |
4182
|
|
|
|
|
|
|
} |
4183
|
|
|
|
|
|
|
} |
4184
|
0
|
0
|
0
|
|
|
|
if( ($dkeys <= 0) or (exists $relDefHash{"CHD"}) ) { |
4185
|
0
|
|
|
|
|
|
my $children = $self->_getExtendedRelated($concept, "CHD"); |
4186
|
0
|
|
|
|
|
|
foreach my $child (@{$children}) { |
|
0
|
|
|
|
|
|
|
4187
|
0
|
|
|
|
|
|
my $odefs = $self->_getCuiDef($child, $sabflag); |
4188
|
0
|
|
|
|
|
|
foreach my $d (@{$odefs}) { |
|
0
|
|
|
|
|
|
|
4189
|
0
|
|
|
|
|
|
my @darray = split/\s+/, $d; |
4190
|
0
|
|
|
|
|
|
my $sab = shift @darray; |
4191
|
0
|
|
|
|
|
|
my $def = "$concept CHD $child $sab : " . (join " ", @darray); |
4192
|
0
|
|
|
|
|
|
push @defs, $def; |
4193
|
|
|
|
|
|
|
} |
4194
|
|
|
|
|
|
|
} |
4195
|
|
|
|
|
|
|
} |
4196
|
0
|
0
|
0
|
|
|
|
if( ($dkeys <= 0) or (exists $relDefHash{"SIB"}) ) { |
4197
|
0
|
|
|
|
|
|
my $siblings = $self->_getExtendedRelated($concept, "SIB"); |
4198
|
0
|
|
|
|
|
|
foreach my $sib (@{$siblings}) { |
|
0
|
|
|
|
|
|
|
4199
|
0
|
|
|
|
|
|
my $odefs = $self->_getCuiDef($sib, $sabflag); |
4200
|
0
|
|
|
|
|
|
foreach my $d (@{$odefs}) { |
|
0
|
|
|
|
|
|
|
4201
|
0
|
|
|
|
|
|
my @darray = split/\s+/, $d; |
4202
|
0
|
|
|
|
|
|
my $sab = shift @darray; |
4203
|
0
|
|
|
|
|
|
my $def = "$concept SIB $sib $sab : " . (join " ", @darray); |
4204
|
0
|
|
|
|
|
|
push @defs, $def; |
4205
|
|
|
|
|
|
|
} |
4206
|
|
|
|
|
|
|
} |
4207
|
|
|
|
|
|
|
} |
4208
|
0
|
0
|
0
|
|
|
|
if( ($dkeys <= 0) or (exists $relDefHash{"SYN"}) ) { |
4209
|
0
|
|
|
|
|
|
my $syns = $self->_getExtendedRelated($concept, "SYN"); |
4210
|
0
|
|
|
|
|
|
foreach my $syn (@{$syns}) { |
|
0
|
|
|
|
|
|
|
4211
|
0
|
|
|
|
|
|
my $odefs = $self->_getCuiDef($syn, $sabflag); |
4212
|
0
|
|
|
|
|
|
foreach my $d (@{$odefs}) { |
|
0
|
|
|
|
|
|
|
4213
|
0
|
|
|
|
|
|
my @darray = split/\s+/, $d; |
4214
|
0
|
|
|
|
|
|
my $sab = shift @darray; |
4215
|
0
|
|
|
|
|
|
my $def = "$concept SYN $syn $sab : " . (join " ", @darray); |
4216
|
0
|
|
|
|
|
|
push @defs, $def; |
4217
|
|
|
|
|
|
|
} |
4218
|
|
|
|
|
|
|
} |
4219
|
|
|
|
|
|
|
} |
4220
|
0
|
0
|
0
|
|
|
|
if( ($dkeys <= 0) or (exists $relDefHash{"RB"}) ) { |
4221
|
0
|
|
|
|
|
|
my $rbs = $self->_getExtendedRelated($concept, "RB"); |
4222
|
0
|
|
|
|
|
|
foreach my $rb (@{$rbs}) { |
|
0
|
|
|
|
|
|
|
4223
|
0
|
|
|
|
|
|
my $odefs = $self->_getCuiDef($rb, $sabflag); |
4224
|
0
|
|
|
|
|
|
foreach my $d (@{$odefs}) { |
|
0
|
|
|
|
|
|
|
4225
|
0
|
|
|
|
|
|
my @darray = split/\s+/, $d; |
4226
|
0
|
|
|
|
|
|
my $sab = shift @darray; |
4227
|
0
|
|
|
|
|
|
my $def = "$concept RB $rb $sab : " . (join " ", @darray); |
4228
|
0
|
|
|
|
|
|
push @defs, $def; |
4229
|
|
|
|
|
|
|
} |
4230
|
|
|
|
|
|
|
} |
4231
|
|
|
|
|
|
|
} |
4232
|
0
|
0
|
0
|
|
|
|
if( ($dkeys <= 0) or (exists $relDefHash{"RN"}) ) { |
4233
|
0
|
|
|
|
|
|
my $rns = $self->_getExtendedRelated($concept, "RN"); |
4234
|
0
|
|
|
|
|
|
foreach my $rn (@{$rns}) { |
|
0
|
|
|
|
|
|
|
4235
|
0
|
|
|
|
|
|
my $odefs = $self->_getCuiDef($rn, $sabflag); |
4236
|
0
|
|
|
|
|
|
foreach my $d (@{$odefs}) { |
|
0
|
|
|
|
|
|
|
4237
|
0
|
|
|
|
|
|
my @darray = split/\s+/, $d; |
4238
|
0
|
|
|
|
|
|
my $sab = shift @darray; |
4239
|
0
|
|
|
|
|
|
my $def = "$concept RN $rn $sab : " . (join " ", @darray); |
4240
|
0
|
|
|
|
|
|
push @defs, $def; |
4241
|
|
|
|
|
|
|
} |
4242
|
|
|
|
|
|
|
} |
4243
|
|
|
|
|
|
|
} |
4244
|
0
|
0
|
0
|
|
|
|
if( ($dkeys <= 0) or (exists $relDefHash{"RO"}) ) { |
4245
|
0
|
|
|
|
|
|
my $ros = $self->_getExtendedRelated($concept, "RO"); |
4246
|
0
|
|
|
|
|
|
foreach my $ro (@{$ros}) { |
|
0
|
|
|
|
|
|
|
4247
|
0
|
|
|
|
|
|
my $odefs = $self->_getCuiDef($ro, $sabflag); |
4248
|
0
|
|
|
|
|
|
foreach my $d (@{$odefs}) { |
|
0
|
|
|
|
|
|
|
4249
|
0
|
|
|
|
|
|
my @darray = split/\s+/, $d; |
4250
|
0
|
|
|
|
|
|
my $sab = shift @darray; |
4251
|
0
|
|
|
|
|
|
my $def = "$concept RO $ro $sab : " . (join " ", @darray); |
4252
|
0
|
|
|
|
|
|
push @defs, $def; |
4253
|
|
|
|
|
|
|
} |
4254
|
|
|
|
|
|
|
} |
4255
|
|
|
|
|
|
|
} |
4256
|
0
|
0
|
0
|
|
|
|
if( ($dkeys <= 0) or (exists $relDefHash{"CUI"}) ) { |
4257
|
0
|
|
|
|
|
|
my $odefs = $self->_getCuiDef($concept, $sabflag); |
4258
|
0
|
|
|
|
|
|
foreach my $d (@{$odefs}) { |
|
0
|
|
|
|
|
|
|
4259
|
0
|
|
|
|
|
|
my @darray = split/\s+/, $d; |
4260
|
0
|
|
|
|
|
|
my $sab = shift @darray; |
4261
|
0
|
|
|
|
|
|
my $def = "$concept CUI $concept $sab : " . (join " ", @darray); |
4262
|
0
|
|
|
|
|
|
push @defs, $def; |
4263
|
|
|
|
|
|
|
} |
4264
|
|
|
|
|
|
|
} |
4265
|
0
|
0
|
0
|
|
|
|
if( ($dkeys <= 0) or (exists $relDefHash{"TERM"}) ) { |
4266
|
0
|
|
|
|
|
|
my $odefs = $self->_getTermSabList($concept); |
4267
|
0
|
|
|
|
|
|
foreach my $item (@{$odefs}) { |
|
0
|
|
|
|
|
|
|
4268
|
0
|
|
|
|
|
|
my ($sab, $term) = split/\s*\:\s*/, $item; |
4269
|
0
|
|
|
|
|
|
my $def = "$concept TERM $concept $sab : $term"; |
4270
|
0
|
|
|
|
|
|
push @defs, $def; |
4271
|
|
|
|
|
|
|
} |
4272
|
|
|
|
|
|
|
} |
4273
|
0
|
|
|
|
|
|
return \@defs; |
4274
|
|
|
|
|
|
|
} |
4275
|
|
|
|
|
|
|
|
4276
|
|
|
|
|
|
|
# subroutine to get a CUIs definition |
4277
|
|
|
|
|
|
|
# input : $concept <- string containing a cui |
4278
|
|
|
|
|
|
|
# output: $array <- reference to an array of definitions (strings) |
4279
|
|
|
|
|
|
|
sub _getCuiDef { |
4280
|
|
|
|
|
|
|
|
4281
|
0
|
|
|
0
|
|
|
my $self = shift; |
4282
|
0
|
|
|
|
|
|
my $concept = shift; |
4283
|
0
|
|
|
|
|
|
my $sabflag = shift; |
4284
|
|
|
|
|
|
|
|
4285
|
0
|
|
|
|
|
|
my $function = "_getCuiDef"; |
4286
|
|
|
|
|
|
|
|
4287
|
|
|
|
|
|
|
# check self |
4288
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
4289
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
4290
|
|
|
|
|
|
|
} |
4291
|
|
|
|
|
|
|
|
4292
|
|
|
|
|
|
|
# check parameter exists |
4293
|
0
|
0
|
|
|
|
|
if(!defined $concept) { |
4294
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
4295
|
|
|
|
|
|
|
} |
4296
|
|
|
|
|
|
|
|
4297
|
|
|
|
|
|
|
# check if valid concept |
4298
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept)) ) { |
4299
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept) is not valid.", 6); |
4300
|
|
|
|
|
|
|
} |
4301
|
|
|
|
|
|
|
|
4302
|
|
|
|
|
|
|
# get database |
4303
|
0
|
|
|
|
|
|
my $db = $self->{'db'}; |
4304
|
0
|
0
|
|
|
|
|
if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); } |
|
0
|
|
|
|
|
|
|
4305
|
|
|
|
|
|
|
|
4306
|
|
|
|
|
|
|
# set the query |
4307
|
0
|
|
|
|
|
|
my $sql = ""; |
4308
|
|
|
|
|
|
|
|
4309
|
0
|
0
|
|
|
|
|
if($sabdefsources ne "") { |
4310
|
0
|
|
|
|
|
|
$sql = qq{ SELECT DEF, SAB FROM MRDEF WHERE CUI=\'$concept\' and ($sabdefsources) }; |
4311
|
|
|
|
|
|
|
} |
4312
|
|
|
|
|
|
|
else { |
4313
|
0
|
|
|
|
|
|
$sql = qq{ SELECT DEF, SAB FROM MRDEF WHERE CUI=\'$concept\' }; |
4314
|
|
|
|
|
|
|
} |
4315
|
|
|
|
|
|
|
|
4316
|
|
|
|
|
|
|
# get the information from the database |
4317
|
0
|
|
|
|
|
|
my $sth = $db->prepare( $sql ); |
4318
|
0
|
|
|
|
|
|
$sth->execute(); |
4319
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $sth); |
4320
|
|
|
|
|
|
|
|
4321
|
|
|
|
|
|
|
# set the output variable |
4322
|
0
|
|
|
|
|
|
my($def, $sab); |
4323
|
0
|
|
|
|
|
|
my @defs = (); |
4324
|
0
|
|
|
|
|
|
$sth->bind_columns( undef, \$def, \$sab ); |
4325
|
0
|
|
|
|
|
|
while( $sth->fetch() ) { |
4326
|
0
|
0
|
|
|
|
|
if(defined $sabflag) { push @defs, "$sab $def"; } |
|
0
|
|
|
|
|
|
|
4327
|
0
|
|
|
|
|
|
else { push @defs, $def; } |
4328
|
0
|
|
|
|
|
|
} $sth->finish(); |
4329
|
|
|
|
|
|
|
|
4330
|
0
|
|
|
|
|
|
return \@defs; |
4331
|
|
|
|
|
|
|
} |
4332
|
|
|
|
|
|
|
|
4333
|
|
|
|
|
|
|
|
4334
|
|
|
|
|
|
|
# returns the table names in both human readable and hex form |
4335
|
|
|
|
|
|
|
# input : |
4336
|
|
|
|
|
|
|
# output: $hash <- reference to a hash containin the table |
4337
|
|
|
|
|
|
|
# names in human readable and hex form |
4338
|
|
|
|
|
|
|
sub _returnTableNames { |
4339
|
0
|
|
|
0
|
|
|
my $self = shift; |
4340
|
|
|
|
|
|
|
|
4341
|
0
|
|
|
|
|
|
my $function = "_returnTableNames"; |
4342
|
|
|
|
|
|
|
|
4343
|
|
|
|
|
|
|
# check self |
4344
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
4345
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
4346
|
|
|
|
|
|
|
} |
4347
|
|
|
|
|
|
|
|
4348
|
|
|
|
|
|
|
# set the output variable |
4349
|
0
|
|
|
|
|
|
my %hash = (); |
4350
|
0
|
|
|
|
|
|
$hash{$parentTableHuman} = $parentTable; |
4351
|
0
|
|
|
|
|
|
$hash{$childTableHuman} = $childTable; |
4352
|
0
|
|
|
|
|
|
$hash{$intrinsicTableHuman} = $intrinsicTable; |
4353
|
0
|
|
|
|
|
|
$hash{$tableNameHuman} = $tableName; |
4354
|
0
|
|
|
|
|
|
$hash{$cacheTableHuman} = $cacheTable; |
4355
|
|
|
|
|
|
|
|
4356
|
0
|
|
|
|
|
|
return \%hash; |
4357
|
|
|
|
|
|
|
} |
4358
|
|
|
|
|
|
|
|
4359
|
|
|
|
|
|
|
# sets the semantic groups |
4360
|
|
|
|
|
|
|
# input: |
4361
|
|
|
|
|
|
|
# output: |
4362
|
|
|
|
|
|
|
sub _setSemanticGroups { |
4363
|
|
|
|
|
|
|
|
4364
|
0
|
|
|
0
|
|
|
%semanticGroups = (); |
4365
|
|
|
|
|
|
|
|
4366
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Activity"}}, "Activities & Behaviors"; |
|
0
|
|
|
|
|
|
|
4367
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Behavior"}}, "Activities & Behaviors"; |
|
0
|
|
|
|
|
|
|
4368
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Daily or Recreational Activity"}}, "Activities & Behaviors"; |
|
0
|
|
|
|
|
|
|
4369
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Event"}}, "Activities & Behaviors"; |
|
0
|
|
|
|
|
|
|
4370
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Governmental or Regulatory Activity"}}, "Activities & Behaviors"; |
|
0
|
|
|
|
|
|
|
4371
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Individual Behavior"}}, "Activities & Behaviors"; |
|
0
|
|
|
|
|
|
|
4372
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Machine Activity"}}, "Activities & Behaviors"; |
|
0
|
|
|
|
|
|
|
4373
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Occupational Activity"}}, "Activities & Behaviors"; |
|
0
|
|
|
|
|
|
|
4374
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Social Behavior"}}, "Activities & Behaviors"; |
|
0
|
|
|
|
|
|
|
4375
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Anatomical Structure"}}, "Anatomy"; |
|
0
|
|
|
|
|
|
|
4376
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Body Location or Region"}}, "Anatomy"; |
|
0
|
|
|
|
|
|
|
4377
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Body Part, Organ, or Organ Component"}}, "Anatomy"; |
|
0
|
|
|
|
|
|
|
4378
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Body Space or Junction"}}, "Anatomy"; |
|
0
|
|
|
|
|
|
|
4379
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Body Substance"}}, "Anatomy"; |
|
0
|
|
|
|
|
|
|
4380
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Body System"}}, "Anatomy"; |
|
0
|
|
|
|
|
|
|
4381
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Cell"}}, "Anatomy"; |
|
0
|
|
|
|
|
|
|
4382
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Cell Component"}}, "Anatomy"; |
|
0
|
|
|
|
|
|
|
4383
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Embryonic Structure"}}, "Anatomy"; |
|
0
|
|
|
|
|
|
|
4384
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Fully Formed Anatomical Structure"}}, "Anatomy"; |
|
0
|
|
|
|
|
|
|
4385
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Tissue"}}, "Anatomy"; |
|
0
|
|
|
|
|
|
|
4386
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Amino Acid, Peptide, or Protein"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4387
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Antibiotic"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4388
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Biologically Active Substance"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4389
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Biomedical or Dental Material"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4390
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Carbohydrate"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4391
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Chemical"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4392
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Chemical Viewed Functionally"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4393
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Chemical Viewed Structurally"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4394
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Clinical Drug"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4395
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Eicosanoid"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4396
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Element, Ion, or Isotope"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4397
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Enzyme"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4398
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Hazardous or Poisonous Substance"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4399
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Hormone"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4400
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Immunologic Factor"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4401
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Indicator, Reagent, or Diagnostic Aid"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4402
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Inorganic Chemical"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4403
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Lipid"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4404
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Neuroreactive Substance or Biogenic Amine"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4405
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Nucleic Acid, Nucleoside, or Nucleotide"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4406
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Organic Chemical"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4407
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Organophosphorus Compound"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4408
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Pharmacologic Substance"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4409
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Receptor"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4410
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Steroid"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4411
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Vitamin"}}, "Chemicals & Drugs"; |
|
0
|
|
|
|
|
|
|
4412
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Classification"}}, "Concepts & Ideas"; |
|
0
|
|
|
|
|
|
|
4413
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Conceptual Entity"}}, "Concepts & Ideas"; |
|
0
|
|
|
|
|
|
|
4414
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Functional Concept"}}, "Concepts & Ideas"; |
|
0
|
|
|
|
|
|
|
4415
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Group Attribute"}}, "Concepts & Ideas"; |
|
0
|
|
|
|
|
|
|
4416
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Idea or Concept"}}, "Concepts & Ideas"; |
|
0
|
|
|
|
|
|
|
4417
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Intellectual Product"}}, "Concepts & Ideas"; |
|
0
|
|
|
|
|
|
|
4418
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Language"}}, "Concepts & Ideas"; |
|
0
|
|
|
|
|
|
|
4419
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Qualitative Concept"}}, "Concepts & Ideas"; |
|
0
|
|
|
|
|
|
|
4420
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Quantitative Concept"}}, "Concepts & Ideas"; |
|
0
|
|
|
|
|
|
|
4421
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Regulation or Law"}}, "Concepts & Ideas"; |
|
0
|
|
|
|
|
|
|
4422
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Spatial Concept"}}, "Concepts & Ideas"; |
|
0
|
|
|
|
|
|
|
4423
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Temporal Concept"}}, "Concepts & Ideas"; |
|
0
|
|
|
|
|
|
|
4424
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Drug Delivery Device"}}, "Devices"; |
|
0
|
|
|
|
|
|
|
4425
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Medical Device"}}, "Devices"; |
|
0
|
|
|
|
|
|
|
4426
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Research Device"}}, "Devices"; |
|
0
|
|
|
|
|
|
|
4427
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Acquired Abnormality"}}, "Disorders"; |
|
0
|
|
|
|
|
|
|
4428
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Anatomical Abnormality"}}, "Disorders"; |
|
0
|
|
|
|
|
|
|
4429
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Cell or Molecular Dysfunction"}}, "Disorders"; |
|
0
|
|
|
|
|
|
|
4430
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Congenital Abnormality"}}, "Disorders"; |
|
0
|
|
|
|
|
|
|
4431
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Disease or Syndrome"}}, "Disorders"; |
|
0
|
|
|
|
|
|
|
4432
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Experimental Model of Disease"}}, "Disorders"; |
|
0
|
|
|
|
|
|
|
4433
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Finding"}}, "Disorders"; |
|
0
|
|
|
|
|
|
|
4434
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Injury or Poisoning"}}, "Disorders"; |
|
0
|
|
|
|
|
|
|
4435
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Mental or Behavioral Dysfunction"}}, "Disorders"; |
|
0
|
|
|
|
|
|
|
4436
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Neoplastic Process"}}, "Disorders"; |
|
0
|
|
|
|
|
|
|
4437
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Pathologic Function"}}, "Disorders"; |
|
0
|
|
|
|
|
|
|
4438
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Sign or Symptom"}}, "Disorders"; |
|
0
|
|
|
|
|
|
|
4439
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Amino Acid Sequence"}}, "Genes & Molecular Sequences"; |
|
0
|
|
|
|
|
|
|
4440
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Carbohydrate Sequence"}}, "Genes & Molecular Sequences"; |
|
0
|
|
|
|
|
|
|
4441
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Gene or Genome"}}, "Genes & Molecular Sequences"; |
|
0
|
|
|
|
|
|
|
4442
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Molecular Sequence"}}, "Genes & Molecular Sequences"; |
|
0
|
|
|
|
|
|
|
4443
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Nucleotide Sequence"}}, "Genes & Molecular Sequences"; |
|
0
|
|
|
|
|
|
|
4444
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Geographic Area"}}, "Geographic Areas"; |
|
0
|
|
|
|
|
|
|
4445
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Age Group"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4446
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Amphibian"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4447
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Animal"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4448
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Archaeon"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4449
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Bacterium"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4450
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Bird"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4451
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Eukaryote"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4452
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Family Group"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4453
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Fish"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4454
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Fungus"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4455
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Group"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4456
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Human"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4457
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Mammal"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4458
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Organism"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4459
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Patient or Disabled Group"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4460
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Plant"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4461
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Population Group"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4462
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Professional or Occupational Group"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4463
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Reptile"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4464
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Vertebrate"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4465
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Virus"}}, "Living Beings"; |
|
0
|
|
|
|
|
|
|
4466
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Entity"}}, "Objects"; |
|
0
|
|
|
|
|
|
|
4467
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Food"}}, "Objects"; |
|
0
|
|
|
|
|
|
|
4468
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Manufactured Object"}}, "Objects"; |
|
0
|
|
|
|
|
|
|
4469
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Physical Object"}}, "Objects"; |
|
0
|
|
|
|
|
|
|
4470
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Substance"}}, "Objects"; |
|
0
|
|
|
|
|
|
|
4471
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Biomedical Occupation or Discipline"}}, "Occupations"; |
|
0
|
|
|
|
|
|
|
4472
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Occupation or Discipline"}}, "Occupations"; |
|
0
|
|
|
|
|
|
|
4473
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Health Care Related Organization"}}, "Organizations"; |
|
0
|
|
|
|
|
|
|
4474
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Organization"}}, "Organizations"; |
|
0
|
|
|
|
|
|
|
4475
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Professional Society"}}, "Organizations"; |
|
0
|
|
|
|
|
|
|
4476
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Self-help or Relief Organization"}}, "Organizations"; |
|
0
|
|
|
|
|
|
|
4477
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Biologic Function"}}, "Phenomena"; |
|
0
|
|
|
|
|
|
|
4478
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Environmental Effect of Humans"}}, "Phenomena"; |
|
0
|
|
|
|
|
|
|
4479
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Human-caused Phenomenon or Process"}}, "Phenomena"; |
|
0
|
|
|
|
|
|
|
4480
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Laboratory or Test Result"}}, "Phenomena"; |
|
0
|
|
|
|
|
|
|
4481
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Natural Phenomenon or Process"}}, "Phenomena"; |
|
0
|
|
|
|
|
|
|
4482
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Phenomenon or Process"}}, "Phenomena"; |
|
0
|
|
|
|
|
|
|
4483
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Cell Function"}}, "Physiology"; |
|
0
|
|
|
|
|
|
|
4484
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Clinical Attribute"}}, "Physiology"; |
|
0
|
|
|
|
|
|
|
4485
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Genetic Function"}}, "Physiology"; |
|
0
|
|
|
|
|
|
|
4486
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Mental Process"}}, "Physiology"; |
|
0
|
|
|
|
|
|
|
4487
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Molecular Function"}}, "Physiology"; |
|
0
|
|
|
|
|
|
|
4488
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Organism Attribute"}}, "Physiology"; |
|
0
|
|
|
|
|
|
|
4489
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Organism Function"}}, "Physiology"; |
|
0
|
|
|
|
|
|
|
4490
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Organ or Tissue Function"}}, "Physiology"; |
|
0
|
|
|
|
|
|
|
4491
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Physiologic Function"}}, "Physiology"; |
|
0
|
|
|
|
|
|
|
4492
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Diagnostic Procedure"}}, "Procedures"; |
|
0
|
|
|
|
|
|
|
4493
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Educational Activity"}}, "Procedures"; |
|
0
|
|
|
|
|
|
|
4494
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Health Care Activity"}}, "Procedures"; |
|
0
|
|
|
|
|
|
|
4495
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Laboratory Procedure"}}, "Procedures"; |
|
0
|
|
|
|
|
|
|
4496
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Molecular Biology Research Technique"}}, "Procedures"; |
|
0
|
|
|
|
|
|
|
4497
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Research Activity"}}, "Procedures"; |
|
0
|
|
|
|
|
|
|
4498
|
0
|
|
|
|
|
|
push @{$semanticGroups{"Therapeutic or Preventive Procedure"}}, "Procedures"; |
|
0
|
|
|
|
|
|
|
4499
|
|
|
|
|
|
|
} |
4500
|
|
|
|
|
|
|
|
4501
|
|
|
|
|
|
|
# removes the configuration tables |
4502
|
|
|
|
|
|
|
# input : |
4503
|
|
|
|
|
|
|
# output: |
4504
|
|
|
|
|
|
|
sub _dropConfigTable { |
4505
|
|
|
|
|
|
|
|
4506
|
0
|
|
|
0
|
|
|
my $self = shift; |
4507
|
|
|
|
|
|
|
|
4508
|
0
|
|
|
|
|
|
my $function = "_dropConfigTable"; |
4509
|
0
|
|
|
|
|
|
&_debug($function); |
4510
|
|
|
|
|
|
|
|
4511
|
|
|
|
|
|
|
# check self |
4512
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
4513
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
4514
|
|
|
|
|
|
|
} |
4515
|
|
|
|
|
|
|
|
4516
|
|
|
|
|
|
|
# connect to the database |
4517
|
0
|
|
|
|
|
|
my $sdb = $self->_connectIndexDB(); |
4518
|
0
|
0
|
|
|
|
|
if(!$sdb) { $errorhandler->_error($pkg, $function, "Error with sdb.", 3); } |
|
0
|
|
|
|
|
|
|
4519
|
|
|
|
|
|
|
|
4520
|
|
|
|
|
|
|
# show all of the tables |
4521
|
0
|
|
|
|
|
|
my $sth = $sdb->prepare("show tables"); |
4522
|
0
|
|
|
|
|
|
$sth->execute(); |
4523
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $sth); |
4524
|
|
|
|
|
|
|
|
4525
|
|
|
|
|
|
|
# get all the tables in mysql |
4526
|
0
|
|
|
|
|
|
my $table = ""; |
4527
|
0
|
|
|
|
|
|
my %tables = (); |
4528
|
0
|
|
|
|
|
|
while(($table) = $sth->fetchrow()) { |
4529
|
0
|
|
|
|
|
|
$tables{$table}++; |
4530
|
|
|
|
|
|
|
} |
4531
|
0
|
|
|
|
|
|
$sth->finish(); |
4532
|
|
|
|
|
|
|
|
4533
|
0
|
0
|
|
|
|
|
if(exists $tables{$intrinsicTable}) { |
4534
|
0
|
|
|
|
|
|
$sdb->do("drop table $intrinsicTable"); |
4535
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
4536
|
|
|
|
|
|
|
} |
4537
|
0
|
0
|
|
|
|
|
if(exists $tables{$parentTable}) { |
4538
|
0
|
|
|
|
|
|
$sdb->do("drop table $parentTable"); |
4539
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
4540
|
|
|
|
|
|
|
} |
4541
|
0
|
0
|
|
|
|
|
if(exists $tables{$childTable}) { |
4542
|
0
|
|
|
|
|
|
$sdb->do("drop table $childTable"); |
4543
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
4544
|
|
|
|
|
|
|
} |
4545
|
0
|
0
|
|
|
|
|
if(exists $tables{$cacheTable}) { |
4546
|
0
|
|
|
|
|
|
$sdb->do("drop table $cacheTable"); |
4547
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
4548
|
|
|
|
|
|
|
} |
4549
|
0
|
0
|
|
|
|
|
if(exists $tables{$tableName}) { |
4550
|
0
|
|
|
|
|
|
$sdb->do("drop table $tableName"); |
4551
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
4552
|
|
|
|
|
|
|
} |
4553
|
0
|
0
|
|
|
|
|
if(exists $tables{$infoTable}) { |
4554
|
0
|
|
|
|
|
|
$sdb->do("drop table $infoTable"); |
4555
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
4556
|
|
|
|
|
|
|
} |
4557
|
0
|
0
|
|
|
|
|
if(exists $tables{"tableindex"}) { |
4558
|
|
|
|
|
|
|
|
4559
|
0
|
|
|
|
|
|
$sdb->do("delete from tableindex where HEX='$intrinsicTable'"); |
4560
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
4561
|
|
|
|
|
|
|
|
4562
|
0
|
|
|
|
|
|
$sdb->do("delete from tableindex where HEX='$parentTable'"); |
4563
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
4564
|
|
|
|
|
|
|
|
4565
|
0
|
|
|
|
|
|
$sdb->do("delete from tableindex where HEX='$childTable'"); |
4566
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
4567
|
|
|
|
|
|
|
|
4568
|
0
|
|
|
|
|
|
$sdb->do("delete from tableindex where HEX='$cacheTable'"); |
4569
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
4570
|
|
|
|
|
|
|
|
4571
|
0
|
|
|
|
|
|
$sdb->do("delete from tableindex where HEX='$tableName'"); |
4572
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
4573
|
|
|
|
|
|
|
|
4574
|
0
|
|
|
|
|
|
$sdb->do("delete from tableindex where HEX='$infoTable'"); |
4575
|
0
|
|
|
|
|
|
$errorhandler->_checkDbError($pkg, $function, $sdb); |
4576
|
|
|
|
|
|
|
} |
4577
|
|
|
|
|
|
|
} |
4578
|
|
|
|
|
|
|
|
4579
|
|
|
|
|
|
|
# removes the configuration files |
4580
|
|
|
|
|
|
|
# input : |
4581
|
|
|
|
|
|
|
# output: |
4582
|
|
|
|
|
|
|
sub _removeConfigFiles { |
4583
|
|
|
|
|
|
|
|
4584
|
0
|
|
|
0
|
|
|
my $self = shift; |
4585
|
|
|
|
|
|
|
|
4586
|
0
|
|
|
|
|
|
my $function = "_removeConfigFiles"; |
4587
|
0
|
|
|
|
|
|
&_debug($function); |
4588
|
|
|
|
|
|
|
|
4589
|
|
|
|
|
|
|
# check self |
4590
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
4591
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
4592
|
|
|
|
|
|
|
} |
4593
|
|
|
|
|
|
|
|
4594
|
|
|
|
|
|
|
# remove the files |
4595
|
0
|
0
|
|
|
|
|
if(-e $tableFile) { |
4596
|
0
|
|
|
|
|
|
system "rm $tableFile"; |
4597
|
|
|
|
|
|
|
} |
4598
|
0
|
0
|
|
|
|
|
if(-e $childFile) { |
4599
|
0
|
|
|
|
|
|
system "rm $childFile"; |
4600
|
|
|
|
|
|
|
} |
4601
|
0
|
0
|
|
|
|
|
if(-e $parentFile) { |
4602
|
0
|
|
|
|
|
|
system "rm $parentFile"; |
4603
|
|
|
|
|
|
|
} |
4604
|
0
|
0
|
|
|
|
|
if(-e $configFile) { |
4605
|
0
|
|
|
|
|
|
system "rm $configFile"; |
4606
|
|
|
|
|
|
|
} |
4607
|
|
|
|
|
|
|
|
4608
|
|
|
|
|
|
|
} |
4609
|
|
|
|
|
|
|
|
4610
|
|
|
|
|
|
|
# checks to see if the cui is in the parent taxonomy |
4611
|
|
|
|
|
|
|
# input : $concept <- string containing a cui |
4612
|
|
|
|
|
|
|
# output: $bool <- indicating if the cui exists in |
4613
|
|
|
|
|
|
|
# the upper level taxonamy |
4614
|
|
|
|
|
|
|
sub _inParentTaxonomy { |
4615
|
|
|
|
|
|
|
|
4616
|
0
|
|
|
0
|
|
|
my $self = shift; |
4617
|
0
|
|
|
|
|
|
my $concept = shift; |
4618
|
|
|
|
|
|
|
|
4619
|
0
|
|
|
|
|
|
my $function = "_inParentTaxonomy"; |
4620
|
0
|
|
|
|
|
|
&_debug($function); |
4621
|
|
|
|
|
|
|
|
4622
|
|
|
|
|
|
|
# check self |
4623
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
4624
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
4625
|
|
|
|
|
|
|
} |
4626
|
|
|
|
|
|
|
|
4627
|
|
|
|
|
|
|
# check parameter exists |
4628
|
0
|
0
|
|
|
|
|
if(!defined $concept) { |
4629
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
4630
|
|
|
|
|
|
|
} |
4631
|
|
|
|
|
|
|
|
4632
|
|
|
|
|
|
|
# check if valid concept |
4633
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept)) ) { |
4634
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept) is not valid.", 6); |
4635
|
|
|
|
|
|
|
} |
4636
|
|
|
|
|
|
|
|
4637
|
0
|
0
|
|
|
|
|
if(exists $parentTaxonomyArray{$concept}) { return 1; } |
|
0
|
|
|
|
|
|
|
4638
|
0
|
|
|
|
|
|
else { return 0; } |
4639
|
|
|
|
|
|
|
} |
4640
|
|
|
|
|
|
|
|
4641
|
|
|
|
|
|
|
# checks to see if the cui is in the child taxonomy |
4642
|
|
|
|
|
|
|
# input : $concept <- string containing a cui |
4643
|
|
|
|
|
|
|
# output: $bool <- indicating if the cui exists in |
4644
|
|
|
|
|
|
|
# the upper level taxonamy |
4645
|
|
|
|
|
|
|
sub _inChildTaxonomy { |
4646
|
|
|
|
|
|
|
|
4647
|
0
|
|
|
0
|
|
|
my $self = shift; |
4648
|
0
|
|
|
|
|
|
my $concept = shift; |
4649
|
|
|
|
|
|
|
|
4650
|
0
|
|
|
|
|
|
my $function = "_inChildTaxonomy"; |
4651
|
0
|
|
|
|
|
|
&_debug($function); |
4652
|
|
|
|
|
|
|
|
4653
|
|
|
|
|
|
|
# check self |
4654
|
0
|
0
|
0
|
|
|
|
if(!defined $self || !ref $self) { |
4655
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "", 2); |
4656
|
|
|
|
|
|
|
} |
4657
|
|
|
|
|
|
|
|
4658
|
|
|
|
|
|
|
# check parameter exists |
4659
|
0
|
0
|
|
|
|
|
if(!defined $concept) { |
4660
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Error with input variable \$concept.", 4); |
4661
|
|
|
|
|
|
|
} |
4662
|
|
|
|
|
|
|
|
4663
|
|
|
|
|
|
|
# check if valid concept |
4664
|
0
|
0
|
|
|
|
|
if(! ($errorhandler->_validCui($concept)) ) { |
4665
|
0
|
|
|
|
|
|
$errorhandler->_error($pkg, $function, "Concept ($concept) is not valid.", 6); |
4666
|
|
|
|
|
|
|
} |
4667
|
|
|
|
|
|
|
|
4668
|
0
|
0
|
|
|
|
|
if(exists $childTaxonomyArray{$concept}) { return 1; } |
|
0
|
|
|
|
|
|
|
4669
|
0
|
|
|
|
|
|
else { return 0; } |
4670
|
|
|
|
|
|
|
} |
4671
|
|
|
|
|
|
|
|
4672
|
|
|
|
|
|
|
|
4673
|
|
|
|
|
|
|
# function to create a timestamp |
4674
|
|
|
|
|
|
|
# input : |
4675
|
|
|
|
|
|
|
# output: $string <- containing the time stamp |
4676
|
|
|
|
|
|
|
sub _timeStamp { |
4677
|
|
|
|
|
|
|
|
4678
|
0
|
|
|
0
|
|
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); |
4679
|
|
|
|
|
|
|
|
4680
|
0
|
|
|
|
|
|
$year += 1900; |
4681
|
0
|
|
|
|
|
|
$mon++; |
4682
|
0
|
|
|
|
|
|
my $d = sprintf("%4d%2.2d%2.2d",$year,$mon,$mday); |
4683
|
0
|
|
|
|
|
|
my $t = sprintf("%2.2d%2.2d%2.2d",$hour,$min,$sec); |
4684
|
|
|
|
|
|
|
|
4685
|
0
|
|
|
|
|
|
my $stamp = $d . $t; |
4686
|
|
|
|
|
|
|
|
4687
|
0
|
|
|
|
|
|
return $stamp; |
4688
|
|
|
|
|
|
|
} |
4689
|
|
|
|
|
|
|
|
4690
|
|
|
|
|
|
|
# function to get the time |
4691
|
|
|
|
|
|
|
# input : |
4692
|
|
|
|
|
|
|
# output: $string <- containing the time |
4693
|
|
|
|
|
|
|
sub _printTime { |
4694
|
0
|
|
|
0
|
|
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); |
4695
|
|
|
|
|
|
|
|
4696
|
0
|
|
|
|
|
|
$year += 1900; |
4697
|
0
|
|
|
|
|
|
$mon++; |
4698
|
|
|
|
|
|
|
|
4699
|
0
|
|
|
|
|
|
my $d = sprintf("%4d%2.2d%2.2d",$year,$mon,$mday); |
4700
|
0
|
|
|
|
|
|
my $t = sprintf("%2.2d%2.2d%2.2d",$hour,$min,$sec); |
4701
|
|
|
|
|
|
|
|
4702
|
0
|
|
|
|
|
|
print STDERR "$t\n"; |
4703
|
|
|
|
|
|
|
|
4704
|
|
|
|
|
|
|
} |
4705
|
|
|
|
|
|
|
|
4706
|
|
|
|
|
|
|
# return the file name containing the index table |
4707
|
|
|
|
|
|
|
sub _getTableFile { |
4708
|
|
|
|
|
|
|
|
4709
|
0
|
|
|
0
|
|
|
return $tableFile; |
4710
|
|
|
|
|
|
|
} |
4711
|
|
|
|
|
|
|
|
4712
|
|
|
|
|
|
|
|
4713
|
|
|
|
|
|
|
# return the table name in the index - this is the hex |
4714
|
|
|
|
|
|
|
sub _getTableName { |
4715
|
|
|
|
|
|
|
|
4716
|
0
|
|
|
0
|
|
|
return $tableName; |
4717
|
|
|
|
|
|
|
} |
4718
|
|
|
|
|
|
|
|
4719
|
|
|
|
|
|
|
# return the table name in the index in human form |
4720
|
|
|
|
|
|
|
sub _getTableNameHuman { |
4721
|
|
|
|
|
|
|
|
4722
|
0
|
|
|
0
|
|
|
return $tableNameHuman; |
4723
|
|
|
|
|
|
|
} |
4724
|
|
|
|
|
|
|
|
4725
|
|
|
|
|
|
|
sub _getCacheTableName { |
4726
|
0
|
|
|
0
|
|
|
return $cacheTable; |
4727
|
|
|
|
|
|
|
} |
4728
|
|
|
|
|
|
|
|
4729
|
|
|
|
|
|
|
sub _getCacheTableNameHuman{ |
4730
|
0
|
|
|
0
|
|
|
return $cacheTableHuman; |
4731
|
|
|
|
|
|
|
} |
4732
|
|
|
|
|
|
|
|
4733
|
|
|
|
|
|
|
sub _getInfoTableName { |
4734
|
0
|
|
|
0
|
|
|
return $infoTable; |
4735
|
|
|
|
|
|
|
} |
4736
|
|
|
|
|
|
|
|
4737
|
|
|
|
|
|
|
sub _getInfoTableNameHuman { |
4738
|
0
|
|
|
0
|
|
|
return $infoTableHuman; |
4739
|
|
|
|
|
|
|
} |
4740
|
|
|
|
|
|
|
|
4741
|
|
|
|
|
|
|
sub _getIntrinsicTableName { |
4742
|
0
|
|
|
0
|
|
|
return $intrinsicTable; |
4743
|
|
|
|
|
|
|
} |
4744
|
|
|
|
|
|
|
|
4745
|
|
|
|
|
|
|
sub _getIntrinsicTableNameHuman { |
4746
|
0
|
|
|
0
|
|
|
return $intrinsicTableHuman; |
4747
|
|
|
|
|
|
|
} |
4748
|
|
|
|
|
|
|
|
4749
|
|
|
|
|
|
|
1; |
4750
|
|
|
|
|
|
|
|
4751
|
|
|
|
|
|
|
|
4752
|
|
|
|
|
|
|
|
4753
|
|
|
|
|
|
|
|
4754
|
|
|
|
|
|
|
__END__ |