r3614: *** empty log message ***

diff --git a/classes.lisp b/classes.lisp
index 09b1e9e0b7a7506eee9f36ef8d01bac08ba3a019..87c058a1914d19d4a6e280e8cc9a9a1bbb64c2b8 100644 (file)
--- 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 9b1120c0cb76caa5aa6156dde16d799ea58afb96..2d4d6affa70efee431296e91ea06663b845ead7a 100644 (file)
--- 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 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))