1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
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
13 ;;;; This file, part of UMLisp, is
14 ;;;; Copyright (c) 2000-2006 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 1300000)
44 cui-lrl-hash (make-hash-table :size 1300000)
45 lui-lrl-hash (make-hash-table :size 4600000)
46 sui-lrl-hash (make-hash-table :size 5100000)
47 cuisui-lrl-hash (make-hash-table :size 2000000)
48 sab-srl-hash (make-hash-table :size 100 :test 'equal))))
50 (defun ensure-preparse (&optional (force-read nil))
51 (when (and *preparse-hash-init?* (not force-read))
52 (return-from ensure-preparse 'already-done))
53 (make-preparse-hash-table)
55 (declare (fixnum counter))
56 (with-umls-file (line "MRCONSO.RRF")
57 (let ((cui (parse-ui (nth 0 line)))
58 (lui (parse-ui (nth 3 line)))
59 (sui (parse-ui (nth 5 line)))
61 (srl (parse-integer (nth 15 line))))
63 (when (= 0 (mod (incf counter) 100000)) (sb-ext:gc :full t))
65 ;; pfstr deprecated by KPKENG field in MRCONSO
67 (unless (gethash cui pfstr-hash) ;; if haven't stored pfstr for cui
68 (when (and (string-equal (nth 1 line) "ENG") ; LAT
69 (string-equal (nth 2 line) "P") ; ts
70 (string-equal (nth 4 line) "PF")) ; stt
71 (setf (gethash cui pfstr-hash) (nth 14 line))))
72 (set-lrl-hash cui srl cui-lrl-hash)
73 (set-lrl-hash lui srl lui-lrl-hash)
74 (set-lrl-hash sui srl sui-lrl-hash)
75 (set-lrl-hash (make-cuisui cui sui) srl cuisui-lrl-hash)
76 (multiple-value-bind (val found) (gethash sab sab-srl-hash)
77 (declare (ignore val))
79 (setf (gethash sab sab-srl-hash) srl))))))
80 (setq *preparse-hash-init?* t)
83 #+nil (defun pfstr-hash (cui) (gethash cui pfstr-hash))
84 (defun cui-lrl (cui) (gethash cui cui-lrl-hash))
85 (defun lui-lrl (lui) (gethash lui lui-lrl-hash))
86 (defun sui-lrl (sui) (gethash sui sui-lrl-hash))
87 (defun sab-srl (sab) (aif (gethash sab sab-srl-hash) it 0))
88 (defun cuisui-lrl (cuisui) (gethash cuisui cuisui-lrl-hash))
92 (defun set-lrl-hash (key lrl hash)
93 "Set the least restrictive level in hash table"
94 (multiple-value-bind (hash-lrl found) (gethash key hash)
95 (if (or (not found) (< lrl hash-lrl))
96 (setf (gethash key hash) lrl))))
98 ;; UMLS file and column structures
99 ;;; SQL datatypes symbols
100 ;;; sql-u - Unique identifier
101 ;;; sql-s - Small integer (16-bit)
102 ;;; sql-i - Integer (32-bit)
103 ;;; sql-l - Big integer (64-bit)
104 ;;; sql-f - Floating point
105 ;;; sql-c - Character data
107 (defparameter +col-datatypes+
108 '(("AV" sql-f) ("BTS" sql-i) ("CLS" sql-i) ("COF" sql-i) ("CUI1" sql-u)
109 ("AUI" sql-u) ("AUI1" sql-u) ("AUI2" sql-u) ("PCUI" sql-u)
110 ("PLUI" sql-u) ("PAUI" sql-u) ("RUI" sql-u)
111 ("CUI2" sql-u) ("CUI" sql-u) ("CXN" sql-s) ("FR" sql-i) ("LRL" sql-s)
112 ("LUI" sql-u) ("MAX" sql-s) ("MIN" sql-s) ("RANK" sql-s) ("REF" sql-c)
114 ("RNK" sql-s) ("RWS" sql-i) ("SRL" sql-s) ("SUI" sql-u) ("TUI" sql-u)
117 ("KCUISUI" sql-l) ("KCUILUI" sql-l) ("KCUILRL" sql-i) ("KLUILRL" sql-i)
119 ("KSRL" sql-i) ("KLRL" sql-i)
121 ("EUI" sql-u) ("EUI2" sql-u)
122 ;;; Semantic net columns
123 ("UI" sql-u) ("UI2" sql-u) ("UI3" sql-u)
124 ;; New fields for 2002AD
125 ("RCUI" sql-u) ("VCUI" sql-u) ("CFR" sql-i) ("TFR" sql-i)
126 ;; New fields for 2004AA
129 "SQL data types for each non-string column")
131 (defparameter +custom-tables+
134 '(("KCON" "SELECT CUI,STR FROM MRCONSO WHERE STT='PF' AND TS='P' AND ISPREF='Y' AND LAT='ENG'"))
135 "Custom tables to create")
137 (defparameter +custom-cols+
138 '(#+nil ("MRCONSO.RRF" "KPFSTR" "TEXT"
139 (slot-value (find-ucol "STR" "MRCONSO.RRF") 'max)
140 (lambda (x) (pfstr-hash (parse-ui (nth 0 x)))))
141 ;; Set to 1 if term is prefered term for english
142 ("MRCONSO.RRF" "KPFENG" "TINYINT" 0
143 (lambda (x) (if (and (string-equal (nth 1 x) "ENG") ; LAT
144 (string-equal (nth 2 x) "P") ; ts
145 (string-equal (nth 4 x) "PF")) ; stt
148 ("MRCONSO.RRF" "KCUISUI" "BIGINT" 0
149 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 5 x))))))
150 ("MRCONSO.RRF" "KCUILUI" "BIGINT" 0
151 (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 3 x))))))
152 ("MRCONSO.RRF" "KCUILRL" "SMALLINT" 0
153 (lambda (x) (write-to-string (lui-lrl (parse-ui (nth 0 x))))))
154 ("MRCONSO.RRF" "KLUILRL" "SMALLINT" 0
155 (lambda (x) (write-to-string (lui-lrl (parse-ui (nth 3 x))))))
156 ("MRCONSO.RRF" "KSUILRL" "SMALLINT" 0
157 (lambda (x) (write-to-string (sui-lrl (parse-ui (nth 5 x))))))
158 ("MRSTY.RRF" "KLRL" "SMALLINT" 0
159 (lambda (x) (write-to-string (cui-lrl (parse-ui (nth 0 x))))))
160 ("MRCOC.RRF" "KLRL" "SMALLINT" 0
161 (lambda (x) (write-to-string
162 (max (cui-lrl (parse-ui (nth 0 x)))
163 (kmrcl:aif (cui-lrl (parse-ui (nth 1 x))) kmrcl::it 0)))))
164 ("MRSAT.RRF" "KSRL" "SMALLINT" 0
165 (lambda (x) (write-to-string (sab-srl (nth 9 x)))))
166 ("MRREL.RRF" "KSRL" "SMALLINT" 0
167 (lambda (x) (write-to-string (sab-srl (nth 10 x)))))
168 ("MRRANK.RRF" "KSRL" "SMALLINT" 0
169 (lambda (x) (write-to-string (sab-srl (nth 1 x)))))
170 ("MRHIER.RRF" "KSRL" "SMALLINT" 0
171 (lambda (x) (write-to-string (sab-srl (nth 4 x)))))
172 ("MRMAP.RRF" "KSRL" "SMALLINT" 0
173 (lambda (x) (write-to-string (sab-srl (nth 1 x)))))
174 ("MRSMAP.RRF" "KSRL" "SMALLINT" 0
175 (lambda (x) (write-to-string (sab-srl (nth 1 x)))))
176 ("MRDEF.RRF" "KSRL" "SMALLINT" 0
177 (lambda (x) (write-to-string (sab-srl (nth 4 x)))))
178 #+nil ("MRCXT.RRF" "KSRL" "SMALLINT" 0 (lambda (x) (write-to-string (sab-srl (nth 2 x)))))
179 ("MRXW_ENG.RRF" "KLRL" "SMALLINT" 0
180 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
182 (parse-ui (nth 4 x)))))))
183 ("MRXW_NONENG.RRF" "KLRL" "SMALLINT" 0
184 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
186 (parse-ui (nth 4 x)))))))
187 ("MRXNW_ENG.RRF" "KLRL" "SMALLINT" 0
188 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
190 (parse-ui (nth 4 x)))))))
191 ("MRXNS_ENG.RRF" "KLRL" "SMALLINT" 0
192 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
194 (parse-ui (nth 4 x)))))))
196 #+nil ("MRREL.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (nth 4 x)))))
197 #+nil ("MRCOC.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (nth 2 x)))))
198 ("MRSAT.RRF" "KCUILUI" "BIGINT" 0
199 (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 1 x))))))
200 ("MRSAT.RRF" "KCUISUI" "BIGINT" 0
201 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 2 x))))))
202 ("MRXW_ENG.RRF" "KCUISUI" "BIGINT" 0
203 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))
204 ("MRXNW_ENG.RRF" "KCUISUI" "BIGINT" 0
205 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))
206 ("MRXNS_ENG.RRF" "KCUISUI" "BIGINT" 0
207 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))
208 ("MRXW_NONENG.RRF" "LAT" "VARCHAR" 3 (lambda (x) (nth 0 x)))
209 ("MRXW_NONENG.RRF" "WD" "VARCHAR" 200 (lambda (x) (nth 1 x)))
210 ("MRXW_NONENG.RRF" "CUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 2 x)))))
211 ("MRXW_NONENG.RRF" "LUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 3 x)))))
212 ("MRXW_NONENG.RRF" "SUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 4 x)))))
213 ("MRXW_NONENG.RRF" "KCUISUI" "BIGINT" 0
214 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x)))))))
215 "Custom columns to create.(filename, col, sqltype, value-func).")
217 (defparameter +index-cols+
218 '(("CUI1" "MRCOC") ("CUI" "MRCONSO") ("LUI" "MRCONSO")
219 ("SRL" "MRCONSO") ("AUI" "MRCONSO") ("KPFENG" "MRCONSO")
220 ("SUI" "MRCONSO") ("SAUI" "MRCONSO") ("CODE" "MRCONSO")
223 ("CUI1" "MRREL") ("CUI2" "MRREL")
224 ("RUI" "MRREL") ("AUI1" "MRREL") ("AUI2" "MRREL")
225 ("CUI" "MRSAT") ("LUI" "MRSAT") ("SUI" "MRSAT")
226 ("METAUI" "MRSAT") ("ATN" "MRSAT")
227 ("CUI" "MRSTY") ("TUI" "MRSTY") ("CUI" "MRXNS_ENG")
228 ("AUI" "MRHIER") ("CUI" "MRHIER") ("CXN" "MRHIER") ("RELA" "MRHIER") ("PAUI" "MRHIER")
230 #+ignore ("NSTR" "MRXNS_ENG" 10)
231 ("CUI" "MRXNW_ENG") ("NWD" "MRXNW_ENG") ("WD" "MRXW_ENG")
232 ("KCUISUI" "MRCONSO") ("KCUILUI" "MRCONSO") ("KCUILRL" "MRCONSO")
233 ("KLUILRL" "MRCONSO")
234 ("KCUISUI" "MRSAT") ("KCUILUI" "MRSAT")
235 ("KCUISUI" "MRXW_ENG") ("KCUISUI" "MRXNW_ENG")
236 ("KCUISUI" "MRXNS_ENG") ("KCUISUI" "MRXW_NONENG")
237 ("KSRL" "MRDEF") ("KSRL" "MRRANK")
238 ("KSRL" "MRREL") ("KSRL" "MRSAT") ("KLRL" "MRCOC")
239 ("KLRL" "MRSTY") ("KLRL" "MRXW_ENG") ("KLRL" "MRXNW_ENG")
240 ("KLRL" "MRXNS_ENG") ("KLRL" "MRXW_NONENG")
242 ("EUI" "LRABR") ("EUI2" "LRABR") ("EUI" "LRAGR") ("EUI" "LRCMP") ("EUI" "LRMOD")
243 ("EUI" "LRNOM") ("EUI2" "LRNOM") ("EUI" "LRPRN") ("EUI" "LRPRP") ("EUI" "LRSPL")
244 ("EUI" "LRTRM") ("EUI" "LRTYP") ("EUI" "LRWD") ("WRD" "LRWD")
246 ;; Semantic NET indices
247 ("UI" "SRSTRE1") ("UI2" "SRSTRE1") ("UI3" "SRSTRE1")
248 ("STY_RL" "SRDEF") ("RT" "SRDEF") ("STY_RL" "SRSTR") ("STY_RL2" "SRSTR")
251 ("SRL" "MRSAB") ("RSAB" "MRSAB") ("VSAB" "MRSAB") ("RCUI" "MRSAB")
252 ("VCUI" "MRSAB") ("LAT" "MRSAB") ("MAPSETCUI" "MRMAP") ("MAPSETCUI" "MRSMAP")
254 "Columns in files to index")
257 (defparameter +custom-index-cols+
260 '(("CUI" "KCON") ("LRL" "KCON"))
261 "Indexes to custom tables")
263 ;; File & Column functions
266 (add-ucols (gen-ucols-meta))
267 (add-ucols (gen-ucols-custom))
268 (add-ucols (gen-ucols-generic "LRFLD"))
269 (add-ucols (gen-ucols-generic "SRFLD")))
271 (defun gen-ucols-meta ()
272 "Initialize all umls columns"
274 (with-umls-file (line "MRCOLS.RRF")
275 (destructuring-bind (col des ref min av max fil dty) line
276 (push (make-ucol col des ref (parse-integer min) (read-from-string av)
277 (parse-integer max) fil dty)
281 (defun gen-ucols-custom ()
282 "Initialize umls columns for custom columns"
283 (loop for customcol in +custom-cols+
285 (make-ucol (nth 1 customcol) "" 0 0 0 (eval (nth 3 customcol))
286 (nth 0 customcol) nil :sqltype (canonicalize-column-type (nth 2 customcol))
287 :custom-value-fun (nth 4 customcol))))
289 (defun gen-ucols-generic (col-filename)
290 "Initialize for generic (LEX/NET) columns"
292 (with-umls-file (line col-filename)
293 (destructuring-bind (nam des ref fil) line
294 (setq nam (escape-column-name nam))
295 (dolist (file (delimited-string-to-list fil #\,))
297 (make-ucol nam des ref nil nil nil file nil)
303 (add-ufiles (gen-ufiles-generic "MRFILES.RRF" "META"))
304 (add-ufiles (gen-ufiles-generic "LRFIL" "LEX"))
305 (add-ufiles (gen-ufiles-generic "SRFIL" "NET"))
306 ;; needs to come last
307 (add-ufiles (gen-ufiles-custom)))
310 (defun gen-ufiles-generic (files-filename dir)
311 "Initialize all LEX file structures"
313 (with-umls-file (line files-filename)
314 (destructuring-bind (fil des fmt cls rws bts) line
318 (parse-integer rws) (parse-integer bts)
319 (concatenate 'list (umls-field-string-to-list fmt)
320 (custom-colnames-for-filename fil)))
324 (defun gen-ufiles-custom ()
325 (make-ufile "META" "MRXW_NONENG.RRF" "Custom NonEnglish Index"
326 5 0 0 (fields (find-ufile "MRXW_ENG.RRF"))))