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