#/usr/local/bin/perl # #This Perl script was created by Jules J. Berman, on 7/28/04 # #The purpose of this script is to create a file of all the UMLS #terms that have a "neoplasm" relationship in UMLS. # #In addition to this script, users will need the UMLS MRCON #and MRCXT files, available at no cost from the National #Library of Medicine. # #neomrcxt.txt is the output file # #This software was originally created by Jules J. Berman on #July 5, 2004. # #The software is provided "as is", without warranty of any kind, #express or implied, including but not limited to the warranties #of merchantability, fitness for a particular purpose and #noninfringement. in no event shall the authors or copyright #holders be liable for any claim, damages or other liability, #whether in an action of contract, tort or otherwise, arising #from, out of or in connection with the software or the use or #other dealings in the software. # #As a courtesy, users of this script should cite the following #manuscript, which includes this script as a supplemental file. # #Berman JJ. Tumor taxonomy for the developmental lineage #classification of neoplasms. Submitted, BMC Cancer, July 5, 2004 # # open (TEXT, "mrcxt")||die"Can't open file"; $line = " "; my %neohash; while ($line ne "") { $line = ; my @linearray = split(/\|/,$line); $relation = lc($linearray[7]); if ($relation =~ /neoplasm/) { next if $relation =~ /history of/; next if $relation =~ /due to/; next if $relation =~ /follow-up/; next if $relation =~ /follow up/; next if $relation =~ /for malignant/; next if $relation =~ /metasta/; next if $relation =~ /secondary/; next if $relation =~ /disorder/; $neohash{$linearray[0]} = "$relation\,"; } } close TEXT; $line = " "; open (CON, "mrcon")||die"Can't open file"; open (OUT,">neomrcxt.txt")||die"Cannot"; while ($line ne "") { $line = ; my @linearray = split(/\|/,$line); next if ($linearray[1] ne "ENG"); $phrase = lc($linearray[6]); next if $phrase =~ /metasta/; next if $phrase =~ /disease/; next if $phrase =~ /disorder/; next if (exists $mrcon{$phrase}); $mrcon{$phrase}=" "; if (exists $neohash{$linearray[0]}) { print OUT "$neohash{$linearray[0]} $line "; } } close CON; close OUT; exit;