r11140: do not export internal functions

[umlisp.git] / sql-classes.lisp

diff --git a/sql-classes.lisp b/sql-classes.lisp
index e70c638d3a485963e4abe5875219b15751ccb811..2831defc003504ff2c1f488793d013a80d612535 100644 (file)
--- a/sql-classes.lisp
+++ b/sql-classes.lisp
@@ -10,7 +10,7 @@
 ;;;; $Id$
 ;;;;
 ;;;; This file, part of UMLisp, is
 ;;;; $Id$
 ;;;;
 ;;;; This file, part of UMLisp, is

-;;;;    Copyright (c) 2000-2003 by Kevin M. Rosenberg, M.D.
+;;;;    Copyright (c) 2000-2006 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.
 ;;;;
 ;;;; UMLisp users are granted the rights to distribute and use this software
 ;;;; as governed by the terms of the GNU General Public License.


@@ -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


@@ -187,9 +187,21 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-ucon-cui (cui &key (srl *current-srl*))
   "Find ucon for a cui"
   (ensure-cui-integer cui)
 (defun find-ucon-cui (cui &key (srl *current-srl*))
   "Find ucon for a cui"
   (ensure-cui-integer cui)

-  (collect-umlisp-query (mrconso (kpfstr kcuilrl) srl cui cui :single t)
-    (make-instance 'ucon :cui cui :pfstr kpfstr
-                  :lrl (ensure-integer kcuilrl))))
+  (unless cui (return-from find-ucon-cui nil))
+
+  (let ((tuple (car (mutex-sql-query 
+                     (format nil
+                             "SELECT kcuilrl,str FROM MRCONSO WHERE CUI=~D AND KPFENG=1~A"
+                             cui (if srl (format nil " AND SRL<=~D" srl) ""))))))
+    (unless tuple
+      (setq tuple (car (mutex-sql-query
+                        (format nil
+                                "SELECT kcuilrl,str FROM MRCONSO WHERE CUI=~D"
+                                cui (if srl (format nil " AND SRL<=~D" srl) nil))))))
+    (unless tuple
+      (return-from find-ucon-cui nil))
+    (make-instance 'ucon :cui cui :pfstr (second tuple)
+                   :lrl (ensure-integer (first tuple)))))

 
 (defun find-ucon-cui-sans-pfstr (cui &key (srl *current-srl*))
   "Find ucon for a cui"
 
 (defun find-ucon-cui-sans-pfstr (cui &key (srl *current-srl*))
   "Find ucon for a cui"


@@ -201,30 +213,45 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-pfstr-cui (cui &key (srl *current-srl*))
   "Find preferred string for a cui"
   (ensure-cui-integer cui)
 (defun find-pfstr-cui (cui &key (srl *current-srl*))
   "Find preferred string for a cui"
   (ensure-cui-integer cui)

-  (collect-umlisp-query (mrconso (kpfstr) srl cui cui :single t)
-    kpfstr))
-
+  (or
+    (caar (mutex-sql-query
+           (format nil "SELECT DISTINCT str FROM MRCONSO WHERE CUI=~D AND KPFENG=1~A LIMIT 1"
+                   cui (if srl (format nil " AND SRL<=~D" srl) ""))))
+    (caar (mutex-sql-query
+           (format nil "SELECT DISTINCT str FROM MRCONSO WHERE CUI=~D~A LIMIT 1"
+                   cui (if srl (format nil " AND SRL<=~D" srl) ""))))))

 
 (defun find-ucon-lui (lui &key (srl *current-srl*))
   "Find list of ucon for lui"
   (ensure-lui-integer lui)
 
 (defun find-ucon-lui (lui &key (srl *current-srl*))
   "Find list of ucon for lui"
   (ensure-lui-integer lui)

-  (collect-umlisp-query (mrconso (cui kpfstr kcuilrl) srl lui lui
+  (collect-umlisp-query (mrconso (cui kcuilrl) srl lui lui

                            :distinct t)
                            :distinct t)

-    (make-instance 'ucon :cui (ensure-integer cui) :pfstr kpfstr
-                  :lrl (ensure-integer kcuilrl))))
+     (make-instance 'ucon :cui (ensure-integer cui) :pfstr (find-pfstr-cui cui)
+                  :lrl (ensure-integer kcuilrl)))
+  (unless lui (return-from find-ucon-lui nil))
+
+  (let ((tuple (car (mutex-sql-query "SELECT cui,kcuilrl,str FROM MRCONSO WHERE LUI=~D AND KPFENG=1~A ORDER BY kcuilrl ASC LIMIT 1"
+                                     lui (if srl (format nil " AND SRL<=~D" srl) "")))))
+    (unless tuple
+      (setq tuple (car (mutex-sql-query "SELECT cui,kcuilrl,str FROM MRCONSO WHERE LUI=~D~A ORDER BY kcuilrl ASC LIMIT 1"
+                                        lui (if srl (format nil " AND SRL<=~D" srl) "")))))
+    (unless tuple
+      (return-from find-ucon-lui nil))
+    (make-instance 'ucon :cui (first tuple) :pfstr (third tuple)
+                   :lrl (ensure-integer (third tuple)))))

 
 (defun find-ucon-sui (sui &key (srl *current-srl*))
   "Find list of ucon for sui"
   (ensure-sui-integer sui)
 
 (defun find-ucon-sui (sui &key (srl *current-srl*))
   "Find list of ucon for sui"
   (ensure-sui-integer sui)

-  (collect-umlisp-query (mrconso (cui kpfstr kcuilrl) srl sui sui :distinct t)
-    (make-instance 'ucon :cui (ensure-integer cui) :pfstr kpfstr
+  (collect-umlisp-query (mrconso (cui kcuilrl) srl sui sui :distinct t)
+    (make-instance 'ucon :cui (ensure-integer cui) :pfstr (find-pfstr-cui cui)

                   :lrl (ensure-integer kcuilrl))))
 
 (defun find-ucon-aui (aui &key (srl *current-srl*))
   "Find list of ucon for aui"
   (ensure-sui-integer aui)
                   :lrl (ensure-integer kcuilrl))))
 
 (defun find-ucon-aui (aui &key (srl *current-srl*))
   "Find list of ucon for aui"
   (ensure-sui-integer aui)

-  (collect-umlisp-query (mrconso (cui kpfstr kcuilrl) srl aui aui :distinct t)
-    (make-instance 'ucon :cui (ensure-integer cui) :pfstr kpfstr
+  (collect-umlisp-query (mrconso (cui kcuilrl) srl aui aui :distinct t)
+    (make-instance 'ucon :cui (ensure-integer cui) :pfstr (find-pfstr-cui cui)

                   :lrl (ensure-integer kcuilrl))))
 
 (defun find-ucon-cuisui (cui sui &key (srl *current-srl*))
                   :lrl (ensure-integer kcuilrl))))
 
 (defun find-ucon-cuisui (cui sui &key (srl *current-srl*))


@@ -232,38 +259,38 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   (ensure-cui-integer cui)
   (ensure-sui-integer sui)
   (when (and cui sui)
   (ensure-cui-integer cui)
   (ensure-sui-integer sui)
   (when (and cui sui)

-    (collect-umlisp-query (mrconso (kpfstr kcuilrl) srl kcuisui
+    (collect-umlisp-query (mrconso (kcuilrl) srl kcuisui

                              (make-cuisui cui sui))
       (make-instance 'ucon :cui cui
                              (make-cuisui cui sui))
       (make-instance 'ucon :cui cui

-                    :pfstr kpfstr
+                    :pfstr (find-pfstr-cui cui)

                     :lrl (ensure-integer kcuilrl)))))
 
 (defun find-ucon-str (str &key (srl *current-srl*))
   "Find ucon that are exact match for str"
                     :lrl (ensure-integer kcuilrl)))))
 
 (defun find-ucon-str (str &key (srl *current-srl*))
   "Find ucon that are exact match for str"

-  (collect-umlisp-query (mrconso (cui kpfstr kcuilrl) srl str str :distinct t)
-    (make-instance 'ucon :cui (ensure-integer cui) :pfstr kpfstr
+  (collect-umlisp-query (mrconso (cui kcuilrl) srl str str :distinct t)
+    (make-instance 'ucon :cui (ensure-integer cui) :pfstr (find-pfstr-cui cui)

                   :lrl (ensure-integer kcuilrl))))
 
 (defun find-ucon-all (&key (srl *current-srl*))
   "Return list of all ucon's"
   (with-sql-connection (db)
                   :lrl (ensure-integer kcuilrl))))
 
 (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)
      'list
      #'(lambda (tuple)

-        (destructuring-bind (cui pfstr cuilrl) tuple
+        (destructuring-bind (cui cuilrl) tuple

             (make-instance 'ucon :cui (ensure-integer cui)
             (make-instance 'ucon :cui (ensure-integer cui)

-                           :pfstr pfstr
-                       :lrl (ensure-integer cuilrl))))
-     (query-string mrconso (cui kpfstr kcuilrl) srl nil nil
+                           :pfstr (find-pfstr-cui cui)
+                            :lrl (ensure-integer cuilrl))))
+     (query-string mrconso (cui kcuilrl) srl nil nil

                   :order (cui asc) :distinct t)
      :database db)))
 
 (defun find-ucon-all2 (&key (srl *current-srl*))
   "Return list of all ucon's"
                   :order (cui asc) :distinct t)
      :database db)))
 
 (defun find-ucon-all2 (&key (srl *current-srl*))
   "Return list of all ucon's"

-  (collect-umlisp-query (mrconso (cui kpfstr kcuilrl) srl nil nil :order (cui asc)
+  (collect-umlisp-query (mrconso (cui kcuilrl) srl nil nil :order (cui asc)

                            :distinct t)
     (make-instance 'ucon :cui (ensure-integer cui)
                            :distinct t)
     (make-instance 'ucon :cui (ensure-integer cui)

-                  :pfstr kpfstr
+                  :pfstr (find-pfstr-cui cui)

                   :lrl (ensure-integer kcuilrl))))
 
 (defun find-cui-ucon-all (&key (srl *current-srl*))
                   :lrl (ensure-integer kcuilrl))))
 
 (defun find-cui-ucon-all (&key (srl *current-srl*))


@@ -275,14 +302,14 @@ 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)
      nil
      #'(lambda (tuple)

