+(defun remove-english-terms (uterms)
+ (remove-if #'english-term-p uterms))
+
+
+(defvar +relationship-abbreviations+
+ '(("RB" "Broader" "has a broader relationship")
+ ("RN" "Narrower" "has a narrower relationship")
+ ("RO" "Other related" "has relationship other than synonymous, narrower, or broader")
+ ("RL" "Like" "the two concepts are similar or 'alike'. In the current edition of the Metathesaurus, most relationships with this attribute are mappings provided by a source")
+ ("RQ" "Unspecified" "unspecified source asserted relatedness, possibly synonymous")
+ ("SY" "Source Synonymy" "source asserted synonymy")
+ ("PAR" "Parent" "has parent relationship in a Metathesaurus source vocabulary")
+ ("CHD" "Child" "has child relationship in a Metathesaurus source vocabulary")
+ ("SIB" "Sibling" "has sibling relationship in a Metathesaurus source vocabulary")
+ ("AQ" "Allowed" "is an allowed qualifier for a concept in a Metathesaurus source vocabulary")
+ ("QB" "Qualified" "can be qualified by a concept in a Metathesaurus source vocabulary")))
+
+(defvar *rel-info-table* (make-hash-table :size 30 :test 'equal))
+(defvar *is-rel-table-init* nil)
+(unless *is-rel-table-init*
+ (dolist (relinfo +relationship-abbreviations+)
+ (setf (gethash (string-downcase (car relinfo)) *rel-info-table*)
+ (cdr relinfo)))
+ (setq *is-rel-table-init* t))
+
+(defun rel-abbr-info (rel)
+ (nth-value 0 (gethash (string-downcase rel) *rel-info-table*)))
+
+(defun filter-urels-by-rel (urels rel)
+ (remove-if-not (lambda (urel) (string-equal rel (rel urel))) urels))
+
+
+(defvar +language-abbreviations+
+ '(("BAQ" . "Basque")
+ ("CZE" . "Chech")
+ ("DAN" . "Danish")
+ ("DUT" . "Dutch")
+ ("ENG" . "English")
+ ("FIN" . "Finnish")
+ ("FRE" . "French")
+ ("GER" . "German")
+ ("HEB" . "Hebrew")
+ ("HUN" . "Hungarian")
+ ("ITA" . "Italian")
+ ("JPN" . "Japanese")
+ ("NOR" . "Norwegian")
+ ("POR" . "Portuguese")
+ ("RUS" . "Russian")
+ ("SPA" . "Spanish")
+ ("SWE" . "Swedish")))
+
+(defvar *lat-info-table* (make-hash-table :size 30 :test 'equal))
+(defvar *is-lat-table-init* nil)
+(unless *is-lat-table-init*
+ (dolist (latinfo +language-abbreviations+)
+ (setf (gethash (string-downcase (car latinfo)) *lat-info-table*)
+ (cdr latinfo)))
+ (setq *is-lat-table-init* t))
+
+(defun lat-abbr-info (lat)
+ (aif (nth-value 0 (gethash (string-downcase lat) *lat-info-table*))
+ it
+ lat))
+
+
+
+(defun stt-abbr-info (stt)
+ (when (string-equal "PF" stt)
+ (return-from stt-abbr-info "Preferred"))
+ (when (char-equal #\V (schar stt 0))
+ (setq stt (subseq stt 1)))
+ (loop for c across stt
+ collect
+ (cond
+ ((char-equal #\C c)
+ "Upper/lower case")
+ ((char-equal #\W c)
+ "Word order")
+ ((char-equal #\S c)
+ "Singular")
+ ((char-equal #\P c)
+ "Plural")
+ ((char-equal #\O c)
+ "Other"))))
+
+
+(defgeneric cxt-ancestors (obj))
+(defmethod cxt-ancestors ((con ucon))
+ (loop for term in (s#term con)
+ append (cxt-ancestors term)))
+
+
+(defmethod cxt-ancestors ((term uterm))
+ (loop for str in (s#str term)
+ append (cxt-ancestors str)))
+
+(defmethod cxt-ancestors ((str ustr))
+ "Return the ancestory contexts of a ustr"
+ (let* ((anc (remove-if-not
+ (lambda (cxt) (string-equal "ANC" (cxl cxt)))
+ (s#cxt str)))
+ (num-contexts (if anc
+ (apply #'max (mapcar (lambda (cxt) (cxn cxt)) anc))
+ 0))
+ (anc-lists '()))
+ (dotimes (i num-contexts (nreverse anc-lists))
+ (let* ((anc-this-cxn (remove-if-not
+ (lambda (cxt) (= (1+ i) (cxn cxt))) anc)))
+ (push
+ (sort anc-this-cxn (lambda (a b) (< (rank a) (rank b))))
+ anc-lists)))))
+
+(defun uso-unique-codes (usos)
+ (let ((sab-codes (make-hash-table :test 'equal)))
+ (dolist (uso usos)
+ (setf (gethash (sab uso) sab-codes) (code uso)))
+ (loop for key being the hash-key in sab-codes
+ collect (list key (gethash key sab-codes)))))
+
+(defun ucon-has-sab (ucon sab)
+ (and (find-if (lambda (uso) (string-equal sab (sab uso))) (s#so ucon)) t))
+
+
+#+scl
+(dolist (c '(urank udef usat uso ucxt ustr uterm usty urel ucoc uatx uconso uxw uxnw uxns lexterm labr lagr lcmp lmod lnom lprn lprp lspl ltrm ltyp lwd sdef sstr sstre1 sstre2 usrl))