r11478: generate custom columns by dynamically finding position of dependant columns...

diff --git a/create-sql.lisp b/create-sql.lisp
index fc8fc8425353c8ab3b844f78c512aec736172299..697ecb0a0eb858260cb67f8c9387b510773ac0d9 100644 (file)
--- a/create-sql.lisp
+++ b/create-sql.lisp
@@ -421,9 +421,9 @@ This is much faster that using create-umls-db-insert."
   (declare (optimize (speed 3) (space 0)))
   (ensure-ucols+ufiles)
   (let ((max 0))
-    (declare (fixnum max))
+    (declare (type (integer 0 1000000) max))
     (dolist (ucol *umls-cols*)
-      (when (> (cmax ucol) max)
+      (when (> (the (integer 0 1000000) (cmax ucol)) max)
        (setq max (cmax ucol))))
     max))
 
@@ -434,7 +434,11 @@ This is much faster that using create-umls-db-insert."
   (let ((rowsizes '()))
     (dolist (file *umls-files*)
       (let ((row 0))
+        (declare (type (integer 0 1000000) row))
        (dolist (ucol (ucols file))
-         (incf row (1+ (cmax ucol))))
+          (let* ((col-max (cmax ucol))
+                 (max-with-delim (1+ col-max)))
+            (declare (type (integer 0 1000000) col-max max-with-delim))
+            (incf row max-with-delim)))
        (push row rowsizes)))
     (car (sort rowsizes #'>))))

diff --git a/parse-common.lisp b/parse-common.lisp
index 96f7b8ddef77cd7a026bb5579a4c8efb3dd516ba..a0c7c2afce6afea1c94dbc0c132041be7d42238d 100644 (file)
--- a/parse-common.lisp
+++ b/parse-common.lisp
@@ -23,12 +23,14 @@
   (handler-case
       (when (or alwaysclear (null *umls-files*))
         (setf *umls-cols* nil *umls-files* nil)
-        (gen-ucols)
         (gen-ufiles)
+        (gen-ucols)
+        (set-ucols-for-ufiles *umls-files*)
         (ensure-field-lengths))
-    (error (e)
-      (setf *umls-cols* nil *umls-files* nil)
-      (error e)))
+      (error (e)
+             (warn "Error reading ucols+ufiles: ~A." e)
+             (setf *umls-cols* nil *umls-files* nil)
+             nil))
   t)
 
 
@@ -123,12 +125,13 @@ Currently, these are the LEX and NET files."
   "Returns a list of FILENAME MAX AV"
   (declare (optimize (speed 3) (safety 0)))
   (let (fields-max fields-av num-fields (count-lines 0))
+    (declare (fixnum count-lines))
     (with-umls-ufile (line ufile)
       (unless num-fields
        (setq num-fields (length line))
        (setq fields-max (make-array num-fields :element-type 'fixnum
                                     :initial-element 0))
-       (setq fields-av (make-array num-fields :element-type 'number
+       (setq fields-av (make-array num-fields :element-type '(or integer float)
                                    :initial-element 0)))
       (dotimes (i num-fields)
        (declare (fixnum i))
@@ -138,6 +141,8 @@ Currently, these are the LEX and NET files."
                             (if *octet-sql-storage*
                                 (ext:convert-string-to-bytes str charset:utf-8)
                               str))))
+          #-(and clisp unicode) (declare (string str))
+          (declare (type (integer 0 10000000) len))
          (incf (aref fields-av i) len)
          (when (> len (aref fields-max i))
            (setf (aref fields-max i) len))))
@@ -223,7 +228,27 @@ Currently, these are the LEX and NET files."
 
 (defun find-ufile (filename)
   "Returns umls-file structure for a filename"
-  (find-if #'(lambda (f) (string-equal filename (fil f))) *umls-files*))
+  (find-if #'(lambda (f) (string= filename (fil f))) *umls-files*))
+
+(defvar *position-hash* (make-hash-table :test 'equal))
+
+(defun position-field-file (filename fieldname)
+  "Returns the position of a field in a file"
+  (let ((key (cons filename fieldname)))
+    (multiple-value-bind (pos found) (gethash key *position-hash*)
+      (if found
+          (return-from position-field-file pos)))
+
+    (let ((ufile (find-ufile filename)))
+      (unless ufile
+        (warn "Unable to find ufile for filename ~A." filename)
+        (return-from position-field-file nil))
+      (let ((pos (position fieldname (fields ufile) :test #'string=)))
+        (unless pos
+          (warn "Unable to find field ~A in ufile ~S." fieldname ufile)
+          (return-from position-field-file nil))
+        (setf (gethash key *position-hash*) pos)
+        pos))))
 
 (defun find-ucols-for-ufile (ufile)
   "Returns list of umls-cols for a file structure"
@@ -268,9 +293,12 @@ append a unique number (starting at 2) onto a column name that is repeated in th
                                :des des :cls cls
                                :rws rws :bts bts :fields fields
                                :table (filename-to-tablename file))))
-      (setf (ucols ufile) (find-ucols-for-ufile ufile))
       ufile)))
 
+(defun set-ucols-for-ufiles (ufiles)
+  (dolist (ufile ufiles)
+    (setf (ucols ufile) (find-ucols-for-ufile ufile))))
+
 (defun datatype-for-colname (colname)
 "Return datatype for column name"
   (second (find colname +col-datatypes+ :key #'car :test #'string-equal)))

diff --git a/parse-rrf.lisp b/parse-rrf.lisp
index d54c6b2e2f4ff8766fdfd60d26d28ef58a8cf5fb..8a1bb1ebd47f116fcd5cdc7710a50d9634cdf83e 100644 (file)
--- a/parse-rrf.lisp
+++ b/parse-rrf.lisp
@@ -50,20 +50,22 @@ used in the United States. We create a new scale (SRLUS) where SRL to SRLUS mapp
       (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 cui-lrlus-hash)
-          (clrhash lui-lrlus-hash)
-          (clrhash sui-lrlus-hash)
-          (clrhash cuisui-lrlus-hash)
-          (clrhash sab-srl-hash)
-          (clrhash sab-srlus-hash))
+       (clear-preparse-hash-tables)
       (setf
          pfstr-hash (make-hash-table :size 1500000)
          cui-lrl-hash (make-hash-table :size 1500000)
@@ -134,7 +136,7 @@ used in the United States. We create a new scale (SRLUS) where SRL to SRLUS mapp
 
 )) ;; closure
 
-  
+
 (defun set-lrl-hash (key srl hash)
   "Set the least restrictive level in hash table"
   (declare (fixnum srl))
@@ -158,13 +160,13 @@ used in the United States. We create a new scale (SRLUS) where SRL to SRLUS mapp
     '(("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) ("RUI" sql-u)
-      ("CUI2" sql-u) ("CUI" sql-u) ("CXN" sql-s) ("FR" sql-i) 
+      ("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)
       ("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) 
+      ("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)
@@ -185,6 +187,14 @@ used in the United States. We create a new scale (SRLUS) where SRL to SRLUS mapp
   '(("KCON" "SELECT CUI,STR FROM MRCONSO WHERE STT='PF' AND TS='P' AND ISPREF='Y' AND LAT='ENG'"))
   "Custom tables to create")
 
+(declaim (inline vff))
+(defun vff (filename fieldname record)
+  (let ((pos (position-field-file filename fieldname)))
+    (unless pos
+      (error "Did not find fieldname ~A in filename ~A." fieldname filename))
+    (locally (declare (fixnum pos))
+      (nth pos record))))
+
 (defparameter +custom-cols+
     '(#+nil ("MRCONSO.RRF" "KPFSTR" "TEXT"
              (slot-value (find-ucol "STR" "MRCONSO.RRF") 'max)
@@ -197,118 +207,133 @@ used in the United States. We create a new scale (SRLUS) where SRL to SRLUS mapp
                       "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))))))
+       (lambda (x) (write-to-string (make-cuilui (parse-ui (vff "MRCONSO.RRF" "CUI" x))
+                                                 (parse-ui (vff "MRCONSO.RRF" "SUI" x))))))
       ("MRCONSO.RRF" "KCUILRL" "TINYINT" 0
-       (lambda (x) (write-to-string (cui-lrl (parse-ui (nth 0 x))))))
+       (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 (nth 0 x))))))
+       (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 (nth 3 x))))))
+       (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 (nth 3 x))))))
+       (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 (nth 5 x))))))
+       (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 (nth 5 x))))))
+       (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 (nth 15 x))))))
+       (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 (nth 3 x))))))
+       (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 (nth 0 x))))))
+       (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 (nth 0 x))))))
+       (lambda (x) (write-to-string (cui-lrlus (parse-ui (vff "MRSTY.RRF" "CUI" x))))))
       ("MRCOC.RRF" "KLRL" "TINYINT" 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)))))
