;;;; Author: Kevin M. Rosenberg
;;;; Created: Apr 2000
;;;;
-;;;; $Id$
-;;;;
;;;; This file, part of UMLisp, is
-;;;; Copyright (c) 2000-2006 by Kevin M. Rosenberg, M.D.
+;;;; Copyright (c) 2000-2010 by Kevin M. Rosenberg, M.D.
;;;;
;;;; UMLisp users are granted the rights to distribute and use this software
;;;; as governed by the terms of the GNU General Public License.
(declaim (inline srl-to-srlus))
(defun srl-to-srlus (srl)
- "Convert the standard SRL category to one oriented for use in the United States.
-Specifically, SRL 4 in the USA has license restrictions between SRL 1 and 2 when
-used in the United States. We create a new scale (SRLUS) where SRL to SRLUS mapping is:
-(0->0, 1->1, 4->2, 2->3, 3->4)."
- (declare (fixnum srl))
+ "Convert the standard SRL category to one oriented for use in the ~
+United States. Specifically, SRL 4 in the USA has license restrictions ~
+between SRL 1 and 2 when used in the United States. As of 2009AA, the
+SNOMED SRL changed from 4 to 9. So we create a new scale ~
+(SRLUS) where SRL to SRLUS mapping is: ~
+(0->0, 1->1, 4->2, 9->2, 2->3, 3->4)."
+ (declare (type (integer 0 100) srl))
(cond
+ ((<= srl 1) srl)
((= srl 4) 2)
+ ((= srl 9) 2)
((= srl 2) 3)
((= srl 3) 4)
(t srl)))
+(defvar *vff-position-hash* (make-hash-table :size 100 :test 'eq))
+
+(defmacro vff (filename fieldname record)
+ (let ((pos (gensym "POS-"))
+ (found (gensym "FOUND-"))
+ (key (kmrcl:ensure-keyword (concatenate 'string filename "^" fieldname))))
+ `(locally (declare (optimize (speed 3) (safety 0)))
+ (multiple-value-bind (,pos ,found) (gethash ,key *vff-position-hash*)
+ (declare (ignore ,found))
+ (if ,pos
+ (locally (declare (type (integer 0 100000) ,pos))
+ (nth ,pos ,record))
+ (let ((,pos (position-field-file ,filename ,fieldname)))
+ (unless ,pos
+ (error "Did not find fieldname ~A in filename ~A." ,fieldname ,filename))
+ (locally (declare (type (integer 0 100000) ,pos))
+ (setf (gethash ,key *vff-position-hash*) ,pos)
+ (nth ,pos ,record))))))))
+
(let ((pfstr-hash nil) ;; Preferred concept strings by CUI
(cui-lrl-hash nil) ;; LRL by CUI
(lui-lrl-hash nil) ;; LRL by LUI
(defun make-preparse-hash-table ()
(if sui-lrl-hash
- (clear-preparse-hash-tables)
+ (clear-preparse-hash-tables)
(setf
- pfstr-hash (make-hash-table :size 1500000)
- cui-lrl-hash (make-hash-table :size 1500000)
- lui-lrl-hash (make-hash-table :size 5000000)
- sui-lrl-hash (make-hash-table :size 6000000)
- cuisui-lrl-hash (make-hash-table :size 6000000)
- cui-lrlus-hash (make-hash-table :size 1500000)
- lui-lrlus-hash (make-hash-table :size 5000000)
- sui-lrlus-hash (make-hash-table :size 6000000)
- cuisui-lrlus-hash (make-hash-table :size 6000000)
- sab-srl-hash (make-hash-table :size 200 :test 'equal)
+ pfstr-hash (make-hash-table :size 1500000)
+ cui-lrl-hash (make-hash-table :size 1500000)
+ lui-lrl-hash (make-hash-table :size 5000000)
+ sui-lrl-hash (make-hash-table :size 6000000)
+ cuisui-lrl-hash (make-hash-table :size 6000000)
+ cui-lrlus-hash (make-hash-table :size 1500000)
+ lui-lrlus-hash (make-hash-table :size 5000000)
+ sui-lrlus-hash (make-hash-table :size 6000000)
+ cuisui-lrlus-hash (make-hash-table :size 6000000)
+ sab-srl-hash (make-hash-table :size 200 :test 'equal)
sab-srlus-hash (make-hash-table :size 200 :test 'equal))))
(defun ensure-preparse (&optional (force-read nil))
(declare (fixnum counter)
(ignorable counter))
(with-umls-file (line "MRCONSO.RRF")
- (let* ((cui (parse-ui (nth 0 line)))
- (lui (parse-ui (nth 3 line)))
- (sui (parse-ui (nth 5 line)))
- (sab (nth 11 line))
- (srl (parse-integer (nth 15 line)))
- (srlus (srl-to-srlus srl)))
+ (let* ((cui (parse-ui (vff "MRCONSO.RRF" "CUI" line)))
+ (lui (parse-ui (vff "MRCONSO.RRF" "LUI" line)))
+ (sui (parse-ui (vff "MRCONSO.RRF" "SUI" line)))
+ (sab (vff "MRCONSO.RRF" "SAB" line))
+ (srl (parse-integer (vff "MRCONSO.RRF" "SRL" line)))
+ (srlus (srl-to-srlus srl))
+ (cuisui (make-cuisui cui sui)))
#+sbcl
(when (= 0 (mod (incf counter) 100000)) (sb-ext:gc :full t))
;; pfstr deprecated by KPFENG field in MRCONSO
#+nil
(unless (gethash cui pfstr-hash) ;; if haven't stored pfstr for cui
- (when (and (string-equal (nth 1 line) "ENG") ; LAT
- (string-equal (nth 2 line) "P") ; ts
- (string-equal (nth 4 line) "PF")) ; stt
- (setf (gethash cui pfstr-hash) (nth 14 line))))
+ (when (and (string-equal (vff "MRCONSO.RRF" "LAT" line) "ENG")
+ (string-equal (vff "MRCONSO.RRF" "TS" line) "P")
+ (string-equal (vff "MRCONSO.RRF" "STT" line) "PF"))
+ (setf (gethash cui pfstr-hash) (vff "MRCONSO.RRF" "STR" line))))
(set-lrl-hash cui srl cui-lrl-hash)
(set-lrl-hash lui srl lui-lrl-hash)
(set-lrl-hash sui srl sui-lrl-hash)
- (set-lrl-hash (make-cuisui cui sui) srl cuisui-lrl-hash)
+ (set-lrl-hash cuisui srl cuisui-lrl-hash)
(set-lrl-hash cui srlus cui-lrlus-hash)
(set-lrl-hash lui srlus lui-lrlus-hash)
(set-lrl-hash sui srlus sui-lrlus-hash)
- (set-lrl-hash (make-cuisui cui sui) srlus cuisui-lrlus-hash)
+ (set-lrl-hash cuisui srlus cuisui-lrlus-hash)
(multiple-value-bind (val found) (gethash sab sab-srl-hash)
(declare (ignore val))
(unless found
(declare (type (or null fixnum) hash-lrl)
(boolean found))
(if (or (not found) (< srl hash-lrl))
- (setf (gethash key hash) srl))))
+ (setf (gethash key hash) srl))))
;; UMLS file and column structures
;;; SQL datatypes symbols
'(("KCON" "SELECT CUI,STR FROM MRCONSO WHERE STT='PF' AND TS='P' AND ISPREF='Y' AND LAT='ENG'"))
"Custom tables to create")
-(defvar *vff-position-hash* (make-hash-table :size 100 :test 'eq))
-
-
-(defmacro vff (filename fieldname record)
- (let ((pos (gensym "POS-"))
- (found (gensym "FOUND-"))
- (key (kmrcl:ensure-keyword (concatenate 'string filename "^" fieldname))))
- `(locally (declare (optimize (speed 3) (safety 0)))
- (multiple-value-bind (,pos ,found) (gethash ,key *vff-position-hash*)
- (declare (ignore ,found))
- (if ,pos
- (locally (declare (type (integer 0 100000) ,pos))
- (nth ,pos ,record))
- (let ((,pos (position-field-file ,filename ,fieldname)))
- (unless ,pos
- (error "Did not find fieldname ~A in filename ~A." ,fieldname ,filename))
- (locally (declare (type (integer 0 100000) ,pos))
- (setf (gethash ,key *vff-position-hash*) ,pos)
- (nth ,pos ,record))))))))
-
(defparameter +custom-cols+
'(#+nil ("MRCONSO.RRF" "KPFSTR" "TEXT"
(slot-value (find-ucol "STR" "MRCONSO.RRF") 'max)
- (lambda (x) (pfstr-hash (parse-ui (nth 0 x)))))
+ (lambda (x) (pfstr-hash (parse-ui (vff "MRCONSO.RRF" "CUI" x)))))
;; Set to 1 if term is prefered term for english
("MRCONSO.RRF" "KPFENG" "TINYINT" 0
- (lambda (x) (if (and (string-equal (nth 1 x) "ENG") ; LAT
- (string-equal (nth 2 x) "P") ; ts
- (string-equal (nth 4 x) "PF")) ; stt
+ (lambda (x) (if (and (string-equal (vff "MRCONSO.RRF" "LAT" x) "ENG")
+ (string-equal (vff "MRCONSO.RRF" "TS" x) "P")
+ (string-equal (vff "MRCONSO.RRF" "STT" x) "PF"))
"1"
"0")))
("MRCONSO.RRF" "KCUISUI" "BIGINT" 0
(parse-ui (vff "MRCONSO.RRF" "SUI" x))))))
("MRCONSO.RRF" "KCUILUI" "BIGINT" 0
(lambda (x) (write-to-string (make-cuilui (parse-ui (vff "MRCONSO.RRF" "CUI" x))
- (parse-ui (vff "MRCONSO.RRF" "SUI" x))))))
+ (parse-ui (vff "MRCONSO.RRF" "LUI" x))))))
("MRCONSO.RRF" "KCUILRL" "TINYINT" 0
(lambda (x) (write-to-string (cui-lrl (parse-ui (vff "MRCONSO.RRF" "CUI" x))))))
("MRCONSO.RRF" "KCUILRLUS" "TINYINT" 0
(lambda (x) (write-to-string (cui-lrl (parse-ui (vff "MRSTY.RRF" "CUI" x))))))
("MRSTY.RRF" "KLRLUS" "TINYINT" 0
(lambda (x) (write-to-string (cui-lrlus (parse-ui (vff "MRSTY.RRF" "CUI" x))))))
- ("MRCOC.RRF" "KLRL" "TINYINT" 0
+ #+mrcoc ("MRCOC.RRF" "KLRL" "TINYINT" 0
(lambda (x) (write-to-string
- (max (cui-lrl (parse-ui (vff "MRCOC.RRF" "CUI1" x)))
- (kmrcl:aif (cui-lrl (parse-ui (vff "MRCOC.RRF" "CUI2" x))) kmrcl::it 0)))))
- ("MRCOC.RRF" "KLRLUS" "TINYINT" 0
+ (max (cui-lrl (parse-ui (vff "MRCOC.RRF" "CUI1" x)))
+ (kmrcl:aif (cui-lrl (parse-ui (vff "MRCOC.RRF" "CUI2" x))) kmrcl::it 0)))))
+ #+mrcoc ("MRCOC.RRF" "KLRLUS" "TINYINT" 0
(lambda (x) (write-to-string
- (max (cui-lrlus (parse-ui (vff "MRCOC.RRF" "CUI1" x)))
- (kmrcl:aif (cui-lrl (parse-ui (vff "MRCOC.RRF" "CUI2" x))) kmrcl::it 0)))))
+ (max (cui-lrlus (parse-ui (vff "MRCOC.RRF" "CUI1" x)))
+ (kmrcl:aif (cui-lrl (parse-ui (vff "MRCOC.RRF" "CUI2" x))) kmrcl::it 0)))))
("MRSAT.RRF" "KSRL" "TINYINT" 0
(lambda (x) (write-to-string (sab-srl (vff "MRSAT.RRF" "SAB" x)))))
("MRSAT.RRF" "KSRLUS" "TINYINT" 0
(lambda (x) (write-to-string (sab-srlus (vff "MRDEF.RRF" "SAB" x)))))
("MRXW_ENG.RRF" "KLRL" "TINYINT" 0
(lambda (x) (write-to-string (cuisui-lrl (make-cuisui
- (parse-ui (vff "MRXW_ENG.RRF" "CUI" x))
- (parse-ui (vff "MRXW_ENG.RRF" "SUI" x)))))))
+ (parse-ui (vff "MRXW_ENG.RRF" "CUI" x))
+ (parse-ui (vff "MRXW_ENG.RRF" "SUI" x)))))))
("MRXW_ENG.RRF" "KLRLUS" "TINYINT" 0
(lambda (x) (write-to-string (cuisui-lrlus (make-cuisui
- (parse-ui (vff "MRXW_ENG.RRF" "CUI" x))
- (parse-ui (vff "MRXW_ENG.RRF" "SUI" x)))))))
+ (parse-ui (vff "MRXW_ENG.RRF" "CUI" x))
+ (parse-ui (vff "MRXW_ENG.RRF" "SUI" x)))))))
("MRXW_NONENG.RRF" "KLRL" "TINYINT" 0
(lambda (x) (write-to-string (cuisui-lrl (make-cuisui
- (parse-ui (vff "MRXW_NONENG.RRF" "CUI" x))
- (parse-ui (vff "MRXW_NONENG.RRF" "SUI" x)))))))
+ (parse-ui (vff "MRXW_NONENG.RRF" "CUI" x))
+ (parse-ui (vff "MRXW_NONENG.RRF" "SUI" x)))))))
("MRXW_NONENG.RRF" "KLRLUS" "TINYINT" 0
(lambda (x) (write-to-string (cuisui-lrlus (make-cuisui
- (parse-ui (vff "MRXW_NONENG.RRF" "CUI" x))
- (parse-ui (vff "MRXW_NONENG.RRF" "SUI" x)))))))
+ (parse-ui (vff "MRXW_NONENG.RRF" "CUI" x))
+ (parse-ui (vff "MRXW_NONENG.RRF" "SUI" x)))))))
("MRXNW_ENG.RRF" "KLRL" "TINYINT" 0
(lambda (x) (write-to-string (cuisui-lrl (make-cuisui
- (parse-ui (vff "MRXNW_ENG.RRF" "CUI" x))
- (parse-ui (vff "MRXNW_ENG.RRF" "SUI" x)))))))
+ (parse-ui (vff "MRXNW_ENG.RRF" "CUI" x))
+ (parse-ui (vff "MRXNW_ENG.RRF" "SUI" x)))))))
("MRXNW_ENG.RRF" "KLRLUS" "TINYINT" 0
(lambda (x) (write-to-string (cuisui-lrlus (make-cuisui
- (parse-ui (vff "MRXNW_ENG.RRF" "CUI" x))
- (parse-ui (vff "MRXNW_ENG.RRF" "SUI" x)))))))
+ (parse-ui (vff "MRXNW_ENG.RRF" "CUI" x))
+ (parse-ui (vff "MRXNW_ENG.RRF" "SUI" x)))))))
("MRXNS_ENG.RRF" "KLRL" "TINYINT" 0
(lambda (x) (write-to-string (cuisui-lrl (make-cuisui
- (parse-ui (vff "MRXNS_ENG.RRF" "CUI" x))
- (parse-ui (vff "MRXNS_ENG.RRF" "SUI" x)))))))
+ (parse-ui (vff "MRXNS_ENG.RRF" "CUI" x))
+ (parse-ui (vff "MRXNS_ENG.RRF" "SUI" x)))))))
("MRXNS_ENG.RRF" "KLRLUS" "TINYINT" 0
(lambda (x) (write-to-string (cuisui-lrlus (make-cuisui
- (parse-ui (vff "MRXNS_ENG.RRF" "CUI" x))
- (parse-ui (vff "MRXNS_ENG.RRF" "SUI" x)))))))
+ (parse-ui (vff "MRXNS_ENG.RRF" "CUI" x))
+ (parse-ui (vff "MRXNS_ENG.RRF" "SUI" x)))))))
- #+nil ("MRREL.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (nth 4 x)))))
- #+nil ("MRCOC.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (nth 2 x)))))
+ #+nil ("MRREL.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (vff "MRREL.RRF" "CUI2" x)))))
+ #+mrcoc ("MRCOC.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (vff "MRCOC.RRF" "CUI2" x)))))
("MRSAT.RRF" "KCUILUI" "BIGINT" 0
(lambda (x) (write-to-string (make-cuilui
"Custom columns to create.(filename, col, sqltype, value-func).")
(defparameter +index-cols+
- '(("CUI1" "MRCOC") ("CUI" "MRCONSO") ("LUI" "MRCONSO")
- ("SRL" "MRCONSO") ("KSRLUS" "MRCONSO") ("AUI" "MRCONSO") ("KPFENG" "MRCONSO")
- ("SUI" "MRCONSO") ("SAUI" "MRCONSO") ("CODE" "MRCONSO")
- ("SCUI" "MRCONSO")
- ("CUI" "MRDEF")
- ("CUI1" "MRREL") ("CUI2" "MRREL") ("SAB" "MRREL")
+ '( #+mrcoc ("CUI1" "MRCOC") #+mrcoc ("KLRL" "MRCOC") #+mrcoc ("KLRLUS" "MRCOC")
+ ("CUI" "MRCONSO") ("LUI" "MRCONSO")
+ ("SRL" "MRCONSO") ("KSRLUS" "MRCONSO") ("AUI" "MRCONSO") ("KPFENG" "MRCONSO")
+ ("SUI" "MRCONSO") ("SAUI" "MRCONSO") ("CODE" "MRCONSO")
+ ("SCUI" "MRCONSO")
+ ("CUI" "MRDEF")
+ ("CUI1" "MRREL") ("CUI2" "MRREL") ("SAB" "MRREL")
("RUI" "MRREL") ("AUI1" "MRREL") ("AUI2" "MRREL")
("CUI" "MRSAT") ("LUI" "MRSAT") ("SUI" "MRSAT")
("METAUI" "MRSAT") ("ATN" "MRSAT")
("CUI" "MRSTY") ("TUI" "MRSTY") ("CUI" "MRXNS_ENG")
- ("AUI" "MRHIER") ("CUI" "MRHIER") ("CXN" "MRHIER") ("RELA" "MRHIER") ("PAUI" "MRHIER")
- ("SAB" "MRHIER")
- #+ignore ("NSTR" "MRXNS_ENG" 10)
+ ("AUI" "MRHIER") ("CUI" "MRHIER") ("CXN" "MRHIER") ("RELA" "MRHIER")
+ ("PAUI" "MRHIER") ("SAB" "MRHIER")
+ ("NSTR" "MRXNS_ENG" 255)
("CUI" "MRXNW_ENG") ("NWD" "MRXNW_ENG") ("WD" "MRXW_ENG")
("KCUISUI" "MRCONSO") ("KCUILUI" "MRCONSO")
("KCUILRL" "MRCONSO") ("KLUILRL" "MRCONSO") ("KSUILRL" "MRCONSO")
("KCUISUI" "MRXNS_ENG") ("KCUISUI" "MRXW_NONENG")
("KSRL" "MRDEF") ("KSRL" "MRRANK")("KSRL" "MRREL") ("KSRL" "MRSAT")
("KSRLUS" "MRDEF") ("KSRLUS" "MRRANK")("KSRLUS" "MRREL") ("KSRLUS" "MRSAT")
- ("KLRL" "MRCOC") ("KLRL" "MRSTY") ("KLRL" "MRXW_ENG") ("KLRL" "MRXNW_ENG")
- ("KLRLUS" "MRCOC") ("KLRLUS" "MRSTY") ("KLRLUS" "MRXW_ENG") ("KLRLUS" "MRXNW_ENG")
+ ("KLRL" "MRSTY") ("KLRL" "MRXW_ENG") ("KLRL" "MRXNW_ENG")
+ ("KLRLUS" "MRSTY") ("KLRLUS" "MRXW_ENG") ("KLRLUS" "MRXNW_ENG")
("KLRL" "MRXNS_ENG") ("KLRL" "MRXW_NONENG")
("KLRLUS" "MRXNS_ENG") ("KLRLUS" "MRXW_NONENG")
;; LEX indices
("RL" "SRSTR")
("SRL" "MRSAB") ("KSRLUS" "MRSAB") ("RSAB" "MRSAB") ("VSAB" "MRSAB") ("RCUI" "MRSAB")
- ("VCUI" "MRSAB") ("LAT" "MRSAB") ("MAPSETCUI" "MRMAP") ("MAPSETCUI" "MRSMAP")
- ("CUI" "MRHIER"))
+ ("VCUI" "MRSAB") ("LAT" "MRSAB") ("MAPSETCUI" "MRMAP") ("MAPSETCUI" "MRSMAP"))
"Columns in files to index")
(let ((cols '()))
(with-umls-file (line "MRCOLS.RRF")
(destructuring-bind (col des ref min av max fil dty) line
- (push (make-ucol col des ref (parse-integer min) (read-from-string av)
- (parse-integer max) fil dty)
- cols)))
+ (push (make-ucol col des ref (parse-integer min) (read-from-string av)
+ (parse-integer max) fil dty)
+ cols)))
(nreverse cols)))
(defun gen-ucols-custom ()
"Initialize umls columns for custom columns"
(loop for customcol in +custom-cols+
- collect
- (make-ucol (nth 1 customcol) "" 0 0 0 (eval (nth 3 customcol))
- (nth 0 customcol) nil :sqltype (canonicalize-column-type (nth 2 customcol))
- :custom-value-fun (compile nil (nth 4 customcol)))))
+ collect
+ (make-ucol (nth 1 customcol) "" 0 0 0 (eval (nth 3 customcol))
+ (nth 0 customcol) nil :sqltype (canonicalize-column-type (nth 2 customcol))
+ :custom-value-fun (compile nil (nth 4 customcol)))))
(defun gen-ucols-generic (col-filename)
"Initialize for generic (LEX/NET) columns"
(let ((cols '()))
(with-umls-file (line col-filename)
(destructuring-bind (nam des ref fil) line
- (setq nam (escape-column-name nam))
- (dolist (file (delimited-string-to-list fil #\,))
- (push
- (make-ucol nam des ref nil nil nil file nil)
- cols))))
+ (setq nam (escape-column-name nam))
+ (dolist (file (delimited-string-to-list fil #\,))
+ (push
+ (make-ucol nam des ref nil nil nil file nil)
+ cols))))
(nreverse cols)))
(let ((files '()))
(with-umls-file (line files-filename)
(destructuring-bind (fil des fmt cls rws bts) line
- (push (make-ufile
- dir fil des
- (parse-integer cls)
- (parse-integer rws) (parse-integer bts)
- (concatenate 'list (umls-field-string-to-list fmt)
- (custom-colnames-for-filename fil)))
- files)))
+ (push (make-ufile
+ dir fil des
+ (parse-integer cls)
+ (parse-integer rws) (parse-integer bts)
+ (concatenate 'list (umls-field-string-to-list fmt)
+ (custom-colnames-for-filename fil)))
+ files)))
(nreverse files)))
(defun gen-ufiles-custom ()
(make-ufile "META" "MRXW_NONENG.RRF" "Custom NonEnglish Index"
- 5 0 0 (fields (find-ufile "MRXW_ENG.RRF"))))
-
-
-
+ 5 0 0 (fields (find-ufile "MRXW_ENG.RRF"))))
projects / umlisp.git / blobdiff