r9039: 2003AC updates

[umlisp.git] / sql-classes.lisp

diff --git a/sql-classes.lisp b/sql-classes.lisp
index 34cbd2a17041c011c4c828931f8ee6b0cfba04d9..2171632836fd8048ea05f4ab8550072b59cf24a7 100644 (file)
--- a/sql-classes.lisp
+++ b/sql-classes.lisp
@@ -7,7 +7,7 @@
 ;;;; Author:        Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: sql-classes.lisp,v 1.90 2003/07/21 11:22:51 kevin Exp $
+;;;; $Id$
 ;;;;
 ;;;; This file, part of UMLisp, is
 ;;;;    Copyright (c) 2000-2003 by Kevin M. Rosenberg, M.D.
@@ -256,6 +256,12 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
                   :pfstr kpfstr
                   :lrl (ensure-integer kcuilrl))))
 
+(defun find-cui-ucon-all (&key (srl *current-srl*))
+  "Return list of CUIs for all ucons"
+  (collect-umlisp-query (mrcon (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)
@@ -298,6 +304,13 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
                   :cui2 (ensure-integer cui2) :rela rela :sab sab :sl sl
                   :mg mg :pfstr2 kpfstr2)))
 
+(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"
   (ensure-cui-integer cui2)
@@ -497,12 +510,12 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 
 (defun find-usab-all ()
   "Find usab for a key"
-  (collect-umlisp-query (mrsab (vcui rcui vsab rsab son sf sver mstart mend imeta
+  (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) nil nil nil)
     (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
+                  :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
@@ -510,13 +523,13 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 
 (defun find-usab-by-key (key-name key)
   "Find usab for a key"
-  (collect-umlisp-query-eval ('mrsab '(vcui rcui vsab rsab son sf sver mstart
-                                   mend imeta rmeta slc scc srl tfr cfr cxty
+  (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)
                                  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
+                  :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
@@ -553,6 +566,24 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
                                      :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"
   (collect-umlisp-query (mrxw_eng (cui sui) srl wd word :lrl klrl
@@ -717,9 +748,9 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
     (make-instance 'ltyp :eui eui :bas bas :sca sca :typ typ)))
 
 (defun find-lwd-wrd (wrd)
-  (make-instance 'lwd :wrd
+  (make-instance 'lwd :wrd wrd
                 :euilist (collect-umlisp-query (lrwd (eui) nil wrd wrd)
-                           (ensure-integer eui))))
+                                               (ensure-integer eui))))
 
 ;;; Semantic Network SQL access functions