From: Kevin M. Rosenberg <kevin@rosenberg.net>
Date: Fri, 13 Dec 2002 07:34:20 +0000 (+0000)
Subject: r3614: *** empty log message ***
X-Git-Tag: v2006ac.2~278
X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=commitdiff_plain;h=03d2fef42180320a95c7a795564ed3456b9854a0

r3614: *** empty log message ***
---

diff --git a/classes.lisp b/classes.lisp
index 09b1e9e..87c058a 100644
--- a/classes.lisp
+++ b/classes.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: classes.lisp,v 1.23 2002/12/13 05:43:38 kevin Exp $
+;;;; $Id: classes.lisp,v 1.24 2002/12/13 07:34:20 kevin Exp $
 ;;;;
 ;;;; This file, part of UMLisp, is
 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
@@ -226,8 +226,8 @@
 (defclass ucon (umlsclass)
   ((cui :type fixnum :initarg :cui :reader cui :print-formatter fmt-cui
 	:hyperlink find-ucon-cui)
-   (pfstr :type cdata :initarg :pfstr :reader pfstr)
    (lrl :type fixnum :initarg :lrl :reader lrl)
+   (pfstr :type cdata :initarg :pfstr :reader pfstr)
    (s#term :reader s#term :subobject (find-uterm-cui cui))
    (s#def :reader s#def :subobject (find-udef-cui cui))
    (s#lo :reader s#lo :subobject (find-ulo-cui cui))
@@ -237,7 +237,7 @@
    (s#atx :reader s#atx :subobject (find-uatx-cui cui))
    (s#sty :reader s#sty :subobject (find-usty-cui cui)))
   (:metaclass hyperobject-class)
-  (:default-initargs :cui nil :pfstr nil :lrl nil)
+  (:default-initargs :cui nil :lrl nil :pfstr nil)
   (:user-name "Concept")
   (:default-print-slots cui lrl pfstr))
 
diff --git a/package.lisp b/package.lisp
index 9b1120c..2d4d6af 100644
--- a/package.lisp
+++ b/package.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: package.lisp,v 1.14 2002/12/09 14:11:09 kevin Exp $
+;;;; $Id: package.lisp,v 1.15 2002/12/13 07:34:20 kevin Exp $
 ;;;;
 ;;;; This file, part of UMLisp, is
 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
@@ -67,6 +67,7 @@
    #:find-uatx-cui
    #:print-umlsclass
    #:find-ucon-cui
+   #:find-ucon-cui-sans-pfstr
    #:find-ucon-lui
    #:find-ucon-sui
    #:find-ucon-cuisui
diff --git a/sql-classes.lisp b/sql-classes.lisp
index 72a7297..1777bbb 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.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))