-        (destructuring-bind (cui pfstr cuilrl) tuple
+        (destructuring-bind (cui cuilrl) tuple

           (funcall fn (make-instance 'ucon :cui (ensure-integer cui)
           (funcall fn (make-instance 'ucon :cui (ensure-integer cui)

-                                     :pfstr pfstr
+                                     :pfstr (find-pfstr-cui cui)

                                      :lrl (ensure-integer cuilrl)))))
                                      :lrl (ensure-integer cuilrl)))))

-     (query-string mrconso (cui kpfstr kcuilrl) srl nil nil :order (cui asc)
+     (query-string mrconso (cui kcuilrl) srl nil nil :order (cui asc)

                   :distinct t)
      :database db)))
 
                   :distinct t)
      :database db)))
 


@@ -304,12 +331,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)


@@ -330,12 +357,12 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-urel-cui (cui &key (srl *current-srl*))
   "Return a list of urel for cui"
   (ensure-cui-integer cui)
 (defun find-urel-cui (cui &key (srl *current-srl*))
   "Return a list of urel for cui"
   (ensure-cui-integer cui)

-  (collect-umlisp-query (mrrel (aui1 rel stype1 cui2 aui2 stype2 rela rui srui sab sl rg dir suppress cvf kpfstr2)
+  (collect-umlisp-query (mrrel (aui1 rel stype1 cui2 aui2 stype2 rela rui srui sab sl rg dir suppress cvf)

                               srl cui1 cui :lrl "KSRL")
     (make-instance 'urel :cui1 cui :aui1 (ensure-integer aui1) :stype1 stype1 :rel rel
                   :cui2 (ensure-integer cui2) :aui2 (ensure-integer aui2) :stype2 stype2
                   :rui rui :srui srui :rela rela :sab sab :sl sl :rg rg :dir dir
                               srl cui1 cui :lrl "KSRL")
     (make-instance 'urel :cui1 cui :aui1 (ensure-integer aui1) :stype1 stype1 :rel rel
                   :cui2 (ensure-integer cui2) :aui2 (ensure-integer aui2) :stype2 stype2
                   :rui rui :srui srui :rela rela :sab sab :sl sl :rg rg :dir dir

-                  :suppress suppress :cvf cvf :pfstr2 kpfstr2)))
+                  :suppress suppress :cvf cvf :pfstr2 (find-pfstr-cui cui2))))

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


