;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: parse-2002.lisp ;;;; Purpose: Parsing and SQL insertion routines for UMLisp which may ;;;; change from year to year ;;;; Author: Kevin M. Rosenberg ;;;; Created: Apr 2000 ;;;; ;;;; $Id$ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2004 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. ;;;; ************************************************************************* (in-package #:umlisp-orf) ;;; Pre-read data for custom fields into hash tables (defvar *preparse-hash-init?* nil) (eval-when (:compile-toplevel :load-toplevel :execute) (let ((pfstr-hash nil) ;;; Preferred concept strings by CUI (cui-lrl-hash nil) ;;; LRL by CUI (lui-lrl-hash nil) ;;; LRL by LUI (cuisui-lrl-hash nil) ;;; LRL by CUISUI (sab-srl-hash nil)) ;;; SRL by SAB (defun make-preparse-hash-table () (if pfstr-hash (progn (clrhash pfstr-hash) (clrhash cui-lrl-hash) (clrhash lui-lrl-hash) (clrhash cuisui-lrl-hash) (clrhash sab-srl-hash)) (setf pfstr-hash (make-hash-table :size 800000) cui-lrl-hash (make-hash-table :size 800000) lui-lrl-hash (make-hash-table :size 1500000) cuisui-lrl-hash (make-hash-table :size 1800000) sab-srl-hash (make-hash-table :size 100 :test 'equal)))) (defun buffered-ensure-preparse (&optional (force-read nil)) (when (or force-read (not *preparse-hash-init?*)) (make-preparse-hash-table) (setq *preparse-hash-init?* t)) (with-buffered-umls-file (line "MRCON") (let ((cui (parse-ui (aref line 0))) (lui (parse-ui (aref line 3))) (sui (parse-ui (aref line 5))) (lrl (parse-integer (aref line 7)))) (unless (gethash cui pfstr-hash) ;; if haven't stored pfstr for cui (if (and (string-equal (aref line 1) "ENG") ; LAT (string-equal (aref line 2) "P") ; ts (string-equal (aref line 4) "PF")) ; stt (setf (gethash cui pfstr-hash) (aref line 6)))) (set-lrl-hash cui lrl cui-lrl-hash) (set-lrl-hash lui lrl lui-lrl-hash) (set-lrl-hash (make-cuisui cui sui) lrl cuisui-lrl-hash))) (with-buffered-umls-file (line "MRSO") (let ((sab (aref line 3))) (unless (gethash sab sab-srl-hash) ;; if haven't stored (setf (gethash sab sab-srl-hash) (aref line 6)))))) (defun ensure-preparse (&optional (force-read nil)) (when (or force-read (not *preparse-hash-init?*)) (make-preparse-hash-table) (setq *preparse-hash-init?* t)) (with-umls-file (line "MRCON") (let ((cui (parse-ui (nth 0 line))) (lui (parse-ui (nth 3 line))) (sui (parse-ui (nth 5 line))) (lrl (parse-integer (nth 7 line)))) (unless (gethash cui pfstr-hash) ;; if haven't stored pfstr for cui (if (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 6 line)))) (set-lrl-hash cui lrl cui-lrl-hash) (set-lrl-hash lui lrl lui-lrl-hash) (set-lrl-hash (make-cuisui cui sui) lrl cuisui-lrl-hash))) (with-umls-file (line "MRSO") (let ((sab (nth 3 line))) (multiple-value-bind (val found) (gethash sab sab-srl-hash) (declare (ignore val)) (unless found (setf (gethash sab sab-srl-hash) (parse-integer (nth 6 line)))))))) (defun pfstr-hash (cui) (gethash cui pfstr-hash)) (defun cui-lrl (cui) (gethash cui cui-lrl-hash)) (defun lui-lrl (lui) (gethash lui lui-lrl-hash)) (defun cuisui-lrl (cuisui) (gethash cuisui cuisui-lrl-hash)) (defun sab-srl (sab) (aif (gethash sab sab-srl-hash) it 0)) )) ;; closure (defun set-lrl-hash (key lrl hash) "Set the least restrictive level in hash table" (multiple-value-bind (hash-lrl found) (gethash key hash) (if (or (not found) (< lrl hash-lrl)) (setf (gethash key hash) lrl)))) ;; UMLS file and column structures ;;; SQL datatypes symbols ;;; sql-u - Unique identifier ;;; sql-s - Small integer (16-bit) ;;; sql-i - Integer (32-bit) ;;; sql-l - Big integer (64-bit) ;;; sql-f - Floating point ;;; sql-c - Character data (defparameter +col-datatypes+ '(("AV" sql-f) ("BTS" sql-i) ("CLS" sql-i) ("COF" sql-i) ("CUI1" sql-u) ("CUI2" sql-u) ("CUI" sql-u) ("CXN" sql-s) ("FR" sql-i) ("LRL" sql-s) ("LUI" sql-u) ("MAX" sql-s) ("MIN" sql-s) ("RANK" sql-s) ("REF" sql-c) ("RNK" sql-s) ("RWS" sql-i) ("SRL" sql-s) ("SUI" sql-u) ("TUI" sql-u) ;;; Custom columns ("KCUISUI" sql-l) ("KCUILUI" sql-l) ("KCUILRL" sql-i) ("KLUILRL" sql-i) ("KSRL" sql-i) ("KLRL" sql-i) ;;; LEX columns ("EUI" sql-u) ("EUI2" sql-u) ;;; Semantic net columns ("UI" sql-u) ("UI2" sql-u) ("UI3" sql-u) ;; New fields for 2002AD ("RCUI" sql-u) ("VCUI" sql-u) ("CFR" sql-i) ("TFR" sql-i) ) "SQL data types for each non-string column") (defparameter +custom-tables+ nil #+ignore '(("MRCONSO" "SELECT m.CUI, m.LAT, m.TS, m.LUI, m.STT, m.SUI, m.STR, m.LRL, s.SAB, s.TTY, s.SCD, s.SRL FROM MRCON m, MRSO s WHERE m.CUI=s.CUI AND m.LUI=s.LUI AND m.SUI=s.SUI") ("MRCONFULL" "SELECT m.CUI, m.LAT, m.TS, m.LUI, m.STT, m.SUI, m.STR, m.LRL, s.SAB, s.TTY, s.SCD, s.SRL, t.TUI FROM MRCON m, MRSO s, MRSTY t WHERE m.CUI=s.CUI AND m.LUI=s.LUI AND m.SUI=s.SUI AND m.CUI=t.CUI AND s.CUI=t.CUI")) "Custom tables to create") (defparameter +custom-cols+ '(("MRCON" "KPFSTR" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (nth 0 x))))) ("MRCON" "KCUISUI" "BIGINT" 0 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 5 x)))))) ("MRCON" "KCUILUI" "BIGINT" 0 (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 3 x)))))) ("MRCON" "KCUILRL" "INTEGER" 0 (lambda (x) (write-to-string (cui-lrl (parse-ui (nth 0 x)))))) ("MRCON" "KLUILRL" "INTEGER" 0 (lambda (x) (write-to-string (lui-lrl (parse-ui (nth 3 x)))))) ("MRLO" "KLRL" "INTEGER" 0 (lambda (x) (write-to-string (if (zerop (length (nth 4 x))) (cui-lrl (parse-ui (nth 0 x))) (cuisui-lrl (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 4 x)))))))) ("MRSTY" "KLRL" "INTEGER" 0 (lambda (x) (write-to-string (cui-lrl (parse-ui (nth 0 x)))))) ("MRCOC" "KLRL" "INTEGER" 0 (lambda (x) (write-to-string (max (cui-lrl (parse-ui (nth 0 x))) (kmrcl:aif (cui-lrl (parse-ui (nth 1 x))) kmrcl::it 0))))) ("MRSAT" "KSRL" "INTEGER" 0 (lambda (x) (write-to-string (sab-srl (nth 5 x))))) ("MRREL" "KSRL" "INTEGER" 0 (lambda (x) (write-to-string (sab-srl (nth 4 x))))) ("MRRANK" "KSRL" "INTEGER" 0 (lambda (x) (write-to-string (sab-srl (nth 1 x))))) ("MRDEF" "KSRL" "INTEGER" 0 (lambda (x) (write-to-string (sab-srl (nth 1 x))))) ("MRCXT" "KSRL" "INTEGER" 0 (lambda (x) (write-to-string (sab-srl (nth 2 x))))) ("MRATX" "KSRL" "INTEGER" 0 (lambda (x) (write-to-string (sab-srl (nth 1 x))))) ("MRXW.ENG" "KLRL" "INTEGER" 0 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))) ("MRXW.NONENG" "KLRL" "INTEGER" 0 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))) ("MRXNW.ENG" "KLRL" "INTEGER" 0 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))) ("MRXNS.ENG" "KLRL" "INTEGER" 0 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))) ("MRREL" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (nth 2 x))))) ("MRCOC" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (nth 1 x))))) ("MRCXT" "KCUISUI" "BIGINT" 0 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 1 x)))))) ("MRSAT" "KCUILUI" "BIGINT" 0 (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 1 x)))))) ("MRSAT" "KCUISUI" "BIGINT" 0 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 2 x)))))) ("MRSO" "KCUISUI" "BIGINT" 0 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 2 x)))))) ("MRXW.ENG" "KCUISUI" "BIGINT" 0 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x)))))) ("MRXNW.ENG" "KCUISUI" "BIGINT" 0 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x)))))) ("MRXNS.ENG" "KCUISUI" "BIGINT" 0 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x)))))) ("MRXW.NONENG" "LAT" "VARCHAR" 3 (lambda (x) (nth 0 x))) ("MRXW.NONENG" "WD" "VARCHAR" 200 (lambda (x) (nth 1 x))) ("MRXW.NONENG" "CUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 2 x))))) ("MRXW.NONENG" "LUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 3 x))))) ("MRXW.NONENG" "SUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 4 x))))) ("MRXW.NONENG" "KCUISUI" "BIGINT" 0 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))) "Custom columns to create.(filename, col, sqltype, value-func).") (defparameter +index-cols+ '(("CUI" "MRATX") ("CUI1" "MRCOC") ("CUI" "MRCON") ("LUI" "MRCON") ("LRL" "MRCON") ("SUI" "MRCON") ("CUI" "MRCXT") ("CUI" "MRDEF") ("CUI" "MRLO") ("CUI1" "MRREL") ("CUI" "MRSAT") ("LUI" "MRSAT") ("SUI" "MRSAT") ("CUI" "MRSO") ("SAB" "MRSO") ("SRL" "MRSO") ("CUI" "MRSTY") ("TUI" "MRSTY") ("CUI" "MRXNS_ENG") #+ignore ("NSTR" "MRXNS_ENG" 10) ("CUI" "MRXNW_ENG") ("NWD" "MRXNW_ENG") ("WD" "MRXW_ENG") ("KCUISUI" "MRCON") ("KCUILUI" "MRCON") ("KCUILRL" "MRCON") ("KLUILRL" "MRCON") ("KCUISUI" "MRCXT") ("KCUISUI" "MRSO") ("KCUISUI" "MRSAT") ("KCUILUI" "MRSAT") ("KCUISUI" "MRXW_ENG") ("KCUISUI" "MRXNW_ENG") ("KCUISUI" "MRXNS_ENG") ("KCUISUI" "MRXW_NONENG") ("KSRL" "MRATX") ("KSRL" "MRCXT") ("KSRL" "MRDEF") ("KSRL" "MRRANK") ("KSRL" "MRREL") ("KSRL" "MRSAT") ("KLRL" "MRCOC") ("KLRL" "MRLO") ("KLRL" "MRSTY") ("KLRL" "MRXW_ENG") ("KLRL" "MRXNW_ENG") ("KLRL" "MRXNS_ENG") ("KLRL" "MRXW_NONENG") ;; LEX indices ("EUI" "LRABR") ("EUI2" "LRABR") ("EUI" "LRAGR") ("EUI" "LRCMP") ("EUI" "LRMOD") ("EUI" "LRNOM") ("EUI2" "LRNOM") ("EUI" "LRPRN") ("EUI" "LRPRP") ("EUI" "LRSPL") ("EUI" "LRTRM") ("EUI" "LRTYP") ("EUI" "LRWD") ("WRD" "LRWD") ("BAS" "LRABR") ;; Semantic NET indices ("UI" "SRSTRE1") ("UI2" "SRSTRE1") ("UI3" "SRSTRE1") ("STY_RL" "SRDEF") ("RT" "SRDEF") ("STY_RL" "SRSTR") ("STY_RL2" "SRSTR") ("RL" "SRSTR") ("SRL" "MRSAB") ("RSAB" "MRSAB") ("VSAB" "MRSAB") ("RCUI" "MRSAB") ("VCUI" "MRSAB") ("LAT" "MRSAB")) "Columns in files to index") (defparameter +custom-index-cols+ nil #+ignore '(("CUI" "MRCONFULL") ("SAB" "MRCONFULL") ("TUI" "MRCONFULL")) "Indexes to custom tables") ;; File & Column functions (defun gen-ucols () (add-ucols (gen-ucols-meta)) (add-ucols (gen-ucols-custom)) (add-ucols (gen-ucols-generic "LRFLD")) (add-ucols (gen-ucols-generic "SRFLD"))) (defun gen-ucols-meta () "Initialize all umls columns" (let ((cols '())) (with-umls-file (line "MRCOLS") (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))) (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 (nth 3 customcol) (nth 0 customcol) nil :sqltype (nth 2 customcol) :custom-value-fun (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)))) (nreverse cols))) (defun gen-ufiles () (add-ufiles (gen-ufiles-generic "MRFILES")) (add-ufiles (gen-ufiles-generic "LRFIL")) (add-ufiles (gen-ufiles-generic "SRFIL")) ;; needs to come last (add-ufiles (gen-ufiles-custom))) (defun gen-ufiles-generic (files-filename) "Initialize all LEX file structures" (let ((files '())) (with-umls-file (line files-filename) (destructuring-bind (fil des fmt cls rws bts) line (push (make-ufile fil des (substitute #\_ #\. fil) (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 "MRXW.NONENG" "Custom NonEnglish Index" "MRXW_NONENG" 5 0 0 (fields (find-ufile "MRXW.ENG"))))