r5339: *** empty log message ***

[umlisp.git] / parse-2002.lisp

diff --git a/parse-2002.lisp b/parse-2002.lisp
index 726764fd63b112f4d5280b5115eab0ff0b3a16fe..53c6d6358dae1c471325ac6979db8425492329e5 100644 (file)
--- a/parse-2002.lisp
+++ b/parse-2002.lisp
@@ -8,10 +8,10 @@
 ;;;; Author:        Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: parse-2002.lisp,v 1.10 2003/05/07 21:57:06 kevin Exp $
+;;;; $Id: parse-2002.lisp,v 1.14 2003/06/11 01:42:03 kevin Exp $
 ;;;;
 ;;;; This file, part of UMLisp, is
-;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
+;;;;    Copyright (c) 2000-2003 by Kevin M. Rosenberg, M.D.
 ;;;;
 ;;;; UMLisp users are granted the rights to distribute and use this software
 ;;;; as governed by the terms of the GNU General Public License.
@@ -23,7 +23,7 @@
   (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))))
 
 ;;; Pre-read data for custom fields into hash tables
-(defvar *parse-hash-init?* nil)
+(defvar *preparse-hash-init?* nil)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
 (let ((pfstr-hash nil)      ;;; Preferred concept strings by CUI
@@ -32,7 +32,7 @@
       (cuisui-lrl-hash nil) ;;; LRL by CUISUI
       (sab-srl-hash nil))   ;;; SRL by SAB
   
-  (defun make-parse-hash-table ()
+  (defun make-preparse-hash-table ()
     (if pfstr-hash
        (progn
          (clrhash pfstr-hash)
@@ -47,10 +47,10 @@
          cuisui-lrl-hash (make-hash-table :size 1800000)
          sab-srl-hash (make-hash-table :size 100 :test 'equal))))
     
-  (defun binit-hash-table (&optional (force-read nil))
-    (when (or force-read (not *parse-hash-init?*))
-      (make-parse-hash-table)
-      (setq *parse-hash-init?* t))
+  (defun buffered-ensure-preparse (&optional (force-read nil))
+    (when (or force-read (not *preparse-hash-init?*))
+      (make-preparse-hash-table)
+      (setq *preparse-hash-init?* t))
     (with-buffered-umls-file (line "MRCON")
       (let ((cui (parse-ui (aref line 0)))
            (lui (parse-ui (aref line 3)))
@@ -69,10 +69,10 @@
        (unless (gethash sab sab-srl-hash)  ;; if haven't stored
          (setf (gethash sab sab-srl-hash) (aref line 6))))))
   
-  (defun init-hash-table (&optional (force-read nil))
-    (when (or force-read (not *parse-hash-init?*))
-      (make-parse-hash-table)
-      (setq *parse-hash-init?* t))
+  (defun ensure-preparse (&optional (force-read nil))
+    (when (or force-read (not *preparse-hash-init?*))
+      (make-preparse-hash-table)
+      (setq *preparse-hash-init?* t))
     (with-umls-file (line "MRCON")
       (let ((cui (parse-ui (nth 0 line)))
            (lui (parse-ui (nth 3 line)))
@@ -106,7 +106,7 @@
     (gethash cuisui cuisui-lrl-hash))
   
   (defun sab-srl (sab)
-    (kmrcl:aif (gethash sab sab-srl-hash) kmrcl::it 0))
+    (aif (gethash sab sab-srl-hash) it 0))
 )) ;; closure
 
 (defun set-lrl-hash (key lrl hash)
@@ -254,6 +254,19 @@
       ("VCUI" "MRSAB") ("LAT" "MRSAB"))
   "Columns in files to index")
 
+(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")))
+
 (defparameter +custom-index-cols+
   nil
   #+ignore
@@ -283,7 +296,8 @@
   (loop for customcol in +custom-cols+
        collect
        (make-ucol (nth 1 customcol) "" 0 0 0 (nth 3 customcol)
-                  (nth 0 customcol) nil :sqltype (nth 2 customcol))))
+                  (nth 0 customcol) nil :sqltype (nth 2 customcol)
+                  :custom-value-fun (nth 4 customcol))))
 
 (defun gen-ucols-generic (col-filename)
 "Initialize for generic (LEX/NET) columns"