+                   (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.RRF" "KLRLUS" "TINYINT" 0
        (lambda (x) (write-to-string
-                   (max (cui-lrlus (parse-ui (nth 0 x)))
-                        (kmrcl:aif (cui-lrl (parse-ui (nth 1 x))) kmrcl::it 0)))))
+                   (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 (nth 9 x)))))
+       (lambda (x) (write-to-string (sab-srl (vff "MRSAT.RRF" "SAB" x)))))
       ("MRSAT.RRF" "KSRLUS" "TINYINT" 0
-       (lambda (x) (write-to-string (sab-srlus (nth 9 x)))))
+       (lambda (x) (write-to-string (sab-srlus (vff "MRSAT.RRF" "SAB" x)))))
       ("MRREL.RRF" "KSRL" "TINYINT" 0
-       (lambda (x) (write-to-string (sab-srl (nth 10 x)))))
+       (lambda (x) (write-to-string (sab-srl (vff "MRREL.RRF" "SAB" x)))))
       ("MRREL.RRF" "KSRLUS" "TINYINT" 0
-       (lambda (x) (write-to-string (sab-srlus (nth 10 x)))))
+       (lambda (x) (write-to-string (sab-srlus (vff "MRREL.RRF" "SAB" x)))))
       ("MRRANK.RRF" "KSRL" "TINYINT" 0
-       (lambda (x) (write-to-string (sab-srl (nth 1 x)))))
+       (lambda (x) (write-to-string (sab-srl (vff "MRRANK.RRF" "SAB" x)))))
       ("MRRANK.RRF" "KSRLUS" "TINYINT" 0
-       (lambda (x) (write-to-string (sab-srlus (nth 1 x)))))
+       (lambda (x) (write-to-string (sab-srlus (vff "MRRANK.RRF" "SAB" x)))))
       ("MRHIER.RRF" "KSRL" "TINYINT" 0
-       (lambda (x) (write-to-string (sab-srl (nth 4 x)))))
+       (lambda (x) (write-to-string (sab-srl (vff "MRHIER.RRF" "SAB" x)))))
       ("MRHIER.RRF" "KSRLUS" "TINYINT" 0
-       (lambda (x) (write-to-string (sab-srlus (nth 4 x)))))
+       (lambda (x) (write-to-string (sab-srlus (vff "MRHIER.RRF" "SAB" x)))))
       ("MRMAP.RRF" "KSRL" "TINYINT" 0
-       (lambda (x) (write-to-string (sab-srl (nth 1 x)))))
+       (lambda (x) (write-to-string (sab-srl (vff "MRMAP.RRF" "MAPSETSAB" x)))))
       ("MRMAP.RRF" "KSRLUS" "TINYINT" 0
-       (lambda (x) (write-to-string (sab-srlus (nth 1 x)))))
+       (lambda (x) (write-to-string (sab-srlus (vff "MRMAP.RRF" "MAPSETSAB" x)))))
       ("MRSMAP.RRF" "KSRL" "TINYINT" 0
-       (lambda (x) (write-to-string (sab-srl (nth 1 x)))))
+       (lambda (x) (write-to-string (sab-srl (vff "MRSMAP.RRF" "MAPSETSAB" x)))))
       ("MRSMAP.RRF" "KSRLUS" "TINYINT" 0
-       (lambda (x) (write-to-string (sab-srlus (nth 1 x)))))
+       (lambda (x) (write-to-string (sab-srlus (vff "MRSMAP.RRF" "MAPSETSAB" x)))))
       ("MRDEF.RRF" "KSRL" "TINYINT" 0
-       (lambda (x) (write-to-string (sab-srl (nth 4 x)))))
+       (lambda (x) (write-to-string (sab-srl (vff "MRDEF.RRF" "SAB" x)))))
       ("MRDEF.RRF" "KSRLUS" "TINYINT" 0
-       (lambda (x) (write-to-string (sab-srlus (nth 4 x)))))
+       (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 (nth 2 x))
-                                                (parse-ui (nth 4 x)))))))
+                                                (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 (nth 2 x))
-                                                   (parse-ui (nth 4 x)))))))
+                                                (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 (nth 2 x))
-                                                (parse-ui (nth 4 x)))))))
+                                                (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 (nth 2 x))
-                                                   (parse-ui (nth 4 x)))))))
+                                                (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 (nth 2 x))
-                                                (parse-ui (nth 4 x)))))))
+                                                (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 (nth 2 x))
-                                                   (parse-ui (nth 4 x)))))))
+                                                (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 (nth 2 x))
-                                                (parse-ui (nth 4 x)))))))
+                                                (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 (nth 2 x))
-                                                   (parse-ui (nth 4 x)))))))
+                                                (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 (nth 4 x)))))
       #+nil  ("MRCOC.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (nth 2 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)))))
