1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: parse-2002.lisp
6 ;;;; Purpose: Parsing and SQL insertion routines for UMLisp which may
7 ;;;; change from year to year
8 ;;;; Author: Kevin M. Rosenberg
13 ;;;; This file, part of UMLisp, is
14 ;;;; Copyright (c) 2000-2004 by Kevin M. Rosenberg, M.D.
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 ;;;; *************************************************************************
22 ;;; Pre-read data for custom fields into hash tables
23 (defvar *preparse-hash-init?* nil)
25 (eval-when (:compile-toplevel :load-toplevel :execute)
26 (let ((pfstr-hash nil) ;; Preferred concept strings by CUI
27 (cui-lrl-hash nil) ;; LRL by CUI
28 (lui-lrl-hash nil) ;; LRL by LUI
29 (sui-lrl-hash nil) ;; LRL by SUI
30 (cuisui-lrl-hash nil) ;; LRL by CUISUI
31 (sab-srl-hash nil)) ;; SRL by SAB
33 (defun make-preparse-hash-table ()
37 (clrhash cui-lrl-hash)
38 (clrhash lui-lrl-hash)
39 (clrhash sui-lrl-hash)
40 (clrhash cuisui-lrl-hash)
41 (clrhash sab-srl-hash))
43 pfstr-hash (make-hash-table :size 800000)
44 cui-lrl-hash (make-hash-table :size 800000)
45 lui-lrl-hash (make-hash-table :size 1500000)
46 sui-lrl-hash (make-hash-table :size 1500000)
47 cuisui-lrl-hash (make-hash-table :size 1800000)
48 sab-srl-hash (make-hash-table :size 100 :test 'equal))))
50 (defun ensure-preparse (&optional (force-read nil))
51 (when (or force-read (not *preparse-hash-init?*))
52 (make-preparse-hash-table)
53 (setq *preparse-hash-init?* t))
54 (with-umls-file (line "MRCONSO.RRF")
55 (let ((cui (parse-ui (nth 0 line)))
56 (lui (parse-ui (nth 3 line)))
57 (sui (parse-ui (nth 5 line)))
59 (srl (parse-integer (nth 15 line))))
60 (unless (gethash cui pfstr-hash) ;; if haven't stored pfstr for cui
61 (if (and (string-equal (nth 1 line) "ENG") ; LAT
62 (string-equal (nth 2 line) "P") ; ts
63 (string-equal (nth 4 line) "PF")) ; stt
64 (setf (gethash cui pfstr-hash) (nth 14 line))))
65 (set-lrl-hash cui srl cui-lrl-hash)
66 (set-lrl-hash lui srl lui-lrl-hash)
67 (set-lrl-hash sui srl sui-lrl-hash)
68 (set-lrl-hash (make-cuisui cui sui) srl cuisui-lrl-hash)
69 (multiple-value-bind (val found) (gethash sab sab-srl-hash)
70 (declare (ignore val))
72 (setf (gethash sab sab-srl-hash) srl))))))
74 (defun pfstr-hash (cui) (gethash cui pfstr-hash))
75 (defun cui-lrl (cui) (gethash cui cui-lrl-hash))
76 (defun lui-lrl (lui) (gethash lui lui-lrl-hash))
77 (defun sui-lrl (sui) (gethash sui sui-lrl-hash))
78 (defun sab-srl (sab) (aif (gethash sab sab-srl-hash) it 0))
79 (defun cuisui-lrl (cuisui) (gethash cuisui cuisui-lrl-hash))
83 (defun set-lrl-hash (key lrl hash)
84 "Set the least restrictive level in hash table"
85 (multiple-value-bind (hash-lrl found) (gethash key hash)
86 (if (or (not found) (< lrl hash-lrl))
87 (setf (gethash key hash) lrl))))
89 ;; UMLS file and column structures
90 ;;; SQL datatypes symbols
91 ;;; sql-u - Unique identifier
92 ;;; sql-s - Small integer (16-bit)
93 ;;; sql-i - Integer (32-bit)
94 ;;; sql-l - Big integer (64-bit)
95 ;;; sql-f - Floating point
96 ;;; sql-c - Character data
98 (defparameter +col-datatypes+
99 '(("AV" sql-f) ("BTS" sql-i) ("CLS" sql-i) ("COF" sql-i) ("CUI1" sql-u)
100 ("AUI" sql-u) ("AUI1" sql-u) ("AUI2" sql-u) ("PCUI" sql-u)
101 ("PLUI" sql-u) ("PAUI" sql-u)
102 ("CUI2" sql-u) ("CUI" sql-u) ("CXN" sql-s) ("FR" sql-i) ("LRL" sql-s)
103 ("LUI" sql-u) ("MAX" sql-s) ("MIN" sql-s) ("RANK" sql-s) ("REF" sql-c)
104 ("RNK" sql-s) ("RWS" sql-i) ("SRL" sql-s) ("SUI" sql-u) ("TUI" sql-u)
107 ("KCUISUI" sql-l) ("KCUILUI" sql-l) ("KCUILRL" sql-i) ("KLUILRL" sql-i)
109 ("KSRL" sql-i) ("KLRL" sql-i)
111 ("EUI" sql-u) ("EUI2" sql-u)
112 ;;; Semantic net columns
113 ("UI" sql-u) ("UI2" sql-u) ("UI3" sql-u)
114 ;; New fields for 2002AD
115 ("RCUI" sql-u) ("VCUI" sql-u) ("CFR" sql-i) ("TFR" sql-i)
116 ;; New fields for 2004AA
119 "SQL data types for each non-string column")
121 (defparameter +custom-tables+
124 '(("KCON" "SELECT CUI,STR FROM MRCONSO WHERE STT='PF' AND TS='P' AND ISPREF='Y' AND LAT='ENG'"))
125 "Custom tables to create")
127 (defparameter +custom-cols+
128 '(("MRCONSO.RRF" "KPFSTR" "TEXT"
129 (slot-value (find-ucol "STR" "MRCONSO.RRF") 'max)
130 (lambda (x) (pfstr-hash (parse-ui (nth 0 x)))))
131 ("MRCONSO.RRF" "KCUISUI" "BIGINT" 0
132 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 5 x))))))
133 ("MRCONSO.RRF" "KCUILUI" "BIGINT" 0
134 (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 3 x))))))
135 ("MRCONSO.RRF" "KCUILRL" "SMALLINT" 0
136 (lambda (x) (write-to-string (lui-lrl (parse-ui (nth 0 x))))))
137 ("MRCONSO.RRF" "KLUILRL" "SMALLINT" 0
138 (lambda (x) (write-to-string (lui-lrl (parse-ui (nth 3 x))))))
139 ("MRCONSO.RRF" "KSUILRL" "SMALLINT" 0
140 (lambda (x) (write-to-string (sui-lrl (parse-ui (nth 5 x))))))
141 ;; Deprecated, last in 2004AA -- skip index
143 ("MRLO.RRF" "KLRL" "SMALLINT" 0
144 (lambda (x) (write-to-string
145 (if (zerop (length (nth 4 x)))
146 (cui-lrl (parse-ui (nth 0 x)))
147 (cuisui-lrl (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 4 x))))))))
148 ("MRSTY.RRF" "KLRL" "SMALLINT" 0
149 (lambda (x) (write-to-string (cui-lrl (parse-ui (nth 0 x))))))
150 ("MRCOC.RRF" "KLRL" "SMALLINT" 0
151 (lambda (x) (write-to-string
152 (max (cui-lrl (parse-ui (nth 0 x)))
153 (kmrcl:aif (cui-lrl (parse-ui (nth 1 x))) kmrcl::it 0)))))
154 ("MRSAT.RRF" "KSRL" "SMALLINT" 0
155 (lambda (x) (write-to-string (sab-srl (nth 9 x)))))
156 ("MRREL.RRF" "KSRL" "SMALLINT" 0
157 (lambda (x) (write-to-string (sab-srl (nth 10 x)))))
158 ("MRRANK.RRF" "KSRL" "SMALLINT" 0
159 (lambda (x) (write-to-string (sab-srl (nth 1 x)))))
160 ("MRDEF.RRF" "KSRL" "SMALLINT" 0
161 (lambda (x) (write-to-string (sab-srl (nth 4 x)))))
162 ("MRCXT.RRF" "KSRL" "SMALLINT" 0
163 (lambda (x) (write-to-string (sab-srl (nth 2 x)))))
164 ("MRXW_ENG.RRF" "KLRL" "SMALLINT" 0
165 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
167 (parse-ui (nth 4 x)))))))
168 ("MRXW_NONENG.RRF" "KLRL" "SMALLINT" 0
169 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
171 (parse-ui (nth 4 x)))))))
172 ("MRXNW_ENG.RRF" "KLRL" "SMALLINT" 0
173 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
175 (parse-ui (nth 4 x)))))))
176 ("MRXNS_ENG.RRF" "KLRL" "SMALLINT" 0
177 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
179 (parse-ui (nth 4 x)))))))
180 ("MRREL.RRF" "KPFSTR2" "TEXT" 1024
181 (lambda (x) (pfstr-hash (parse-ui (nth 4 x)))))
182 ("MRCOC.RRF" "KPFSTR2" "TEXT" 1024
183 (lambda (x) (pfstr-hash (parse-ui (nth 2 x)))))
184 ("MRCXT.RRF" "KCUISUI" "BIGINT" 0
185 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 1 x))))))
186 ("MRSAT.RRF" "KCUILUI" "BIGINT" 0
187 (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 1 x))))))
188 ("MRSAT.RRF" "KCUISUI" "BIGINT" 0
189 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 2 x))))))
190 ("MRXW_ENG.RRF" "KCUISUI" "BIGINT" 0
191 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))
192 ("MRXNW_ENG.RRF" "KCUISUI" "BIGINT" 0
193 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))
194 ("MRXNS_ENG.RRF" "KCUISUI" "BIGINT" 0
195 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))
196 ("MRXW_NONENG.RRF" "LAT" "VARCHAR" 3 (lambda (x) (nth 0 x)))
197 ("MRXW_NONENG.RRF" "WD" "VARCHAR" 200 (lambda (x) (nth 1 x)))
198 ("MRXW_NONENG.RRF" "CUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 2 x)))))
199 ("MRXW_NONENG.RRF" "LUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 3 x)))))
200 ("MRXW_NONENG.RRF" "SUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 4 x)))))
201 ("MRXW_NONENG.RRF" "KCUISUI" "BIGINT" 0
202 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x)))))))
203 "Custom columns to create.(filename, col, sqltype, value-func).")
205 (defparameter +index-cols+
206 '(("CUI1" "MRCOC") ("CUI" "MRCONSO") ("LUI" "MRCONSO")
207 ("SRL" "MRCONSO") ("AUI" "MRCONSO")
208 ("SUI" "MRCONSO") ("CUI" "MRCXT") ("CUI" "MRDEF") ("CUI" "MRLO")
209 ("CUI1" "MRREL") ("CUI" "MRSAT") ("LUI" "MRSAT") ("SUI" "MRSAT")
211 ("TUI" "MRSTY") ("CUI" "MRXNS_ENG")
212 #+ignore ("NSTR" "MRXNS_ENG" 10)
213 ("CUI" "MRXNW_ENG") ("NWD" "MRXNW_ENG") ("WD" "MRXW_ENG")
214 ("KCUISUI" "MRCONSO") ("KCUILUI" "MRCONSO") ("KCUILRL" "MRCONSO")
215 ("KLUILRL" "MRCONSO") ("KCUISUI" "MRCXT")
216 ("KCUISUI" "MRSAT") ("KCUILUI" "MRSAT")
217 ("KCUISUI" "MRXW_ENG") ("KCUISUI" "MRXNW_ENG")
218 ("KCUISUI" "MRXNS_ENG") ("KCUISUI" "MRXW_NONENG")
219 ("KSRL" "MRCXT") ("KSRL" "MRDEF") ("KSRL" "MRRANK")
220 ("KSRL" "MRREL") ("KSRL" "MRSAT") ("KLRL" "MRCOC")
221 #+ignore ("KLRL" "MRLO") ;; deprecated
222 ("KLRL" "MRSTY") ("KLRL" "MRXW_ENG") ("KLRL" "MRXNW_ENG")
223 ("KLRL" "MRXNS_ENG") ("KLRL" "MRXW_NONENG")
225 ("EUI" "LRABR") ("EUI2" "LRABR") ("EUI" "LRAGR") ("EUI" "LRCMP") ("EUI" "LRMOD")
226 ("EUI" "LRNOM") ("EUI2" "LRNOM") ("EUI" "LRPRN") ("EUI" "LRPRP") ("EUI" "LRSPL")
227 ("EUI" "LRTRM") ("EUI" "LRTYP") ("EUI" "LRWD") ("WRD" "LRWD")
229 ;; Semantic NET indices
230 ("UI" "SRSTRE1") ("UI2" "SRSTRE1") ("UI3" "SRSTRE1")
231 ("STY_RL" "SRDEF") ("RT" "SRDEF") ("STY_RL" "SRSTR") ("STY_RL2" "SRSTR")
234 ("SRL" "MRSAB") ("RSAB" "MRSAB") ("VSAB" "MRSAB") ("RCUI" "MRSAB")
235 ("VCUI" "MRSAB") ("LAT" "MRSAB") ("MAPSETCUI" "MRMAP") ("MAPSETCUI" "MRSMAP")
236 ("CUI" "MRHIER") ("AUI" "MRHIER") ("PAUI" "MRHIER"))
237 "Columns in files to index")
240 (defparameter +custom-index-cols+
243 '(("CUI" "KCON") ("LRL" "KCON"))
244 "Indexes to custom tables")
246 ;; File & Column functions
249 (add-ucols (gen-ucols-meta))
250 (add-ucols (gen-ucols-custom))
251 (add-ucols (gen-ucols-generic "LRFLD"))
252 (add-ucols (gen-ucols-generic "SRFLD")))
254 (defun gen-ucols-meta ()
255 "Initialize all umls columns"
257 (with-umls-file (line "MRCOLS.RRF")
258 (destructuring-bind (col des ref min av max fil dty) line
259 (push (make-ucol col des ref (parse-integer min) (read-from-string av)
260 (parse-integer max) fil dty)
264 (defun gen-ucols-custom ()
265 "Initialize umls columns for custom columns"
266 (loop for customcol in +custom-cols+
268 (make-ucol (nth 1 customcol) "" 0 0 0 (eval (nth 3 customcol))
269 (nth 0 customcol) nil :sqltype (canonicalize-column-type (nth 2 customcol))
270 :custom-value-fun (nth 4 customcol))))
272 (defun gen-ucols-generic (col-filename)
273 "Initialize for generic (LEX/NET) columns"
275 (with-umls-file (line col-filename)
276 (destructuring-bind (nam des ref fil) line
277 (setq nam (escape-column-name nam))
278 (dolist (file (delimited-string-to-list fil #\,))
280 (make-ucol nam des ref nil nil nil file nil)
286 (add-ufiles (gen-ufiles-generic "MRFILES.RRF" "META"))
287 (add-ufiles (gen-ufiles-generic "LRFIL" "LEX"))
288 (add-ufiles (gen-ufiles-generic "SRFIL" "NET"))
289 ;; needs to come last
290 (add-ufiles (gen-ufiles-custom)))
293 (defun gen-ufiles-generic (files-filename dir)
294 "Initialize all LEX file structures"
296 (with-umls-file (line files-filename)
297 (destructuring-bind (fil des fmt cls rws bts) line
301 (parse-integer rws) (parse-integer bts)
302 (concatenate 'list (umls-field-string-to-list fmt)
303 (custom-colnames-for-filename fil)))
307 (defun gen-ufiles-custom ()
308 (make-ufile "META" "MRXW_NONENG.RRF" "Custom NonEnglish Index"
309 5 0 0 (fields (find-ufile "MRXW_ENG.RRF"))))