@@ -347,12 +374,12 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-urel-cui2 (cui2 &key (srl *current-srl*))
   "Return a list of urel for cui2"
   (ensure-cui-integer cui2)
 (defun find-urel-cui2 (cui2 &key (srl *current-srl*))
   "Return a list of urel for cui2"
   (ensure-cui-integer cui2)

-  (collect-umlisp-query (mrrel (rel cui1 aui1 stype1 aui2 stype2 rela rui srui sab sl rg dir suppress cvf kpfstr2)
+  (collect-umlisp-query (mrrel (rel cui1 aui1 stype1 aui2 stype2 rela rui srui sab sl rg dir suppress cvf)

                               srl cui2 cui2 :lrl "KSRL")
     (make-instance 'urel :cui2 cui2 :rel rel :aui2 (ensure-integer aui2) :stype2 stype2 :rui rui :srui srui
                   :stype1 stype1 :cui1 (ensure-integer cui1) :aui1 (ensure-integer aui1)
                   :rela rela :sab sab :sl sl :rg rg :dir dir :suppress suppress :cvf cvf
                               srl cui2 cui2 :lrl "KSRL")
     (make-instance 'urel :cui2 cui2 :rel rel :aui2 (ensure-integer aui2) :stype2 stype2 :rui rui :srui srui
                   :stype1 stype1 :cui1 (ensure-integer cui1) :aui1 (ensure-integer aui1)
                   :rela rela :sab sab :sl sl :rg rg :dir dir :suppress suppress :cvf cvf

-                  :pfstr2 kpfstr2)))
+                  :pfstr2 (find-pfstr-cui cui2))))

 
 (defun find-ucon-rel-cui2 (cui2 &key (srl *current-srl*))
   (ensure-cui-integer cui2)
 
 (defun find-ucon-rel-cui2 (cui2 &key (srl *current-srl*))
   (ensure-cui-integer cui2)


@@ -363,41 +390,33 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-ucoc-cui (cui &key (srl *current-srl*))
   "Return a list of ucoc for cui"
   (ensure-cui-integer cui)
 (defun find-ucoc-cui (cui &key (srl *current-srl*))
   "Return a list of ucoc for cui"
   (ensure-cui-integer cui)

-  (collect-umlisp-query (mrcoc (aui1 cui2 aui2 sab cot cof coa kpfstr2) srl cui1
+  (collect-umlisp-query (mrcoc (aui1 cui2 aui2 sab cot cof coa) srl cui1

                            cui :lrl klrl :order (cof asc))
     (setq cui2 (ensure-integer cui2))
     (when (eql 0 cui2) (setq cui2 nil))
     (make-instance 'ucoc :cui1 cui :aui1 (ensure-integer aui1)
                   :cui2 (ensure-integer cui2) :aui2 (ensure-integer aui2)
                   :cot cot :cof (ensure-integer cof) :coa coa :sab sab
                            cui :lrl klrl :order (cof asc))
     (setq cui2 (ensure-integer cui2))
     (when (eql 0 cui2) (setq cui2 nil))
     (make-instance 'ucoc :cui1 cui :aui1 (ensure-integer aui1)
                   :cui2 (ensure-integer cui2) :aui2 (ensure-integer aui2)
                   :cot cot :cof (ensure-integer cof) :coa coa :sab sab

-                  :pfstr2 kpfstr2)))
+                  :pfstr2 (find-pfstr-cui cui2))))

 
 (defun find-ucoc-cui2 (cui2 &key (srl *current-srl*))
   "Return a list of ucoc for cui2"
   (ensure-cui-integer cui2)
 
 (defun find-ucoc-cui2 (cui2 &key (srl *current-srl*))
   "Return a list of ucoc for cui2"
   (ensure-cui-integer cui2)

-  (collect-umlisp-query (mrcoc (cui1 aui1 aui2 sab cot cof coa kpfstr2) srl cui2
+  (collect-umlisp-query (mrcoc (cui1 aui1 aui2 sab cot cof coa) srl cui2

                            cui2 :lrl klrl :order (cof asc))
     (when (zerop cui2) (setq cui2 nil))
     (make-instance 'ucoc :cui1 (ensure-integer cui1) :cui2 cui2
                   :aui1 (ensure-integer aui1) :aui2 (ensure-integer aui2)
                   :sab sab :cot cot :cof (ensure-integer cof) :coa coa
                            cui2 :lrl klrl :order (cof asc))
     (when (zerop cui2) (setq cui2 nil))
     (make-instance 'ucoc :cui1 (ensure-integer cui1) :cui2 cui2
                   :aui1 (ensure-integer aui1) :aui2 (ensure-integer aui2)
                   :sab sab :cot cot :cof (ensure-integer cof) :coa coa

-                  :pfstr2 kpfstr2)))
+                  :pfstr2 (find-pfstr-cui cui2))))

 
 (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 +429,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 +473,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,18 +486,18 @@ 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)
        'list
        #'(lambda (tuple)

-          (destructuring-bind (cui lui sui stt ksuilrl suppress pfstr) tuple
+          (destructuring-bind (cui lui sui stt ksuilrl suppress) tuple

             (make-instance 'ustr :cui (ensure-integer cui)
                            :lui (ensure-integer lui) :sui (ensure-integer sui)
             (make-instance 'ustr :cui (ensure-integer cui)
                            :lui (ensure-integer lui) :sui (ensure-integer sui)

-                           :stt stt :str pfstr
+                           :stt stt :str (find-pfstr-cui cui)

                            :cuisui (make-cuisui (ensure-integer cui)
                                                 (ensure-integer sui))
                            :suppress suppress
                            :lrl (ensure-integer ksuilrl))))
                            :cuisui (make-cuisui (ensure-integer cui)
                                                 (ensure-integer sui))
                            :suppress suppress
                            :lrl (ensure-integer ksuilrl))))

