r3614: *** empty log message ***

[umlisp.git] / sql-classes.lisp

diff --git a/sql-classes.lisp b/sql-classes.lisp
index 72a7297b3fdd19f29af0f976f8b5464fe640cbba..1777bbbc65ebd43569e4b0b7fdb9d1536dcdebed 100644 (file)
--- 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.12 2002/12/09 19:38:02 kevin Exp $
+;;;; $Id: sql-classes.lisp,v 1.13 2002/12/13 07:34:20 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"
@@ -491,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))