X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=blobdiff_plain;f=parse-rrf.lisp;h=2d943ea55508c2c5f1331fb5a67e8b57723ef7c1;hp=145b13c24409de805aed34abd28d27df4dc83b65;hb=HEAD;hpb=fab71e6fecf552789593d979b85cea58099f236d diff --git a/parse-rrf.lisp b/parse-rrf.lisp index 145b13c..5e28ed5 100644 --- a/parse-rrf.lisp +++ b/parse-rrf.lisp @@ -2,16 +2,14 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: parse-2002.lisp +;;;; Name: parse-rrf.lisp ;;;; Purpose: Parsing and SQL insertion routines for UMLisp which may ;;;; change from year to year ;;;; Author: Kevin M. Rosenberg ;;;; Created: Apr 2000 ;;;; -;;;; $Id$ -;;;; ;;;; This file, part of UMLisp, is -;;;; Copyright (c) 2000-2004 by Kevin M. Rosenberg, M.D. +;;;; Copyright (c) 2000-2010 by Kevin M. Rosenberg, M.D. ;;;; ;;;; UMLisp users are granted the rights to distribute and use this software ;;;; as governed by the terms of the GNU General Public License. @@ -23,72 +21,157 @@ (defvar *preparse-hash-init?* nil) (eval-when (:compile-toplevel :load-toplevel :execute) + +(declaim (inline srl-to-srlus)) +(defun srl-to-srlus (srl) + "Convert the standard SRL category to one oriented for use in the ~ +United States. Specifically, SRL 4 in the USA has license restrictions ~ +between SRL 1 and 2 when used in the United States. As of 2009AA, the +SNOMED SRL changed from 4 to 9. So we create a new scale ~ +(SRLUS) where SRL to SRLUS mapping is: ~ +(0->0, 1->1, 4->2, 9->2, 2->3, 3->4)." + (declare (type (integer 0 100) srl)) + (cond + ((<= srl 1) srl) + ((= srl 4) 2) + ((= srl 9) 2) + ((= srl 2) 3) + ((= srl 3) 4) + (t srl))) + +(defvar *vff-position-hash* (make-hash-table :size 100 :test 'eq)) + +(defmacro vff (filename fieldname record) + (let ((pos (gensym "POS-")) + (found (gensym "FOUND-")) + (key (kmrcl:ensure-keyword (concatenate 'string filename "^" fieldname)))) + `(locally (declare (optimize (speed 3) (safety 0))) + (multiple-value-bind (,pos ,found) (gethash ,key *vff-position-hash*) + (declare (ignore ,found)) + (if ,pos + (locally (declare (type (integer 0 100000) ,pos)) + (nth ,pos ,record)) + (let ((,pos (position-field-file ,filename ,fieldname))) + (unless ,pos + (error "Did not find fieldname ~A in filename ~A." ,fieldname ,filename)) + (locally (declare (type (integer 0 100000) ,pos)) + (setf (gethash ,key *vff-position-hash*) ,pos) + (nth ,pos ,record)))))))) + (let ((pfstr-hash nil) ;; Preferred concept strings by CUI (cui-lrl-hash nil) ;; LRL by CUI (lui-lrl-hash nil) ;; LRL by LUI (sui-lrl-hash nil) ;; LRL by SUI (cuisui-lrl-hash nil) ;; LRL by CUISUI - (sab-srl-hash nil)) ;; SRL by SAB - + (cui-lrlus-hash nil) ;; LRLUS by CUI + (lui-lrlus-hash nil) ;; LRLUS by LUI + (sui-lrlus-hash nil) ;; LRLUS by SUI + (cuisui-lrlus-hash nil) ;; LRL by CUISUI + + (sab-srl-hash nil) + (sab-srlus-hash nil)) ;; SRL by SAB + + (defun clear-preparse-hash-tables () + (clrhash pfstr-hash) + (clrhash cui-lrl-hash) + (clrhash lui-lrl-hash) + (clrhash sui-lrl-hash) + (clrhash cuisui-lrl-hash) + (clrhash cui-lrlus-hash) + (clrhash lui-lrlus-hash) + (clrhash sui-lrlus-hash) + (clrhash cuisui-lrlus-hash) + (clrhash sab-srl-hash) + (clrhash sab-srlus-hash)) + (defun make-preparse-hash-table () (if sui-lrl-hash - (progn - (clrhash pfstr-hash) - (clrhash cui-lrl-hash) - (clrhash lui-lrl-hash) - (clrhash sui-lrl-hash) - (clrhash cuisui-lrl-hash) - (clrhash sab-srl-hash)) + (clear-preparse-hash-tables) (setf - pfstr-hash (make-hash-table :size 800000) - cui-lrl-hash (make-hash-table :size 800000) - lui-lrl-hash (make-hash-table :size 1500000) - sui-lrl-hash (make-hash-table :size 1500000) - cuisui-lrl-hash (make-hash-table :size 1800000) - sab-srl-hash (make-hash-table :size 100 :test 'equal)))) - + pfstr-hash (make-hash-table :size 1500000) + cui-lrl-hash (make-hash-table :size 1500000) + lui-lrl-hash (make-hash-table :size 5000000) + sui-lrl-hash (make-hash-table :size 6000000) + cuisui-lrl-hash (make-hash-table :size 6000000) + cui-lrlus-hash (make-hash-table :size 1500000) + lui-lrlus-hash (make-hash-table :size 5000000) + sui-lrlus-hash (make-hash-table :size 6000000) + cuisui-lrlus-hash (make-hash-table :size 6000000) + sab-srl-hash (make-hash-table :size 200 :test 'equal) + sab-srlus-hash (make-hash-table :size 200 :test 'equal)))) + (defun ensure-preparse (&optional (force-read nil)) - (when (or force-read (not *preparse-hash-init?*)) - (make-preparse-hash-table) - (setq *preparse-hash-init?* t)) - (with-umls-file (line "MRCONSO.RRF") - (let ((cui (parse-ui (nth 0 line))) - (lui (parse-ui (nth 3 line))) - (sui (parse-ui (nth 5 line))) - (sab (nth 11 line)) - (srl (parse-integer (nth 15 line)))) - (unless (gethash cui pfstr-hash) ;; if haven't stored pfstr for cui - (if (and (string-equal (nth 1 line) "ENG") ; LAT - (string-equal (nth 2 line) "P") ; ts - (string-equal (nth 4 line) "PF")) ; stt - (setf (gethash cui pfstr-hash) (nth 14 line)))) - (set-lrl-hash cui srl cui-lrl-hash) - (set-lrl-hash lui srl lui-lrl-hash) - (set-lrl-hash sui srl sui-lrl-hash) - (set-lrl-hash (make-cuisui cui sui) srl cuisui-lrl-hash) - (multiple-value-bind (val found) (gethash sab sab-srl-hash) - (declare (ignore val)) - (unless found - (setf (gethash sab sab-srl-hash) srl)))))) - - (defun pfstr-hash (cui) (gethash cui pfstr-hash)) - (defun cui-lrl (cui) (gethash cui cui-lrl-hash)) - (defun lui-lrl (lui) (gethash lui lui-lrl-hash)) - (defun sui-lrl (sui) (gethash sui sui-lrl-hash)) - (defun sab-srl (sab) (aif (gethash sab sab-srl-hash) it 0)) + (when (and *preparse-hash-init?* (not force-read)) + (return-from ensure-preparse 'already-done)) + (make-preparse-hash-table) + (let ((counter 0)) + (declare (fixnum counter) + (ignorable counter)) + (with-umls-file (line "MRCONSO.RRF") + (let* ((cui (parse-ui (vff "MRCONSO.RRF" "CUI" line))) + (lui (parse-ui (vff "MRCONSO.RRF" "LUI" line))) + (sui (parse-ui (vff "MRCONSO.RRF" "SUI" line))) + (sab (vff "MRCONSO.RRF" "SAB" line)) + (srl (parse-integer (vff "MRCONSO.RRF" "SRL" line))) + (srlus (srl-to-srlus srl)) + (cuisui (make-cuisui cui sui))) + #+sbcl + (when (= 0 (mod (incf counter) 100000)) (sb-ext:gc :full t)) + + ;; pfstr deprecated by KPFENG field in MRCONSO + #+nil + (unless (gethash cui pfstr-hash) ;; if haven't stored pfstr for cui + (when (and (string-equal (vff "MRCONSO.RRF" "LAT" line) "ENG") + (string-equal (vff "MRCONSO.RRF" "TS" line) "P") + (string-equal (vff "MRCONSO.RRF" "STT" line) "PF")) + (setf (gethash cui pfstr-hash) (vff "MRCONSO.RRF" "STR" line)))) + (set-lrl-hash cui srl cui-lrl-hash) + (set-lrl-hash lui srl lui-lrl-hash) + (set-lrl-hash sui srl sui-lrl-hash) + (set-lrl-hash cuisui srl cuisui-lrl-hash) + (set-lrl-hash cui srlus cui-lrlus-hash) + (set-lrl-hash lui srlus lui-lrlus-hash) + (set-lrl-hash sui srlus sui-lrlus-hash) + (set-lrl-hash cuisui srlus cuisui-lrlus-hash) + (multiple-value-bind (val found) (gethash sab sab-srl-hash) + (declare (ignore val)) + (unless found + (setf (gethash sab sab-srl-hash) srl))) + (multiple-value-bind (val found) (gethash sab sab-srlus-hash) + (declare (ignore val)) + (unless found + (setf (gethash sab sab-srlus-hash) srlus)))))) + (setq *preparse-hash-init?* t) + t) + + #+nil (defun pfstr-hash (cui) (gethash cui pfstr-hash)) + (defun cui-lrl (cui) (gethash cui cui-lrl-hash)) + (defun lui-lrl (lui) (gethash lui lui-lrl-hash)) + (defun sui-lrl (sui) (gethash sui sui-lrl-hash)) (defun cuisui-lrl (cuisui) (gethash cuisui cuisui-lrl-hash)) - + (defun cui-lrlus (cui) (gethash cui cui-lrlus-hash)) + (defun lui-lrlus (lui) (gethash lui lui-lrlus-hash)) + (defun sui-lrlus (sui) (gethash sui sui-lrlus-hash)) + (defun cuisui-lrlus (cuisui) (gethash cuisui cuisui-lrlus-hash)) + (defun sab-srl (sab) (aif (gethash sab sab-srl-hash) it 0)) + (defun sab-srlus (sab) (aif (gethash sab sab-srlus-hash) it 0)) + )) ;; closure -(defun set-lrl-hash (key lrl hash) + +(defun set-lrl-hash (key srl hash) "Set the least restrictive level in hash table" + (declare (fixnum srl)) (multiple-value-bind (hash-lrl found) (gethash key hash) - (if (or (not found) (< lrl hash-lrl)) - (setf (gethash key hash) lrl)))) + (declare (type (or null fixnum) hash-lrl) + (boolean found)) + (if (or (not found) (< srl hash-lrl)) + (setf (gethash key hash) srl)))) ;; UMLS file and column structures ;;; SQL datatypes symbols ;;; sql-u - Unique identifier +;;; sql-t - Tiny integer (8-bit) ;;; sql-s - Small integer (16-bit) ;;; sql-i - Integer (32-bit) ;;; sql-l - Big integer (64-bit) @@ -98,15 +181,17 @@ (defparameter +col-datatypes+ '(("AV" sql-f) ("BTS" sql-i) ("CLS" sql-i) ("COF" sql-i) ("CUI1" sql-u) ("AUI" sql-u) ("AUI1" sql-u) ("AUI2" sql-u) ("PCUI" sql-u) - ("PLUI" sql-u) ("PAUI" sql-u) - ("CUI2" sql-u) ("CUI" sql-u) ("CXN" sql-s) ("FR" sql-i) ("LRL" sql-s) + ("PLUI" sql-u) ("PAUI" sql-u) ("RUI" sql-u) + ("CUI2" sql-u) ("CUI" sql-u) ("CXN" sql-s) ("FR" sql-i) ("LUI" sql-u) ("MAX" sql-s) ("MIN" sql-s) ("RANK" sql-s) ("REF" sql-c) - ("RNK" sql-s) ("RWS" sql-i) ("SRL" sql-s) ("SUI" sql-u) ("TUI" sql-u) + ("PTR" sql-c) + ("RNK" sql-s) ("RWS" sql-i) ("SRL" sql-t) ("SUI" sql-u) ("TUI" sql-u) ("MAPRANK" sql-s) ;;; Custom columns - ("KCUISUI" sql-l) ("KCUILUI" sql-l) ("KCUILRL" sql-i) ("KLUILRL" sql-i) - ("KSUILRL" sql-i) - ("KSRL" sql-i) ("KLRL" sql-i) + ("KCUISUI" sql-l) ("KCUILUI" sql-l) + ("KSRL" sql-t) ("KSRLUS" sql-t) ("LRL" sql-t) ("LRLUS" sql-t) + ("KCUILRL" sql-t) ("KLUILRL" sql-t) ("KSUILRL" sql-t) ("KLRL" sql-t) + ("KCUILRLUS" sql-t) ("KLUILRLUS" sql-t) ("KSUILRLUS" sql-t) ("KLRLUS" sql-t) ;;; LEX columns ("EUI" sql-u) ("EUI2" sql-u) ;;; Semantic net columns @@ -115,7 +200,7 @@ ("RCUI" sql-u) ("VCUI" sql-u) ("CFR" sql-i) ("TFR" sql-i) ;; New fields for 2004AA ("MAPSETCUI" sql-u) - ) + ) "SQL data types for each non-string column") (defparameter +custom-tables+ @@ -125,115 +210,185 @@ "Custom tables to create") (defparameter +custom-cols+ - '(("MRCONSO.RRF" "KPFSTR" "TEXT" - (slot-value (find-ucol "STR" "MRCONSO.RRF") 'max) - (lambda (x) (pfstr-hash (parse-ui (nth 0 x))))) + '(#+nil ("MRCONSO.RRF" "KPFSTR" "TEXT" + (slot-value (find-ucol "STR" "MRCONSO.RRF") 'max) + (lambda (x) (pfstr-hash (parse-ui (vff "MRCONSO.RRF" "CUI" x))))) + ;; Set to 1 if term is prefered term for english + ("MRCONSO.RRF" "KPFENG" "TINYINT" 0 + (lambda (x) (if (and (string-equal (vff "MRCONSO.RRF" "LAT" x) "ENG") + (string-equal (vff "MRCONSO.RRF" "TS" x) "P") + (string-equal (vff "MRCONSO.RRF" "STT" x) "PF")) + "1" + "0"))) ("MRCONSO.RRF" "KCUISUI" "BIGINT" 0 - (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 5 x)))))) + (lambda (x) (write-to-string (make-cuisui (parse-ui (vff "MRCONSO.RRF" "CUI" x)) + (parse-ui (vff "MRCONSO.RRF" "SUI" x)))))) ("MRCONSO.RRF" "KCUILUI" "BIGINT" 0 - (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 3 x)))))) - ("MRCONSO.RRF" "KCUILRL" "SMALLINT" 0 - (lambda (x) (write-to-string (lui-lrl (parse-ui (nth 0 x)))))) - ("MRCONSO.RRF" "KLUILRL" "SMALLINT" 0 - (lambda (x) (write-to-string (lui-lrl (parse-ui (nth 3 x)))))) - ("MRCONSO.RRF" "KSUILRL" "SMALLINT" 0 - (lambda (x) (write-to-string (sui-lrl (parse-ui (nth 5 x)))))) - ;; Deprecated, last in 2004AA -- skip index - #+ignore - ("MRLO.RRF" "KLRL" "SMALLINT" 0 - (lambda (x) (write-to-string - (if (zerop (length (nth 4 x))) - (cui-lrl (parse-ui (nth 0 x))) - (cuisui-lrl (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 4 x)))))))) - ("MRSTY.RRF" "KLRL" "SMALLINT" 0 - (lambda (x) (write-to-string (cui-lrl (parse-ui (nth 0 x)))))) - ("MRCOC.RRF" "KLRL" "SMALLINT" 0 - (lambda (x) (write-to-string - (max (cui-lrl (parse-ui (nth 0 x))) - (kmrcl:aif (cui-lrl (parse-ui (nth 1 x))) kmrcl::it 0))))) - ("MRSAT.RRF" "KSRL" "SMALLINT" 0 - (lambda (x) (write-to-string (sab-srl (nth 9 x))))) - ("MRREL.RRF" "KSRL" "SMALLINT" 0 - (lambda (x) (write-to-string (sab-srl (nth 10 x))))) - ("MRRANK.RRF" "KSRL" "SMALLINT" 0 - (lambda (x) (write-to-string (sab-srl (nth 1 x))))) - ("MRDEF.RRF" "KSRL" "SMALLINT" 0 - (lambda (x) (write-to-string (sab-srl (nth 4 x))))) - ("MRCXT.RRF" "KSRL" "SMALLINT" 0 - (lambda (x) (write-to-string (sab-srl (nth 2 x))))) - ("MRXW_ENG.RRF" "KLRL" "SMALLINT" 0 - (lambda (x) (write-to-string (cuisui-lrl (make-cuisui - (parse-ui (nth 2 x)) - (parse-ui (nth 4 x))))))) - ("MRXW_NONENG.RRF" "KLRL" "SMALLINT" 0 - (lambda (x) (write-to-string (cuisui-lrl (make-cuisui - (parse-ui (nth 2 x)) - (parse-ui (nth 4 x))))))) - ("MRXNW_ENG.RRF" "KLRL" "SMALLINT" 0 - (lambda (x) (write-to-string (cuisui-lrl (make-cuisui - (parse-ui (nth 2 x)) - (parse-ui (nth 4 x))))))) - ("MRXNS_ENG.RRF" "KLRL" "SMALLINT" 0 - (lambda (x) (write-to-string (cuisui-lrl (make-cuisui - (parse-ui (nth 2 x)) - (parse-ui (nth 4 x))))))) - ("MRREL.RRF" "KPFSTR2" "TEXT" 1024 - (lambda (x) (pfstr-hash (parse-ui (nth 4 x))))) - ("MRCOC.RRF" "KPFSTR2" "TEXT" 1024 - (lambda (x) (pfstr-hash (parse-ui (nth 2 x))))) - ("MRCXT.RRF" "KCUISUI" "BIGINT" 0 - (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 1 x)))))) + (lambda (x) (write-to-string (make-cuilui (parse-ui (vff "MRCONSO.RRF" "CUI" x)) + (parse-ui (vff "MRCONSO.RRF" "LUI" x)))))) + ("MRCONSO.RRF" "KCUILRL" "TINYINT" 0 + (lambda (x) (write-to-string (cui-lrl (parse-ui (vff "MRCONSO.RRF" "CUI" x)))))) + ("MRCONSO.RRF" "KCUILRLUS" "TINYINT" 0 + (lambda (x) (write-to-string (cui-lrlus (parse-ui (vff "MRCONSO.RRF" "CUI" x)))))) + ("MRCONSO.RRF" "KLUILRL" "TINYINT" 0 + (lambda (x) (write-to-string (lui-lrl (parse-ui (vff "MRCONSO.RRF" "LUI" x)))))) + ("MRCONSO.RRF" "KLUILRLUS" "TINYINT" 0 + (lambda (x) (write-to-string (lui-lrlus (parse-ui (vff "MRCONSO.RRF" "LUI" x)))))) + ("MRCONSO.RRF" "KSUILRL" "TINYINT" 0 + (lambda (x) (write-to-string (sui-lrl (parse-ui (vff "MRCONSO.RRF" "SUI" x)))))) + ("MRCONSO.RRF" "KSUILRLUS" "TINYINT" 0 + (lambda (x) (write-to-string (sui-lrlus (parse-ui (vff "MRCONSO.RRF" "SUI" x)))))) + ("MRCONSO.RRF" "KSRLUS" "TINYINT" 0 + (lambda (x) (write-to-string (srl-to-srlus (parse-integer (vff "MRCONSO.RRF" "SRL" x)))))) + ("MRSAB.RRF" "KSRLUS" "TINYINT" 0 + (lambda (x) (write-to-string (srl-to-srlus (parse-integer (vff "MRSAB.RRF" "SRL" x)))))) + ("MRSTY.RRF" "KLRL" "TINYINT" 0 + (lambda (x) (write-to-string (cui-lrl (parse-ui (vff "MRSTY.RRF" "CUI" x)))))) + ("MRSTY.RRF" "KLRLUS" "TINYINT" 0 + (lambda (x) (write-to-string (cui-lrlus (parse-ui (vff "MRSTY.RRF" "CUI" x)))))) + #+mrcoc ("MRCOC.RRF" "KLRL" "TINYINT" 0 + (lambda (x) (write-to-string + (max (cui-lrl (parse-ui (vff "MRCOC.RRF" "CUI1" x))) + (kmrcl:aif (cui-lrl (parse-ui (vff "MRCOC.RRF" "CUI2" x))) kmrcl::it 0))))) + #+mrcoc ("MRCOC.RRF" "KLRLUS" "TINYINT" 0 + (lambda (x) (write-to-string + (max (cui-lrlus (parse-ui (vff "MRCOC.RRF" "CUI1" x))) + (kmrcl:aif (cui-lrl (parse-ui (vff "MRCOC.RRF" "CUI2" x))) kmrcl::it 0))))) + ("MRSAT.RRF" "KSRL" "TINYINT" 0 + (lambda (x) (write-to-string (sab-srl (vff "MRSAT.RRF" "SAB" x))))) + ("MRSAT.RRF" "KSRLUS" "TINYINT" 0 + (lambda (x) (write-to-string (sab-srlus (vff "MRSAT.RRF" "SAB" x))))) + ("MRREL.RRF" "KSRL" "TINYINT" 0 + (lambda (x) (write-to-string (sab-srl (vff "MRREL.RRF" "SAB" x))))) + ("MRREL.RRF" "KSRLUS" "TINYINT" 0 + (lambda (x) (write-to-string (sab-srlus (vff "MRREL.RRF" "SAB" x))))) + ("MRRANK.RRF" "KSRL" "TINYINT" 0 + (lambda (x) (write-to-string (sab-srl (vff "MRRANK.RRF" "SAB" x))))) + ("MRRANK.RRF" "KSRLUS" "TINYINT" 0 + (lambda (x) (write-to-string (sab-srlus (vff "MRRANK.RRF" "SAB" x))))) + ("MRHIER.RRF" "KSRL" "TINYINT" 0 + (lambda (x) (write-to-string (sab-srl (vff "MRHIER.RRF" "SAB" x))))) + ("MRHIER.RRF" "KSRLUS" "TINYINT" 0 + (lambda (x) (write-to-string (sab-srlus (vff "MRHIER.RRF" "SAB" x))))) + ("MRMAP.RRF" "KSRL" "TINYINT" 0 + (lambda (x) (write-to-string (sab-srl (vff "MRMAP.RRF" "MAPSETSAB" x))))) + ("MRMAP.RRF" "KSRLUS" "TINYINT" 0 + (lambda (x) (write-to-string (sab-srlus (vff "MRMAP.RRF" "MAPSETSAB" x))))) + ("MRSMAP.RRF" "KSRL" "TINYINT" 0 + (lambda (x) (write-to-string (sab-srl (vff "MRSMAP.RRF" "MAPSETSAB" x))))) + ("MRSMAP.RRF" "KSRLUS" "TINYINT" 0 + (lambda (x) (write-to-string (sab-srlus (vff "MRSMAP.RRF" "MAPSETSAB" x))))) + ("MRDEF.RRF" "KSRL" "TINYINT" 0 + (lambda (x) (write-to-string (sab-srl (vff "MRDEF.RRF" "SAB" x))))) + ("MRDEF.RRF" "KSRLUS" "TINYINT" 0 + (lambda (x) (write-to-string (sab-srlus (vff "MRDEF.RRF" "SAB" x))))) + ("MRXW_ENG.RRF" "KLRL" "TINYINT" 0 + (lambda (x) (write-to-string (cuisui-lrl (make-cuisui + (parse-ui (vff "MRXW_ENG.RRF" "CUI" x)) + (parse-ui (vff "MRXW_ENG.RRF" "SUI" x))))))) + ("MRXW_ENG.RRF" "KLRLUS" "TINYINT" 0 + (lambda (x) (write-to-string (cuisui-lrlus (make-cuisui + (parse-ui (vff "MRXW_ENG.RRF" "CUI" x)) + (parse-ui (vff "MRXW_ENG.RRF" "SUI" x))))))) + ("MRXW_NONENG.RRF" "KLRL" "TINYINT" 0 + (lambda (x) (write-to-string (cuisui-lrl (make-cuisui + (parse-ui (vff "MRXW_NONENG.RRF" "CUI" x)) + (parse-ui (vff "MRXW_NONENG.RRF" "SUI" x))))))) + ("MRXW_NONENG.RRF" "KLRLUS" "TINYINT" 0 + (lambda (x) (write-to-string (cuisui-lrlus (make-cuisui + (parse-ui (vff "MRXW_NONENG.RRF" "CUI" x)) + (parse-ui (vff "MRXW_NONENG.RRF" "SUI" x))))))) + ("MRXNW_ENG.RRF" "KLRL" "TINYINT" 0 + (lambda (x) (write-to-string (cuisui-lrl (make-cuisui + (parse-ui (vff "MRXNW_ENG.RRF" "CUI" x)) + (parse-ui (vff "MRXNW_ENG.RRF" "SUI" x))))))) + ("MRXNW_ENG.RRF" "KLRLUS" "TINYINT" 0 + (lambda (x) (write-to-string (cuisui-lrlus (make-cuisui + (parse-ui (vff "MRXNW_ENG.RRF" "CUI" x)) + (parse-ui (vff "MRXNW_ENG.RRF" "SUI" x))))))) + ("MRXNS_ENG.RRF" "KLRL" "TINYINT" 0 + (lambda (x) (write-to-string (cuisui-lrl (make-cuisui + (parse-ui (vff "MRXNS_ENG.RRF" "CUI" x)) + (parse-ui (vff "MRXNS_ENG.RRF" "SUI" x))))))) + ("MRXNS_ENG.RRF" "KLRLUS" "TINYINT" 0 + (lambda (x) (write-to-string (cuisui-lrlus (make-cuisui + (parse-ui (vff "MRXNS_ENG.RRF" "CUI" x)) + (parse-ui (vff "MRXNS_ENG.RRF" "SUI" x))))))) + + #+nil ("MRREL.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (vff "MRREL.RRF" "CUI2" x))))) + #+mrcoc ("MRCOC.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (vff "MRCOC.RRF" "CUI2" x))))) + ("MRSAT.RRF" "KCUILUI" "BIGINT" 0 - (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 1 x)))))) + (lambda (x) (write-to-string (make-cuilui + (parse-ui (vff "MRSAT.RRF" "CUI" x)) + (parse-ui (vff "MRSAT.RRF" "LUI" x)))))) ("MRSAT.RRF" "KCUISUI" "BIGINT" 0 - (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 2 x)))))) + (lambda (x) (write-to-string (make-cuisui + (parse-ui (vff "MRSAT.RRF" "CUI" x)) + (parse-ui (vff "MRSAT.RRF" "SUI" x)))))) ("MRXW_ENG.RRF" "KCUISUI" "BIGINT" 0 - (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x)))))) + (lambda (x) (write-to-string (make-cuisui + (parse-ui (vff "MRXW_ENG.RRF" "CUI" x)) + (parse-ui (vff "MRXW_ENG.RRF" "SUI" x)))))) ("MRXNW_ENG.RRF" "KCUISUI" "BIGINT" 0 - (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x)))))) + (lambda (x) (write-to-string (make-cuisui + (parse-ui (vff "MRXNW_ENG.RRF" "CUI" x)) + (parse-ui (vff "MRXNW_ENG.RRF" "SUI" x)))))) ("MRXNS_ENG.RRF" "KCUISUI" "BIGINT" 0 - (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x)))))) - ("MRXW_NONENG.RRF" "LAT" "VARCHAR" 3 (lambda (x) (nth 0 x))) - ("MRXW_NONENG.RRF" "WD" "VARCHAR" 200 (lambda (x) (nth 1 x))) - ("MRXW_NONENG.RRF" "CUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 2 x))))) - ("MRXW_NONENG.RRF" "LUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 3 x))))) - ("MRXW_NONENG.RRF" "SUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 4 x))))) - ("MRXW_NONENG.RRF" "KCUISUI" "BIGINT" 0 - (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))) - "Custom columns to create.(filename, col, sqltype, value-func).") + (lambda (x) (write-to-string (make-cuisui + (parse-ui (vff "MRXNS_ENG.RRF" "CUI" x)) + (parse-ui (vff "MRXNS_ENG.RRF" "SUI" x)))))) + ("MRXW_NONENG.RRF" "LAT" "VARCHAR" 3 (lambda (x) (vff "MRXW_NONENG.RRF" "LAT" x))) + ("MRXW_NONENG.RRF" "WD" "VARCHAR" 200 (lambda (x) (vff "MRXW_NONENG.RRF" "WD" x))) + ("MRXW_NONENG.RRF" "CUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (vff "MRXW_NONENG.RRF" "CUI" x))))) + ("MRXW_NONENG.RRF" "LUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (vff "MRXW_NONENG.RRF" "LUI" x))))) + ("MRXW_NONENG.RRF" "SUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (vff "MRXW_NONENG.RRF" "SUI" x))))) + ("MRXW_NONENG.RRF" "KCUISUI" "BIGINT" 0 + (lambda (x) (write-to-string (make-cuisui + (parse-ui (vff "MRXW_NONENG.RRF" "CUI" x)) + (parse-ui (vff "MRXW_NONENG.RRF" "SUI" x))))))) + "Custom columns to create.(filename, col, sqltype, value-func).") (defparameter +index-cols+ - '(("CUI1" "MRCOC") ("CUI" "MRCONSO") ("LUI" "MRCONSO") - ("SRL" "MRCONSO") ("AUI" "MRCONSO") - ("SUI" "MRCONSO") ("CUI" "MRCXT") ("CUI" "MRDEF") ("CUI" "MRLO") - ("CUI1" "MRREL") ("CUI" "MRSAT") ("LUI" "MRSAT") ("SUI" "MRSAT") - ("CUI" "MRSTY") - ("TUI" "MRSTY") ("CUI" "MRXNS_ENG") - #+ignore ("NSTR" "MRXNS_ENG" 10) + '( #+mrcoc ("CUI1" "MRCOC") #+mrcoc ("KLRL" "MRCOC") #+mrcoc ("KLRLUS" "MRCOC") + ("CUI" "MRCONSO") ("LUI" "MRCONSO") + ("SRL" "MRCONSO") ("KSRLUS" "MRCONSO") ("AUI" "MRCONSO") ("KPFENG" "MRCONSO") + ("SUI" "MRCONSO") ("SAUI" "MRCONSO") ("CODE" "MRCONSO") + ("SCUI" "MRCONSO") + ("CUI" "MRDEF") + ("CUI1" "MRREL") ("CUI2" "MRREL") ("SAB" "MRREL") + ("RUI" "MRREL") ("AUI1" "MRREL") ("AUI2" "MRREL") + ("CUI" "MRSAT") ("LUI" "MRSAT") ("SUI" "MRSAT") + ("METAUI" "MRSAT") ("ATN" "MRSAT") + ("CUI" "MRSTY") ("TUI" "MRSTY") ("CUI" "MRXNS_ENG") + ("AUI" "MRHIER") ("CUI" "MRHIER") ("CXN" "MRHIER") ("RELA" "MRHIER") + ("PAUI" "MRHIER") ("SAB" "MRHIER") + ("NSTR" "MRXNS_ENG" 255) ("CUI" "MRXNW_ENG") ("NWD" "MRXNW_ENG") ("WD" "MRXW_ENG") - ("KCUISUI" "MRCONSO") ("KCUILUI" "MRCONSO") ("KCUILRL" "MRCONSO") - ("KLUILRL" "MRCONSO") ("KCUISUI" "MRCXT") + ("KCUISUI" "MRCONSO") ("KCUILUI" "MRCONSO") + ("KCUILRL" "MRCONSO") ("KLUILRL" "MRCONSO") ("KSUILRL" "MRCONSO") + ("KCUILRLUS" "MRCONSO") ("KLUILRLUS" "MRCONSO") ("KSUILRLUS" "MRCONSO") ("KCUISUI" "MRSAT") ("KCUILUI" "MRSAT") - ("KCUISUI" "MRXW_ENG") ("KCUISUI" "MRXNW_ENG") + ("KCUISUI" "MRXW_ENG") ("KCUISUI" "MRXNW_ENG") ("KCUISUI" "MRXNS_ENG") ("KCUISUI" "MRXW_NONENG") - ("KSRL" "MRCXT") ("KSRL" "MRDEF") ("KSRL" "MRRANK") - ("KSRL" "MRREL") ("KSRL" "MRSAT") ("KLRL" "MRCOC") - #+ignore ("KLRL" "MRLO") ;; deprecated + ("KSRL" "MRDEF") ("KSRL" "MRRANK")("KSRL" "MRREL") ("KSRL" "MRSAT") + ("KSRLUS" "MRDEF") ("KSRLUS" "MRRANK")("KSRLUS" "MRREL") ("KSRLUS" "MRSAT") ("KLRL" "MRSTY") ("KLRL" "MRXW_ENG") ("KLRL" "MRXNW_ENG") + ("KLRLUS" "MRSTY") ("KLRLUS" "MRXW_ENG") ("KLRLUS" "MRXNW_ENG") ("KLRL" "MRXNS_ENG") ("KLRL" "MRXW_NONENG") + ("KLRLUS" "MRXNS_ENG") ("KLRLUS" "MRXW_NONENG") ;; LEX indices ("EUI" "LRABR") ("EUI2" "LRABR") ("EUI" "LRAGR") ("EUI" "LRCMP") ("EUI" "LRMOD") ("EUI" "LRNOM") ("EUI2" "LRNOM") ("EUI" "LRPRN") ("EUI" "LRPRP") ("EUI" "LRSPL") ("EUI" "LRTRM") ("EUI" "LRTYP") ("EUI" "LRWD") ("WRD" "LRWD") - ("BAS" "LRABR") + ("BAS" "LRABR") ;; Semantic NET indices - ("UI" "SRSTRE1") ("UI2" "SRSTRE1") ("UI3" "SRSTRE1") + ("UI" "SRSTRE1") ("UI2" "SRSTRE1") ("UI3" "SRSTRE1") ("STY_RL" "SRDEF") ("RT" "SRDEF") ("STY_RL" "SRSTR") ("STY_RL2" "SRSTR") ("RL" "SRSTR") - - ("SRL" "MRSAB") ("RSAB" "MRSAB") ("VSAB" "MRSAB") ("RCUI" "MRSAB") - ("VCUI" "MRSAB") ("LAT" "MRSAB") ("MAPSETCUI" "MRMAP") ("MAPSETCUI" "MRSMAP") - ("CUI" "MRHIER") ("AUI" "MRHIER") ("PAUI" "MRHIER")) + + ("SRL" "MRSAB") ("KSRLUS" "MRSAB") ("RSAB" "MRSAB") ("VSAB" "MRSAB") ("RCUI" "MRSAB") + ("VCUI" "MRSAB") ("LAT" "MRSAB") ("MAPSETCUI" "MRMAP") ("MAPSETCUI" "MRSMAP")) "Columns in files to index") @@ -247,38 +402,38 @@ (defun gen-ucols () (add-ucols (gen-ucols-meta)) - (add-ucols (gen-ucols-custom)) (add-ucols (gen-ucols-generic "LRFLD")) - (add-ucols (gen-ucols-generic "SRFLD"))) + (add-ucols (gen-ucols-generic "SRFLD")) + (add-ucols (gen-ucols-custom))) (defun gen-ucols-meta () -"Initialize all umls columns" +"Initialize all umls columns" (let ((cols '())) (with-umls-file (line "MRCOLS.RRF") (destructuring-bind (col des ref min av max fil dty) line - (push (make-ucol col des ref (parse-integer min) (read-from-string av) - (parse-integer max) fil dty) - cols))) + (push (make-ucol col des ref (parse-integer min) (read-from-string av) + (parse-integer max) fil dty) + cols))) (nreverse cols))) (defun gen-ucols-custom () -"Initialize umls columns for custom columns" +"Initialize umls columns for custom columns" (loop for customcol in +custom-cols+ - collect - (make-ucol (nth 1 customcol) "" 0 0 0 (eval (nth 3 customcol)) - (nth 0 customcol) nil :sqltype (canonicalize-column-type (nth 2 customcol)) - :custom-value-fun (nth 4 customcol)))) + collect + (make-ucol (nth 1 customcol) "" 0 0 0 (eval (nth 3 customcol)) + (nth 0 customcol) nil :sqltype (canonicalize-column-type (nth 2 customcol)) + :custom-value-fun (compile nil (nth 4 customcol))))) (defun gen-ucols-generic (col-filename) -"Initialize for generic (LEX/NET) columns" +"Initialize for generic (LEX/NET) columns" (let ((cols '())) (with-umls-file (line col-filename) (destructuring-bind (nam des ref fil) line - (setq nam (escape-column-name nam)) - (dolist (file (delimited-string-to-list fil #\,)) - (push - (make-ucol nam des ref nil nil nil file nil) - cols)))) + (setq nam (escape-column-name nam)) + (dolist (file (delimited-string-to-list fil #\,)) + (push + (make-ucol nam des ref nil nil nil file nil) + cols)))) (nreverse cols))) @@ -289,24 +444,21 @@ ;; needs to come last (add-ufiles (gen-ufiles-custom))) - + (defun gen-ufiles-generic (files-filename dir) -"Initialize all LEX file structures" +"Initialize generic UMLS file structures" (let ((files '())) (with-umls-file (line files-filename) (destructuring-bind (fil des fmt cls rws bts) line - (push (make-ufile - dir fil des - (parse-integer cls) - (parse-integer rws) (parse-integer bts) - (concatenate 'list (umls-field-string-to-list fmt) - (custom-colnames-for-filename fil))) - files))) + (push (make-ufile + dir fil des + (parse-integer cls) + (parse-integer rws) (parse-integer bts) + (concatenate 'list (umls-field-string-to-list fmt) + (custom-colnames-for-filename fil))) + files))) (nreverse files))) (defun gen-ufiles-custom () - (make-ufile "META" "MRXW_NONENG.RRF" "Custom NonEnglish Index" - 5 0 0 (fields (find-ufile "MRXW_ENG.RRF")))) - - - + (make-ufile "META" "MRXW_NONENG.RRF" "Custom NonEnglish Index" + 5 0 0 (fields (find-ufile "MRXW_ENG.RRF"))))