;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: classes.lisp,v 1.9 2002/11/04 18:02:13 kevin Exp $
+;;;; $Id: classes.lisp,v 1.12 2002/11/12 17:25:43 kevin Exp $
;;;;
;;;; This file, part of UMLisp, is
;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
(in-package :umlisp)
(declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3)))
-(defclass umlsclass ()
+(defclass umlsclass (hyperobject)
()
(:metaclass hyperobject-class)
(:documentation "Parent class of all UMLS objects. It is based on the HYPEROBJECT-CLASS metaclass that provides object printing functions."))
-(defmethod print-object ((obj umlsclass) (s stream))
- (print-unreadable-object (obj s :type t :identity t)
- (let ((fmt (make-instance 'kmrcl::textformat)))
- (apply #'format
- s (funcall (kmrcl::obj-data-fmtstr fmt) obj)
- (multiple-value-list
- (funcall (funcall (kmrcl::obj-data-value-func fmt) obj) obj))))))
-
-
(defclass usrl (umlsclass)
((sab :type string :initarg :sab :reader sab)
(srl :type integer :initarg :srl :reader srl))
(:metaclass hyperobject-class)
(:default-initargs :def nil :sab nil)
(:title "Definition")
- (:ref-fields (sab find-bsab-sab))
+ (:ref-fields (sab find-usab-rsab))
(:fields (sab :string) (def :cdata)))
(defclass usat (umlsclass)
(:metaclass hyperobject-class)
(:default-initargs :sab nil :code nil :atn nil :atv nil)
(:title "Simple Attribute")
- (:ref-fields (sab find-bsab-sab))
+ (:ref-fields (sab find-usab-rsab))
(:fields (sab :string) (code :string) (atn :string) (atv :cdata)))
+(defclass usab (umlsclass)
+ ((vcui :type fixnum :initarg :vcui :reader vcui)
+ (rcui :type fixnum :initarg :rcui :reader rcui)
+ (vsab :type string :initarg :vsab :reader vsab)
+ (rsab :type string :initarg :rsab :reader rsab)
+ (son :type string :initarg :son :reader son)
+ (sf :type string :initarg :sf :reader sf)
+ (sver :type string :initarg :sver :reader sver)
+ (mstart :type string :initarg :mstart :reader mstart)
+ (mend :type string :initarg :mend :reader mend)
+ (imeta :type string :initarg :imeta :reader imeta)
+ (rmeta :type string :initarg :rmeta :reader rmeta)
+ (slc :type string :initarg :slc :reader slc)
+ (scc :type string :initarg :scc :reader scc)
+ (srl :type fixnum :initarg :srl :reader srl)
+ (tfr :type fixnum :initarg :tfr :reader tfr)
+ (cfr :type fixnum :initarg :cfr :reader cfr)
+ (cxty :type string :initarg :cxty :reader cxty)
+ (ttyl :type string :initarg :ttyl :reader ttyl)
+ (atnl :type string :initarg :atnl :reader atnl)
+ (lat :type string :initarg :lat :reader lat)
+ (cenc :type string :initarg :cenc :reader cenc)
+ (curver :type string :initarg :curver :reader curver)
+ (sabin :type string :initarg :sabin :reader sabin))
+ (:metaclass hyperobject-class)
+ (:default-initargs :vcui nil :rcui nil :vsab nil :rsab nil :son nil :sf nil
+ :sver nil :mstart nil :mend nil :imeta nil :rmeta nil
+ :slc nil :scc nil :srl nil :tfr nil :cfr nil :cxty nil
+ :ttyl nil :atnl nil :lat nil :cenc nil :curver nil
+ :sabin nil)
+ (:title "Source Abbreviation")
+ (:ref-fields (rsab find-ucon-sab))
+ (:fields (vcui :string fmt-cui) (rcui :string fmt-cui)
+ (vsab :string) (rsab :string) (son :cdata) (sf :string)
+ (sver :string) (mstart :string) (mend :string) (imeta :string)
+ (rmeta :string) (slc :cdata) (scc :cdata) (srl :fixnum)
+ (tfr :commainteger) (cfr :commainteger) (cxty :string)
+ (ttyl :string) (atnl :string) (lat :string) (cenc :string)
+ (curver :string) (sabin :string)))
+
(defclass uso (umlsclass)
((sab :type string :initarg :sab :reader sab)
(code :type string :initarg :code :reader code)
(:metaclass hyperobject-class)
(:default-initargs :sab nil :code nil :tty nil :srl nil)
(:title "Source")
- (:ref-fields (sab find-bsab-sab) (tty find-btty-tty))
+ (:ref-fields (sab find-usab-rsab) (tty find-btty-tty))
(:fields (sab :string) (code :string) (tty :string) (srl :fixnum)))
(defclass ucxt (umlsclass)
(:default-initargs :sab nil :code nil :rnk nil :cxn nil :cxl nil :cxs nil
:cui2 nil :hcd nil :rela nil :xc nil)
(:title "Context")
- (:ref-fields (sab find-bsab-sab) (cui2 find-ucon-cui))
+ (:ref-fields (sab find-usab-rsab) (cui2 find-ucon-cui))
(:fields
(sab :string) (code :string) (rnk :fixnum) (cxn :fixnum) (cxl :string)
(hcd :string) (rela :string) (xc :string) (cui2 :string fmt-cui)
(:default-initargs
:rel nil :cui1 nil :cui2 nil :pfstr2 nil :rela nil :sab nil :sl nil :mg nil)
(:title "Relationship")
- (:ref-fields (rel find-brel-rel) (sab find-bsab-sab) (cui2 find-ucon-cui))
+ (:ref-fields (rel find-brel-rel) (sab find-usab-rsab) (cui2 find-ucon-cui))
(:fields (rel :string) (rela :string) (sab :string) (sl :string)
(mg :string) (cui2 :string fmt-cui) (pfstr2 :cdata)))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun english-term-p (obj)
"Returns two values: T/NIL if term is english and T/NIL if obj is a TERM"
- (if (eq (kmrcl::hyperobject-class-name (kmrcl::hyperobject-class-of obj)) 'uterm)
+ (if (eq (hyperobject::portable-class-name (hyperobject::portable-class-of obj)) 'uterm)
(values (string-equal (lat obj) "ENG") t)
(values nil nil))))