-       (query-string mrconso (cui lui sui stt ksuilrl kpfstr) srl nil nil :lrl ksuilrl
+       (query-string mrconso (cui lui sui stt ksuilrl) srl nil nil :lrl ksuilrl

                     :distinct t
                     :order (sui asc))
        :database db)))
                     :distinct t
                     :order (sui asc))
        :database db)))


@@ -507,9 +526,10 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-ucxt-cuisui (cui sui &key (srl *current-srl*))
   (ensure-cui-integer cui)
   (ensure-sui-integer sui)
 (defun find-ucxt-cuisui (cui sui &key (srl *current-srl*))
   (ensure-cui-integer cui)
   (ensure-sui-integer sui)

-  (collect-umlisp-query (mrcxt (sab code cxn cxl cxs cui2 hcd rela xc)
+  (collect-umlisp-query (mrcxt (sab rank code cxn cxl cxs cui2 hcd rela xc)

                            srl kcuisui (make-cuisui cui sui) :lrl ksrl)
                            srl kcuisui (make-cuisui cui sui) :lrl ksrl)

-    (make-instance 'ucxt :sab sab :code code
+                       (make-instance 'ucxt :sab sab :code code
+               :rank rank

                   :cxn (ensure-integer cxn) :cxl cxl :cxs cxs :hcd hcd
                   :rela rela :xc xc
                   :cui2 (ensure-integer cui2))))
                   :cxn (ensure-integer cxn) :cxl cxl :cxs cxs :hcd hcd
                   :rela rela :xc xc
                   :cui2 (ensure-integer cui2))))


