r11209: fix test

[umlisp.git] / sql-classes.lisp

diff --git a/sql-classes.lisp b/sql-classes.lisp
index 608c463ad6a7e44020c5bd3be8cac675b13d9411..20ef37eafe82939234e727cfa8441c18f3edfa97 100644 (file)
--- a/sql-classes.lisp
+++ b/sql-classes.lisp
@@ -2,22 +2,21 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;

-;;;; Name:          sql-classes.lisp
-;;;; Purpose:       Routines for reading UMLS objects from SQL database
-;;;; Author:        Kevin M. Rosenberg
-;;;; Date Started:  Apr 2000
+;;;; Name:     sql-classes.lisp
+;;;; Purpose:  Routines for reading UMLS objects from SQL database
+;;;; Author:   Kevin M. Rosenberg
+;;;; Created:  Apr 2000

 ;;;;
 ;;;;

-;;;; $Id: sql-classes.lisp,v 1.74 2003/05/06 21:52:34 kevin Exp $
+;;;; $Id$

 ;;;;
 ;;;; This file, part of UMLisp, is
 ;;;;
 ;;;; This file, part of UMLisp, is

-;;;;    Copyright (c) 2000-2002 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.
 ;;;; *************************************************************************
 

-(in-package :umlisp)
-(declaim (optimize (compilation-speed 0) (debug 3)))
+(in-package #:umlisp)

 
 
 (defvar *current-srl* nil)
 
 
 (defvar *current-srl* nil)


@@ -27,104 +26,136 @@
   (setq *current-srl* srl))
 
 (defmacro query-string (table fields &optional srl where-name where-value
   (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)
                      ""))
                                    order)
                      ""))

-        (%%lrl (format nil " and ~:@(~A~)<=" lrl))
+        (%%lrl (format nil " AND ~:@(~A~)<=" lrl))

         (%%where (when where-name
         (%%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
-                 (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
 
 (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
   (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
    (if where-name
        (format nil
               (typecase where-value

-                (number "=~D")
-                (null " is null")
+                (number "='~D'")
+                (null " IS NULL")

                 (t
                 (t

-                 (if like " like '%~A%""='~A'")))
+                 (if like " LINK '%~A%""='~A'")))

               where-value)
        "")
               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
 
 
 (defmacro umlisp-query (table fields srl where-name where-value

-                    &key (lrl "KCUILRL") single distinct order like)
+                    &key (lrl "KCUILRL") single distinct order like
+                     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 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 ,table ,fields ,srl ,where-name ,where-value 
-     :lrl ,lrl :single ,single :distinct ,distinct :order ,order :like ,like)))
+  `(,query-cmd
+    (query-string ,table ,fields ,srl ,where-name ,where-value
+     :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
 
 (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 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)))
+    (query-string-eval ,table ,fields ,srl ,where-name ,where-value
+     :lrl ,lrl :single ,single :distinct ,distinct :order ,order :like ,like
+     :filter ,filter :limit ,limit)))

 
 ;; only WHERE-VALUE and SRL are evaluated
 
 ;; only WHERE-VALUE and SRL are evaluated

-(defmacro with-umlisp-query ((table fields srl where-name where-value
+(defmacro collect-umlisp-query ((table fields srl where-name where-value

                                    &key (lrl "KCUILRL") distinct single
                                    &key (lrl "KCUILRL") distinct single

-                                   order like)
-                            &body body)
+                                   order like (query-cmd 'mutex-sql-query)
+                                    filter limit)
+                               &body body)

   (let ((value (gensym))
   (let ((value (gensym))

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

     (if single
     (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))))
-         ,@(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
        `(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
               (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))))))
 
               collect (destructuring-bind ,fields tuple ,@body))))))
 

-(defmacro with-umlisp-query-eval ((table fields srl where-name where-value
+(defmacro collect-umlisp-query-eval ((table fields srl where-name where-value

                                         &key (lrl "KCUILRL") distinct single
                                         &key (lrl "KCUILRL") distinct single

-                                        order like)
+                                        order like filter limit)

                                  &body body)
   (let ((value (gensym))
        (r (gensym))
                                  &body body)
   (let ((value (gensym))
        (r (gensym))


@@ -134,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
                (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)))
          (when tuple
            (destructuring-bind ,eval-fields tuple
              ,@body)))


@@ -142,233 +174,361 @@ 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
               (,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
             (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))))))
 
 ;;;
 ;;; Read from SQL database
 
               collect (destructuring-bind ,eval-fields tuple ,@body))))))
 
 ;;;
 ;;; Read from SQL database
 

