parse-rrf.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:     parse-rrf.lisp
   6 ;;;; Purpose:  Parsing and SQL insertion routines for UMLisp which may
   7 ;;;;           change from year to year
   8 ;;;; Author:   Kevin M. Rosenberg
   9 ;;;; Created:  Apr 2000
  10 ;;;;
  11 ;;;; $Id$
  12 ;;;;
  13 ;;;; This file, part of UMLisp, is
  14 ;;;;    Copyright (c) 2000-2006 by Kevin M. Rosenberg, M.D.
  15 ;;;;
  16 ;;;; UMLisp users are granted the rights to distribute and use this software
  17 ;;;; as governed by the terms of the GNU General Public License.
  18 ;;;; *************************************************************************
  19
  20 (in-package #:umlisp)
  21
  22 ;;; Pre-read data for custom fields into hash tables
  23 (defvar *preparse-hash-init?* nil)
  24
  25 (eval-when (:compile-toplevel :load-toplevel :execute)
  26
  27 (declaim (inline srl-to-srlus))
  28 (defun srl-to-srlus (srl)
  29   "Convert the standard SRL category to one oriented for use in the United States.
  30 Specifically, SRL 4 in the USA has license restrictions between SRL 1 and 2 when
  31 used in the United States. We create a new scale (SRLUS) where SRL to SRLUS mapping is:
  32 (0->0, 1->1, 4->2, 2->3, 3->4)."
  33   (declare (fixnum srl))
  34   (cond
  35     ((= srl 4) 2)
  36     ((= srl 2) 3)
  37     ((= srl 3) 4)
  38     (t srl)))
  39
  40 (let ((pfstr-hash nil)      ;; Preferred concept strings by CUI
  41       (cui-lrl-hash nil)    ;; LRL by CUI
  42       (lui-lrl-hash nil)    ;; LRL by LUI
  43       (sui-lrl-hash nil)    ;; LRL by SUI
  44       (cuisui-lrl-hash nil) ;; LRL by CUISUI
  45       (cui-lrlus-hash nil)  ;; LRLUS by CUI
  46       (lui-lrlus-hash nil)  ;; LRLUS by LUI
  47       (sui-lrlus-hash nil)  ;; LRLUS by SUI
  48       (cuisui-lrlus-hash nil) ;; LRL by CUISUI
  49
  50       (sab-srl-hash nil)
  51       (sab-srlus-hash nil))   ;; SRL by SAB
  52
  53   (defun clear-preparse-hash-tables ()
  54     (clrhash pfstr-hash)
  55     (clrhash cui-lrl-hash)
  56     (clrhash lui-lrl-hash)
  57     (clrhash sui-lrl-hash)
  58     (clrhash cuisui-lrl-hash)
  59     (clrhash cui-lrlus-hash)
  60     (clrhash lui-lrlus-hash)
  61     (clrhash sui-lrlus-hash)
  62     (clrhash cuisui-lrlus-hash)
  63     (clrhash sab-srl-hash)
  64     (clrhash sab-srlus-hash))
  65
  66   (defun make-preparse-hash-table ()
  67     (if sui-lrl-hash
  68         (clear-preparse-hash-tables)
  69       (setf
  70           pfstr-hash (make-hash-table :size 1500000)
  71           cui-lrl-hash (make-hash-table :size 1500000)
  72           lui-lrl-hash (make-hash-table :size 5000000)
  73           sui-lrl-hash (make-hash-table :size 6000000)
  74           cuisui-lrl-hash (make-hash-table :size 6000000)
  75           cui-lrlus-hash (make-hash-table :size 1500000)
  76           lui-lrlus-hash (make-hash-table :size 5000000)
  77           sui-lrlus-hash (make-hash-table :size 6000000)
  78           cuisui-lrlus-hash (make-hash-table :size 6000000)
  79           sab-srl-hash (make-hash-table :size 200 :test 'equal)
  80           sab-srlus-hash (make-hash-table :size 200 :test 'equal))))
  81
  82   (defun ensure-preparse (&optional (force-read nil))
  83     (when (and *preparse-hash-init?* (not force-read))
  84       (return-from ensure-preparse 'already-done))
  85     (make-preparse-hash-table)
  86     (let ((counter 0))
  87       (declare (fixnum counter)
  88                (ignorable counter))
  89       (with-umls-file (line "MRCONSO.RRF")
  90         (let* ((cui (parse-ui (nth 0 line)))
  91                (lui (parse-ui (nth 3 line)))
  92                (sui (parse-ui (nth 5 line)))
  93                (sab (nth 11 line))
  94                (srl (parse-integer (nth 15 line)))
  95                (srlus (srl-to-srlus srl)))
  96           #+sbcl
  97           (when (= 0 (mod (incf counter) 100000)) (sb-ext:gc :full t))
  98
  99           ;; pfstr deprecated by KPFENG field in MRCONSO
 100           #+nil
 101           (unless (gethash cui pfstr-hash)  ;; if haven't stored pfstr for cui
 102             (when (and (string-equal (nth 1 line) "ENG") ; LAT
 103                        (string-equal (nth 2 line) "P") ; ts
 104                        (string-equal (nth 4 line) "PF")) ; stt
 105               (setf (gethash cui pfstr-hash) (nth 14 line))))
 106           (set-lrl-hash cui srl cui-lrl-hash)
 107           (set-lrl-hash lui srl lui-lrl-hash)
 108           (set-lrl-hash sui srl sui-lrl-hash)
 109           (set-lrl-hash (make-cuisui cui sui) srl cuisui-lrl-hash)
 110           (set-lrl-hash cui srlus cui-lrlus-hash)
 111           (set-lrl-hash lui srlus lui-lrlus-hash)
 112           (set-lrl-hash sui srlus sui-lrlus-hash)
 113           (set-lrl-hash (make-cuisui cui sui) srlus cuisui-lrlus-hash)
 114           (multiple-value-bind (val found) (gethash sab sab-srl-hash)
 115             (declare (ignore val))
 116             (unless found
 117               (setf (gethash sab sab-srl-hash) srl)))
 118           (multiple-value-bind (val found) (gethash sab sab-srlus-hash)
 119             (declare (ignore val))
 120             (unless found
 121               (setf (gethash sab sab-srlus-hash) srlus))))))
 122     (setq *preparse-hash-init?* t)
 123     t)
 124
 125   #+nil (defun pfstr-hash (cui) (gethash cui pfstr-hash))
 126   (defun cui-lrl (cui)       (gethash cui cui-lrl-hash))
 127   (defun lui-lrl (lui)       (gethash lui lui-lrl-hash))
 128   (defun sui-lrl (sui)       (gethash sui sui-lrl-hash))
 129   (defun cuisui-lrl (cuisui) (gethash cuisui cuisui-lrl-hash))
 130   (defun cui-lrlus (cui)     (gethash cui cui-lrlus-hash))
 131   (defun lui-lrlus (lui)     (gethash lui lui-lrlus-hash))
 132   (defun sui-lrlus (sui)     (gethash sui sui-lrlus-hash))
 133   (defun cuisui-lrlus (cuisui) (gethash cuisui cuisui-lrlus-hash))
 134   (defun sab-srl (sab)      (aif (gethash sab sab-srl-hash) it 0))
 135   (defun sab-srlus (sab)    (aif (gethash sab sab-srlus-hash) it 0))
 136
 137 )) ;; closure
 138
 139
 140 (defun set-lrl-hash (key srl hash)
 141   "Set the least restrictive level in hash table"
 142   (declare (fixnum srl))
 143   (multiple-value-bind (hash-lrl found) (gethash key hash)
 144     (declare (type (or null fixnum) hash-lrl)
 145              (boolean found))
 146     (if (or (not found) (< srl hash-lrl))
 147         (setf (gethash key hash) srl))))
 148
 149 ;; UMLS file and column structures
 150 ;;; SQL datatypes symbols
 151 ;;; sql-u - Unique identifier
 152 ;;; sql-t - Tiny integer (8-bit)
 153 ;;; sql-s - Small integer (16-bit)
 154 ;;; sql-i - Integer (32-bit)
 155 ;;; sql-l - Big integer (64-bit)
 156 ;;; sql-f - Floating point
 157 ;;; sql-c - Character data
 158
 159 (defparameter +col-datatypes+
 160     '(("AV" sql-f) ("BTS" sql-i) ("CLS" sql-i) ("COF" sql-i) ("CUI1" sql-u)
 161       ("AUI" sql-u) ("AUI1" sql-u) ("AUI2" sql-u) ("PCUI" sql-u)
 162       ("PLUI" sql-u) ("PAUI" sql-u) ("RUI" sql-u)
 163       ("CUI2" sql-u) ("CUI" sql-u) ("CXN" sql-s) ("FR" sql-i)
 164       ("LUI" sql-u) ("MAX" sql-s) ("MIN" sql-s) ("RANK" sql-s) ("REF" sql-c)
 165       ("PTR" sql-c)
 166       ("RNK" sql-s) ("RWS" sql-i) ("SRL" sql-t) ("SUI" sql-u) ("TUI" sql-u)
 167       ("MAPRANK" sql-s)
 168       ;;; Custom columns
 169       ("KCUISUI" sql-l) ("KCUILUI" sql-l)
 170       ("KSRL" sql-t) ("KSRLUS" sql-t) ("LRL" sql-t) ("LRLUS" sql-t)
 171       ("KCUILRL" sql-t) ("KLUILRL" sql-t) ("KSUILRL" sql-t) ("KLRL" sql-t)
 172       ("KCUILRLUS" sql-t) ("KLUILRLUS" sql-t) ("KSUILRLUS" sql-t) ("KLRLUS" sql-t)
 173       ;;; LEX columns
 174       ("EUI" sql-u) ("EUI2" sql-u)
 175       ;;; Semantic net columns
 176       ("UI" sql-u) ("UI2" sql-u) ("UI3" sql-u)
 177       ;; New fields for 2002AD
 178       ("RCUI" sql-u) ("VCUI" sql-u) ("CFR" sql-i) ("TFR" sql-i)
 179       ;; New fields for 2004AA
 180       ("MAPSETCUI" sql-u)
 181       )
 182     "SQL data types for each non-string column")
 183
 184 (defparameter +custom-tables+
 185     nil
 186   #+ignore
 187   '(("KCON" "SELECT CUI,STR FROM MRCONSO WHERE STT='PF' AND TS='P' AND ISPREF='Y' AND LAT='ENG'"))
 188   "Custom tables to create")
 189
 190 (defvar *vff-position-hash* (make-hash-table :size 100 :test 'eq))
 191
 192
 193 (defmacro vff (filename fieldname record)
 194   (let ((pos (gensym "POS-"))
 195         (found (gensym "FOUND-"))
 196         (key (kmrcl:ensure-keyword (concatenate 'string filename "^" fieldname))))
 197     `(locally (declare (optimize (speed 3) (safety 0)))
 198       (multiple-value-bind (,pos ,found) (gethash ,key *vff-position-hash*)
 199         (declare (ignore ,found))
 200         (if ,pos
 201             (locally (declare (type (integer 0 100000) ,pos))
 202               (nth ,pos ,record))
 203             (let ((,pos (position-field-file ,filename ,fieldname)))
 204               (unless ,pos
 205                 (error "Did not find fieldname ~A in filename ~A." ,fieldname ,filename))
 206               (locally (declare (type (integer 0 100000) ,pos))
 207                 (setf (gethash ,key *vff-position-hash*) ,pos)
 208                 (nth ,pos ,record))))))))
 209
 210 (defparameter +custom-cols+
 211     '(#+nil ("MRCONSO.RRF" "KPFSTR" "TEXT"
 212              (slot-value (find-ucol "STR" "MRCONSO.RRF") 'max)
 213              (lambda (x) (pfstr-hash (parse-ui (nth 0 x)))))
 214       ;; Set to 1 if term is prefered term for english
 215       ("MRCONSO.RRF" "KPFENG" "TINYINT" 0
 216        (lambda (x)  (if (and (string-equal (nth 1 x) "ENG") ; LAT
 217                              (string-equal (nth 2 x) "P") ; ts
 218                              (string-equal (nth 4 x) "PF")) ; stt
 219                       "1"
 220                       "0")))
 221       ("MRCONSO.RRF" "KCUISUI" "BIGINT" 0
 222        (lambda (x) (write-to-string (make-cuisui (parse-ui (vff "MRCONSO.RRF" "CUI" x))
 223                                                  (parse-ui (vff "MRCONSO.RRF" "SUI" x))))))
 224       ("MRCONSO.RRF" "KCUILUI" "BIGINT" 0
 225        (lambda (x) (write-to-string (make-cuilui (parse-ui (vff "MRCONSO.RRF" "CUI" x))
 226                                                  (parse-ui (vff "MRCONSO.RRF" "SUI" x))))))
 227       ("MRCONSO.RRF" "KCUILRL" "TINYINT" 0
 228        (lambda (x) (write-to-string (cui-lrl (parse-ui (vff "MRCONSO.RRF" "CUI" x))))))
 229       ("MRCONSO.RRF" "KCUILRLUS" "TINYINT" 0
 230        (lambda (x) (write-to-string (cui-lrlus (parse-ui (vff "MRCONSO.RRF" "CUI" x))))))
 231       ("MRCONSO.RRF" "KLUILRL" "TINYINT" 0
 232        (lambda (x) (write-to-string (lui-lrl (parse-ui (vff "MRCONSO.RRF" "LUI" x))))))
 233       ("MRCONSO.RRF" "KLUILRLUS" "TINYINT" 0
 234        (lambda (x) (write-to-string (lui-lrlus (parse-ui (vff "MRCONSO.RRF" "LUI" x))))))
 235       ("MRCONSO.RRF" "KSUILRL" "TINYINT" 0
 236        (lambda (x) (write-to-string (sui-lrl (parse-ui (vff "MRCONSO.RRF" "SUI" x))))))
 237       ("MRCONSO.RRF" "KSUILRLUS" "TINYINT" 0
 238        (lambda (x) (write-to-string (sui-lrlus (parse-ui (vff "MRCONSO.RRF" "SUI" x))))))
 239       ("MRCONSO.RRF" "KSRLUS" "TINYINT" 0
 240        (lambda (x) (write-to-string (srl-to-srlus (parse-integer (vff "MRCONSO.RRF" "SRL" x))))))
 241       ("MRSAB.RRF" "KSRLUS" "TINYINT" 0
 242        (lambda (x) (write-to-string (srl-to-srlus (parse-integer (vff "MRSAB.RRF" "SRL" x))))))
 243       ("MRSTY.RRF" "KLRL" "TINYINT" 0
 244        (lambda (x) (write-to-string (cui-lrl (parse-ui (vff "MRSTY.RRF" "CUI" x))))))
 245       ("MRSTY.RRF" "KLRLUS" "TINYINT" 0
 246        (lambda (x) (write-to-string (cui-lrlus (parse-ui (vff "MRSTY.RRF" "CUI" x))))))
 247       ("MRCOC.RRF" "KLRL" "TINYINT" 0
 248        (lambda (x) (write-to-string
 249                     (max (cui-lrl (parse-ui (vff "MRCOC.RRF" "CUI1" x)))
 250                          (kmrcl:aif (cui-lrl (parse-ui (vff "MRCOC.RRF" "CUI2" x))) kmrcl::it 0)))))
 251       ("MRCOC.RRF" "KLRLUS" "TINYINT" 0
 252        (lambda (x) (write-to-string
 253                     (max (cui-lrlus (parse-ui (vff "MRCOC.RRF" "CUI1" x)))
 254                          (kmrcl:aif (cui-lrl (parse-ui (vff "MRCOC.RRF" "CUI2" x))) kmrcl::it 0)))))
 255       ("MRSAT.RRF" "KSRL" "TINYINT" 0
 256        (lambda (x) (write-to-string (sab-srl (vff "MRSAT.RRF" "SAB" x)))))
 257       ("MRSAT.RRF" "KSRLUS" "TINYINT" 0
 258        (lambda (x) (write-to-string (sab-srlus (vff "MRSAT.RRF" "SAB" x)))))
 259       ("MRREL.RRF" "KSRL" "TINYINT" 0
 260        (lambda (x) (write-to-string (sab-srl (vff "MRREL.RRF" "SAB" x)))))
 261       ("MRREL.RRF" "KSRLUS" "TINYINT" 0
 262        (lambda (x) (write-to-string (sab-srlus (vff "MRREL.RRF" "SAB" x)))))
 263       ("MRRANK.RRF" "KSRL" "TINYINT" 0
 264        (lambda (x) (write-to-string (sab-srl (vff "MRRANK.RRF" "SAB" x)))))
 265       ("MRRANK.RRF" "KSRLUS" "TINYINT" 0
 266        (lambda (x) (write-to-string (sab-srlus (vff "MRRANK.RRF" "SAB" x)))))
 267       ("MRHIER.RRF" "KSRL" "TINYINT" 0
 268        (lambda (x) (write-to-string (sab-srl (vff "MRHIER.RRF" "SAB" x)))))
 269       ("MRHIER.RRF" "KSRLUS" "TINYINT" 0
 270        (lambda (x) (write-to-string (sab-srlus (vff "MRHIER.RRF" "SAB" x)))))
 271       ("MRMAP.RRF" "KSRL" "TINYINT" 0
 272        (lambda (x) (write-to-string (sab-srl (vff "MRMAP.RRF" "MAPSETSAB" x)))))
 273       ("MRMAP.RRF" "KSRLUS" "TINYINT" 0
 274        (lambda (x) (write-to-string (sab-srlus (vff "MRMAP.RRF" "MAPSETSAB" x)))))
 275       ("MRSMAP.RRF" "KSRL" "TINYINT" 0
 276        (lambda (x) (write-to-string (sab-srl (vff "MRSMAP.RRF" "MAPSETSAB" x)))))
 277       ("MRSMAP.RRF" "KSRLUS" "TINYINT" 0
 278        (lambda (x) (write-to-string (sab-srlus (vff "MRSMAP.RRF" "MAPSETSAB" x)))))
 279       ("MRDEF.RRF" "KSRL" "TINYINT" 0
 280        (lambda (x) (write-to-string (sab-srl (vff "MRDEF.RRF" "SAB" x)))))
 281       ("MRDEF.RRF" "KSRLUS" "TINYINT" 0
 282        (lambda (x) (write-to-string (sab-srlus (vff "MRDEF.RRF" "SAB" x)))))
 283       ("MRXW_ENG.RRF" "KLRL" "TINYINT" 0
 284        (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
 285                                                  (parse-ui (vff "MRXW_ENG.RRF" "CUI" x))
 286                                                  (parse-ui (vff "MRXW_ENG.RRF" "SUI" x)))))))
 287       ("MRXW_ENG.RRF" "KLRLUS" "TINYINT" 0
 288        (lambda (x) (write-to-string (cuisui-lrlus (make-cuisui
 289                                                  (parse-ui (vff "MRXW_ENG.RRF" "CUI" x))
 290                                                  (parse-ui (vff "MRXW_ENG.RRF" "SUI" x)))))))
 291       ("MRXW_NONENG.RRF" "KLRL" "TINYINT" 0
 292        (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
 293                                                  (parse-ui (vff "MRXW_NONENG.RRF" "CUI" x))
 294                                                  (parse-ui (vff "MRXW_NONENG.RRF" "SUI" x)))))))
 295       ("MRXW_NONENG.RRF" "KLRLUS" "TINYINT" 0
 296        (lambda (x) (write-to-string (cuisui-lrlus (make-cuisui
 297                                                  (parse-ui (vff "MRXW_NONENG.RRF" "CUI" x))
 298                                                  (parse-ui (vff "MRXW_NONENG.RRF" "SUI" x)))))))
 299       ("MRXNW_ENG.RRF" "KLRL" "TINYINT" 0
 300        (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
 301                                                  (parse-ui (vff "MRXNW_ENG.RRF" "CUI" x))
 302                                                  (parse-ui (vff "MRXNW_ENG.RRF" "SUI" x)))))))
 303       ("MRXNW_ENG.RRF" "KLRLUS" "TINYINT" 0
 304        (lambda (x) (write-to-string (cuisui-lrlus (make-cuisui
 305                                                  (parse-ui (vff "MRXNW_ENG.RRF" "CUI" x))
 306                                                  (parse-ui (vff "MRXNW_ENG.RRF" "SUI" x)))))))
 307       ("MRXNS_ENG.RRF" "KLRL" "TINYINT" 0
 308        (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
 309                                                  (parse-ui (vff "MRXNS_ENG.RRF" "CUI" x))
 310                                                  (parse-ui (vff "MRXNS_ENG.RRF" "SUI" x)))))))
 311       ("MRXNS_ENG.RRF" "KLRLUS" "TINYINT" 0
 312        (lambda (x) (write-to-string (cuisui-lrlus (make-cuisui
 313                                                  (parse-ui (vff "MRXNS_ENG.RRF" "CUI" x))
 314                                                  (parse-ui (vff "MRXNS_ENG.RRF" "SUI" x)))))))
 315
 316       #+nil  ("MRREL.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (nth 4 x)))))
 317       #+nil  ("MRCOC.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (nth 2 x)))))
 318
 319       ("MRSAT.RRF" "KCUILUI" "BIGINT" 0
 320        (lambda (x) (write-to-string (make-cuilui
 321                                      (parse-ui (vff "MRSAT.RRF" "CUI" x))
 322                                      (parse-ui (vff "MRSAT.RRF" "LUI" x))))))
 323       ("MRSAT.RRF" "KCUISUI" "BIGINT" 0
 324        (lambda (x) (write-to-string (make-cuisui
 325                                      (parse-ui (vff "MRSAT.RRF" "CUI" x))
 326                                      (parse-ui (vff "MRSAT.RRF" "SUI" x))))))
 327       ("MRXW_ENG.RRF" "KCUISUI" "BIGINT" 0
 328        (lambda (x) (write-to-string (make-cuisui
 329                                      (parse-ui (vff "MRXW_ENG.RRF" "CUI" x))
 330                                      (parse-ui (vff "MRXW_ENG.RRF" "SUI" x))))))
 331       ("MRXNW_ENG.RRF" "KCUISUI" "BIGINT" 0
 332        (lambda (x) (write-to-string (make-cuisui
 333                                      (parse-ui (vff "MRXNW_ENG.RRF" "CUI" x))
 334                                      (parse-ui (vff "MRXNW_ENG.RRF" "SUI" x))))))
 335       ("MRXNS_ENG.RRF" "KCUISUI" "BIGINT" 0
 336        (lambda (x) (write-to-string (make-cuisui
 337                                      (parse-ui (vff "MRXNS_ENG.RRF" "CUI" x))
 338                                      (parse-ui (vff "MRXNS_ENG.RRF" "SUI" x))))))
 339       ("MRXW_NONENG.RRF" "LAT" "VARCHAR" 3 (lambda (x) (vff "MRXW_NONENG.RRF" "LAT" x)))
 340       ("MRXW_NONENG.RRF" "WD"  "VARCHAR" 200  (lambda (x) (vff "MRXW_NONENG.RRF" "WD" x)))
 341       ("MRXW_NONENG.RRF" "CUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (vff "MRXW_NONENG.RRF" "CUI" x)))))
 342       ("MRXW_NONENG.RRF" "LUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (vff "MRXW_NONENG.RRF" "LUI" x)))))
 343       ("MRXW_NONENG.RRF" "SUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (vff "MRXW_NONENG.RRF" "SUI" x)))))
 344       ("MRXW_NONENG.RRF" "KCUISUI" "BIGINT" 0
 345        (lambda (x) (write-to-string (make-cuisui
 346                                      (parse-ui (vff "MRXW_NONENG.RRF" "CUI" x))
 347                                      (parse-ui (vff "MRXW_NONENG.RRF" "SUI" x)))))))
 348     "Custom columns to create.(filename, col, sqltype, value-func).")
 349
 350 (defparameter +index-cols+
 351     '(("CUI1" "MRCOC") ("CUI" "MRCONSO") ("LUI" "MRCONSO")
 352       ("SRL" "MRCONSO") ("KSRLUS" "MRCONSO") ("AUI" "MRCONSO") ("KPFENG" "MRCONSO")
 353       ("SUI" "MRCONSO") ("SAUI" "MRCONSO") ("CODE" "MRCONSO")
 354       ("SCUI" "MRCONSO")
 355       ("CUI" "MRDEF")
 356       ("CUI1" "MRREL") ("CUI2" "MRREL") ("SAB" "MRREL")
 357       ("RUI" "MRREL") ("AUI1" "MRREL") ("AUI2" "MRREL")
 358       ("CUI" "MRSAT") ("LUI" "MRSAT") ("SUI" "MRSAT")
 359       ("METAUI" "MRSAT") ("ATN" "MRSAT")
 360       ("CUI" "MRSTY")  ("TUI" "MRSTY") ("CUI" "MRXNS_ENG")
 361       ("AUI" "MRHIER") ("CUI" "MRHIER") ("CXN" "MRHIER") ("RELA" "MRHIER") ("PAUI" "MRHIER")
 362       ("SAB" "MRHIER")
 363       #+ignore ("NSTR" "MRXNS_ENG" 10)
 364       ("CUI" "MRXNW_ENG") ("NWD" "MRXNW_ENG") ("WD" "MRXW_ENG")
 365       ("KCUISUI" "MRCONSO") ("KCUILUI" "MRCONSO")
 366       ("KCUILRL" "MRCONSO") ("KLUILRL" "MRCONSO") ("KSUILRL" "MRCONSO")
 367       ("KCUILRLUS" "MRCONSO") ("KLUILRLUS" "MRCONSO") ("KSUILRLUS" "MRCONSO")
 368       ("KCUISUI" "MRSAT")  ("KCUILUI" "MRSAT")
 369       ("KCUISUI" "MRXW_ENG") ("KCUISUI" "MRXNW_ENG")
 370       ("KCUISUI" "MRXNS_ENG") ("KCUISUI" "MRXW_NONENG")
 371       ("KSRL" "MRDEF") ("KSRL" "MRRANK")("KSRL" "MRREL") ("KSRL" "MRSAT")
 372       ("KSRLUS" "MRDEF") ("KSRLUS" "MRRANK")("KSRLUS" "MRREL") ("KSRLUS" "MRSAT")
 373       ("KLRL" "MRCOC") ("KLRL" "MRSTY") ("KLRL" "MRXW_ENG") ("KLRL" "MRXNW_ENG")
 374       ("KLRLUS" "MRCOC") ("KLRLUS" "MRSTY") ("KLRLUS" "MRXW_ENG") ("KLRLUS" "MRXNW_ENG")
 375       ("KLRL" "MRXNS_ENG") ("KLRL" "MRXW_NONENG")
 376       ("KLRLUS" "MRXNS_ENG") ("KLRLUS" "MRXW_NONENG")
 377       ;; LEX indices
 378       ("EUI" "LRABR") ("EUI2" "LRABR") ("EUI" "LRAGR") ("EUI" "LRCMP") ("EUI" "LRMOD")
 379       ("EUI" "LRNOM") ("EUI2" "LRNOM") ("EUI" "LRPRN") ("EUI" "LRPRP") ("EUI" "LRSPL")
 380       ("EUI" "LRTRM") ("EUI" "LRTYP") ("EUI" "LRWD") ("WRD" "LRWD")
 381       ("BAS" "LRABR")
 382       ;; Semantic NET indices
 383       ("UI" "SRSTRE1") ("UI2" "SRSTRE1") ("UI3" "SRSTRE1")
 384       ("STY_RL" "SRDEF") ("RT" "SRDEF") ("STY_RL" "SRSTR") ("STY_RL2" "SRSTR")
 385       ("RL" "SRSTR")
 386
 387       ("SRL" "MRSAB") ("KSRLUS" "MRSAB") ("RSAB" "MRSAB") ("VSAB" "MRSAB") ("RCUI" "MRSAB")
 388       ("VCUI" "MRSAB") ("LAT" "MRSAB") ("MAPSETCUI" "MRMAP")  ("MAPSETCUI" "MRSMAP")
 389       ("CUI" "MRHIER"))
 390   "Columns in files to index")
 391
 392
 393 (defparameter +custom-index-cols+
 394   nil
 395   #+ignore
 396   '(("CUI" "KCON") ("LRL" "KCON"))
 397   "Indexes to custom tables")
 398
 399 ;; File & Column functions
 400
 401 (defun gen-ucols ()
 402   (add-ucols (gen-ucols-meta))
 403   (add-ucols (gen-ucols-generic "LRFLD"))
 404   (add-ucols (gen-ucols-generic "SRFLD"))
 405   (add-ucols (gen-ucols-custom)))
 406
 407 (defun gen-ucols-meta ()
 408 "Initialize all umls columns"
 409   (let ((cols '()))
 410     (with-umls-file (line "MRCOLS.RRF")
 411       (destructuring-bind (col des ref min av max fil dty) line
 412         (push (make-ucol col des ref (parse-integer min) (read-from-string av)
 413                          (parse-integer max) fil dty)
 414               cols)))
 415     (nreverse cols)))
 416
 417 (defun gen-ucols-custom ()
 418 "Initialize umls columns for custom columns"
 419   (loop for customcol in +custom-cols+
 420         collect
 421         (make-ucol (nth 1 customcol) "" 0 0 0 (eval (nth 3 customcol))
 422                    (nth 0 customcol) nil :sqltype (canonicalize-column-type (nth 2 customcol))
 423                    :custom-value-fun (compile nil (nth 4 customcol)))))
 424
 425 (defun gen-ucols-generic (col-filename)
 426 "Initialize for generic (LEX/NET) columns"
 427   (let ((cols '()))
 428     (with-umls-file (line col-filename)
 429       (destructuring-bind (nam des ref fil) line
 430         (setq nam (escape-column-name nam))
 431         (dolist (file (delimited-string-to-list fil #\,))
 432           (push
 433            (make-ucol nam des ref nil nil nil file nil)
 434            cols))))
 435     (nreverse cols)))
 436
 437
 438 (defun gen-ufiles ()
 439   (add-ufiles (gen-ufiles-generic "MRFILES.RRF" "META"))
 440   (add-ufiles (gen-ufiles-generic "LRFIL" "LEX"))
 441   (add-ufiles (gen-ufiles-generic "SRFIL" "NET"))
 442   ;; needs to come last
 443   (add-ufiles (gen-ufiles-custom)))
 444
 445
 446 (defun gen-ufiles-generic (files-filename dir)
 447 "Initialize generic UMLS file structures"
 448   (let ((files '()))
 449     (with-umls-file (line files-filename)
 450       (destructuring-bind (fil des fmt cls rws bts) line
 451         (push (make-ufile
 452                dir fil des
 453                (parse-integer cls)
 454                (parse-integer rws) (parse-integer bts)
 455                (concatenate 'list (umls-field-string-to-list fmt)
 456                             (custom-colnames-for-filename fil)))
 457               files)))
 458     (nreverse files)))
 459
 460 (defun gen-ufiles-custom ()
 461   (make-ufile "META" "MRXW_NONENG.RRF" "Custom NonEnglish Index"
 462               5 0 0 (fields (find-ufile "MRXW_ENG.RRF"))))
 463
 464
 465