r11168: add cdist-metric

[umlisp.git] / sql-classes.lisp

diff --git a/sql-classes.lisp b/sql-classes.lisp
index f6f306ecb204ce8162f92bcf39b9dad8d01a5d3c..6a566f2570d677eb2dff9662439c643c00bcd611 100644 (file)
--- a/sql-classes.lisp
+++ b/sql-classes.lisp
@@ -224,25 +224,27 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
     (setq ,eui (parse-eui ,eui))
     ,eui))
 
-(defun find-ucon-cui (cui &key (srl *current-srl*))
+(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"
   (ensure-cui-integer cui)
   (unless cui (return-from find-ucon-cui 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-ucon-cui-sans-pfstr (cui &key (srl *current-srl*))
-  "Find ucon for a 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)))
+  (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"
@@ -380,15 +382,19 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
                            :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)
-                              srl cui1 cui :lrl "KSRL")
-    (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 :pfstr2 (find-pfstr-cui cui2))))
+                              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"