r11624: improve find-uconso-code

[umlisp.git] / sql-classes.lisp

diff --git a/sql-classes.lisp b/sql-classes.lisp
index 2831defc003504ff2c1f488793d013a80d612535..6bd0012f9809c2cbb3c32b2dd5293e2dfc0ac05a 100644 (file)
--- a/sql-classes.lisp
+++ b/sql-classes.lisp
@@ -25,110 +25,137 @@
 (defun current-srl! (srl)
   (setq *current-srl* srl))
 
 (defun current-srl! (srl)
   (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~)~^,~}"
+(defmacro query-string (table fields srl where-name where-value
+                       &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
-             #+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")))))
-
-(defun query-string-eval (table fields &optional srl where-name where-value
-                         &key (lrl "KCUILRL") single distinct order like)
+                   (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 (~S) and limit (~S)" ,%single ,%limit))
+         (,%single
+          " LIMIT 1")
+         (,%limit
+          (format nil " LIMIT ~D" ,%limit))
+         (t
+          ""))))))
+
+(defun query-string-eval (table fields srl where-name where-value
+                         &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
                 (number "='~D'")
    (if where-name
        (format nil
               (typecase where-value
                 (number "='~D'")

-                (null " is null")
+                (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
                     &key (lrl "KCUILRL") single distinct order like
 
 
 (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
   "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
 
 (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
   "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
 
 ;; 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
                                &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
        `(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))))))
 
 (defmacro collect-umlisp-query-eval ((table fields srl where-name where-value
                                         &key (lrl "KCUILRL") distinct single
               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))
                                  &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
                (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)))


@@ -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
               (,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))))))
 
 ;;;
               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))
 
     (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))
 (defmacro ensure-tui-integer (tui)
   `(if (stringp ,tui)
     (setq ,tui (parse-tui ,tui))


@@ -184,61 +224,101 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
     (setq ,eui (parse-eui ,eui))
     ,eui))
 
     (setq ,eui (parse-eui ,eui))
     ,eui))
 

-(defun find-ucon-cui (cui &key (srl *current-srl*))
-  "Find ucon for a cui"
+(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. If set SAB, the without-pfstr is on by default"

   (ensure-cui-integer cui)
   (unless cui (return-from find-ucon-cui nil))
 
   (ensure-cui-integer cui)
   (unless cui (return-from find-ucon-cui nil))
 

-  (let ((tuple (car (mutex-sql-query 
-                     (format nil
-                             "SELECT kcuilrl,str FROM MRCONSO WHERE CUI=~D AND KPFENG=1~A"
-                             cui (if srl (format nil " AND SRL<=~D" srl) ""))))))
-    (unless tuple
-      (setq tuple (car (mutex-sql-query
-                        (format nil
-                                "SELECT kcuilrl,str FROM MRCONSO WHERE CUI=~D"
-                                cui (if srl (format nil " AND SRL<=~D" srl) nil))))))
-    (unless tuple
-      (return-from find-ucon-cui nil))
-    (make-instance 'ucon :cui cui :pfstr (second tuple)
-                   :lrl (ensure-integer (first tuple)))))
-
-(defun find-ucon-cui-sans-pfstr (cui &key (srl *current-srl*))
-  "Find ucon for a cui"
+  (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-uconso-cui (cui &key sab (srl *current-srl*))
+  "Find uconso for a cui."

   (ensure-cui-integer 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)))
+  (unless cui (return-from find-uconso-cui nil))
+
+  (collect-umlisp-query (mrconso (lat ts lui stt sui ispref aui saui scui sdui sab tty code str
+                                      srl suppress cvf kpfeng kcuisui kcuilui kcuilrl
+                                      kluilrl ksuilrl) srl cui cui
+                                      :filter (if sab (concatenate 'string "SAB='" sab "'") nil))
+    (make-instance 'uconso :cui cui :lat lat :ts ts :lui lui :stt stt :sui sui :ispref ispref
+                   :aui aui :saui saui :scui scui :sdui sdui :sab sab :tty tty :code code
+                   :str str :srl srl :suppress suppress :cvf cvf :kpfeng kpfeng
+                   :kcuisui kcuisui :kcuilui kcuilui :kcuilrl kcuilrl :kluilrl kluilrl
+                   :ksuilrl ksuilrl)))
+
+
+(defun find-uconso-code (code &key first sab (srl *current-srl*) (like nil))
+  "Return list of uconso objects that match code. Optional, filter for SAB. Optionally, use SQL's LIKE syntax"
+  (collect-umlisp-query (mrconso (cui sab) srl code code :like like :distinct t
+                                 :lrl klrl
+                                 :filter (if sab (concatenate 'string "SAB='" sab "'") nil))
+    (let ((uconsos (find-uconso-cui cui :sab sab :srl srl)))
+      (if first
+          (first uconsos)
+          uconsos))))
+
+(defun find-uconso-sui (sui &key sab (srl *current-srl*))
+  "Find uconso for a sui. If set SAB, the without-pfstr is on by default"
+  (ensure-sui-integer sui)
+  (unless (and sui (stringp sab))
+    (return-from find-uconso-sui nil))
+
+  (collect-umlisp-query (mrconso (cui lat ts lui stt sui ispref aui saui scui sdui sab tty code str
+                                      srl suppress cvf kpfeng kcuisui kcuilui kcuilrl
+                                      kluilrl ksuilrl) srl sui sui
+                                      :distinct t
+                                      :filter (if sab (concatenate 'string "SAB='" sab "'") nil))
+    (make-instance 'uconso :cui cui :lat lat :ts ts :lui lui :stt stt :sui sui :ispref ispref
+                   :aui aui :saui saui :scui scui :sdui sdui :sab sab :tty tty :code code
+                   :str str :srl srl :suppress suppress :cvf cvf :kpfeng kpfeng
+                   :kcuisui kcuisui :kcuilui kcuilui :kcuilrl kcuilrl :kluilrl kluilrl
+                   :ksuilrl ksuilrl)))

 
 (defun find-pfstr-cui (cui &key (srl *current-srl*))
   "Find preferred string for a cui"
   (ensure-cui-integer cui)
   (or
 
 (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 DISTINCT str FROM MRCONSO WHERE CUI=~D AND KPFENG=1~A LIMIT 1"
-                   cui (if srl (format nil " AND SRL<=~D" srl) ""))))
-    (caar (mutex-sql-query
-           (format nil "SELECT DISTINCT str FROM MRCONSO WHERE CUI=~D~A LIMIT 1"
-                   cui (if srl (format nil " AND SRL<=~D" srl) ""))))))
+   (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)
 
 (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))
   (unless lui (return-from find-ucon-lui nil))

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


@@ -249,7 +329,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"
 
 (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))))
   (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))))


@@ -323,24 +403,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)
 (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)
 
 (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)
 
 (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"
 
 (defun find-usty-cui (cui &key (srl *current-srl*))
   "Return a list of usty for cui"


@@ -354,14 +431,28 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
                            :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"
   (ensure-cui-integer cui)
   (collect-umlisp-query (mrrel (aui1 rel stype1 cui2 aui2 stype2 rela rui srui sab sl rg dir suppress cvf)
   "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
                   :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*))
                   :suppress suppress :cvf cvf :pfstr2 (find-pfstr-cui cui2))))
 
 (defun find-cui2-urel-cui (cui &key (srl *current-srl*))


@@ -376,8 +467,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")
   (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))))
 
                   :rela rela :sab sab :sl sl :rg rg :dir dir :suppress suppress :cvf cvf
                   :pfstr2 (find-pfstr-cui cui2))))
 


