- ((sty :type string :initarg :ui :reader sty)
- (rl :type string :initarg :ui2 :reader rl)
- (sty2 :type string :initarg :ui3 :reader sty2))
- (:metaclass kmrcl:ml-class)
- (:default-initargs :sty nil :rl nil :sty2 nil)
- (:title "Fully Inherited Set of Releatons (strings)")
- (:fields (sty :string) (rl :string) (sty2 :string)))
-
-;;; Formatting routines
-
-(defmethod fmt-cui ((c ucon))
- (format nil "C~7,'0d" (cui c)))
-
-(defmethod fmt-cui ((c fixnum))
- (format nil "C~7,'0d" c))
-
-(defmethod fmt-cui ((c string))
- (if (eql (aref c 0) #\C)
- c
- (format nil "C~7,'0d" (parse-integer c))))
-
-(defmethod fmt-cui ((c null))
- (format nil "nil"))
-
-(defmethod fmt-lui ((l uterm))
- (format nil "L~7,'0d" (lui l)))
-
-(defmethod fmt-lui ((l fixnum))
- (format nil "L~7,'0d" l))
-
-(defmethod fmt-lui ((l string))
- (if (eql (aref l 0) #\L)
- l
- (format nil "L~7,'0d" (parse-integer l))))
-
-(defmethod fmt-sui ((s ustr))
- (format nil "S~7,'0d" (sui s)))
-
-(defmethod fmt-sui ((s fixnum))
- (format nil "S~7,'0d" s))
-
-(defmethod fmt-sui ((s string))
- (if (eql (aref s 0) #\S)
- s
- (format nil "S~7,'0d" (parse-integer s))))
-
-(defmethod fmt-tui ((s fixnum))
- (format nil "T~3,'0d" s))
-
-(defmethod fmt-tui ((s string))
- (if (eql (aref s 0) #\T)
- s
- (format nil "T~3,'0d" (parse-integer s))))
-
-(defmethod fmt-eui ((e fixnum))
- (format nil "E~7,'0d" e))
-
-(defmethod fmt-eui ((e string))
- (if (eql (aref e 0) #\E)
- e
- (format nil "E~7,'0d" (parse-integer e))))
-
-(defmethod fmt-eui ((e null))
- (format nil "nil"))
-
-;;; Generic display functions
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-(defun english-term-p (obj)
- (and (eq (class-name (class-of obj)) 'uterm)
- (string-equal (lat obj) "ENG"))))
-
-(defun display-umls-obj
- (obj &key (os *standard-output*) (format :text) (label nil)
- (file-wrapper t) (english-only nil) (subobjects nil)
- (refvars nil))
- (display-ml-class
- obj :os os :format format :label label :subobjects subobjects
- :file-wrapper file-wrapper
- :english-only-function (if english-only #'english-term-p nil)
- :refvars refvars))
-
-(defmacro defludisp-ml-class (newfuncname lookup-func)
- "Defines functions for looking up and displaying objects"
- `(defun ,newfuncname
- (keyval &key (os *standard-output*) (format :text) (label nil)
- (file-wrapper t) (english-only nil) (subobjects nil))
- (let ((obj (funcall ,lookup-func keyval)))
- (display-umls-obj obj :os os :format format :label label
- :file-wrapper file-wrapper :english-only english-only
- :subobjects subobjects))))
-
-(defludisp-ml-class disp-con #'find-ucon-cui)
-(defludisp-ml-class disp-term #'find-uterm-lui)
-(defludisp-ml-class disp-str #'find-ustr-sui)
-
+ ((sty :value-type string :initarg :ui :reader sty)
+ (rl :value-type string :initarg :ui2 :reader rl)
+ (sty2 :value-type string :initarg :ui3 :reader sty2))
+ (:metaclass hyperobject-class)
+ (:user-name "Fully Inherited Set of Relation (strings)"
+ "Fully Inherited Set of Relations (strings)")
+ (:default-print-slots sty rl sty2))
+
+
+;;; **************************
+;;; Local Classes
+;;; **************************
+
+(defclass ustats (umlsclass)
+ ((name :value-type string :initarg :name :reader name)
+ (hits :value-type integer :initarg :hits :reader hits
+ :user-name "count"
+ :print-formatter fmt-comma-integer)
+ (srl :value-type fixnum :initarg :srl :reader srl))
+ (:metaclass hyperobject-class)
+ (:default-initargs :name nil :hits nil :srl nil)
+ (:user-name "UMLS Statistic")
+ (:default-print-slots name hits srl)
+ (:documentation "Custom Table: UMLS Database statistics."))
+
+
+(defclass bsab (umlsclass)
+ ((sab :value-type string :initarg :sab :reader sab
+ :hyperlink find-ustr-sab
+ :hyperlink-parameters (("subobjects" . "no")))
+ (name :value-type string :initarg :name :reader name)
+ (hits :value-type fixnum :initarg :hits :reader hits
+ :user-name "count"
+ :print-formatter fmt-comma-integer))
+ (:metaclass hyperobject-class)
+ (:default-initargs :sab nil :name nil :hits nil)
+ (:user-name "Source of Abbreviation")
+ (:default-print-slots sab name hits)
+ (:documentation "Bonus SAB file"))
+
+(defclass btty (umlsclass)
+ ((tty :value-type string :initarg :tty :reader tty)
+ (name :value-type string :initarg :name :reader name)
+ (hits :value-type fixnum :initarg :hits :reader hits
+ :user-name "count"
+ :print-formatter fmt-comma-integer))
+ (:metaclass hyperobject-class)
+ (:default-initargs :tty nil :name nil :hits nil)
+ (:user-name "Bonus TTY")
+ (:default-print-slots tty name hits)
+ (:documentation "Bonus TTY file"))
+
+(defclass brel (umlsclass)
+ ((sab :value-type string :initarg :sab :reader sab)
+ (sl :value-type string :initarg :sl :reader sl)
+ (rel :value-type string :initarg :rel :reader rel)
+ (rela :value-type string :initarg :rela :reader rela)
+ (hits :value-type fixnum :initarg :hits :reader hits
+ :user-name "count"
+ :print-formatter fmt-comma-integer))
+ (:metaclass hyperobject-class)
+ (:default-initargs :sab nil :sl nil :rel nil :rela nil :hits nil)
+ (:user-name "Bonus REL")
+ (:default-print-slots sab sl rel rela hits)
+ (:documentation "Bonus REL file"))
+
+(defclass batn (umlsclass)
+ ((sab :value-type string :initarg :sab :reader sab)
+ (atn :value-type string :initarg :atn :reader atn)
+ (hits :value-type fixnum :initarg :hits :reader hits
+ :user-name "count"
+ :print-formatter fmt-comma-intger))
+ (:metaclass hyperobject-class)
+ (:default-initargs :sab nil :atn nil)
+ (:user-name "Bonus ATN")
+ (:default-print-slots sab atn hits)
+ (:documentation "Bonus ATN file"))