@@ -547,7 +567,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)))))
 


@@ -572,7 +592,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)


@@ -584,15 +604,17 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   "Find usab for a key"
   (collect-umlisp-query-eval ('mrsab '(vcui rcui vsab rsab son sf sver vstart
                                       vend imeta rmeta slc scc srl tfr cfr cxty
   "Find usab for a key"
   (collect-umlisp-query-eval ('mrsab '(vcui rcui vsab rsab son sf sver vstart
                                       vend imeta rmeta slc scc srl tfr cfr cxty

-                                      ttyl atnl lat cenc curver sabin)
+                                      ttyl atnl lat cenc curver sabin
+                                      ssn scit)

                                     nil key-name key :single t)
                                     nil key-name key :single t)

-     (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)
-                  :tfr (ensure-integer tfr) :cfr (ensure-integer cfr)
-                  :cxty cxty :ttyl ttyl :atnl atnl :lat lat :cenc cenc
-                  :curver curver :sabin sabin)))
+     (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)
+                   :tfr (ensure-integer tfr) :cfr (ensure-integer cfr)
+                   :cxty cxty :ttyl ttyl :atnl atnl :lat lat :cenc cenc
+                   :curver curver :sabin sabin
+                   :ssn ssn :scit scit)))

 
 (defun find-usab-rsab (rsab)
   "Find usab for rsab"
 
 (defun find-usab-rsab (rsab)
   "Find usab for rsab"


@@ -626,7 +648,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


@@ -702,34 +724,44 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 ;;; Multiword lookup and score functions
 
 (defun find-uobj-multiword (str obj-lookup-fun sort-fun key srl
 ;;; Multiword lookup and score functions
 
 (defun find-uobj-multiword (str obj-lookup-fun sort-fun key srl

-                           only-exact-if-match)
+                           only-exact-if-match limit)

   (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))))
           (funcall sort-fun str
                    (delete-duplicates uobjs :test #'= :key key))))

-      (if (and (plusp (length sorted))
-              only-exact-if-match
-              (multiword-match str (pfstr (first sorted))))
-         (first sorted)
-       sorted))))
-    
+      (let ((len (length sorted)))
+        (cond
+         ((zerop len)
+          (return-from find-uobj-multiword nil))
+         ((and only-exact-if-match (multiword-match str (pfstr (first sorted))))
+          (first sorted))
+         (limit
+          (if (and (plusp limit) (> len limit))
+              (subseq sorted 0 limit)
+            limit))
+         (t
+          sorted))))))
+

 (defun find-ucon-multiword (str &key (srl *current-srl*)
 (defun find-ucon-multiword (str &key (srl *current-srl*)

-                                    (only-exact-if-match t))
+                                    (only-exact-if-match t)
+                                     limit)

   (find-uobj-multiword str #'find-ucon-word #'sort-score-pfstr-str
   (find-uobj-multiword str #'find-ucon-word #'sort-score-pfstr-str

-                      #'cui srl only-exact-if-match))
+                      #'cui srl only-exact-if-match limit))

 
 (defun find-uterm-multiword (str &key (srl *current-srl*)
 
 (defun find-uterm-multiword (str &key (srl *current-srl*)

-                                     (only-exact-if-match t))
+                                     (only-exact-if-match t)
+                                      limit)

   (find-uobj-multiword str #'find-uterm-word #'sort-score-pfstr-str
   (find-uobj-multiword str #'find-uterm-word #'sort-score-pfstr-str

-                      #'lui srl only-exact-if-match))
+                      #'lui srl only-exact-if-match limit))

 
 (defun find-ustr-multiword (str &key (srl *current-srl*)
 
 (defun find-ustr-multiword (str &key (srl *current-srl*)

-                                    (only-exact-if-match t))
+                                    (only-exact-if-match t)
+                                     limit)

   (find-uobj-multiword str #'find-ustr-word #'sort-score-ustr-str
   (find-uobj-multiword str #'find-ustr-word #'sort-score-ustr-str

-                      #'sui srl only-exact-if-match))
-       
+                      #'sui srl only-exact-if-match limit))
+

 (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))


@@ -742,7 +774,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))))
 


@@ -763,7 +795,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))))
 


@@ -812,7 +844,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)


@@ -865,18 +897,18 @@ 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)
       (insert-ustats-count conn "Distinct Term Count" "MRCONSO" "distinct LUI" "KLUILRL" srl)
       (insert-ustats-count conn "String Count" "MRCONSO" "*" "KSUILRL" srl)
       (insert-ustats-count conn "Distinct String Count" "MRCONSO" "distinct SUI" "KSUILRL" 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)
       (insert-ustats-count conn "Distinct Term Count" "MRCONSO" "distinct LUI" "KLUILRL" srl)
       (insert-ustats-count conn "String Count" "MRCONSO" "*" "KSUILRL" srl)
       (insert-ustats-count conn "Distinct String Count" "MRCONSO" "distinct SUI" "KSUILRL" srl)

-      (insert-ustats-count conn "Context Count" "MRCXT" "*" "KSRL" srl)
+      (insert-ustats-count conn "Hierarchcy" "MRHIER" "*" "KSRL" srl)
+      (insert-ustats-count conn "Mappings" "MRMAP" "*" "KSRL" srl)
+      (insert-ustats-count conn "Simple Mappings" "MRSMAP" "*" "KSRL" srl)

       (insert-ustats-count conn "Co-occuring Concept Count" "MRCOC" "*" "KLRL" srl)
       (insert-ustats-count conn "Definition Count" "MRDEF" "*" "KSRL" srl)
       (insert-ustats-count conn "Co-occuring Concept Count" "MRCOC" "*" "KLRL" srl)
       (insert-ustats-count conn "Definition Count" "MRDEF" "*" "KSRL" srl)

-      #+ignore
-      (insert-ustats-count conn "Locator Count" "MRLO" "*" "KLRL" srl)

       (insert-ustats-count conn "Rank Count" "MRRANK" "*" "KSRL" srl)
       (insert-ustats-count conn "Relationship Count" "MRREL" "*" "KSRL" srl)
       (insert-ustats-count conn "Semantic Type Count" "MRSTY" "*" "KLRL" srl)
       (insert-ustats-count conn "Rank Count" "MRRANK" "*" "KSRL" srl)
       (insert-ustats-count conn "Relationship Count" "MRREL" "*" "KSRL" srl)
       (insert-ustats-count conn "Semantic Type Count" "MRSTY" "*" "KLRL" srl)


@@ -894,13 +926,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


@@ -908,8 +940,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*))


@@ -924,7 +956,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))))