r11154: fix var name

diff --git a/class-support.lisp b/class-support.lisp
index 2b94e91a93c2451f861100aa3446168d3686f837..92b39aab617f3a7549c0ed5f587cc1eff0078377 100644 (file)
--- a/class-support.lisp
+++ b/class-support.lisp
@@ -104,7 +104,7 @@
 (defgeneric fmt-rui (rui))
 (when *has-fixnum-class*
   (defmethod fmt-rui ((rui fixnum))
-    (prefixed-fixnum-string aui #\A 8)))
+    (prefixed-fixnum-string rui #\A 8)))
 
 (defmethod fmt-rui ((rui integer))
   (prefixed-integer-string rui #\A 8))
@@ -336,12 +336,15 @@
          "Other"))))
 
 
-(defun ucon-parents (con &optional sab)
-  (ucon-ancestors con sab t))
+(defun ucon-parents (con &key sab include-rb)
+  (ucon-ancestors con :sab sab :include-rb include-rb 
+                  :single-level t))
 
-(defun ucon-ancestors (ucon &optional sab single-level)
+(defun ucon-ancestors (ucon &key sab single-level include-rb)
   "Returns a list of ancestor lists for a concept"
-  (let* ((parent-rels (filter-urels-by-rel (s#rel ucon) "par"))
+  (let* ((parent-rels (append (filter-urels-by-rel (s#rel ucon) "par")
+                              (when include-rb 
+                                (filter-urels-by-rel (s#rel ucon) "rb"))))
         (anc nil))
     (when sab
       (setq parent-rels (delete-if-not
@@ -388,7 +391,11 @@
     (loop for key being the hash-key in sab-codes
         collect (list key (gethash key sab-codes)))))
 
-                                          
+
+(defun ucon-has-sab (ucon sab)
+  (and (find-if (lambda (uso) (string-equal sab (sab uso))) (s#so ucon)) t))
+
+    
 #+scl
 (dolist (c '(urank udef usat uso ucxt ustr ulo uterm usty urel ucoc uatx ucon uxw uxnw uxns lexterm labr lagr lcmp lmod lnom lprn lprp lspl ltrm ltyp lwd sdef sstr sstre1 sstre2 usrl))
     (let ((cl (find-class c)))

diff --git a/package.lisp b/package.lisp
index d8fbe3f6734f5630af63da58b02a16889a3fe225..18cbc61e2e2722619ca31fa12eaf016cf4ddbbf2 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -52,7 +52,7 @@
    #:ucon-ancestors #:ucon-parents
    #:mesh-number #:cxt-ancestors #:ucon-ustrs
    #:lat-abbr-info #:stt-abbr-info
-   #:uso-unique-codes
+   #:uso-unique-codes #:ucon-has-sab
    
    ;; From sql.lisp
    #:*umls-sql-db*

diff --git a/sql-classes.lisp b/sql-classes.lisp
index 5543d58d5e4babd3db812ad744afd4ff48a4bfa5..1187d5931bd9bc52a0791c43752dbaa434b2e865 100644 (file)
--- a/sql-classes.lisp
+++ b/sql-classes.lisp
@@ -107,7 +107,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
      :filter ,filter :limit ,limit)))
 
 (defmacro umlisp-query-eval (table fields srl where-name where-value
-                    &key (lrl "KCUILRL") single distinct order like 
+                    &key (lrl "KCUILRL") single distinct order like
                      filter limit)
   "Query the UMLisp database. Return a list of umlisp objects whose name
 is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
@@ -229,7 +229,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   (ensure-cui-integer cui)
   (unless cui (return-from find-ucon-cui nil))
 
-  (let ((tuple (car (mutex-sql-query 
+  (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) ""))))))
@@ -254,10 +254,10 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   "Find preferred string for a cui"
   (ensure-cui-integer cui)
   (or
-   (collect-umlisp-query (mrconso (str) srl cui cui :distinct t 
+   (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 
+   (collect-umlisp-query (mrconso (str) srl cui cui :distinct t
                                   :single t)
       str)))
 
@@ -399,9 +399,9 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (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 cui2 aui2 stype2 rela rui srui sab sl rg dir suppress cvf)
+  (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 cui :aui1 (ensure-integer aui1) :stype1 stype1 :rel rel
+    (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))))
@@ -418,7 +418,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   (ensure-cui-integer cui2)
   (collect-umlisp-query (mrrel (rel cui1 aui1 stype1 aui2 stype2 rela rui srui sab sl rg dir suppress cvf)
                               srl cui2 cui2 :lrl "KSRL")
-    (make-instance 'urel :cui2 cui2 :rel rel :aui2 (ensure-integer aui2) 
+    (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)
@@ -563,7 +563,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 
 (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) 
+  (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