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