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)
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 ;; pfstr deprecated by KPKENG field in MRCONSO
62 (unless (gethash cui pfstr-hash) ;; if haven't stored pfstr for cui
63 (when (and (string-equal (nth 1 line) "ENG") ; LAT
64 (string-equal (nth 2 line) "P") ; ts
65 (string-equal (nth 4 line) "PF")) ; stt
66 (setf (gethash cui pfstr-hash) (nth 14 line))))
67 (set-lrl-hash cui srl cui-lrl-hash)
68 (set-lrl-hash lui srl lui-lrl-hash)
69 (set-lrl-hash sui srl sui-lrl-hash)
70 (set-lrl-hash (make-cuisui cui sui) srl cuisui-lrl-hash)
71 (multiple-value-bind (val found) (gethash sab sab-srl-hash)
72 (declare (ignore val))
74 (setf (gethash sab sab-srl-hash) srl)))))
75 (setq *preparse-hash-init?* t)
78 #+nil (defun pfstr-hash (cui) (gethash cui pfstr-hash))
79 (defun cui-lrl (cui) (gethash cui cui-lrl-hash))
80 (defun lui-lrl (lui) (gethash lui lui-lrl-hash))
81 (defun sui-lrl (sui) (gethash sui sui-lrl-hash))
82 (defun sab-srl (sab) (aif (gethash sab sab-srl-hash) it 0))
83 (defun cuisui-lrl (cuisui) (gethash cuisui cuisui-lrl-hash))
87 (defun set-lrl-hash (key lrl hash)
88 "Set the least restrictive level in hash table"
89 (multiple-value-bind (hash-lrl found) (gethash key hash)
90 (if (or (not found) (< lrl hash-lrl))
91 (setf (gethash key hash) lrl))))
93 ;; UMLS file and column structures
94 ;;; SQL datatypes symbols
95 ;;; sql-u - Unique identifier
96 ;;; sql-s - Small integer (16-bit)
97 ;;; sql-i - Integer (32-bit)
98 ;;; sql-l - Big integer (64-bit)
99 ;;; sql-f - Floating point
100 ;;; sql-c - Character data
102 (defparameter +col-datatypes+
103 '(("AV" sql-f) ("BTS" sql-i) ("CLS" sql-i) ("COF" sql-i) ("CUI1" sql-u)
104 ("AUI" sql-u) ("AUI1" sql-u) ("AUI2" sql-u) ("PCUI" sql-u)
105 ("PLUI" sql-u) ("PAUI" sql-u) ("RUI" sql-u)
106 ("CUI2" sql-u) ("CUI" sql-u) ("CXN" sql-s) ("FR" sql-i) ("LRL" sql-s)
107 ("LUI" sql-u) ("MAX" sql-s) ("MIN" sql-s) ("RANK" sql-s) ("REF" sql-c)
109 ("RNK" sql-s) ("RWS" sql-i) ("SRL" sql-s) ("SUI" sql-u) ("TUI" sql-u)
112 ("KCUISUI" sql-l) ("KCUILUI" sql-l) ("KCUILRL" sql-i) ("KLUILRL" sql-i)
114 ("KSRL" sql-i) ("KLRL" sql-i)
116 ("EUI" sql-u) ("EUI2" sql-u)
117 ;;; Semantic net columns
118 ("UI" sql-u) ("UI2" sql-u) ("UI3" sql-u)
119 ;; New fields for 2002AD
120 ("RCUI" sql-u) ("VCUI" sql-u) ("CFR" sql-i) ("TFR" sql-i)
121 ;; New fields for 2004AA
124 "SQL data types for each non-string column")
126 (defparameter +custom-tables+
129 '(("KCON" "SELECT CUI,STR FROM MRCONSO WHERE STT='PF' AND TS='P' AND ISPREF='Y' AND LAT='ENG'"))
130 "Custom tables to create")
132 (defparameter +custom-cols+
133 '(#+nil ("MRCONSO.RRF" "KPFSTR" "TEXT"
134 (slot-value (find-ucol "STR" "MRCONSO.RRF") 'max)
135 (lambda (x) (pfstr-hash (parse-ui (nth 0 x)))))
136 ;; Set to 1 if term is prefered term for english
137 ("MRCONSO.RRF" "KPFENG" "TINYINT" 0
138 (lambda (x) (if (and (string-equal (nth 1 x) "ENG") ; LAT
139 (string-equal (nth 2 x) "P") ; ts
140 (string-equal (nth 4 x) "PF")) ; stt
143 ("MRCONSO.RRF" "KCUISUI" "BIGINT" 0
144 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 5 x))))))
145 ("MRCONSO.RRF" "KCUILUI" "BIGINT" 0
146 (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 3 x))))))
147 ("MRCONSO.RRF" "KCUILRL" "SMALLINT" 0
148 (lambda (x) (write-to-string (lui-lrl (parse-ui (nth 0 x))))))
149 ("MRCONSO.RRF" "KLUILRL" "SMALLINT" 0
150 (lambda (x) (write-to-string (lui-lrl (parse-ui (nth 3 x))))))
151 ("MRCONSO.RRF" "KSUILRL" "SMALLINT" 0
152 (lambda (x) (write-to-string (sui-lrl (parse-ui (nth 5 x))))))
153 ("MRSTY.RRF" "KLRL" "SMALLINT" 0
154 (lambda (x) (write-to-string (cui-lrl (parse-ui (nth 0 x))))))
155 ("MRCOC.RRF" "KLRL" "SMALLINT" 0
156 (lambda (x) (write-to-string
157 (max (cui-lrl (parse-ui (nth 0 x)))
158 (kmrcl:aif (cui-lrl (parse-ui (nth 1 x))) kmrcl::it 0)))))
159 ("MRSAT.RRF" "KSRL" "SMALLINT" 0
160 (lambda (x) (write-to-string (sab-srl (nth 9 x)))))
161 ("MRREL.RRF" "KSRL" "SMALLINT" 0
162 (lambda (x) (write-to-string (sab-srl (nth 10 x)))))
163 ("MRRANK.RRF" "KSRL" "SMALLINT" 0
164 (lambda (x) (write-to-string (sab-srl (nth 1 x)))))
165 ("MRHIER.RRF" "KSRL" "SMALLINT" 0
166 (lambda (x) (write-to-string (sab-srl (nth 4 x)))))
167 ("MRMAP.RRF" "KSRL" "SMALLINT" 0
168 (lambda (x) (write-to-string (sab-srl (nth 1 x)))))
169 ("MRSMAP.RRF" "KSRL" "SMALLINT" 0
170 (lambda (x) (write-to-string (sab-srl (nth 1 x)))))
171 ("MRDEF.RRF" "KSRL" "SMALLINT" 0
172 (lambda (x) (write-to-string (sab-srl (nth 4 x)))))
173 #+nil ("MRCXT.RRF" "KSRL" "SMALLINT" 0 (lambda (x) (write-to-string (sab-srl (nth 2 x)))))
174 ("MRXW_ENG.RRF" "KLRL" "SMALLINT" 0
175 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
177 (parse-ui (nth 4 x)))))))
178 ("MRXW_NONENG.RRF" "KLRL" "SMALLINT" 0
179 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
181 (parse-ui (nth 4 x)))))))
182 ("MRXNW_ENG.RRF" "KLRL" "SMALLINT" 0
183 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
185 (parse-ui (nth 4 x)))))))
186 ("MRXNS_ENG.RRF" "KLRL" "SMALLINT" 0
187 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
189 (parse-ui (nth 4 x)))))))
191 #+nil ("MRREL.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (nth 4 x)))))
192 #+nil ("MRCOC.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (nth 2 x)))))
193 ("MRSAT.RRF" "KCUILUI" "BIGINT" 0
194 (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 1 x))))))
195 ("MRSAT.RRF" "KCUISUI" "BIGINT" 0
196 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 2 x))))))
197 ("MRXW_ENG.RRF" "KCUISUI" "BIGINT" 0
198 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))
199 ("MRXNW_ENG.RRF" "KCUISUI" "BIGINT" 0
200 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))
201 ("MRXNS_ENG.RRF" "KCUISUI" "BIGINT" 0
202 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))
203 ("MRXW_NONENG.RRF" "LAT" "VARCHAR" 3 (lambda (x) (nth 0 x)))
204 ("MRXW_NONENG.RRF" "WD" "VARCHAR" 200 (lambda (x) (nth 1 x)))
205 ("MRXW_NONENG.RRF" "CUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 2 x)))))
206 ("MRXW_NONENG.RRF" "LUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 3 x)))))
207 ("MRXW_NONENG.RRF" "SUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 4 x)))))
208 ("MRXW_NONENG.RRF" "KCUISUI" "BIGINT" 0
209 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x)))))))
210 "Custom columns to create.(filename, col, sqltype, value-func).")
212 (defparameter +index-cols+
213 '(("CUI1" "MRCOC") ("CUI" "MRCONSO") ("LUI" "MRCONSO")
214 ("SRL" "MRCONSO") ("AUI" "MRCONSO") ("KPFENG" "MRCONSO")
215 ("SUI" "MRCONSO") ("SAUI" "MRCONSO") ("CODE" "MRCONSO")
218 ("CUI1" "MRREL") ("CUI2" "MRREL")
219 ("RUI" "MRREL") ("AUI1" "MRREL") ("AUI2" "MRREL")
220 ("CUI" "MRSAT") ("LUI" "MRSAT") ("SUI" "MRSAT")
221 ("METAUI" "MRSAT") ("ATN" "MRSAT")
222 ("CUI" "MRSTY") ("TUI" "MRSTY") ("CUI" "MRXNS_ENG")
223 ("AUI" "MRHIER") ("PTR" "MRHIER" 255) ("CUI" "MRHIER") ("CXN" "MRHIER") ("RELA" "MRHIER") ("PAUI" "MRHIER")
225 #+ignore ("NSTR" "MRXNS_ENG" 10)
226 ("CUI" "MRXNW_ENG") ("NWD" "MRXNW_ENG") ("WD" "MRXW_ENG")
227 ("KCUISUI" "MRCONSO") ("KCUILUI" "MRCONSO") ("KCUILRL" "MRCONSO")
228 ("KLUILRL" "MRCONSO")
229 ("KCUISUI" "MRSAT") ("KCUILUI" "MRSAT")
230 ("KCUISUI" "MRXW_ENG") ("KCUISUI" "MRXNW_ENG")
231 ("KCUISUI" "MRXNS_ENG") ("KCUISUI" "MRXW_NONENG")
232 ("KSRL" "MRDEF") ("KSRL" "MRRANK")
233 ("KSRL" "MRREL") ("KSRL" "MRSAT") ("KLRL" "MRCOC")
234 ("KLRL" "MRSTY") ("KLRL" "MRXW_ENG") ("KLRL" "MRXNW_ENG")
235 ("KLRL" "MRXNS_ENG") ("KLRL" "MRXW_NONENG")
237 ("EUI" "LRABR") ("EUI2" "LRABR") ("EUI" "LRAGR") ("EUI" "LRCMP") ("EUI" "LRMOD")
238 ("EUI" "LRNOM") ("EUI2" "LRNOM") ("EUI" "LRPRN") ("EUI" "LRPRP") ("EUI" "LRSPL")
239 ("EUI" "LRTRM") ("EUI" "LRTYP") ("EUI" "LRWD") ("WRD" "LRWD")
241 ;; Semantic NET indices
242 ("UI" "SRSTRE1") ("UI2" "SRSTRE1") ("UI3" "SRSTRE1")
243 ("STY_RL" "SRDEF") ("RT" "SRDEF") ("STY_RL" "SRSTR") ("STY_RL2" "SRSTR")
246 ("SRL" "MRSAB") ("RSAB" "MRSAB") ("VSAB" "MRSAB") ("RCUI" "MRSAB")
247 ("VCUI" "MRSAB") ("LAT" "MRSAB") ("MAPSETCUI" "MRMAP") ("MAPSETCUI" "MRSMAP")
249 "Columns in files to index")
252 (defparameter +custom-index-cols+
255 '(("CUI" "KCON") ("LRL" "KCON"))
256 "Indexes to custom tables")
258 ;; File & Column functions
261 (add-ucols (gen-ucols-meta))
262 (add-ucols (gen-ucols-custom))
263 (add-ucols (gen-ucols-generic "LRFLD"))
264 (add-ucols (gen-ucols-generic "SRFLD")))
266 (defun gen-ucols-meta ()
267 "Initialize all umls columns"
269 (with-umls-file (line "MRCOLS.RRF")
270 (destructuring-bind (col des ref min av max fil dty) line
271 (push (make-ucol col des ref (parse-integer min) (read-from-string av)
272 (parse-integer max) fil dty)
276 (defun gen-ucols-custom ()
277 "Initialize umls columns for custom columns"
278 (loop for customcol in +custom-cols+
280 (make-ucol (nth 1 customcol) "" 0 0 0 (eval (nth 3 customcol))
281 (nth 0 customcol) nil :sqltype (canonicalize-column-type (nth 2 customcol))
282 :custom-value-fun (nth 4 customcol))))
284 (defun gen-ucols-generic (col-filename)
285 "Initialize for generic (LEX/NET) columns"
287 (with-umls-file (line col-filename)
288 (destructuring-bind (nam des ref fil) line
289 (setq nam (escape-column-name nam))
290 (dolist (file (delimited-string-to-list fil #\,))
292 (make-ucol nam des ref nil nil nil file nil)
298 (add-ufiles (gen-ufiles-generic "MRFILES.RRF" "META"))
299 (add-ufiles (gen-ufiles-generic "LRFIL" "LEX"))
300 (add-ufiles (gen-ufiles-generic "SRFIL" "NET"))
301 ;; needs to come last
302 (add-ufiles (gen-ufiles-custom)))
305 (defun gen-ufiles-generic (files-filename dir)
306 "Initialize all LEX file structures"
308 (with-umls-file (line files-filename)
309 (destructuring-bind (fil des fmt cls rws bts) line
313 (parse-integer rws) (parse-integer bts)
314 (concatenate 'list (umls-field-string-to-list fmt)
315 (custom-colnames-for-filename fil)))
319 (defun gen-ufiles-custom ()
320 (make-ufile "META" "MRXW_NONENG.RRF" "Custom NonEnglish Index"
321 5 0 0 (fields (find-ufile "MRXW_ENG.RRF"))))