r11103: 2006 umls updates

diff --git a/class-support.lisp b/class-support.lisp
index a9fae985c89b54108da0d916d6c52c6c7ea19571..e7fe96025c47aa25126d121162bf286b68d4ea2c 100644 (file)
--- a/class-support.lisp
+++ b/class-support.lisp
@@ -87,10 +87,14 @@
 (defgeneric fmt-aui (aui))
 (when *has-fixnum-class*
   (defmethod fmt-aui ((aui fixnum))
 (defgeneric fmt-aui (aui))
 (when *has-fixnum-class*
   (defmethod fmt-aui ((aui fixnum))

-    (prefixed-fixnum-string aui #\A 7)))
+    (if (>= aui 10000000)
+      (prefixed-fixnum-string aui #\A 8)
+      (prefixed-fixnum-string aui #\A 7))))

 
 (defmethod fmt-aui ((aui integer))
 
 (defmethod fmt-aui ((aui integer))

-  (prefixed-integer-string aui #\A 7))
+  (if (>= aui 10000000)
+    (prefixed-integer-string aui #\A 8)
+    (prefixed-integer-string aui #\A 7)))

 
 (defmethod fmt-aui ((aui string))
   (if (eql (aref aui 0) #\A)
 
 (defmethod fmt-aui ((aui string))
   (if (eql (aref aui 0) #\A)


@@ -218,7 +222,7 @@
     (dolist (term (s#term ucon) (nreverse res))
       (dolist (str (s#str term))
        (push str res)))))
     (dolist (term (s#term ucon) (nreverse res))
       (dolist (str (s#str term))
        (push str res)))))

-                    
+

 
 (defmethod pfstr ((uterm uterm))
   "Return the preferred string for a uterm"
 
 (defmethod pfstr ((uterm uterm))
   "Return the preferred string for a uterm"


@@ -318,7 +322,7 @@
         ((char-equal #\O c)
          "Other"))))
 
         ((char-equal #\O c)
          "Other"))))
 

-           
+

 (defun ucon-parents (con &optional sab)
   (ucon-ancestors con sab t))
 
 (defun ucon-parents (con &optional sab)
   (ucon-ancestors con sab t))
 


@@ -327,7 +331,7 @@
   (let* ((parent-rels (filter-urels-by-rel (s#rel ucon) "par"))
         (anc nil))
     (when sab
   (let* ((parent-rels (filter-urels-by-rel (s#rel ucon) "par"))
         (anc nil))
     (when sab

-      (setq parent-rels (delete-if-not 
+      (setq parent-rels (delete-if-not

                         (lambda (rel) (string-equal sab (sab rel)))
                         parent-rels)))
     (dolist (rel parent-rels (nreverse anc))
                         (lambda (rel) (string-equal sab (sab rel)))
                         parent-rels)))
     (dolist (rel parent-rels (nreverse anc))


@@ -342,12 +346,12 @@
 (defmethod cxt-ancestors ((con ucon))
   (loop for term in (s#term con)
       append (cxt-ancestors term)))
 (defmethod cxt-ancestors ((con ucon))
   (loop for term in (s#term con)
       append (cxt-ancestors term)))

-                   
+

 
 (defmethod cxt-ancestors ((term uterm))
   (loop for str in (s#str term)
       append (cxt-ancestors str)))
 
 (defmethod cxt-ancestors ((term uterm))
   (loop for str in (s#str term)
       append (cxt-ancestors str)))

-    
+

 (defmethod cxt-ancestors ((str ustr))
   "Return the ancestory contexts of a ustr"
   (let* ((anc (remove-if-not
 (defmethod cxt-ancestors ((str ustr))
   "Return the ancestory contexts of a ustr"
   (let* ((anc (remove-if-not


@@ -364,7 +368,7 @@
         (sort anc-this-cxn (lambda (a b) (< (rank a) (rank b))))
         anc-lists)))))
 
         (sort anc-this-cxn (lambda (a b) (< (rank a) (rank b))))
         anc-lists)))))
 

-  
+

 #+scl
 (dolist (c '(urank udef usat uso ucxt ustr ulo uterm usty urel ucoc uatx ucon uxw uxnw uxns lexterm labr lagr lcmp lmod lnom lprn lprp lspl ltrm ltyp lwd sdef sstr sstre1 sstre2 usrl))
     (let ((cl (find-class c)))
 #+scl
 (dolist (c '(urank udef usat uso ucxt ustr ulo uterm usty urel ucoc uatx ucon uxw uxnw uxns lexterm labr lagr lcmp lmod lnom lprn lprp lspl ltrm ltyp lwd sdef sstr sstre1 sstre2 usrl))
     (let ((cl (find-class c)))

diff --git a/create-sql.lisp b/create-sql.lisp
index fdc444c9cf2bd8fb1279674bff3f8e5c0e414cf0..f2762861637a5422dc055db70f43fecc5bbaf844 100644 (file)
--- a/create-sql.lisp
+++ b/create-sql.lisp
@@ -46,7 +46,7 @@
                " MAX_ROWS=200000000"
              "")
            (if (eq *umls-sql-type* :mysql)
                " MAX_ROWS=200000000"
              "")
            (if (eq *umls-sql-type* :mysql)

-               " TYPE=MYISAM DEFAULT CHARACTER latin1"
+               " TYPE=MYISAM CHARACTER SET utf8"

                ""))))
 
 (defun create-custom-table-cmd (tablename sql-cmd)
                ""))))
 
 (defun create-custom-table-cmd (tablename sql-cmd)


@@ -277,18 +277,53 @@ This is much faster that using create-umls-db-insert."
   (translate-files (find-ufile "MRXW_NONENG.RRF")
                   extension (noneng-lang-index-files)))
 
   (translate-files (find-ufile "MRXW_NONENG.RRF")
                   extension (noneng-lang-index-files)))
 

+(defun verify-translation-file (output-path input-ufiles)
+  "Returns t if translation file exists and is correct size. Warns and deletes incomplete translation file."
+  (when (probe-file output-path)
+    (let ((translated-lines 0)
+          (input-lines 0)
+          (eof (cons nil nil)))
+      (catch 'done-counting
+        (with-open-file (ts output-path :direction :input
+                            #+(and clisp unicode) :external-format
+                            #+(and clisp unicode) charset:utf-8)
+          (do ()
+              ((eq (read-line ts nil eof) eof))
+            (incf translated-lines)))
+        (dolist (input-ufile input-ufiles)
+          (with-umls-ufile (line input-ufile)
+            (incf input-lines)
+            (when (> input-lines translated-lines)
+              (throw 'done-counting 'incomplete)))))
+      (cond
+        ((eql input-lines 0)
+          (error "Input lines is 0")
+          nil)
+        ((< input-lines translated-lines)
+          (format t "Translated file ~A incomplete, deleting...~%" output-path)
+          (delete-file output-path)
+          nil)
+        ((eql input-lines translated-lines)
+          (format t "Translated file ~A already exists: skipping...~%" output-path)
+          t)
+        ((> translated-lines input-lines)
+          (error "Shouldn't happen. Translated lines of ~A is ~D, greater than input lines ~D"
+                 output-path translated-lines input-lines)
+          (delete-file output-path)
+          nil)))))
+

 (defun translate-files (out-ufile extension input-ufiles)
   "Translate a umls file into a format suitable for sql copy cmd"
   (let ((output-path (ufile-pathname out-ufile extension)))
 (defun translate-files (out-ufile extension input-ufiles)
   "Translate a umls file into a format suitable for sql copy cmd"
   (let ((output-path (ufile-pathname out-ufile extension)))

-    (if (probe-file output-path)
-       (format t "File ~A already exists: skipping~%" output-path)
-      (with-open-file (ostream output-path :direction :output
-                               #+(and clisp unicode) :external-format
-                               #+(and clisp unicode) charset:utf-8)
-       (dolist (input-ufile input-ufiles)
-         (with-umls-ufile (line input-ufile)
-           (translate-line out-ufile line ostream)
-           (princ #\newline ostream)))))))
+    (when (verify-translation-file output-path input-ufiles)
+      (return-from translate-files output-path))
+    (with-open-file (ostream output-path :direction :output
+                             #+(and clisp unicode) :external-format
+                             #+(and clisp unicode) charset:utf-8)
+      (dolist (input-ufile input-ufiles)
+        (with-umls-ufile (line input-ufile)
+          (translate-line out-ufile line ostream)
+          (princ #\newline ostream))))))

 
 (defun translate-line (file line strm)
   "Translate a single line for sql output"
 
 (defun translate-line (file line strm)
   "Translate a single line for sql output"

diff --git a/parse-rrf.lisp b/parse-rrf.lisp
index 4c617a02655c539da1e370a52de14c7faec1dcdc..c34f3eec79ef9e54b7b04fb04a73df852f32a6a7 100644 (file)
--- a/parse-rrf.lisp
+++ b/parse-rrf.lisp
@@ -127,9 +127,16 @@
   "Custom tables to create")
 
 (defparameter +custom-cols+
   "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 (nth 0 x)))))
+      ;; Set to 1 if term is prefered term for english
+      ("MRCONSO.RRF" "KPFENG" "TINYINT" 0
+       (lambda (x)  (if (and (string-equal (nth 1 x) "ENG") ; LAT
+                             (string-equal (nth 2 x) "P") ; ts
+                             (string-equal (nth 4 x) "PF")) ; stt
+                      "1"
+                      "0")))

       ("MRCONSO.RRF" "KCUISUI" "BIGINT" 0
        (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 5 x))))))
       ("MRCONSO.RRF" "KCUILUI" "BIGINT" 0
       ("MRCONSO.RRF" "KCUISUI" "BIGINT" 0
        (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 5 x))))))
       ("MRCONSO.RRF" "KCUILUI" "BIGINT" 0


@@ -140,13 +147,6 @@
        (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))))))
        (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
       ("MRSTY.RRF" "KLRL" "SMALLINT" 0
        (lambda (x) (write-to-string (cui-lrl (parse-ui (nth 0 x))))))
       ("MRCOC.RRF" "KLRL" "SMALLINT" 0


@@ -161,8 +161,7 @@
        (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)))))
        (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)))))
+      #+nil  ("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))
       ("MRXW_ENG.RRF" "KLRL" "SMALLINT" 0
        (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
                                                 (parse-ui (nth 2 x))


@@ -179,12 +178,12 @@
        (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
                                                 (parse-ui (nth 2 x))
                                                 (parse-ui (nth 4 x)))))))
        (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))))))
+
+      ;; FIXME: For MRREF and MRCOC, add lookups to KPFSTR2 using new MRCONSO index KPFENG
+
+      #+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)))))
+      #+use-mrctx  ("MRCXT.RRF" "KCUISUI" "BIGINT" 0 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 1 x))))))

       ("MRSAT.RRF" "KCUILUI" "BIGINT" 0
        (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 1 x))))))
       ("MRSAT.RRF" "KCUISUI" "BIGINT" 0
       ("MRSAT.RRF" "KCUILUI" "BIGINT" 0
        (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 1 x))))))
       ("MRSAT.RRF" "KCUISUI" "BIGINT" 0


@@ -206,21 +205,23 @@
 
 (defparameter +index-cols+
     '(("CUI1" "MRCOC") ("CUI" "MRCONSO") ("LUI" "MRCONSO")
 
 (defparameter +index-cols+
     '(("CUI1" "MRCOC") ("CUI" "MRCONSO") ("LUI" "MRCONSO")

-      ("SRL" "MRCONSO") ("AUI" "MRCONSO")
-      ("SUI" "MRCONSO") ("CUI" "MRCXT") ("CUI" "MRDEF") ("CUI" "MRLO")
+      ("SRL" "MRCONSO") ("AUI" "MRCONSO") ("KPFENG" "MRCONSO")
+      ("SUI" "MRCONSO") ("CUI" "MRDEF")

       ("CUI1" "MRREL") ("CUI" "MRSAT") ("LUI" "MRSAT") ("SUI" "MRSAT")
       ("CUI" "MRSTY")
       ("TUI" "MRSTY") ("CUI" "MRXNS_ENG")
       ("CUI1" "MRREL") ("CUI" "MRSAT") ("LUI" "MRSAT") ("SUI" "MRSAT")
       ("CUI" "MRSTY")
       ("TUI" "MRSTY") ("CUI" "MRXNS_ENG")

+      ;; ("CUI" "MRCXT") ("KCUISUI" "MRCXT") ("KSRL" "MRCXT")
+      ("AUI" "MRHIER") ("PTR" "MRHIER") ("CUI" "MRHIER") ("CXN" "MRHIER") ("RELA" "MRHIER") ("PAUI" "MRHIER")
+      ("SAB" "MRHIER")

       #+ignore ("NSTR" "MRXNS_ENG" 10)
       ("CUI" "MRXNW_ENG") ("NWD" "MRXNW_ENG") ("WD" "MRXW_ENG")
       ("KCUISUI" "MRCONSO") ("KCUILUI" "MRCONSO") ("KCUILRL" "MRCONSO")
       #+ignore ("NSTR" "MRXNS_ENG" 10)
       ("CUI" "MRXNW_ENG") ("NWD" "MRXNW_ENG") ("WD" "MRXW_ENG")
       ("KCUISUI" "MRCONSO") ("KCUILUI" "MRCONSO") ("KCUILRL" "MRCONSO")

-      ("KLUILRL" "MRCONSO") ("KCUISUI" "MRCXT")
+      ("KLUILRL" "MRCONSO")

       ("KCUISUI" "MRSAT")  ("KCUILUI" "MRSAT")
       ("KCUISUI" "MRXW_ENG") ("KCUISUI" "MRXNW_ENG")
       ("KCUISUI" "MRXNS_ENG") ("KCUISUI" "MRXW_NONENG")
       ("KCUISUI" "MRSAT")  ("KCUILUI" "MRSAT")
       ("KCUISUI" "MRXW_ENG") ("KCUISUI" "MRXNW_ENG")
       ("KCUISUI" "MRXNS_ENG") ("KCUISUI" "MRXW_NONENG")

-      ("KSRL" "MRCXT") ("KSRL" "MRDEF") ("KSRL" "MRRANK")
+      ("KSRL" "MRDEF") ("KSRL" "MRRANK")

       ("KSRL" "MRREL") ("KSRL" "MRSAT") ("KLRL" "MRCOC")
       ("KSRL" "MRREL") ("KSRL" "MRSAT") ("KLRL" "MRCOC")

-      #+ignore ("KLRL" "MRLO")  ;; deprecated

       ("KLRL" "MRSTY") ("KLRL" "MRXW_ENG") ("KLRL" "MRXNW_ENG")
       ("KLRL" "MRXNS_ENG") ("KLRL" "MRXW_NONENG")
       ;; LEX indices
       ("KLRL" "MRSTY") ("KLRL" "MRXW_ENG") ("KLRL" "MRXNW_ENG")
       ("KLRL" "MRXNS_ENG") ("KLRL" "MRXW_NONENG")
       ;; LEX indices


@@ -235,7 +236,7 @@
 
       ("SRL" "MRSAB") ("RSAB" "MRSAB") ("VSAB" "MRSAB") ("RCUI" "MRSAB")
       ("VCUI" "MRSAB") ("LAT" "MRSAB") ("MAPSETCUI" "MRMAP")  ("MAPSETCUI" "MRSMAP")
 
       ("SRL" "MRSAB") ("RSAB" "MRSAB") ("VSAB" "MRSAB") ("RCUI" "MRSAB")
       ("VCUI" "MRSAB") ("LAT" "MRSAB") ("MAPSETCUI" "MRMAP")  ("MAPSETCUI" "MRSMAP")

-      ("CUI" "MRHIER") ("AUI" "MRHIER") ("PAUI" "MRHIER"))
+      ("CUI" "MRHIER"))

   "Columns in files to index")
 
 
   "Columns in files to index")
 
 

diff --git a/sql-classes.lisp b/sql-classes.lisp
index 293c961b43157fb7d6af9c7fa97c696a0a325bf1..d38df6928f2281b8bdfff217b03dc8df58636ad6 100644 (file)
--- a/sql-classes.lisp
+++ b/sql-classes.lisp
@@ -59,7 +59,7 @@
                          &key (lrl "KCUILRL") single distinct order like)
   (concatenate
    'string
                          &key (lrl "KCUILRL") single distinct order like)
   (concatenate
    'string

-   (format nil "select ~A~{~:@(~A~)~^,~} from ~:@(~A~)" 
+   (format nil "select ~A~{~:@(~A~)~^,~} from ~:@(~A~)"

           (if distinct "distinct " "") fields table)
    (if where-name (format nil " where ~:@(~A~)" where-name) "")
    (if where-name
           (if distinct "distinct " "") fields table)
    (if where-name (format nil " where ~:@(~A~)" where-name) "")
    (if where-name


@@ -82,7 +82,7 @@
   "Query the UMLisp database. Return a list of umlisp objects whose name
 is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   `(,query-cmd
   "Query the UMLisp database. Return a list of umlisp objects whose name
 is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   `(,query-cmd

-    (query-string ,table ,fields ,srl ,where-name ,where-value 
+    (query-string ,table ,fields ,srl ,where-name ,where-value

      :lrl ,lrl :single ,single :distinct ,distinct :order ,order :like ,like)))
 
 (defmacro umlisp-query-eval (table fields srl where-name where-value
      :lrl ,lrl :single ,single :distinct ,distinct :order ,order :like ,like)))
 
 (defmacro umlisp-query-eval (table fields srl where-name where-value


@@ -90,7 +90,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   "Query the UMLisp database. Return a list of umlisp objects whose name
 is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   `(mutex-sql-query
   "Query the UMLisp database. Return a list of umlisp objects whose name
 is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   `(mutex-sql-query

-    (query-string-eval ,table ,fields ,srl ,where-name ,where-value 
+    (query-string-eval ,table ,fields ,srl ,where-name ,where-value

      :lrl ,lrl :single ,single :distinct ,distinct :order ,order :like ,like)))
 
 ;; only WHERE-VALUE and SRL are evaluated
      :lrl ,lrl :single ,single :distinct ,distinct :order ,order :like ,like)))
 
 ;; only WHERE-VALUE and SRL are evaluated


@@ -99,7 +99,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
                                    order like (query-cmd 'mutex-sql-query))
                                &body body)
   (let ((value (gensym))
                                    order like (query-cmd 'mutex-sql-query))
                                &body body)
   (let ((value (gensym))

-       (r (gensym))) 
+       (r (gensym)))

     (if single
        `(let* ((,value ,where-value)
                (tuple (car (umlisp-query ,table ,fields ,srl ,where-name ,value
     (if single
        `(let* ((,value ,where-value)
                (tuple (car (umlisp-query ,table ,fields ,srl ,where-name ,value


@@ -247,7 +247,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-ucon-all (&key (srl *current-srl*))
   "Return list of all ucon's"
   (with-sql-connection (db)
 (defun find-ucon-all (&key (srl *current-srl*))
   "Return list of all ucon's"
   (with-sql-connection (db)

-    (clsql:map-query 
+    (clsql:map-query

      'list
      #'(lambda (tuple)
         (destructuring-bind (cui pfstr cuilrl) tuple
      'list
      #'(lambda (tuple)
         (destructuring-bind (cui pfstr cuilrl) tuple


@@ -275,7 +275,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun map-ucon-all (fn &key (srl *current-srl*))
   "Map a function over all ucon's"
   (with-sql-connection (db)
 (defun map-ucon-all (fn &key (srl *current-srl*))
   "Map a function over all ucon's"
   (with-sql-connection (db)

-    (clsql:map-query 
+    (clsql:map-query

      nil
      #'(lambda (tuple)
         (destructuring-bind (cui pfstr cuilrl) tuple
      nil
      #'(lambda (tuple)
         (destructuring-bind (cui pfstr cuilrl) tuple


@@ -304,12 +304,12 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
     (make-instance 'udoc :key dockey :value value :type type :expl expl)))
 
 (defun find-udoc-key-value (key value)
     (make-instance 'udoc :key dockey :value value :type type :expl expl)))
 
 (defun find-udoc-key-value (key value)

-  (let ((tuple (car (mutex-sql-query 
+  (let ((tuple (car (mutex-sql-query

                     (format nil "SELECT TYPE,EXPL FROM MRDOC WHERE DOCKEY='~A' AND VALUE='~A'"
                             key value)))))
     (when tuple
       (make-instance 'udoc :key key :value value :type (first tuple) :expl (second tuple)))))
                     (format nil "SELECT TYPE,EXPL FROM MRDOC WHERE DOCKEY='~A' AND VALUE='~A'"
                             key value)))))
     (when tuple
       (make-instance 'udoc :key key :value value :type (first tuple) :expl (second tuple)))))

-                                    
+

 (defun find-udoc-all ()
   "Return all abbreviation documentation"
   (collect-umlisp-query (mrdoc (dockey value type expl) nil nil nil)
 (defun find-udoc-all ()
   "Return all abbreviation documentation"
   (collect-umlisp-query (mrdoc (dockey value type expl) nil nil nil)


@@ -386,18 +386,10 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-ucon-coc-cui2 (cui2 &key (srl *current-srl*))
   "List of ucon with co-occurance cui2"
   (ensure-cui-integer cui2)
 (defun find-ucon-coc-cui2 (cui2 &key (srl *current-srl*))
   "List of ucon with co-occurance cui2"
   (ensure-cui-integer cui2)

-  (mapcar 
+  (mapcar

    #'(lambda (cui) (find-ucon-cui cui :srl srl))
    (remove-duplicates (mapcar #'cui1 (find-ucoc-cui2 cui2 :srl srl)))))
 
    #'(lambda (cui) (find-ucon-cui cui :srl srl))
    (remove-duplicates (mapcar #'cui1 (find-ucoc-cui2 cui2 :srl srl)))))
 

-(defun find-ulo-cui (cui &key (srl *current-srl*))
-  "Return a list of ulo for cui"
-  (ensure-cui-integer cui)
-  (collect-umlisp-query (mrlo (isn fr un sui sna soui) srl cui cui
-                          :lrl "KLRL")
-    (make-instance 'ulo :isn isn :fr (ensure-integer fr) :un un
-                  :sui (ensure-integer sui) :sna sna :soui soui)))
-

 
 (defun find-uterm-cui (cui &key (srl *current-srl*))
   "Return a list of uterm for cui"
 
 (defun find-uterm-cui (cui &key (srl *current-srl*))
   "Return a list of uterm for cui"


@@ -410,7 +402,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-uterm-lui (lui &key (srl *current-srl*))
   "Return a list of uterm for lui"
   (ensure-lui-integer lui)
 (defun find-uterm-lui (lui &key (srl *current-srl*))
   "Return a list of uterm for lui"
   (ensure-lui-integer lui)

-  (collect-umlisp-query (mrconso (cui lat ts kluilrl) srl lui lui 
+  (collect-umlisp-query (mrconso (cui lat ts kluilrl) srl lui lui

                             :lrl kluilrl :distinct t)
     (make-instance 'uterm :cui (ensure-integer cui) :lui lui
                   :lat lat :ts ts :lrl (ensure-integer kluilrl))))
                             :lrl kluilrl :distinct t)
     (make-instance 'uterm :cui (ensure-integer cui) :lui lui
                   :lat lat :ts ts :lrl (ensure-integer kluilrl))))


@@ -454,12 +446,12 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
                   :cuisui (make-cuisui (ensure-integer cui) sui)
                   :suppress suppress
                   :lui (ensure-integer lui) :lrl (ensure-integer ksuilrl))))
                   :cuisui (make-cuisui (ensure-integer cui) sui)
                   :suppress suppress
                   :lui (ensure-integer lui) :lrl (ensure-integer ksuilrl))))

-      
+

 (defun find-ustr-sab (sab &key (srl *current-srl*))
   "Return the list of ustr for sab"
   (collect-umlisp-query (mrconso (kcuisui) srl sab sab :lrl srl)
     (let ((cuisui (ensure-integer kcuisui)))
 (defun find-ustr-sab (sab &key (srl *current-srl*))
   "Return the list of ustr for sab"
   (collect-umlisp-query (mrconso (kcuisui) srl sab sab :lrl srl)
     (let ((cuisui (ensure-integer kcuisui)))

-      (apply #'find-ustr-cuisui 
+      (apply #'find-ustr-cuisui

             (append
              (multiple-value-list (decompose-cuisui cuisui))
              (list :srl srl))))))
             (append
              (multiple-value-list (decompose-cuisui cuisui))
              (list :srl srl))))))


@@ -467,7 +459,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-ustr-all (&key (srl *current-srl*))
   "Return list of all ustr's"
     (with-sql-connection (db)
 (defun find-ustr-all (&key (srl *current-srl*))
   "Return list of all ustr's"
     (with-sql-connection (db)

-      (clsql:map-query 
+      (clsql:map-query

        'list
        #'(lambda (tuple)
           (destructuring-bind (cui lui sui stt ksuilrl suppress pfstr) tuple
        'list
        #'(lambda (tuple)
           (destructuring-bind (cui lui sui stt ksuilrl suppress pfstr) tuple


@@ -548,7 +540,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
                        "' and lui='0' and sui='0'")))
     (when srl
       (string-append ls " and KSRL<=" (prefixed-fixnum-string srl nil 3)))
                        "' and lui='0' and sui='0'")))
     (when srl
       (string-append ls " and KSRL<=" (prefixed-fixnum-string srl nil 3)))

-    (loop for tuple in (mutex-sql-query ls) collect 
+    (loop for tuple in (mutex-sql-query ls) collect

          (destructuring-bind (code atn sab atv) tuple
            (make-instance 'usat :code code :atn atn :sab sab :atv atv)))))
 
          (destructuring-bind (code atn sab atv) tuple
            (make-instance 'usat :code code :atn atn :sab sab :atv atv)))))
 


@@ -573,7 +565,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   (collect-umlisp-query (mrsab (vcui rcui vsab rsab son sf sver vstart vend imeta
                                  rmeta slc scc srl tfr cfr cxty ttyl atnl lat
                                  cenc curver sabin ssn scit) nil nil nil)
   (collect-umlisp-query (mrsab (vcui rcui vsab rsab son sf sver vstart vend imeta
                                  rmeta slc scc srl tfr cfr cxty ttyl atnl lat
                                  cenc curver sabin ssn scit) nil nil nil)

-    (make-instance 'usab :vcui (ensure-integer vcui) 
+    (make-instance 'usab :vcui (ensure-integer vcui)

                   :rcui (ensure-integer rcui) :vsab vsab :rsab rsab :son son
                   :sf sf :sver sver :vstart vstart :vend vend :imeta imeta
                   :rmeta rmeta :slc slc :scc scc  :srl (ensure-integer srl)
                   :rcui (ensure-integer rcui) :vsab vsab :rsab rsab :son son
                   :sf sf :sver sver :vstart vstart :vend vend :imeta imeta
                   :rmeta rmeta :slc slc :scc scc  :srl (ensure-integer srl)


@@ -588,7 +580,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
                                       ttyl atnl lat cenc curver sabin
                                       ssn scit)
                                     nil key-name key :single t)
                                       ttyl atnl lat cenc curver sabin
                                       ssn scit)
                                     nil key-name key :single t)

-     (make-instance 'usab :vcui (ensure-integer vcui) 
+     (make-instance 'usab :vcui (ensure-integer vcui)

                    :rcui (ensure-integer rcui) :vsab vsab :rsab rsab :son son
                    :sf sf :sver sver :vstart vstart :vend vend :imeta imeta
                    :rmeta rmeta :slc slc :scc scc :srl (ensure-integer srl)
                    :rcui (ensure-integer rcui) :vsab vsab :rsab rsab :son son
                    :sf sf :sver sver :vstart vstart :vend vend :imeta imeta
                    :rmeta rmeta :slc slc :scc scc :srl (ensure-integer srl)


@@ -629,7 +621,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   (ensure-tui-integer tui)
   (collect-umlisp-query (mrsty (cui) srl tui tui :lrl klrl :order (cui asc))
     (find-ucon-cui (ensure-integer cui) :srl srl)))
   (ensure-tui-integer tui)
   (collect-umlisp-query (mrsty (cui) srl tui tui :lrl klrl :order (cui asc))
     (find-ucon-cui (ensure-integer cui) :srl srl)))

-  
+

 (defun find-ucon-word (word &key (srl *current-srl*) (like nil))
   "Return list of ucons that match word. Optionally, use SQL's LIKE syntax"
   (collect-umlisp-query-eval ('mrxw_eng '(cui) srl 'wd word :like like :distinct t
 (defun find-ucon-word (word &key (srl *current-srl*) (like nil))
   "Return list of ucons that match word. Optionally, use SQL's LIKE syntax"
   (collect-umlisp-query-eval ('mrxw_eng '(cui) srl 'wd word :like like :distinct t


@@ -709,7 +701,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   (let ((uobjs '()))
     (dolist (word (delimited-string-to-list str #\space))
       (setq uobjs (append uobjs (funcall obj-lookup-fun word :srl srl))))
   (let ((uobjs '()))
     (dolist (word (delimited-string-to-list str #\space))
       (setq uobjs (append uobjs (funcall obj-lookup-fun word :srl srl))))

-    (let ((sorted 
+    (let ((sorted

           (funcall sort-fun str
                    (delete-duplicates uobjs :test #'= :key key))))
       (if (and (plusp (length sorted))
           (funcall sort-fun str
                    (delete-duplicates uobjs :test #'= :key key))))
       (if (and (plusp (length sorted))


@@ -717,7 +709,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
               (multiword-match str (pfstr (first sorted))))
          (first sorted)
        sorted))))
               (multiword-match str (pfstr (first sorted))))
          (first sorted)
        sorted))))

-    
+

 (defun find-ucon-multiword (str &key (srl *current-srl*)
                                     (only-exact-if-match t))
   (find-uobj-multiword str #'find-ucon-word #'sort-score-pfstr-str
 (defun find-ucon-multiword (str &key (srl *current-srl*)
                                     (only-exact-if-match t))
   (find-uobj-multiword str #'find-ucon-word #'sort-score-pfstr-str


@@ -732,7 +724,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
                                     (only-exact-if-match t))
   (find-uobj-multiword str #'find-ustr-word #'sort-score-ustr-str
                       #'sui srl only-exact-if-match))
                                     (only-exact-if-match t))
   (find-uobj-multiword str #'find-ustr-word #'sort-score-ustr-str
                       #'sui srl only-exact-if-match))

-       
+

 (defun sort-score-pfstr-str (str uobjs)
   "Return list of sorted and scored ucons. Score by match of str to ucon-pfstr"
   (sort-score-umlsclass-str uobjs str #'pfstr))
 (defun sort-score-pfstr-str (str uobjs)
   "Return list of sorted and scored ucons. Score by match of str to ucon-pfstr"
   (sort-score-umlsclass-str uobjs str #'pfstr))


@@ -745,7 +737,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   "Sort a list of objects based on scoring to a string"
   (let ((scored '()))
     (dolist (obj objs)
   "Sort a list of objects based on scoring to a string"
   (let ((scored '()))
     (dolist (obj objs)

-      (push (list obj (score-multiword-match str (funcall lookup-func obj))) 
+      (push (list obj (score-multiword-match str (funcall lookup-func obj)))

        scored))
     (mapcar #'car (sort scored #'> :key #'cadr))))
 
        scored))
     (mapcar #'car (sort scored #'> :key #'cadr))))
 


@@ -766,7 +758,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 
 (defun find-labr-eui (eui)
   (ensure-eui-integer eui)
 
 (defun find-labr-eui (eui)
   (ensure-eui-integer eui)

-  (collect-umlisp-query (lrabr (bas abr eui2 bas2) nil eui eui) 
+  (collect-umlisp-query (lrabr (bas abr eui2 bas2) nil eui eui)

     (make-instance 'labr :eui eui :bas bas :abr abr :bas2 bas2
                   :eui2 (ensure-integer eui2))))
 
     (make-instance 'labr :eui eui :bas bas :abr abr :bas2 bas2
                   :eui2 (ensure-integer eui2))))
 


@@ -815,7 +807,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 
 (defun find-ltrm-eui (eui)
   (ensure-eui-integer eui)
 
 (defun find-ltrm-eui (eui)
   (ensure-eui-integer eui)

-  (collect-umlisp-query (lrtrm (bas gen) nil eui eui) 
+  (collect-umlisp-query (lrtrm (bas gen) nil eui eui)

     (make-instance 'ltrm :eui eui :bas bas :gen gen)))
 
 (defun find-ltyp-eui (eui)
     (make-instance 'ltrm :eui eui :bas bas :gen gen)))
 
 (defun find-ltyp-eui (eui)


@@ -868,7 +860,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   (with-sql-connection (conn)
     (ignore-errors (sql-execute "drop table USTATS" conn))
     (sql-execute "create table USTATS (NAME varchar(160), COUNT bigint, SRL integer)" conn)
   (with-sql-connection (conn)
     (ignore-errors (sql-execute "drop table USTATS" conn))
     (sql-execute "create table USTATS (NAME varchar(160), COUNT bigint, SRL integer)" conn)

-    
+

     (dotimes (srl 5)
       (insert-ustats-count conn "Concept Count" "MRCONSO" "distinct CUI" "KCUILRL" srl)
       (insert-ustats-count conn "Term Count" "MRCONSO" "distinct KCUILUI" "KCUILRL" srl)
     (dotimes (srl 5)
       (insert-ustats-count conn "Concept Count" "MRCONSO" "distinct CUI" "KCUILRL" srl)
       (insert-ustats-count conn "Term Count" "MRCONSO" "distinct KCUILUI" "KCUILRL" srl)


@@ -897,13 +889,13 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-count-table (conn table srl count-variable srl-control)
   (cond
    ((stringp srl-control)
 (defun find-count-table (conn table srl count-variable srl-control)
   (cond
    ((stringp srl-control)

-    (ensure-integer 
-     (caar (sql-query (format nil "select count(~a) from ~a where ~a <= ~d" 
+    (ensure-integer
+     (caar (sql-query (format nil "select count(~a) from ~a where ~a <= ~d"

                              count-variable table srl-control srl)
                      conn))))
    ((null srl-control)
     (ensure-integer
                              count-variable table srl-control srl)
                      conn))))
    ((null srl-control)
     (ensure-integer

-     (caar (sql-query (format nil "select count(~a) from ~a" 
+     (caar (sql-query (format nil "select count(~a) from ~a"

                              count-variable table )
                      conn))))
    (t
                              count-variable table )
                      conn))))
    (t


@@ -911,8 +903,8 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
     0)))
 
 (defun insert-ustats (conn name count srl)
     0)))
 
 (defun insert-ustats (conn name count srl)

-  (sql-execute (format nil "insert into USTATS (name,count,srl) values ('~a',~d,~d)" 
-                      name count (if srl srl 3)) 
+  (sql-execute (format nil "insert into USTATS (name,count,srl) values ('~a',~d,~d)"
+                      name count (if srl srl 3))

               conn))
 
 (defun find-ustats-all (&key (srl *current-srl*))
               conn))
 
 (defun find-ustats-all (&key (srl *current-srl*))


@@ -927,7 +919,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
                          (make-instance 'ustats :name name
                                         :hits (ensure-integer count)
                                         :srl (ensure-integer srl)))))
                          (make-instance 'ustats :name name
                                         :hits (ensure-integer count)
                                         :srl (ensure-integer srl)))))

-  
+

 (defun find-ustats-srl (srl)
   (collect-umlisp-query (ustats (name count) nil srl srl :order (name asc))
                           (make-instance 'ustats :name name :hits (ensure-integer count))))
 (defun find-ustats-srl (srl)
   (collect-umlisp-query (ustats (name count) nil srl srl :order (name asc))
                           (make-instance 'ustats :name name :hits (ensure-integer count))))