@@ -511,28 +604,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)
 (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
     (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)
 
 (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
     (make-instance 'uso :aui aui :cui cui :sab sab :code code :srl srl :tty tty

-                  :sui sui :saui saui :sdui sdui :scui scui)))
-
-(defun find-ucxt-cuisui (cui sui &key (srl *current-srl*))
-  (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)
-                       (make-instance 'ucxt :sab sab :code code
-               :rank rank
-                  :cxn (ensure-integer cxn) :cxl cxl :cxs cxs :hcd hcd
-                  :rela rela :xc xc
-                  :cui2 (ensure-integer cui2))))
+                  :sui sui :saui saui :sdui sdui :scui scui :lat lat
+                   :str str)))

 
 (defun find-uhier-cui (cui &key (srl *current-srl*))
   (ensure-cui-integer cui)
 
 (defun find-uhier-cui (cui &key (srl *current-srl*))
   (ensure-cui-integer cui)


@@ -551,11 +644,11 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
                   :paui (ensure-integer paui)
                   :sab sab :rela rela :ptr ptr :hcd hcd :cvf cvf)))
 
                   :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 &key lui sui (srl *current-srl*))

   (ensure-cui-integer cui)
   (ensure-lui-integer lui)
   (ensure-sui-integer sui)
   (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)
     (cond
       (sui (string-append ls "KCUISUI='"
                          (integer-string (make-cuisui cui sui) 14)


@@ -588,7 +681,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
     (find-usty-tui tui)))
 
 (defun find-usab-all ()
     (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)
   (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)


@@ -641,6 +734,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)))
 
                   :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*))
 ;;;; Cross table find functions
 
 (defun find-ucon-tui (tui &key (srl *current-srl*))


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

-(defun find-ucon-word (word &key (srl *current-srl*) (like nil))
-  "Return list of ucons that match word. Optionally, use SQL's LIKE syntax"
-  (collect-umlisp-query-eval ('mrxw_eng '(cui) srl 'wd word :like like :distinct t
-                                    :lrl 'klrl :order '(cui asc))
-    (find-ucon-cui cui :srl srl)))
+(defun mrconso-query-word-cui (word sab srl like)
+  (format nil "SELECT DISTINCT c.cui FROM MRCONSO c,MRXW_ENG x WHERE x.WD~A'~A' AND x.cui=c.cui~A~A"
+          (if like " LIKE " "=")
+          (clsql-sys::sql-escape-quotes word)
+          (etypecase sab
+            (string
+             (format nil " AND c.sab='~A'" (clsql-sys::sql-escape-quotes sab)))
+            (cons
+             (format nil " AND c.sab IN (~{'~A'~^,~})"
+                     (mapcar 'clsql-sys::sql-escape-quotes sab)))
+            (null
+             ""))
+          (if srl (format nil " AND KCUILRL <= ~A" srl) "")))
+
+(defun mrconso-query-word-sui (word sab srl like)
+  (format nil "SELECT DISTINCT c.sui FROM MRCONSO c,MRXW_ENG x WHERE x.WD~A'~A' AND x.sui=c.sui~A~A"
+          (if like " LIKE " "=")
+          (clsql-sys::sql-escape-quotes word)
+          (etypecase sab
+            (string
+             (format nil " AND c.sab='~A'" (clsql-sys::sql-escape-quotes sab)))
+            (cons
+             (format nil " AND c.sab IN (~{'~A'~^,~})"
+                     (mapcar 'clsql-sys::sql-escape-quotes sab)))
+            (null
+             ""))
+          (if srl (format nil " AND KCUILRL <= ~A" srl) "")))
+
+(defun find-uconso-word (word &key sab (srl *current-srl*) (like nil))
+  "Return list of uconso that match word. Optionally, matching SAB. Optionally, use SQL's LIKE syntax"
+  (cond
+    (sab
+     (let ((sui-query (mrconso-query-word-sui word sab srl like))
+           (uconsos nil))
+       (dolist (sui (remove-duplicates (sort (mapcar 'car (mutex-sql-query sui-query)) #'<)))
+         (setq uconsos (nconc uconsos (find-uconso-sui sui :sab sab))))
+       (remove-duplicates uconsos :key 'cui)))
+    (t
+     (collect-umlisp-query-eval ('mrxw_eng '(cui) srl 'wd word :like like :distinct t
+                                           :lrl 'klrl :order '(cui asc))
+       (find-uconso-cui cui :srl srl)))))
+
+(defun find-ucon-word (word &key sab (srl *current-srl*) (like nil))
+  "Return list of ucon that match word in matching SAB. Optionally, use SQL's LIKE syntax"
+  (cond
+    (sab
+     (let ((query (mrconso-query-word-cui word sab srl like)))
+       (loop for tuple in (mutex-sql-query query)
+             collect (make-instance 'ucon :cui (first tuple)))))
+    (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"
 
 (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"


@@ -679,11 +829,30 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
                                         :lrl 'klrl :order '(cui asc))
                             sui))
 
                                         :lrl 'klrl :order '(cui asc))
                             sui))
 

-(defun find-ustr-word (word &key (srl *current-srl*))
-  "Return list of ustrs that match word"
-  (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-word (word &key sab (srl *current-srl*) (like nil))
+  "Return list of ustr that match word in matching SAB. Optionally, use SQL's LIKE syntax"
+  (cond
+    (sab
+     (let ((query (format nil "SELECT c.sui,c.cui,c.lui,c.str,c.lrl,c.stt,c.suppress,c.cuisui FROM MRCONSO c,MRXW_ENG x WHERE x.WD ~A '~A' AND x.cui=c.cui AND x.lui=c.lui AND x.sui=c.sui~A~A"
+                          (if like "LIKE" "=")
+                          (clsql-sys::sql-escape-quotes word)
+                          (typecase sab
+                            (string
+                             (format nil " AND c.sab='~A'" (clsql-sys::sql-escape-quotes sab)))
+                            (cons
+                             (format nil " AND c.sab IN (~('~A'~^,~))"
+                                     (mapcar 'clsql-sys::sql-escape-quotes sab)))
+                            (null
+                             ""))
+                          (if srl (format nil " AND KCUILRL <= ~D" srl) ""))))
+       (loop for tuple in (mutex-sql-query query)
+             collect (destructuring-bind (sui cui lui str lrl stt suppress cuisui) tuple
+                       (make-instance 'ustr :sui sui :cui cui :lui lui :str str :lrl lrl
+                                      :stt stt :suppress suppress :cuisui cuisui)))))
+    (t
+     (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"
 
 (defun find-ustr-normalized-word (word &key (srl *current-srl*))
   "Return list of ustrs that match word"


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

-                           only-exact-if-match limit)
+                                only-exact-if-match limit &key extra-lookup-args)

   (let ((uobjs '()))
     (dolist (word (delimited-string-to-list str #\space))
   (let ((uobjs '()))
     (dolist (word (delimited-string-to-list str #\space))

-      (setq uobjs (append uobjs (funcall obj-lookup-fun word :srl srl))))
+      (setq uobjs (append uobjs (apply obj-lookup-fun word :srl srl extra-lookup-args))))

     (let ((sorted
           (funcall sort-fun str
                    (delete-duplicates uobjs :test #'= :key key))))
     (let ((sorted
           (funcall sort-fun str
                    (delete-duplicates uobjs :test #'= :key key))))


@@ -746,9 +915,19 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 
 (defun find-ucon-multiword (str &key (srl *current-srl*)
                                     (only-exact-if-match t)
 
 (defun find-ucon-multiword (str &key (srl *current-srl*)
                                     (only-exact-if-match t)

-                                     limit)
+                                     limit
+                                     sab)

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

-                      #'cui srl only-exact-if-match limit))
+                       #'cui srl only-exact-if-match limit
+                       :extra-lookup-args (list :sab sab)))
+
+(defun find-uconso-multiword (str &key (srl *current-srl*)
+                                    (only-exact-if-match t)
+                                     limit
+                                     sab)
+  (find-uobj-multiword str #'find-uconso-word #'sort-score-pfstr-str
+                       #'cui srl only-exact-if-match limit
+                       :extra-lookup-args (list :sab sab)))

 
 (defun find-uterm-multiword (str &key (srl *current-srl*)
                                      (only-exact-if-match t)
 
 (defun find-uterm-multiword (str &key (srl *current-srl*)
                                      (only-exact-if-match t)


@@ -758,9 +937,11 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 
 (defun find-ustr-multiword (str &key (srl *current-srl*)
                                     (only-exact-if-match t)
 
 (defun find-ustr-multiword (str &key (srl *current-srl*)
                                     (only-exact-if-match t)

-                                     limit)
+                                     limit
+                                     sab)

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

-                      #'sui srl only-exact-if-match limit))
+                       #'sui srl only-exact-if-match limit
+                       :extra-lookup-args (list :sab sab)))

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


@@ -961,25 +1142,3 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   (collect-umlisp-query (ustats (name count) nil srl srl :order (name asc))
                           (make-instance 'ustats :name name :hits (ensure-integer count))))
 
   (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))))