+       (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 (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 "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")
@@ -325,14 +350,14 @@ used in the United States. We create a new scale (SRLUS) where SRL to SRLUS mapp
       ("SAB" "MRHIER")
       #+ignore ("NSTR" "MRXNS_ENG" 10)
       ("CUI" "MRXNW_ENG") ("NWD" "MRXNW_ENG") ("WD" "MRXW_ENG")
-      ("KCUISUI" "MRCONSO") ("KCUILUI" "MRCONSO") 
+      ("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" "MRXNS_ENG") ("KCUISUI" "MRXW_NONENG")
-      ("KSRL" "MRDEF") ("KSRL" "MRRANK")("KSRL" "MRREL") ("KSRL" "MRSAT") 
-      ("KSRLUS" "MRDEF") ("KSRLUS" "MRRANK")("KSRLUS" "MRREL") ("KSRLUS" "MRSAT") 
+      ("KSRL" "MRDEF") ("KSRL" "MRRANK")("KSRL" "MRREL") ("KSRL" "MRSAT")
+      ("KSRLUS" "MRDEF") ("KSRLUS" "MRRANK")("KSRLUS" "MRREL") ("KSRLUS" "MRSAT")
       ("KLRL" "MRCOC") ("KLRL" "MRSTY") ("KLRL" "MRXW_ENG") ("KLRL" "MRXNW_ENG")
       ("KLRLUS" "MRCOC") ("KLRLUS" "MRSTY") ("KLRLUS" "MRXW_ENG") ("KLRLUS" "MRXNW_ENG")
       ("KLRL" "MRXNS_ENG") ("KLRL" "MRXW_NONENG")
@@ -363,9 +388,9 @@ used in the United States. We create a new scale (SRLUS) where SRL to SRLUS mapp
 
 (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"
@@ -383,7 +408,7 @@ used in the United States. We create a new scale (SRLUS) where SRL to SRLUS mapp
        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))))