-(defun find-ucon-cui (cui &key (srl *current-srl*))
-  "Find ucon for a cui"
-  (with-umlisp-query (mrcon (kpfstr kcuilrl) srl cui (parse-cui cui) :single t)
-    (make-instance 'ucon :cui (parse-cui cui) :pfstr kpfstr
-                  :lrl (ensure-integer kcuilrl))))
-
-(defun find-ucon-cui-sans-pfstr (cui &key (srl *current-srl*))
+(defmacro ensure-cui-integer (cui)
+  `(if (stringp ,cui)
+    (setq ,cui (parse-cui ,cui))
+    ,cui))
+
+(defmacro ensure-lui-integer (lui)
+  `(if (stringp ,lui)
+    (setq ,lui (parse-lui ,lui))
+    ,lui))
+
+(defmacro ensure-sui-integer (sui)
+  `(if (stringp ,sui)
+    (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))
+    ,tui))
+
+(defmacro ensure-eui-integer (eui)
+  `(if (stringp ,eui)
+    (setq ,eui (parse-eui ,eui))
+    ,eui))
+
+(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"
   "Find ucon for a cui"

-  (with-umlisp-query (mrcon (kcuilrl) srl cui (parse-cui cui) :single t)
-    (make-instance 'ucon :cui (parse-cui cui) :lrl (ensure-integer kcuilrl)
-                  :pfstr nil)))
+  (ensure-cui-integer cui)
+  (unless cui (return-from find-ucon-cui 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"
 
 (defun find-pfstr-cui (cui &key (srl *current-srl*))
   "Find preferred string for a cui"

-  (with-umlisp-query (mrcon (kpfstr) srl cui (parse-cui cui) :single t)
-    kpfstr))
+  (ensure-cui-integer cui)
+  (or
+   (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"
 
 (defun find-ucon-lui (lui &key (srl *current-srl*))
   "Find list of ucon for lui"

-  (with-umlisp-query (mrcon (cui kpfstr kcuilrl) srl lui (parse-lui lui)
-                           :distinct t)
-    (make-instance 'ucon :cui (ensure-integer cui) :pfstr kpfstr
-                  :lrl (ensure-integer kcuilrl))))
+  (ensure-lui-integer lui)
+  (unless lui (return-from find-ucon-lui nil))
+  (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"
 
 (defun find-ucon-sui (sui &key (srl *current-srl*))
   "Find list of ucon for sui"

-  (with-umlisp-query (mrcon (cui kpfstr kcuilrl) srl sui (parse-sui sui)
-                           :distinct t)
-    (make-instance 'ucon :cui (ensure-integer cui) :pfstr kpfstr
+  (ensure-sui-integer sui)
+  (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-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))))
 
 (defun find-ucon-cuisui (cui sui &key (srl *current-srl*))
   "Find ucon for cui/sui"
                   :lrl (ensure-integer kcuilrl))))
 
 (defun find-ucon-cuisui (cui sui &key (srl *current-srl*))
   "Find ucon for cui/sui"

+  (ensure-cui-integer cui)
+  (ensure-sui-integer sui)

   (when (and cui sui)
   (when (and cui sui)

-    (with-umlisp-query (mrcon (cui kpfstr kcuilrl) srl kcuisui 
-                              (make-cuisui (parse-cui cui) (parse-sui sui)))
-      (make-instance 'ucon :cui (ensure-integer cui)
-                    :pfstr kpfstr
+    (collect-umlisp-query (mrconso (kcuilrl) srl kcuisui
+                             (make-cuisui cui sui))
+      (make-instance 'ucon :cui cui
+                    :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"

-  (with-umlisp-query (mrcon (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
      'list

-     #'(lambda (cui pfstr cuilrl)
-        (make-instance 'ucon :cui (ensure-integer cui)
-                       :pfstr pfstr
-                       :lrl (ensure-integer cuilrl)))
-     (query-string mrcon (cui kpfstr kcuilrl) srl nil nil
+     #'(lambda (tuple)
+        (destructuring-bind (cui cuilrl) tuple
+            (make-instance 'ucon :cui (ensure-integer cui)
+                           :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"

-  (with-umlisp-query (mrcon (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))))
 
                   :lrl (ensure-integer kcuilrl))))
 

+(defun find-cui-ucon-all (&key (srl *current-srl*))
+  "Return list of CUIs for all ucons"
+  (collect-umlisp-query (mrconso (cui) srl nil nil :order (cui asc)
+                              :distinct t)
+                       cui))
+

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

-     #'(lambda (cui pfstr cuilrl)
-        (funcall fn
-                 (make-instance 'ucon :cui (ensure-integer cui)
-                                :pfstr pfstr
-                                :lrl (ensure-integer cuilrl))))
-     (query-string mrcon (cui kpfstr kcuilrl) srl nil nil :order (cui asc)
+     #'(lambda (tuple)
+        (destructuring-bind (cui cuilrl) tuple
+          (funcall fn (make-instance 'ucon :cui (ensure-integer cui)
+                                     :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-udef-cui (cui &key (srl *current-srl*))
   "Return a list of udefs for cui"
                   :distinct t)
      :database db)))
 
 
 (defun find-udef-cui (cui &key (srl *current-srl*))
   "Return a list of udefs for cui"

-  (with-umlisp-query (mrdef (sab def) srl cui (parse-cui cui) :lrl "KSRL")
-    (make-instance 'udef :sab sab :def def)))
+  (ensure-cui-integer cui)
+  (collect-umlisp-query (mrdef (sab def suppress) srl cui cui :lrl "KSRL")
+    (make-instance 'udef :sab sab :def def :suppress suppress)))
+
+(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 :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 :dockey dockey :dvalue value :dtype type :expl expl)))
+
+(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 :dockey dockey :dvalue value :dtype type :expl expl)))

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

-  (with-umlisp-query (mrsty (tui sty) srl cui (parse-cui cui) :lrl "KLRL")
+  (ensure-cui-integer cui)
+  (collect-umlisp-query (mrsty (tui sty) srl cui cui :lrl "KLRL")

     (make-instance 'usty :tui (ensure-integer tui) :sty sty)))
 
 (defun find-usty-word (word &key (srl *current-srl*))
   "Return a list of usty that match word"
     (make-instance 'usty :tui (ensure-integer tui) :sty sty)))
 
 (defun find-usty-word (word &key (srl *current-srl*))
   "Return a list of usty that match word"

-  (with-umlisp-query (mrsty (tui sty) srl sty word :lrl klrl :like t
+  (collect-umlisp-query (mrsty (tui sty) srl sty word :lrl klrl :like t

                            :distinct t)
     (make-instance 'usty :tui (ensure-integer tui) :sty sty)))
 
                            :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"
   "Return a list of urel for cui"

-  (with-umlisp-query (mrrel (rel cui2 rela sab sl mg kpfstr2) srl cui1
-                           (parse-cui cui) :lrl "KSRL")
-    (make-instance 'urel :cui1 (parse-cui cui) :rel rel
-                  :cui2 (ensure-integer cui2) :rela rela :sab sab :sl sl
-                  :mg mg :pfstr2 kpfstr2)))
+  (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" :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 (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*))
+  "Return a list of urel for cui"
+  (ensure-cui-integer cui)
+  (collect-umlisp-query (mrrel (cui2) srl cui1
+                              cui :lrl "KSRL")
+                       cui2))

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

-  (with-umlisp-query (mrrel (rel cui1 rela sab sl mg kpfstr2) srl cui2
-                           (parse-cui cui2) :lrl "KSRL")
-    (make-instance 'urel :cui2 (parse-cui cui2) :rel rel
-                  :cui1 (ensure-integer cui1) :rela rela :sab sab :sl sl
-                  :mg mg :pfstr2 kpfstr2)))
+  (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 (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))))

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

-  (mapcar 
-   #'(lambda (cui) (find-ucon-cui cui :srl srl))
-   (remove-duplicates (mapcar #'cui1 (find-urel-cui2 cui2 :srl srl)))))
+  (ensure-cui-integer cui2)
+  (loop for cui in (remove-duplicates
+                   (mapcar #'cui1 (find-urel-cui2 cui2 :srl srl)))
+       collect (find-ucon-cui cui :srl srl)))

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

-  (with-umlisp-query (mrcoc (cui2 soc cot cof coa kpfstr2) srl cui1
-                           (parse-cui cui) :lrl klrl :order (cof asc))
+  (ensure-cui-integer cui)
+  (collect-umlisp-query (mrcoc (aui1 cui2 aui2 sab cot cof coa) srl cui1
+                           cui :lrl klrl :order (cof asc))

     (setq cui2 (ensure-integer cui2))
     (setq cui2 (ensure-integer cui2))

-    (when (zerop cui2) (setq cui2 nil))
-    (make-instance 'ucoc :cui1 (parse-cui cui) :cui2 (ensure-integer cui2)
-                  :soc soc :cot cot :cof (ensure-integer cof) :coa coa
-                  :pfstr2 kpfstr2)))
+    (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 (find-pfstr-cui cui2))))

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

-  (with-umlisp-query (mrcoc (cui1 soc cot cof coa kpfstr2) srl cui2
-                           (parse-cui cui2) :lrl klrl :order (cof asc))
-    (setq cui2 (ensure-integer cui2))
+  (ensure-cui-integer 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))
     (when (zerop cui2) (setq cui2 nil))

-    (make-instance 'ucoc :cui1 (ensure-integer cui1) :cui2 (parse-cui cui2)
-                  :soc soc :cot cot :cof (ensure-integer cof) :coa coa
-                  :pfstr2 kpfstr2)))
+    (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 (find-pfstr-cui cui2))))

 
 (defun find-ucon-coc-cui2 (cui2 &key (srl *current-srl*))
   "List of ucon with co-occurance cui2"
 
 (defun find-ucon-coc-cui2 (cui2 &key (srl *current-srl*))
   "List of ucon with co-occurance cui2"

-  (mapcar 
+  (ensure-cui-integer cui2)
+  (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"
-  (with-umlisp-query (mrlo (isn fr un sui sna soui) srl cui (parse-cui cui)
-                          :lrl "KLRL")
-    (make-instance 'ulo :isn isn :fr (ensure-integer fr) :un un
-                  :sui (ensure-integer sui) :sna sna :soui soui)))
-
-(defgeneric suistr (lo))
-(defmethod suistr ((lo ulo))
-  "Return the string for a ulo object"
-  (find-string-sui (sui lo)))
-
-(defun find-uatx-cui (cui &key (srl *current-srl*))
-  "Return a list of uatx for cui"
-  (with-umlisp-query (mratx (sab rel atx) srl cui (parse-cui cui) :lrl ksrl)
-    (make-instance 'uatx :sab sab :rel rel :atx atx)))
-

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

-  (with-umlisp-query (mrcon (lui lat ts kluilrl) srl cui (parse-cui cui)
+  (ensure-cui-integer cui)
+  (collect-umlisp-query (mrconso (lui lat ts kluilrl) srl cui cui

                            :lrl kluilrl :distinct t)
                            :lrl kluilrl :distinct t)

-    (make-instance 'uterm :lui (ensure-integer lui) :cui (parse-cui cui)
+    (make-instance 'uterm :lui (ensure-integer lui) :cui cui

                   :lat lat :ts ts :lrl (ensure-integer kluilrl))))
 
 (defun find-uterm-lui (lui &key (srl *current-srl*))
   "Return a list of uterm for lui"
                   :lat lat :ts ts :lrl (ensure-integer kluilrl))))
 
 (defun find-uterm-lui (lui &key (srl *current-srl*))
   "Return a list of uterm for lui"

-  (with-umlisp-query (mrcon (cui lat ts kluilrl) srl lui (parse-lui lui) 
+  (ensure-lui-integer lui)
+  (collect-umlisp-query (mrconso (cui lat ts kluilrl) srl lui lui

                             :lrl kluilrl :distinct t)
                             :lrl kluilrl :distinct t)

-    (make-instance 'uterm :cui (ensure-integer cui) :lui (parse-lui lui)
+    (make-instance 'uterm :cui (ensure-integer cui) :lui lui

                   :lat lat :ts ts :lrl (ensure-integer kluilrl))))
 
 (defun find-uterm-cuilui (cui lui &key (srl *current-srl*))
   "Return single uterm for cui/lui"
                   :lat lat :ts ts :lrl (ensure-integer kluilrl))))
 
 (defun find-uterm-cuilui (cui lui &key (srl *current-srl*))
   "Return single uterm for cui/lui"

-  (with-umlisp-query (mrcon (lat ts kluilrl) srl kcuilui
-                            (make-cuilui (parse-cui cui) (parse-lui lui))
+  (ensure-cui-integer cui)
+  (ensure-lui-integer lui)
+  (collect-umlisp-query (mrconso (lat ts kluilrl) srl kcuilui
+                            (make-cuilui cui lui)

                             :lrl kluilrl :single t)
     (make-instance 'uterm :cui cui :lui lui :lat lat :ts ts
                   :lrl (ensure-integer kluilrl))))
 
 (defun find-ustr-cuilui (cui lui &key (srl *current-srl*))
   "Return a list of ustr for cui/lui"
                             :lrl kluilrl :single t)
     (make-instance 'uterm :cui cui :lui lui :lat lat :ts ts
                   :lrl (ensure-integer kluilrl))))
 
 (defun find-ustr-cuilui (cui lui &key (srl *current-srl*))
   "Return a list of ustr for cui/lui"

-  (with-umlisp-query (mrcon (sui stt str lrl) srl kcuilui
-                           (make-cuilui cui lui) :lrl lrl)
-    (make-instance 'ustr :sui (ensure-integer sui) :cui cui :lui lui
-                  :cuisui (make-cuisui cui sui) :stt stt :str str
-                  :lrl (ensure-integer lrl))))
+  (ensure-cui-integer cui)
+  (ensure-lui-integer lui)
+  (collect-umlisp-query (mrconso (sui stt str suppress ksuilrl) srl kcuilui
+                                (make-cuilui cui lui) :lrl ksuilrl)
+               (make-instance 'ustr :sui (ensure-integer sui) :cui cui :lui lui
+                  :cuisui (make-cuisui cui sui) :stt stt :str str :suppress suppress
+                  :lrl (ensure-integer ksuilrl))))

 
 (defun find-ustr-cuisui (cui sui &key (srl *current-srl*))
   "Return the single ustr for cuisui"
 
 (defun find-ustr-cuisui (cui sui &key (srl *current-srl*))
   "Return the single ustr for cuisui"

-  (with-umlisp-query (mrcon (lui stt str lrl) srl kcuisui
-                           (make-cuisui cui sui) :lrl lrl :single t)
+  (ensure-cui-integer cui)
+  (ensure-sui-integer sui)
+  (collect-umlisp-query (mrconso (lui stt str suppress ksuilrl) srl kcuisui
+                           (make-cuisui cui sui) :lrl lsuilrl :single t)

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

-                  :lui (ensure-integer lui) :stt stt :str str
-                  :lrl (ensure-integer lrl))))
+                  :lui (ensure-integer lui) :stt stt :str str :suppress suppress
+                  :lrl (ensure-integer ksuilrl))))

 
 (defun find-ustr-sui (sui &key (srl *current-srl*))
   "Return the list of ustr for sui"
 
 (defun find-ustr-sui (sui &key (srl *current-srl*))
   "Return the list of ustr for sui"

-  (with-umlisp-query (mrcon (cui lui stt str lrl) srl sui (parse-sui sui)
-                           :lrl lrl)
+  (ensure-sui-integer sui)
+  (collect-umlisp-query (mrconso (cui lui stt str suppress ksuilrl) srl sui sui
+                           :lrl ksuilrl)

     (make-instance 'ustr :sui sui :cui cui :stt stt :str str
     (make-instance 'ustr :sui sui :cui cui :stt stt :str str

-                  :cuisui (make-cuisui (ensure-integer cui) (parse-sui sui))
-                  :lui (ensure-integer lui) :lrl (ensure-integer lrl))))
-      
+                  :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"
 (defun find-ustr-sab (sab &key (srl *current-srl*))
   "Return the list of ustr for sab"

-  (with-umlisp-query (mrso (kcuisui) srl sab sab :lrl srl)
+  (collect-umlisp-query (mrconso (kcuisui) srl sab sab :lrl srl)

     (let ((cuisui (ensure-integer kcuisui)))
     (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))))))


@@ -376,92 +536,146 @@ 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
        'list

-       #'(lambda (cui lui sui stt lrl pfstr)
-          (make-instance 'ustr :cui (ensure-integer cui)
-                         :lui (ensure-integer lui) :sui (ensure-integer sui)
-                         :stt stt :str pfstr
-                         :cuisui (make-cuisui (ensure-integer cui)
-                                              (ensure-integer sui))
-                         :lrl (ensure-integer lrl)))
-       (query-string mrcon (cui lui sui stt lrl kpfstr) srl nil nil :lrl lrl
+       #'(lambda (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)
+                           :stt stt :str (find-pfstr-cui cui)
+                           :cuisui (make-cuisui (ensure-integer cui)
+                                                (ensure-integer sui))
+                           :suppress suppress
+                           :lrl (ensure-integer ksuilrl))))
+       (query-string mrconso (cui lui sui stt ksuilrl) srl nil nil :lrl ksuilrl

                     :distinct t
                     :order (sui asc))
        :database db)))
 
 (defun find-string-sui (sui &key (srl *current-srl*))
   "Return the string associated with sui"
                     :distinct t
                     :order (sui asc))
        :database db)))
 
 (defun find-string-sui (sui &key (srl *current-srl*))
   "Return the string associated with sui"

-  (with-umlisp-query (mrcon (str) srl sui sui :lrl lrl :single t)
+  (ensure-sui-integer sui)
+  (collect-umlisp-query (mrconso (str) srl sui sui :lrl ksuilrl :single t)

     str))
 
 (defun find-uso-cuisui (cui sui &key (srl *current-srl*))
     str))
 
 (defun find-uso-cuisui (cui sui &key (srl *current-srl*))

-  (with-umlisp-query (mrso (sab code srl tty) srl kcuisui
-                          (make-cuisui cui sui) :lrl srl)
-      (make-instance 'uso :sab sab :code code :srl srl :tty tty)))
+  (ensure-sui-integer sui)
+  (ensure-cui-integer cui)
+  (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
+                   :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 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 :lat lat
+                   :str str)))

 
 (defun find-ucxt-cuisui (cui sui &key (srl *current-srl*))
 
 (defun find-ucxt-cuisui (cui sui &key (srl *current-srl*))

-  (with-umlisp-query (mrcxt (sab code cxn cxl rnk cxs cui2 hcd rela xc)
+  (ensure-cui-integer cui)
+  (ensure-sui-integer sui)
+  (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
                   :cxn (ensure-integer cxn) :cxl cxl :cxs cxs :hcd hcd

-                  :rela rela :xc xc :rnk (ensure-integer rnk)
+                  :rela rela :xc xc

                   :cui2 (ensure-integer cui2))))
 
                   :cui2 (ensure-integer cui2))))
 

+(defun find-uhier-cui (cui &key (srl *current-srl*))
+  (ensure-cui-integer cui)
+  (collect-umlisp-query (mrhier (aui cxn paui sab rela ptr hcd cvf)
+                           srl cui cui :lrl ksrl)
+    (make-instance 'uhier :cui cui :aui (ensure-integer aui)
+                  :cxn (ensure-integer cxn)
+                  :paui (ensure-integer paui)
+                  :sab sab :rela rela :ptr ptr :hcd hcd :cvf cvf)))
+
+(defun find-uhier-all (&key (srl *current-srl*))
+  (collect-umlisp-query (mrhier (cui aui cxn paui sab rela ptr hcd cvf)
+                           srl nil nil :lrl ksrl)
+    (make-instance 'uhier :cui cui :aui (ensure-integer aui)
+                  :cxn (ensure-integer cxn)
+                  :paui (ensure-integer paui)
+                  :sab sab :rela rela :ptr ptr :hcd hcd :cvf cvf)))
+

 (defun find-usat-ui (cui &optional (lui nil) (sui nil) &key (srl *current-srl*))
 (defun find-usat-ui (cui &optional (lui nil) (sui nil) &key (srl *current-srl*))

-  (let ((ls (format nil "select CODE,ATN,SAB,ATV from MRSAT where ")))
+  (ensure-cui-integer cui)
+  (ensure-lui-integer lui)
+  (ensure-sui-integer sui)
+  (let ((ls "SELECT CODE,ATN,SAB,ATV FROM MRSAT WHERE "))

     (cond
     (cond

-      (sui (string-append ls (format nil "KCUISUI=~D" (make-cuisui cui sui))))
-      (lui (string-append ls (format nil "KCUILUI=~D and sui=0"
-                                    (make-cuilui cui lui))))
-      (t (string-append ls (format nil "cui=~D and lui=0 and sui=0" cui))))
+      (sui (string-append ls "KCUISUI='"
+                         (integer-string (make-cuisui cui sui) 14)
+                         "'"))
+      (lui (string-append ls "KCUILUI='"
+                         (integer-string (make-cuilui cui lui) 14)
+                         "' and sui='0'"))
+      (t (string-append ls "cui='" (prefixed-fixnum-string cui nil 7)
+                       "' and lui='0' and sui='0'")))

     (when srl
     (when srl

-      (string-append ls (format nil " and KSRL <= ~D" srl)))
-    (loop for tuple in (mutex-sql-query ls) collect 
+      (string-append ls " and KSRL<=" (prefixed-fixnum-string srl nil 3)))
+    (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)))))
 
 (defun find-usty-tui (tui)
   "Find usty for tui"
          (destructuring-bind (code atn sab atv) tuple
            (make-instance 'usat :code code :atn atn :sab sab :atv atv)))))
 
 (defun find-usty-tui (tui)
   "Find usty for tui"

-  (with-umlisp-query (mrsty (sty) nil tui (parse-tui tui) :single t)
-    (make-instance 'usty :tui (parse-tui tui) :sty sty)))
+  (ensure-tui-integer tui)
+  (collect-umlisp-query (mrsty (sty) nil tui tui :single t)
+    (make-instance 'usty :tui tui :sty sty)))

 
 (defun find-usty-sty (sty)
   "Find usty for a sty"
 
 (defun find-usty-sty (sty)
   "Find usty for a sty"

-  (with-umlisp-query (mrsty (tui) nil sty sty :single t)
+  (collect-umlisp-query (mrsty (tui) nil sty sty :single t)

     (make-instance 'usty :tui (ensure-integer tui) :sty sty)))
 
 (defun find-usty-all ()
   "Return list of usty's for all semantic types"
     (make-instance 'usty :tui (ensure-integer tui) :sty sty)))
 
 (defun find-usty-all ()
   "Return list of usty's for all semantic types"

-  (with-umlisp-query (mrsty (tui) nil nil nil :distinct t)
+  (collect-umlisp-query (mrsty (tui) nil nil nil :distinct t)

     (find-usty-tui tui)))
 
 (defun find-usab-all ()
     (find-usty-tui tui)))
 
 (defun find-usab-all ()

-  "Find usab for a key"
-  (with-umlisp-query (mrsab (vcui rcui vsab rsab son sf sver mstart mend imeta
+  "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
                                  rmeta slc scc srl tfr cfr cxty ttyl atnl lat

-                                 cenc curver sabin) nil nil nil)
-    (make-instance 'usab :vcui (ensure-integer vcui) 
+                                 cenc curver sabin ssn scit) nil nil nil)
+    (make-instance 'usab :vcui (ensure-integer vcui)

                   :rcui (ensure-integer rcui) :vsab vsab :rsab rsab :son son
                   :rcui (ensure-integer rcui) :vsab vsab :rsab rsab :son son

-                  :sf sf :sver sver :mstart mstart :mend mend :imeta imeta
+                  :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
                   :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)))
+                  :curver curver :sabin sabin :ssn ssn :scit scit)))

 
 (defun find-usab-by-key (key-name key)
   "Find usab for a key"
 
 (defun find-usab-by-key (key-name key)
   "Find usab for a key"

-  (with-umlisp-query-eval ('mrsab '(vcui rcui vsab rsab son sf sver mstart
-                                   mend imeta rmeta slc scc srl tfr cfr cxty
-                                   ttyl atnl lat cenc curver sabin)
-                                 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 :mstart mstart :mend mend :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)))
+  (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
+                                      ssn scit)
+                                    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
+                   :ssn ssn :scit scit)))

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


@@ -474,76 +688,153 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-cui-max ()
   (ensure-integer (caar (mutex-sql-query "select max(CUI) from MRCON"))))
 
 (defun find-cui-max ()
   (ensure-integer (caar (mutex-sql-query "select max(CUI) from MRCON"))))
 

+(defun find-umap-cui (cui)
+  (ensure-cui-integer cui)
+  (collect-umlisp-query (mrmap (mapsetsab mapsubsetid maprank fromid fromsid fromexpr
+                                         fromtype fromrule fromres rel rela toid tosid
+                                         toexpr totype torule tores maprule maptype
+                                         mapatn mapatv cvf)
+                              nil mapsetcui cui)
+    (make-instance 'umap :mapsetcui cui :mapsetsab mapsetsab :mapsubsetid mapsubsetid
+                  :maprank (ensure-integer maprank) :fromid fromid :fromsid fromsid
+                  :fromexpr fromexpr :fromtype fromtype :fromrule fromrule :fromres fromres
+                  :rel rel :rela rela :toid toid :tosid tosid :toexpr toexpr :totype totype
+                  :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*))
   "Find list of ucon for tui"
 ;;;; Cross table find functions
 
 (defun find-ucon-tui (tui &key (srl *current-srl*))
   "Find list of ucon for tui"

-  (with-umlisp-query (mrsty (cui) srl tui (parse-tui tui) :lrl klrl :order (cui asc))
+  (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)))
     (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"
 (defun find-ucon-word (word &key (srl *current-srl*) (like nil))
   "Return list of ucons that match word. Optionally, use SQL's LIKE syntax"

-  (with-umlisp-query-eval ('mrxw_eng '(cui) srl 'wd word :like like :distinct t
+  (collect-umlisp-query-eval ('mrxw_eng '(cui) srl 'wd word :like like :distinct t

                                     :lrl 'klrl :order '(cui asc))
     (find-ucon-cui cui :srl srl)))
 
 (defun find-ucon-normalized-word (word &key (srl *current-srl*) (like nil))
   "Return list of ucons that match word, optionally use SQL's LIKE syntax"
                                     :lrl 'klrl :order '(cui asc))
     (find-ucon-cui cui :srl srl)))
 
 (defun find-ucon-normalized-word (word &key (srl *current-srl*) (like nil))
   "Return list of ucons that match word, optionally use SQL's LIKE syntax"

-  (with-umlisp-query-eval ('mrxnw_eng '(cui) srl 'nwd word :like like :distinct t
+  (collect-umlisp-query-eval ('mrxnw_eng '(cui) srl 'nwd word :like like :distinct t

                                      :lrl 'klrl :order '(cui asc))
     (find-ucon-cui cui :srl srl)))
 
                                      :lrl 'klrl :order '(cui asc))
     (find-ucon-cui cui :srl srl)))
 

+(defun find-cui-normalized-word (word &key (srl *current-srl*) (like nil))
+  "Return list of cui that match word, optionally use SQL's LIKE syntax"
+  (collect-umlisp-query-eval ('mrxnw_eng '(cui) srl 'nwd word :like like :distinct t
+                                        :lrl 'klrl :order '(cui asc))
+                            cui))
+
+(defun find-lui-normalized-word (word &key (srl *current-srl*) (like nil))
+  "Return list of cui that match word, optionally use SQL's LIKE syntax"
+  (collect-umlisp-query-eval ('mrxnw_eng '(lui) srl 'nwd word :like like :distinct t
+                                        :lrl 'klrl :order '(cui asc))
+                            lui))
+
+(defun find-sui-normalized-word (word &key (srl *current-srl*) (like nil))
+  "Return list of cui that match word, optionally use SQL's LIKE syntax"
+  (collect-umlisp-query-eval ('mrxnw_eng '(sui) srl 'nwd word :like like :distinct t
+                                        :lrl 'klrl :order '(cui asc))
+                            sui))
+

 (defun find-ustr-word (word &key (srl *current-srl*))
   "Return list of ustrs that match word"
 (defun find-ustr-word (word &key (srl *current-srl*))
   "Return list of ustrs that match word"

-  (with-umlisp-query (mrxw_eng (cui sui) srl wd word :lrl klrl
+  (collect-umlisp-query (mrxw_eng (cui sui) srl wd word :lrl klrl

                               :order (cui asc sui asc))
     (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl)))
 
 (defun find-ustr-normalized-word (word &key (srl *current-srl*))
   "Return list of ustrs that match word"
                               :order (cui asc sui asc))
     (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl)))
 
 (defun find-ustr-normalized-word (word &key (srl *current-srl*))
   "Return list of ustrs that match word"

-  (with-umlisp-query (mrxnw_eng (cui sui) srl nwd word :lrl klrl
+  (collect-umlisp-query (mrxnw_eng (cui sui) srl nwd word :lrl klrl

                                 :order (cui asc sui asc))
     (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl)))
 
                                 :order (cui asc sui asc))
     (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl)))
 

+(defun find-uterm-word (word &key (srl *current-srl*))
+  "Return list of uterms that match word"
+  (collect-umlisp-query (mrxw_eng (cui lui) srl wd word :lrl klrl
+                              :order (cui asc lui asc))
+    (find-uterm-cuilui (ensure-integer cui) (ensure-integer lui) :srl srl)))
+
+(defun find-uterm-normalized-word (word &key (srl *current-srl*))
+  "Return list of uterms that match word"
+  (collect-umlisp-query (mrxnw_eng (cui lui) srl nwd word :lrl klrl
+                                :order (cui asc lui asc))
+    (find-uterm-cuilui (ensure-integer cui) (ensure-integer lui) :srl srl)))
+

 (defun find-ucon-noneng-word (word &key (srl *current-srl*) (like nil))
   "Return list of ucons that match non-english word"
 (defun find-ucon-noneng-word (word &key (srl *current-srl*) (like nil))
   "Return list of ucons that match non-english word"

-  (with-umlisp-query-eval ('mrxw_noneng '(cui) srl 'wd word :like like
+  (collect-umlisp-query-eval ('mrxw_noneng '(cui) srl 'wd word :like like

                                        :distinct t :lrl 'klrl :order '(cui asc))
     (find-ucon-cui cui :srl srl)))
 
 (defun find-ustr-noneng-word (word &key (srl *current-srl*))
   "Return list of ustrs that match non-english word"
                                        :distinct t :lrl 'klrl :order '(cui asc))
     (find-ucon-cui cui :srl srl)))
 
 (defun find-ustr-noneng-word (word &key (srl *current-srl*))
   "Return list of ustrs that match non-english word"

-  (with-umlisp-query (mrxw_noneng (cui sui) srl wd word :lrl klrl
+  (collect-umlisp-query (mrxw_noneng (cui sui) srl wd word :lrl klrl

                                  :order (cui asc sui asc))
     (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl)))
 
 ;; Special tables
 
 (defun find-usrl-all ()
                                  :order (cui asc sui asc))
     (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl)))
 
 ;; Special tables
 
 (defun find-usrl-all ()

-  (with-umlisp-query (usrl (sab srl) nil nil nil :order (sab asc))
+  (collect-umlisp-query (usrl (sab srl) nil nil nil :order (sab asc))

     (make-instance 'usrl :sab sab :srl (ensure-integer srl))))
 
 ;;; Multiword lookup and score functions
 
     (make-instance 'usrl :sab sab :srl (ensure-integer srl))))
 
 ;;; Multiword lookup and score functions
 

-(defun find-ucon-multiword (str &key (srl *current-srl*))
-  "Return sorted list of ucon's that match a multiword string"
-  (let* ((words (delimited-string-to-list str #\space))
-        (ucons '()))
-    (dolist (word words)
-      (setq ucons (append ucons (find-ucon-word word :srl srl))))
-    (sort-score-ucon-str str (delete-duplicates ucons :test #'eql :key #'cui))))
-
-(defun find-ustr-multiword (str &key (srl *current-srl*))
-  "Return sorted list of ustr's that match a multiword string"
-  (let* ((words (delimited-string-to-list str #\space))
-        (ustrs '()))
-    (dolist (word words)
-      (setq ustrs (append ustrs (find-ustr-word word :srl srl))))
-    (sort-score-ustr-str str (delete-duplicates ustrs :test #'eql :key #'cui))))
-       
-(defun sort-score-ucon-str (str ucons)
+(defun find-uobj-multiword (str obj-lookup-fun sort-fun key srl
+                           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))))
+      (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)
+                                     limit)
+  (find-uobj-multiword str #'find-ucon-word #'sort-score-pfstr-str
+                      #'cui srl only-exact-if-match limit))
+
+(defun find-uterm-multiword (str &key (srl *current-srl*)
+                                     (only-exact-if-match t)
+                                      limit)
+  (find-uobj-multiword str #'find-uterm-word #'sort-score-pfstr-str
+                      #'lui srl only-exact-if-match limit))
+
+(defun find-ustr-multiword (str &key (srl *current-srl*)
+                                    (only-exact-if-match t)
+                                     limit)
+  (find-uobj-multiword str #'find-ustr-word #'sort-score-ustr-str
+                      #'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"
   "Return list of sorted and scored ucons. Score by match of str to ucon-pfstr"

-  (sort-score-umlsclass-str ucons str #'pfstr))
+  (sort-score-umlsclass-str uobjs str #'pfstr))

 
 (defun sort-score-ustr-str (str ustrs)
   "Return list of sorted and scored ucons. Score by match of str to ucon-pfstr"
 
 (defun sort-score-ustr-str (str ustrs)
   "Return list of sorted and scored ucons. Score by match of str to ucon-pfstr"


@@ -553,137 +844,212 @@ 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))))
 

-(defun score-multiword-match (s1 s2)
-  "Score a match between two strings with s1 being reference string"
-  (let* ((word-list-1 (delimited-string-to-list s1 #\space))
-        (word-list-2 (delimited-string-to-list s2 #\space))
-        (n1 (length word-list-1))
-        (n2 (length word-list-2))
-        (unmatched n1)
-        (score 0)
-        (nlong 0)
-        (nshort 0)
-        short-list long-list)
-    (declare (fixnum n1 n2 nshort nlong score unmatched))
-    (if (> n1 n2)
-       (progn
-         (setq nlong n1)
-         (setq nshort n2)
-         (setq long-list word-list-1)
-         (setq short-list word-list-2))
-      (progn
-       (setq nlong n2)
-       (setq nshort n1)
-       (setq long-list word-list-2)
-       (setq short-list word-list-1)))
-    (decf score (- nlong nshort)) ;; reduce score for extra words
-    (dotimes (iword nshort)
-      (declare (fixnum iword))
-      (kmrcl:aif (position (nth iword short-list) long-list :test #'string-equal)
-          (progn
-            (incf score (- 10 (abs (- kmrcl::it iword))))
-            (decf unmatched))))
-    (decf score (* 2 unmatched))
-    score))
-

 
 ;;; LEX SQL functions
 
 (defun find-lexterm-eui (eui)
 
 ;;; LEX SQL functions
 
 (defun find-lexterm-eui (eui)

-  (with-umlisp-query (lrwd (wrd) nil eui eui :single t)
+  (ensure-eui-integer eui)
+  (collect-umlisp-query (lrwd (wrd) nil eui eui :single t)

     (make-instance 'lexterm :eui eui :wrd wrd)))
 
 (defun find-lexterm-word (wrd)
     (make-instance 'lexterm :eui eui :wrd wrd)))
 
 (defun find-lexterm-word (wrd)

-  (with-umlisp-query (lrwd (eui) nil wrd wrd)
+  (collect-umlisp-query (lrwd (eui) nil wrd wrd)

     (make-instance 'lexterm :eui (ensure-integer eui)
                   :wrd (copy-seq wrd))))
 
 ;; LEX SQL Read functions
 
 (defun find-labr-eui (eui)
     (make-instance 'lexterm :eui (ensure-integer eui)
                   :wrd (copy-seq wrd))))
 
 ;; LEX SQL Read functions
 
 (defun find-labr-eui (eui)

-  (with-umlisp-query (lrabr (bas abr eui2 bas2) nil eui eui) 
+  (ensure-eui-integer 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))))
 
 (defun find-labr-bas (bas)
     (make-instance 'labr :eui eui :bas bas :abr abr :bas2 bas2
                   :eui2 (ensure-integer eui2))))
 
 (defun find-labr-bas (bas)

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

     (make-instance 'labr :eui (ensure-integer eui) :abr abr :bas2 bas2
                   :bas (copy-seq bas) :eui2 (ensure-integer eui2))))
 
 (defun find-lagr-eui (eui)
     (make-instance 'labr :eui (ensure-integer eui) :abr abr :bas2 bas2
                   :bas (copy-seq bas) :eui2 (ensure-integer eui2))))
 
 (defun find-lagr-eui (eui)

-  (with-umlisp-query (lragr (str sca agr cit bas) nil eui eui)
+  (ensure-eui-integer eui)
+  (collect-umlisp-query (lragr (str sca agr cit bas) nil eui eui)

     (make-instance 'lagr :eui eui :str str :sca sca :agr agr
                   :cit cit :bas bas)))
 
 (defun find-lcmp-eui (eui)
     (make-instance 'lagr :eui eui :str str :sca sca :agr agr
                   :cit cit :bas bas)))
 
 (defun find-lcmp-eui (eui)

-  (with-umlisp-query (lrcmp (bas sca com) nil eui eui)
+  (ensure-eui-integer eui)
+  (collect-umlisp-query (lrcmp (bas sca com) nil eui eui)

     (make-instance 'lcmp :eui eui :bas bas :sca sca :com com)))
 
 (defun find-lmod-eui (eui)
     (make-instance 'lcmp :eui eui :bas bas :sca sca :com com)))
 
 (defun find-lmod-eui (eui)

-  (with-umlisp-query (lrmod (bas sca psn_mod fea) nil eui eui)
+  (ensure-eui-integer eui)
+  (collect-umlisp-query (lrmod (bas sca psn_mod fea) nil eui eui)

     (make-instance 'lmod :eui eui :bas bas :sca sca :psnmod psn_mod :fea fea)))
 
 (defun find-lnom-eui (eui)
     (make-instance 'lmod :eui eui :bas bas :sca sca :psnmod psn_mod :fea fea)))
 
 (defun find-lnom-eui (eui)

-  (with-umlisp-query (lrnom (bas sca eui2 bas2 sca2) nil eui eui)
+  (ensure-eui-integer eui)
+  (collect-umlisp-query (lrnom (bas sca eui2 bas2 sca2) nil eui eui)

     (make-instance 'lnom :eui eui :bas bas :sca sca :bas2 bas2 :sca2 sca2
                   :eui2 (ensure-integer eui2))))
 
 (defun find-lprn-eui (eui)
     (make-instance 'lnom :eui eui :bas bas :sca sca :bas2 bas2 :sca2 sca2
                   :eui2 (ensure-integer eui2))))
 
 (defun find-lprn-eui (eui)

-  (with-umlisp-query (lrprn (bas num gnd cas pos qnt fea) nil eui eui)
+  (ensure-eui-integer eui)
+  (collect-umlisp-query (lrprn (bas num gnd cas pos qnt fea) nil eui eui)

     (make-instance 'lprn :eui eui :bas bas :num num :gnd gnd
                   :cas cas :pos pos :qnt qnt :fea fea)))
 
 (defun find-lprp-eui (eui)
     (make-instance 'lprn :eui eui :bas bas :num num :gnd gnd
                   :cas cas :pos pos :qnt qnt :fea fea)))
 
 (defun find-lprp-eui (eui)

-  (with-umlisp-query (lrprp (bas str sca fea) nil eui eui)
+  (ensure-eui-integer eui)
+  (collect-umlisp-query (lrprp (bas str sca fea) nil eui eui)

     (make-instance 'lprp :eui eui :bas bas :str str :sca sca :fea fea)))
 
 (defun find-lspl-eui (eui)
     (make-instance 'lprp :eui eui :bas bas :str str :sca sca :fea fea)))
 
 (defun find-lspl-eui (eui)

-  (with-umlisp-query (lrspl (spv bas) nil eui eui)
+  (ensure-eui-integer eui)
+  (collect-umlisp-query (lrspl (spv bas) nil eui eui)

     (make-instance 'lspl :eui eui :spv spv :bas bas)))
 
 (defun find-ltrm-eui (eui)
     (make-instance 'lspl :eui eui :spv spv :bas bas)))
 
 (defun find-ltrm-eui (eui)

-  (with-umlisp-query (lrtrm (bas gen) nil eui eui) 
+  (ensure-eui-integer 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)

-  (with-umlisp-query (lrtyp (bas sca typ) nil eui eui)
+  (ensure-eui-integer eui)
+  (collect-umlisp-query (lrtyp (bas sca typ) nil eui eui)

     (make-instance 'ltyp :eui eui :bas bas :sca sca :typ typ)))
 
 (defun find-lwd-wrd (wrd)
     (make-instance 'ltyp :eui eui :bas bas :sca sca :typ typ)))
 
 (defun find-lwd-wrd (wrd)

-  (make-instance 'lwd :wrd
-                :euilist (with-umlisp-query (lrwd (eui) nil wrd wrd)
-                           (ensure-integer eui))))
+  (make-instance 'lwd :wrd wrd
+                :euilist (collect-umlisp-query (lrwd (eui) nil wrd wrd)
+                                               (ensure-integer eui))))

 
 ;;; Semantic Network SQL access functions
 
 (defun find-sdef-ui (ui)
 
 ;;; Semantic Network SQL access functions
 
 (defun find-sdef-ui (ui)

-  (with-umlisp-query (srdef (rt sty_rl stn_rtn def ex un rh abr rin)
+  (collect-umlisp-query (srdef (rt sty_rl stn_rtn def ex un rh abr rin)

                            nil ui ui :single t)
     (make-instance 'sdef :rt rt :ui ui :styrl sty_rl :stnrtn stn_rtn
                   :def def :ex ex :un un :rh rh :abr abr :rin rin)))
 
 (defun find-sstre1-ui (ui)
                            nil ui ui :single t)
     (make-instance 'sdef :rt rt :ui ui :styrl sty_rl :stnrtn stn_rtn
                   :def def :ex ex :un un :rh rh :abr abr :rin rin)))
 
 (defun find-sstre1-ui (ui)

-  (with-umlisp-query (srstre1 (ui2 ui3) nil ui ui)
+  (collect-umlisp-query (srstre1 (ui2 ui3) nil ui ui)

     (make-instance 'sstre1 :ui ui :ui2 (ensure-integer ui2)
                   :ui3 (ensure-integer ui3))))
 
 (defun find-sstre1-ui2 (ui2)
     (make-instance 'sstre1 :ui ui :ui2 (ensure-integer ui2)
                   :ui3 (ensure-integer ui3))))
 
 (defun find-sstre1-ui2 (ui2)

-  (with-umlisp-query (srstre1 (ui ui3) nil ui2 ui2)
+  (collect-umlisp-query (srstre1 (ui ui3) nil ui2 ui2)

     (make-instance 'sstre1 :ui (ensure-integer ui) :ui2 ui2
                   :ui3 (ensure-integer ui3))))
 
 (defun find-sstr-rl (rl)
     (make-instance 'sstre1 :ui (ensure-integer ui) :ui2 ui2
                   :ui3 (ensure-integer ui3))))
 
 (defun find-sstr-rl (rl)

-  (with-umlisp-query (srstre (sty_rl sty_rl2 ls) nil rl rl)
+  (collect-umlisp-query (srstre (sty_rl sty_rl2 ls) nil rl rl)

     (make-instance 'sstr :rl rl :styrl sty_rl :styrl2 sty_rl2 :ls ls)))
 
 (defun find-sstre2-sty (sty)
     (make-instance 'sstr :rl rl :styrl sty_rl :styrl2 sty_rl2 :ls ls)))
 
 (defun find-sstre2-sty (sty)

-  (with-umlisp-query (srstre2 (rl sty2) nil sty sty)
+  (collect-umlisp-query (srstre2 (rl sty2) nil sty sty)

     (make-instance 'sstre2 :sty (copy-seq sty) :rl rl :sty2 sty2)))
 
 (defun find-sstr-styrl (styrl)
     (make-instance 'sstre2 :sty (copy-seq sty) :rl rl :sty2 sty2)))
 
 (defun find-sstr-styrl (styrl)

-  (with-umlisp-query (srstr (rl sty_rl2 ls) nil styrl styrl)
+  (collect-umlisp-query (srstr (rl sty_rl2 ls) nil styrl styrl)

     (make-instance 'sstr :styrl styrl :rl rl :styrl2 sty_rl2 :ls ls)))
     (make-instance 'sstr :styrl styrl :rl rl :styrl2 sty_rl2 :ls ls)))

+
+
+;;; **************************
+;;; Local Classes
+;;; **************************
+
+
+(defun make-ustats ()
+  (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)
+      (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 "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 "Simple Attribute Count" "MRSAT" "*" "KSRL" srl)
+      (insert-ustats-count conn "Source Abbreviation Count" "MRSAB" "*" "SRL" srl)
+      (insert-ustats-count conn "Word Index Count" "MRXW_ENG" "*" "KLRL" srl)
+      (insert-ustats-count conn "Normalized Word Index Count" "MRXNW_ENG" "*" "KLRL" srl)
+      (insert-ustats-count conn "Normalized String Index Count" "MRXNS_ENG" "*" "KLRL" srl))
+    (sql-execute "create index USTATS_SRL on USTATS (SRL)" conn))
+  (find-ustats-all))
+
+(defun insert-ustats-count (conn name table count-variable srl-control srl)
+  (insert-ustats conn name (find-count-table conn table srl count-variable srl-control) srl))
+
+(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"
+                             count-variable table srl-control srl)
+                     conn))))
+   ((null srl-control)
+    (ensure-integer
+     (caar (sql-query (format nil "select count(~a) from ~a"
+                             count-variable table )
+                     conn))))
+   (t
+    (error "Unknown srl-control")
+    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))
+              conn))
+
+(defun find-ustats-all (&key (srl *current-srl*))
+  (if srl
+      (collect-umlisp-query (ustats (name count srl) nil srl srl
+                                   :order (name asc))
+                           (make-instance 'ustats :name name
+                                          :hits (ensure-integer count)
+                                          :srl (ensure-integer srl)))
+    (collect-umlisp-query (ustats (name count srl) nil nil nil
+                                 :order (name asc))
+                         (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-bsab-sab (sab)
+ (collect-umlisp-query (bonus_sab (name count) nil sab sab :single t)
+     (make-instance 'bsab :sab sab :name name :hits (ensure-integer count))))
+
+(defun find-bsab-all ()
+ (collect-umlisp-query (bonus_sab (sab name count) nil nil nil :order (sab asc))
+     (make-instance 'bsab :sab sab :name name :hits (ensure-integer count))))
+
+(defun find-btty-tty (tty)
+ (collect-umlisp-query (bonus_tty (name count) nil tty tty :single t)
+     (make-instance 'btty :tty tty :name name :hits (ensure-integer count))))
+
+(defun find-btty-all ()
+ (collect-umlisp-query (bonus_tty (tty name count) nil nil nil :order (tty asc))
+  (make-instance 'btty :tty tty :name name :hits (ensure-integer count))))
+
+(defun find-brel-rel (rel)
+  (collect-umlisp-query (bonus_rel (sab sl rel rela count) nil rel rel)
+    (make-instance 'brel :sab sab :sl sl :rel rel :rela rela
+                   :hits (ensure-integer count))))