X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=blobdiff_plain;f=sql-classes.lisp;h=20ef37eafe82939234e727cfa8441c18f3edfa97;hp=f6f306ecb204ce8162f92bcf39b9dad8d01a5d3c;hb=57c4b059639968903aec88e65103a7263cb97535;hpb=357dad37300c0f2cc45156dae18bd89265c20431

diff --git a/sql-classes.lisp b/sql-classes.lisp
index f6f306e..20ef37e 100644
--- 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"
@@ -253,7 +255,13 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
       str)
    (collect-umlisp-query (mrconso (str) srl cui cui :distinct t
                                   :single t)
-      str)))
+                         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"
@@ -380,15 +388,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"