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