X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql-classes.lisp;h=25567ebc3e946b2621710c0be9f6986691687627;hb=f1ceffd73c7e181db3b2a739b7dbc64243cfca2d;hp=b163e0bbd657a5f4ecea92c8fe537684c98c5238;hpb=baef3e3eba503d04fe6d19ac3087bf9d3dbc37b9;p=umlisp.git

diff --git a/sql-classes.lisp b/sql-classes.lisp
index b163e0b..25567eb 100644
--- a/sql-classes.lisp
+++ b/sql-classes.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: sql-classes.lisp,v 1.11 2002/12/09 14:11:09 kevin Exp $
+;;;; $Id: sql-classes.lisp,v 1.14 2002/12/13 08:41:32 kevin Exp $
 ;;;;
 ;;;; This file, part of UMLisp, is
 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
@@ -49,18 +49,39 @@
 
 (defun find-ucon-cui (cui &key (srl *current-srl*))
   "Find ucon for a cui"
-  (if (stringp cui)
+  (when (stringp cui) (setq cui (parse-cui cui)))
+  (when cui
+    (let ((ls (format nil "select KPFSTR,KCUILRL from MRCON where CUI=~d" cui)))
+      (when srl
+	(string-append ls (format nil " and KCUILRL <= ~d" srl)))
+      (string-append ls " limit 1")
+      (awhen (car (mutex-sql-query ls))
+	     (make-instance 'ucon :cui cui :pfstr (car it) 
+			    :lrl (ensure-integer (cadr it)))))))
+
+(defun find-ucon-cui-sans-pfstr (cui &key (srl *current-srl*))
+  "Find ucon for a cui"
+  (when (stringp cui) (setq cui (parse-cui cui)))
+  (when cui
+    (let ((ls (format nil "select KCUILRL from MRCON where CUI=~d" cui)))
+      (when srl
+	(string-append ls (format nil " and KCUILRL <= ~d" srl)))
+      (string-append ls " limit 1")
+      (awhen (car (mutex-sql-query ls))
+	     (make-instance 'ucon :cui cui
+			    :lrl (ensure-integer (cdr it)))))))
+
+(defun find-pfstr-cui (cui &key (srl *current-srl*))
+  "Find preferred string for a cui"
+  (when (stringp cui)
       (setq cui (parse-cui cui)))
-  (if cui
-      (let ((ls (format nil "select KPFSTR,KCUILRL from MRCON where CUI=~d"
-			cui)))
-	(if srl
-	    (string-append ls (format nil " and KCUILRL <= ~d limit 1" srl))
-	  (string-append ls " limit 1"))
-	(kmrcl:awhen (car (mutex-sql-query ls))
-		  (make-instance 'ucon :cui cui :pfstr (car kmrcl::it) 
-				 :lrl (ensure-integer (cadr kmrcl::it)))))
-    nil))
+  (when cui
+      (let ((ls (format nil "select KPFSTR from MRCON where CUI=~d" cui)))
+	(when srl
+	  (string-append ls (format nil " and KCUILRL <= ~d" srl)))
+	(string-append ls " limit 1")
+	(awhen (car (mutex-sql-query ls))
+	       (car it)))))
 
 (defun find-ucon-lui (lui &key (srl *current-srl*))
   "Find list of ucon for lui"
@@ -467,10 +488,9 @@
 	(string-append ls (format nil " and KSRL <= ~d" srl)))
     (dolist (tuple (mutex-sql-query ls))
       (destructuring-bind (sab code cxn cxl rnk cxs cui2 hcd rela xc) tuple
-	(push (make-instance 'ucxt :sab sab :code 
+	(push (make-instance 'ucxt :sab sab :code code
 			     :cxn (ensure-integer cxn)
 			     :cxl cxl :cxs cxs :hcd hcd :rela rela :xc xc
-			     :code code
 			     :rnk (ensure-integer rnk)
 			     :cui2 (ensure-integer cui2))
 	      ucxts)))
@@ -492,9 +512,6 @@
       (nreverse usats))))
 
 
-(defun find-pfstr-cui (cui)
-  (caar (mutex-sql-query (format nil "select KPFSTR from MRCON where CUI=~d limit 1" cui))))
-
 (defun find-usty-tui (tui)
   "Find usty for tui"
   (setq tui (parse-tui tui)) 
@@ -756,8 +773,8 @@
 	(results '()))
     (dolist (tuple tuples)
       (destructuring-bind (str sca agr cit bas) tuple
-	(push (make-instance 'lagr :eui eui :str str :sca sca :agr agr :
-			     cit cit :bas bas)
+	(push (make-instance 'lagr :eui eui :str str :sca sca :agr agr 
+			     :cit cit :bas bas)
 	      results)))
     (nreverse results)))