-(defun fmt-comma-integer (i)
- (format nil "~:d" i))
-
-(defgeneric fmt-cui (c))
-(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"))
-
-(defgeneric fmt-lui (c))
-(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))))
-
-(defgeneric fmt-sui (s))
-(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))))
-
-(defgeneric fmt-tui (t))
-(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))))
-
-(defgeneric fmt-eui (e))
-(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)
- "Returns two values: T/NIL if term is english and T/NIL if obj is a TERM"
- (if (eq (hyperobject::class-name (hyperobject::class-of obj)) 'uterm)
- (values (string-equal (lat obj) "ENG") t)
- (values nil nil))))
-
-
-(defgeneric print-umlsclass (obj &key os format label file-wrapper english-only subobjects refvars)
- )
-
-(defmethod print-umlsclass ((obj umlsclass) &key (os *standard-output*) (format :text)
- (label nil) (file-wrapper t) (english-only nil) (subobjects nil)
- (refvars nil))
- (view 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 define-lookup-display (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)))
- (print-umlsclass obj :os os :format format :label label
- :file-wrapper file-wrapper :english-only english-only
- :subobjects subobjects)
- obj)))
-
-(define-lookup-display display-con #'find-ucon-cui)
-(define-lookup-display display-term #'find-uterm-lui)
-(define-lookup-display display-str #'find-ustr-sui)
-
-#+(or scl cmu)
-(dolist (c '(urank udef usat uso ucxt ustr ulo uterm usty urel ucoc uatx ucon uxw uxnw uxns lexterm labr lagr lcmp lmod lnom lprn lprp lspl ltrm ltyp lwd sdef sstr sstre1 sstre2 usrl))
- #+cmu
- (let ((cl (pcl:find-class c)))
- (pcl:finalize-inheritance cl))
- #+scl
- (let ((cl (find-class c)))
- (clos:finalize-inheritance cl)))
+(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"))