+                  :custom-value-fun (compile nil (nth 4 customcol)))))
 
 (defun gen-ucols-generic (col-filename)
 "Initialize for generic (LEX/NET) columns"

diff --git a/utils.lisp b/utils.lisp
index ba75eea82c7fb4074c3500a30e9f7523e1088e72..358a1413bbcca0741711fdd61be38cca11011241 100644 (file)
--- a/utils.lisp
+++ b/utils.lisp
@@ -35,10 +35,10 @@
 (defun parse-ui (s &optional (nullvalue 0))
   "Return integer value for a UMLS unique identifier."
   (declare (simple-string s)
-          (optimize (speed 3) (safety 0)))
+           (optimize (speed 3) (safety 0)))
   (if (< (length s) 2)
       nullvalue
-    (nth-value 0 (parse-integer s :start 1))))
+      (nth-value 0 (parse-integer s :start 1))))
 
 (defun parse-cui (cui)
   (declare (optimize (speed 3) (safety 0)))
@@ -115,9 +115,10 @@
 
 #-(or 64bit x86-64)
 (defun make-cuisui (cui sui)
-  (declare (fixnum cui sui)
-          (optimize (speed 3) (safety 0) (space 0)))
-  (+ (* +cuisui-scale+ cui) sui))
+  (when (and cui sui)
+    (locally (declare (fixnum cui sui)
+                      (optimize (speed 3) (safety 0) (space 0)))
+             (+ (* +cuisui-scale+ cui) sui))))
 
 #+(or 64bit x86-64)
 (defun make-cuilui (cui lui)