From 756b9f208a0f807c326b0ecc6d29bfc73967440e Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Thu, 14 Sep 2006 15:01:36 +0000 Subject: [PATCH] r11154: fix var name --- class-support.lisp | 19 +++++++++++++------ package.lisp | 2 +- sql-classes.lisp | 16 ++++++++-------- 3 files changed, 22 insertions(+), 15 deletions(-) diff --git a/class-support.lisp b/class-support.lisp index 2b94e91..92b39aa 100644 --- 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 d8fbe3f..18cbc61 100644 --- 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 5543d58..1187d59 100644 --- 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 -- 2.34.1