r11209: fix test
[umlisp.git] / sql-classes.lisp
index 2c8c93eb760cda10257ac11e68dac2788ca6af77..20ef37eafe82939234e727cfa8441c18f3edfa97 100644 (file)
   (setq *current-srl* srl))
 
 (defmacro query-string (table fields &optional srl where-name where-value
-                       &key (lrl "KCUILRL") single distinct order like)
-  (let* ((%%fields (format nil "select ~A~{~:@(~A~)~^,~} from ~:@(~A~)"
-                          (if distinct "distinct " "") fields table))
-        (%%order (if order (format nil " order by ~{~:@(~A~) ~(~A~)~^,~}"
+                       &key (lrl "KCUILRL") single distinct order like limit
+                        filter)
+  (let* ((%%fields (format nil "SELECT ~A~{~:@(~A~)~^,~} FROM ~:@(~A~)"
+                          (if distinct "DISTINCT " "") fields table))
+        (%%order (if order (format nil " ORDER BY ~{~:@(~A~) ~(~A~)~^,~}"
                                    order)
                      ""))
-        (%%lrl (format nil " and ~:@(~A~)<=" lrl))
+        (%%lrl (format nil " AND ~:@(~A~)<=" lrl))
         (%%where (when where-name
-                   (format nil " where ~:@(~A~)~A" where-name
-                         (if like " like " "")))))
-    `(concatenate
-      'string
-      ,%%fields
-      ,@(when %%where (list %%where))
-      ,@(when %%where
-         `((typecase ,where-value
-             #+ignore
-             (fixnum
-              (concatenate 'string "='" (prefixed-fixnum-string ,where-value #\0 10) "'"))
-             (number
-              (concatenate 'string "='" (write-to-string ,where-value) "'"))
-             (null
-              " is null")
-             (t
-              (format nil ,(if like "'%~A%'" "='~A'") ,where-value)))))
-      (if ,srl (concatenate 'string ,%%lrl (write-to-string ,srl)) "")
-      ,@(when %%order (list %%order))
-      ,@(when single (list " limit 1")))))
+                   (format nil " WHERE ~:@(~A~)~A" where-name
+                         (if like " like " ""))))
+         (%filter (gensym "FILTER-"))
+         (%single (gensym "SINGLE-"))
+         (%limit (gensym "LIMIT-")))
+    `(let ((,%limit ,limit)
+           (,%single ,single)
+           (,%filter ,filter))
+       (concatenate
+        'string
+        ,%%fields
+        ,@(when %%where (list %%where))
+        ,@(when %%where
+            `((typecase ,where-value
+                #+ignore
+                (fixnum
+                 (concatenate 'string "='" (prefixed-fixnum-string ,where-value #\0 10) "'"))
+                (number
+                 (concatenate 'string "='" (write-to-string ,where-value) "'"))
+                (null
+                 " IS NULL")
+                (t
+                 (format nil ,(if like "'%~A%'" "='~A'") ,where-value)))))
+        (if ,%filter (concatenate 'string
+                                  ,(if %%where " AND " " WHERE ")
+                                  ,%filter) "")
+        (if ,srl (concatenate 'string ,%%lrl (write-to-string ,srl)) "")
+        ,@(when %%order (list %%order))
+        (cond
+         ((and ,%single ,%limit)
+          (error "Can't set single and limit"))
+         (,%single
+          " LIMIT 1")
+         (,%limit
+          (format nil " LIMIT ~D" ,%limit))
+         (t
+          ""))))))
 
 (defun query-string-eval (table fields &optional srl where-name where-value
-                         &key (lrl "KCUILRL") single distinct order like)
+                         &key (lrl "KCUILRL") single distinct order like limit filter)
+  (when single (setq limit 1))
   (concatenate
    'string
-   (format nil "select ~A~{~:@(~A~)~^,~} from ~:@(~A~)"
-          (if distinct "distinct " "") fields table)
-   (if where-name (format nil " where ~:@(~A~)" where-name) "")
+   (format nil "SELECT ~A~{~:@(~A~)~^,~} FROM ~:@(~A~)"
+          (if distinct "DISTINCT " "") fields table)
+   (if where-name (format nil " WHERE ~:@(~A~)" where-name) "")
    (if where-name
        (format nil
               (typecase where-value
                 (number "='~D'")
-                (null " is null")
+                (null " IS NULL")
                 (t
-                 (if like " like '%~A%""='~A'")))
+                 (if like " LINK '%~A%""='~A'")))
               where-value)
        "")
-   (if srl (format nil " and ~:@(~A~)<=~D" lrl srl) "")
-   (if order (format nil " order by ~{~:@(~A~) ~(~A~)~^,~}" order) "")
-   (if single " limit 1" "")))
+   (if filter (concatenate 'string " AND " filter) nil)
+   (if srl (format nil " AND ~:@(~A~)<=~D" lrl srl) "")
+   (if order (format nil " ORDER BY ~{~:@(~A~) ~(~A~)~^,~}" order) "")
+   (if limit (format nil " LIMIT ~D" limit) "")))
 
 
 (defmacro umlisp-query (table fields srl where-name where-value
                     &key (lrl "KCUILRL") single distinct order like
-                       (query-cmd 'mutex-sql-query))
+                     limit filter (query-cmd '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"
   `(,query-cmd
     (query-string ,table ,fields ,srl ,where-name ,where-value
-     :lrl ,lrl :single ,single :distinct ,distinct :order ,order :like ,like)))
+     :lrl ,lrl :single ,single :distinct ,distinct :order ,order :like ,like
+     :filter ,filter :limit ,limit)))
 
 (defmacro umlisp-query-eval (table fields srl where-name where-value
-                    &key (lrl "KCUILRL") single distinct order like)
+                    &key (lrl "KCUILRL") single distinct order like
+                     filter limit)
   "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
-     :lrl ,lrl :single ,single :distinct ,distinct :order ,order :like ,like)))
+     :lrl ,lrl :single ,single :distinct ,distinct :order ,order :like ,like
+     :filter ,filter :limit ,limit)))
 
 ;; only WHERE-VALUE and SRL are evaluated
 (defmacro collect-umlisp-query ((table fields srl where-name where-value
                                    &key (lrl "KCUILRL") distinct single
-                                   order like (query-cmd 'mutex-sql-query))
+                                   order like (query-cmd 'mutex-sql-query)
+                                    filter limit)
                                &body body)
   (let ((value (gensym))
        (r (gensym)))
     (if single
-       `(let* ((,value ,where-value)
-               (tuple (car (umlisp-query ,table ,fields ,srl ,where-name ,value
-                                         :lrl ,lrl :single ,single
-                                         :distinct ,distinct :order ,order
-                                         :like ,like
-                                         :query-cmd ,query-cmd))))
-         ,@(unless where-name `((declare (ignore ,value))))
-         (when tuple
-               (destructuring-bind ,fields tuple
-                 ,@body)))
+        (if (and limit (> limit 1))
+            (error "Can't set limit along with single.")
+          `(let* ((,value ,where-value)
+                  (tuple (car (umlisp-query ,table ,fields ,srl ,where-name ,value
+                                            :lrl ,lrl :single ,single
+                                            :distinct ,distinct :order ,order
+                                            :like ,like :filter ,filter
+                                            :query-cmd ,query-cmd))))
+             ,@(unless where-name `((declare (ignore ,value))))
+             (when tuple
+               (destructuring-bind ,fields tuple
+                 ,@body))))
        `(let ((,value ,where-value))
           ,@(unless where-name `((declare (ignore ,value))))
           (let ((,r '()))
             (dolist (tuple (umlisp-query ,table ,fields ,srl ,where-name ,value
                                          :lrl ,lrl :single ,single :distinct ,distinct
-                                         :order ,order :like ,like))
+                                         :order ,order :filter ,filter :like ,like
+                                          :limit ,limit))
               (push (destructuring-bind ,fields tuple ,@body) ,r))
             (nreverse ,r))
           #+ignore
           (loop for tuple in
                 (umlisp-query ,table ,fields ,srl ,where-name ,value
                               :lrl ,lrl :single ,single :distinct ,distinct
-                              :order ,order :like ,like)
+                              :order ,order :like ,like :filter ,filter :limit ,limit)
               collect (destructuring-bind ,fields tuple ,@body))))))
 
 (defmacro collect-umlisp-query-eval ((table fields srl where-name where-value
                                         &key (lrl "KCUILRL") distinct single
-                                        order like)
+                                        order like filter limit)
                                  &body body)
   (let ((value (gensym))
        (r (gensym))
@@ -138,7 +165,8 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
                (tuple (car (umlisp-query-eval ,table ,fields ,srl ,where-name ,value
                                               :lrl ,lrl :single ,single
                                               :distinct ,distinct :order ,order
-                                              :like ,like))))
+                                              :like ,like :filter ,filter
+                                               :limit ,limit))))
          (when tuple
            (destructuring-bind ,eval-fields tuple
              ,@body)))
@@ -146,14 +174,16 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
               (,r '()))
           (dolist (tuple (umlisp-query-eval ,table ,fields ,srl ,where-name ,value
                                             :lrl ,lrl :single ,single :distinct ,distinct
-                                            :order ,order :like ,like))
+                                            :order ,order :like ,like
+                                             :filter ,filter :limit ,limit))
             (push (destructuring-bind ,eval-fields tuple ,@body) ,r))
           (nreverse ,r)
           #+ignore
           (loop for tuple in
                 (umlisp-query-eval ,table ,fields ,srl ,where-name ,value
                                    :lrl ,lrl :single ,single :distinct ,distinct
-                                   :order ,order :like ,like)
+                                   :order ,order :like ,like :filter ,filter
+                                    :limit ,limit)
               collect (destructuring-bind ,eval-fields tuple ,@body))))))
 
 ;;;
@@ -174,6 +204,16 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
     (setq ,sui (parse-sui ,sui))
     ,sui))
 
+(defmacro ensure-aui-integer (aui)
+  `(if (stringp ,aui)
+    (setq ,aui (parse-aui ,aui))
+    ,aui))
+
+(defmacro ensure-rui-integer (rui)
+  `(if (stringp ,rui)
+    (setq ,rui (parse-rui ,rui))
+    ,rui))
+
 (defmacro ensure-tui-integer (tui)
   `(if (stringp ,tui)
     (setq ,tui (parse-tui ,tui))
@@ -184,57 +224,58 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
     (setq ,eui (parse-eui ,eui))
     ,eui))
 
-(defun find-ucon-cui (cui &key (srl *current-srl*))
+(defun make-ucon-cui (cui)
+  (ensure-cui-integer cui)
+  (when cui
+    (make-instance 'ucon :cui cui)))
+  
+(defun find-ucon-cui (cui &key (srl *current-srl*) without-pfstr)
   "Find ucon for a cui"
   (ensure-cui-integer cui)
   (unless cui (return-from find-ucon-cui nil))
 
-  (let ((tuple (car (mutex-sql-query "SELECT kcuilrl,str FROM MRCONSO WHERE CUI=~D AND KPFENG=1 AND SRL<=~D"
-                                     cui srl))))
-    (unless tuple
-      (setq tuple (car (mutex-sql-query "SELECT kcuilrl,str FROM MRCONSO WHERE CUI=~D AND SRL<=~D"
-                                        cui srl))))
-    (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"
-  (ensure-cui-integer cui)
-  (collect-umlisp-query (mrconso (kcuilrl) srl cui cui :single t)
-    (make-instance 'ucon :cui cui :lrl (ensure-integer kcuilrl)
-                  :pfstr nil)))
+  (if without-pfstr
+      (collect-umlisp-query (mrconso (kcuilrl) srl cui cui :single t)
+                            (make-instance 'ucon :cui cui :lrl (ensure-integer kcuilrl)
+                                           :pfstr nil)))
+   (or
+     (collect-umlisp-query (mrconso (kcuilrl str) srl cui cui :single t :filter "KPFENG=1")
+        (make-instance 'ucon :cui cui :pfstr str
+                       :lrl kcuilrl))
+     (collect-umlisp-query (mrconso (kcuilrl str) srl cui cui :single t)
+        (make-instance 'ucon :cui cui :pfstr str
+                       :lrl kcuilrl))))
 
 (defun find-pfstr-cui (cui &key (srl *current-srl*))
   "Find preferred string for a cui"
   (ensure-cui-integer cui)
   (or
-    (caar (mutex-sql-query
-           (format nil "SELECT str FROM MRCONSO WHERE CUI=~D AND KPFENG=1 AND SLR<=~D"
-                   cui srl)))
-    (caar (mutex-sql-query
-           (format nil "SELECT str FROM MRCONSO WHERE CUI=~D AND SLR<=~D"
-                   cui srl)))))
+   (collect-umlisp-query (mrconso (str) srl cui cui :distinct t
+                                  :filter " KPFENG=1" :single t)
+      str)
+   (collect-umlisp-query (mrconso (str) srl cui cui :distinct t
+                                  :single t)
+                         str)))
+
+(defun find-lrl-cui (cui &key (srl *current-srl*))
+  "Find LRL for a cui"
+  (ensure-cui-integer cui)
+  (collect-umlisp-query (mrconso (kcuilrl) srl cui cui :distinct t :single t)
+                        (ensure-integer kcuilrl)))
 
 (defun find-ucon-lui (lui &key (srl *current-srl*))
   "Find list of ucon for lui"
   (ensure-lui-integer lui)
-  (collect-umlisp-query (mrconso (cui kcuilrl) srl lui lui
-                           :distinct t)
-     (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 AND SRL<=~D"
-                                     lui srl))))
-    (unless tuple
-      (setq tuple (car (mutex-sql-query "SELECT cui,kcuilrl,str FROM MRCONSO WHERE LUI=~D AND SRL<=~D"
-                                        lui srl))))
-    (unless tuple
-      (return-from find-ucon-lui nil))
-    (make-instance 'ucon :cui (first tuple) :pfstr (third tuple)
-                   :lrl (ensure-integer (third tuple)))))
+  (or
+   (collect-umlisp-query (mrconso (cui kcuilrl str) srl lui lui
+                                  :filter " KPFENG=1" :single t)
+      (make-instance 'ucon :cui (ensure-integer cui)
+                     :pfstr str :lrl (ensure-integer kcuilrl)))
+   (collect-umlisp-query (mrconso (cui kcuilrl str) srl lui lui
+                                  :single t)
+      (make-instance 'ucon :cui (ensure-integer cui)
+                     :pfstr str :lrl (ensure-integer kcuilrl)))))
 
 (defun find-ucon-sui (sui &key (srl *current-srl*))
   "Find list of ucon for sui"
@@ -245,7 +286,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 
 (defun find-ucon-aui (aui &key (srl *current-srl*))
   "Find list of ucon for aui"
-  (ensure-sui-integer aui)
+  (ensure-aui-integer aui)
   (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))))
@@ -319,24 +360,21 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-udoc-key (key)
   "Return list of abbreviation documentation for a key"
   (collect-umlisp-query (mrdoc (value type expl) nil dockey key)
-    (make-instance 'udoc :key key :value value :type type :expl expl)))
+    (make-instance 'udoc :dockey key :dvalue value :dtype type :expl expl)))
 
 (defun find-udoc-value (value)
   "Return abbreviation documentation"
   (collect-umlisp-query (mrdoc (dockey type expl) nil value value)
-    (make-instance 'udoc :key dockey :value value :type type :expl expl)))
+    (make-instance 'udoc :dockey dockey :dvalue value :dtype type :expl expl)))
 
-(defun find-udoc-key-value (key value)
-  (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)))))
+(defun find-udoc-key-value (dockey value)
+  (collect-umlisp-query (mrdoc (type expl) nil dockey dockey :filter (format nil "VALUE='~A'" value))
+      (make-instance 'udoc :dockey dockey :dvalue value :dtype type :expl expl)))
 
 (defun find-udoc-all ()
   "Return all abbreviation documentation"
   (collect-umlisp-query (mrdoc (dockey value type expl) nil nil nil)
-    (make-instance 'udoc :key dockey :value value :type type :expl expl)))
+    (make-instance 'udoc :dockey dockey :dvalue value :dtype type :expl expl)))
 
 (defun find-usty-cui (cui &key (srl *current-srl*))
   "Return a list of usty for cui"
@@ -350,14 +388,28 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
                            :distinct t)
     (make-instance 'usty :tui (ensure-integer tui) :sty sty)))
 
-(defun find-urel-cui (cui &key (srl *current-srl*))
+(defun find-urel-cui (cui &key (srl *current-srl*) filter without-pfstr2)
   "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)
-                              srl cui1 cui :lrl "KSRL")
-    (make-instance 'urel :cui1 cui :aui1 (ensure-integer aui1) :stype1 stype1 :rel rel
+                              srl cui1 cui :lrl "KSRL" :filter filter)
+    (let ((rel                        
+      (make-instance 'urel :cui1 cui :aui1 (ensure-integer aui1) :stype1 stype1 :rel rel
+                     :cui2 (ensure-integer cui2) :aui2 (ensure-integer aui2) :stype2 stype2
+                     :rui (ensure-integer rui) :srui srui :rela rela :sab sab :sl sl :rg rg :dir dir
+                     :suppress suppress :cvf cvf)))
+      (unless without-pfstr2
+        (setf (slot-value rel 'pfstr2) (find-pfstr-cui cui2)))
+      rel)))
+
+(defun find-urel-rui (rui &key (srl *current-srl*))
+  "Return the urel for a rui"
+  (ensure-rui-integer rui)
+  (collect-umlisp-query (mrrel (aui1 rel stype1 cui1 cui2 aui2 stype2 rela rui srui sab sl rg dir suppress cvf)
+                              srl rui rui :lrl "KSRL" :single t)
+    (make-instance 'urel :cui1 cui1 :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
+                  :rui (ensure-integer rui) :srui srui :rela rela :sab sab :sl sl :rg rg :dir dir
                   :suppress suppress :cvf cvf :pfstr2 (find-pfstr-cui cui2))))
 
 (defun find-cui2-urel-cui (cui &key (srl *current-srl*))
@@ -372,8 +424,10 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   (ensure-cui-integer cui2)
   (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)
+    (make-instance 'urel :cui2 cui2 :rel rel :aui2 (ensure-integer aui2)
+                   :stype2 stype2 :rui (ensure-integer 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 (find-pfstr-cui cui2))))
 
@@ -507,17 +561,28 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-uso-cuisui (cui sui &key (srl *current-srl*))
   (ensure-sui-integer sui)
   (ensure-cui-integer cui)
-  (collect-umlisp-query (mrconso (aui sab code srl tty saui sdui scui) srl kcuisui
-                          (make-cuisui cui sui) :lrl srl)
+  (collect-umlisp-query (mrconso (aui sab code srl tty saui sdui scui lat str)
+                                 srl kcuisui (make-cuisui cui sui) :lrl srl)
     (make-instance 'uso :aui aui :sab sab :code code :srl srl :tty tty
-                  :cui cui :sui sui :saui saui :sdui sdui :scui scui)))
+                  :cui cui :sui sui :saui saui :sdui sdui :scui scui
+                   :lat lat :str str)))
+
+(defun find-uso-cui (cui &key (srl *current-srl*) (english-only nil) limit)
+  (ensure-cui-integer cui)
+  (collect-umlisp-query (mrconso (aui sab code srl tty saui sdui scui lat str sui)
+                                 srl cui cui :lrl srl :limit limit
+                                 :filter (when english-only "LAT='ENG'"))
+     (make-instance 'uso :aui aui :sab sab :code code :srl srl :tty tty
+                    :cui cui :sui sui :saui saui :sdui sdui :scui scui
+                    :lat lat :str str)))
 
 (defun find-uso-aui (aui &key (srl *current-srl*))
   (ensure-sui-integer aui)
-  (collect-umlisp-query (mrconso (sab cui sui code srl tty saui sdui scui) srl aui
-                                aui :lrl srl :single t)
+  (collect-umlisp-query (mrconso (sab cui sui code srl tty saui sdui scui lat
+                                      str) srl aui aui :lrl srl :single t)
     (make-instance 'uso :aui aui :cui cui :sab sab :code code :srl srl :tty tty
-                  :sui sui :saui saui :sdui sdui :scui scui)))
+                  :sui sui :saui saui :sdui sdui :scui scui :lat lat
+                   :str str)))
 
 (defun find-ucxt-cuisui (cui sui &key (srl *current-srl*))
   (ensure-cui-integer cui)
@@ -551,7 +616,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   (ensure-cui-integer cui)
   (ensure-lui-integer lui)
   (ensure-sui-integer sui)
-  (let ((ls "select CODE,ATN,SAB,ATV from MRSAT where "))
+  (let ((ls "SELECT CODE,ATN,SAB,ATV FROM MRSAT WHERE "))
     (cond
       (sui (string-append ls "KCUISUI='"
                          (integer-string (make-cuisui cui sui) 14)
@@ -584,7 +649,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
     (find-usty-tui tui)))
 
 (defun find-usab-all ()
-  "Find usab for a key"
+  "Return all usab objects"
   (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)
@@ -637,6 +702,15 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
                   :torule torule :tores tores :maprule maprule :maptype maptype :mapatn mapatn
                   :mapatv mapatv :cvf cvf)))
 
+(defun find-usmap-cui (cui)
+  (ensure-cui-integer cui)
+  (collect-umlisp-query (mrsmap (mapsetsab fromexpr fromtype rel rela toexpr totype cvf)
+                              nil mapsetcui cui)
+    (make-instance 'usmap :mapsetcui cui :mapsetsab mapsetsab
+                  :fromexpr fromexpr :fromtype fromtype
+                  :rel rel :rela rela :toexpr toexpr :totype totype
+                   :cvf cvf)))
+
 ;;;; Cross table find functions
 
 (defun find-ucon-tui (tui &key (srl *current-srl*))
@@ -720,33 +794,43 @@ 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
-                           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 ((sorted
           (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*)
-                                    (only-exact-if-match t))
+                                    (only-exact-if-match t)
+                                     limit)
   (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*)
-                                     (only-exact-if-match t))
+                                     (only-exact-if-match t)
+                                      limit)
   (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*)
-                                    (only-exact-if-match t))
+                                    (only-exact-if-match t)
+                                     limit)
   (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"