From 6ebaa3627ee89b8f7f429ebcd01c4dc8d9892e0b Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Wed, 6 Sep 2006 17:45:46 +0000 Subject: [PATCH 1/1] r11103: 2006 umls updates --- class-support.lisp | 20 ++++++++------ create-sql.lisp | 55 ++++++++++++++++++++++++++++++------- parse-rrf.lisp | 49 +++++++++++++++++---------------- sql-classes.lisp | 68 ++++++++++++++++++++-------------------------- 4 files changed, 112 insertions(+), 80 deletions(-) diff --git a/class-support.lisp b/class-support.lisp index a9fae98..e7fe960 100644 --- a/class-support.lisp +++ b/class-support.lisp @@ -87,10 +87,14 @@ (defgeneric fmt-aui (aui)) (when *has-fixnum-class* (defmethod fmt-aui ((aui fixnum)) - (prefixed-fixnum-string aui #\A 7))) + (if (>= aui 10000000) + (prefixed-fixnum-string aui #\A 8) + (prefixed-fixnum-string aui #\A 7)))) (defmethod fmt-aui ((aui integer)) - (prefixed-integer-string aui #\A 7)) + (if (>= aui 10000000) + (prefixed-integer-string aui #\A 8) + (prefixed-integer-string aui #\A 7))) (defmethod fmt-aui ((aui string)) (if (eql (aref aui 0) #\A) @@ -218,7 +222,7 @@ (dolist (term (s#term ucon) (nreverse res)) (dolist (str (s#str term)) (push str res))))) - + (defmethod pfstr ((uterm uterm)) "Return the preferred string for a uterm" @@ -318,7 +322,7 @@ ((char-equal #\O c) "Other")))) - + (defun ucon-parents (con &optional sab) (ucon-ancestors con sab t)) @@ -327,7 +331,7 @@ (let* ((parent-rels (filter-urels-by-rel (s#rel ucon) "par")) (anc nil)) (when sab - (setq parent-rels (delete-if-not + (setq parent-rels (delete-if-not (lambda (rel) (string-equal sab (sab rel))) parent-rels))) (dolist (rel parent-rels (nreverse anc)) @@ -342,12 +346,12 @@ (defmethod cxt-ancestors ((con ucon)) (loop for term in (s#term con) append (cxt-ancestors term))) - + (defmethod cxt-ancestors ((term uterm)) (loop for str in (s#str term) append (cxt-ancestors str))) - + (defmethod cxt-ancestors ((str ustr)) "Return the ancestory contexts of a ustr" (let* ((anc (remove-if-not @@ -364,7 +368,7 @@ (sort anc-this-cxn (lambda (a b) (< (rank a) (rank b)))) anc-lists))))) - + #+scl (dolist (c '(urank udef usat uso ucxt ustr ulo uterm usty urel ucoc uatx ucon uxw uxnw uxns lexterm labr lagr lcmp lmod lnom lprn lprp lspl ltrm ltyp lwd sdef sstr sstre1 sstre2 usrl)) (let ((cl (find-class c))) diff --git a/create-sql.lisp b/create-sql.lisp index fdc444c..f276286 100644 --- a/create-sql.lisp +++ b/create-sql.lisp @@ -46,7 +46,7 @@ " MAX_ROWS=200000000" "") (if (eq *umls-sql-type* :mysql) - " TYPE=MYISAM DEFAULT CHARACTER latin1" + " TYPE=MYISAM CHARACTER SET utf8" "")))) (defun create-custom-table-cmd (tablename sql-cmd) @@ -277,18 +277,53 @@ This is much faster that using create-umls-db-insert." (translate-files (find-ufile "MRXW_NONENG.RRF") extension (noneng-lang-index-files))) +(defun verify-translation-file (output-path input-ufiles) + "Returns t if translation file exists and is correct size. Warns and deletes incomplete translation file." + (when (probe-file output-path) + (let ((translated-lines 0) + (input-lines 0) + (eof (cons nil nil))) + (catch 'done-counting + (with-open-file (ts output-path :direction :input + #+(and clisp unicode) :external-format + #+(and clisp unicode) charset:utf-8) + (do () + ((eq (read-line ts nil eof) eof)) + (incf translated-lines))) + (dolist (input-ufile input-ufiles) + (with-umls-ufile (line input-ufile) + (incf input-lines) + (when (> input-lines translated-lines) + (throw 'done-counting 'incomplete))))) + (cond + ((eql input-lines 0) + (error "Input lines is 0") + nil) + ((< input-lines translated-lines) + (format t "Translated file ~A incomplete, deleting...~%" output-path) + (delete-file output-path) + nil) + ((eql input-lines translated-lines) + (format t "Translated file ~A already exists: skipping...~%" output-path) + t) + ((> translated-lines input-lines) + (error "Shouldn't happen. Translated lines of ~A is ~D, greater than input lines ~D" + output-path translated-lines input-lines) + (delete-file output-path) + nil))))) + (defun translate-files (out-ufile extension input-ufiles) "Translate a umls file into a format suitable for sql copy cmd" (let ((output-path (ufile-pathname out-ufile extension))) - (if (probe-file output-path) - (format t "File ~A already exists: skipping~%" output-path) - (with-open-file (ostream output-path :direction :output - #+(and clisp unicode) :external-format - #+(and clisp unicode) charset:utf-8) - (dolist (input-ufile input-ufiles) - (with-umls-ufile (line input-ufile) - (translate-line out-ufile line ostream) - (princ #\newline ostream))))))) + (when (verify-translation-file output-path input-ufiles) + (return-from translate-files output-path)) + (with-open-file (ostream output-path :direction :output + #+(and clisp unicode) :external-format + #+(and clisp unicode) charset:utf-8) + (dolist (input-ufile input-ufiles) + (with-umls-ufile (line input-ufile) + (translate-line out-ufile line ostream) + (princ #\newline ostream)))))) (defun translate-line (file line strm) "Translate a single line for sql output" diff --git a/parse-rrf.lisp b/parse-rrf.lisp index 4c617a0..c34f3ee 100644 --- a/parse-rrf.lisp +++ b/parse-rrf.lisp @@ -127,9 +127,16 @@ "Custom tables to create") (defparameter +custom-cols+ - '(("MRCONSO.RRF" "KPFSTR" "TEXT" - (slot-value (find-ucol "STR" "MRCONSO.RRF") 'max) - (lambda (x) (pfstr-hash (parse-ui (nth 0 x))))) + '(#+nil ("MRCONSO.RRF" "KPFSTR" "TEXT" + (slot-value (find-ucol "STR" "MRCONSO.RRF") 'max) + (lambda (x) (pfstr-hash (parse-ui (nth 0 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 + "1" + "0"))) ("MRCONSO.RRF" "KCUISUI" "BIGINT" 0 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 5 x)))))) ("MRCONSO.RRF" "KCUILUI" "BIGINT" 0 @@ -140,13 +147,6 @@ (lambda (x) (write-to-string (lui-lrl (parse-ui (nth 3 x)))))) ("MRCONSO.RRF" "KSUILRL" "SMALLINT" 0 (lambda (x) (write-to-string (sui-lrl (parse-ui (nth 5 x)))))) - ;; Deprecated, last in 2004AA -- skip index - #+ignore - ("MRLO.RRF" "KLRL" "SMALLINT" 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.RRF" "KLRL" "SMALLINT" 0 (lambda (x) (write-to-string (cui-lrl (parse-ui (nth 0 x)))))) ("MRCOC.RRF" "KLRL" "SMALLINT" 0 @@ -161,8 +161,7 @@ (lambda (x) (write-to-string (sab-srl (nth 1 x))))) ("MRDEF.RRF" "KSRL" "SMALLINT" 0 (lambda (x) (write-to-string (sab-srl (nth 4 x))))) - ("MRCXT.RRF" "KSRL" "SMALLINT" 0 - (lambda (x) (write-to-string (sab-srl (nth 2 x))))) + #+nil ("MRCXT.RRF" "KSRL" "SMALLINT" 0 (lambda (x) (write-to-string (sab-srl (nth 2 x))))) ("MRXW_ENG.RRF" "KLRL" "SMALLINT" 0 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui (parse-ui (nth 2 x)) @@ -179,12 +178,12 @@ (lambda (x) (write-to-string (cuisui-lrl (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))) - ("MRREL.RRF" "KPFSTR2" "TEXT" 1024 - (lambda (x) (pfstr-hash (parse-ui (nth 4 x))))) - ("MRCOC.RRF" "KPFSTR2" "TEXT" 1024 - (lambda (x) (pfstr-hash (parse-ui (nth 2 x))))) - ("MRCXT.RRF" "KCUISUI" "BIGINT" 0 - (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 1 x)))))) + + ;; FIXME: For MRREF and MRCOC, add lookups to KPFSTR2 using new MRCONSO index KPFENG + + #+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))))) + #+use-mrctx ("MRCXT.RRF" "KCUISUI" "BIGINT" 0 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 1 x)))))) ("MRSAT.RRF" "KCUILUI" "BIGINT" 0 (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 1 x)))))) ("MRSAT.RRF" "KCUISUI" "BIGINT" 0 @@ -206,21 +205,23 @@ (defparameter +index-cols+ '(("CUI1" "MRCOC") ("CUI" "MRCONSO") ("LUI" "MRCONSO") - ("SRL" "MRCONSO") ("AUI" "MRCONSO") - ("SUI" "MRCONSO") ("CUI" "MRCXT") ("CUI" "MRDEF") ("CUI" "MRLO") + ("SRL" "MRCONSO") ("AUI" "MRCONSO") ("KPFENG" "MRCONSO") + ("SUI" "MRCONSO") ("CUI" "MRDEF") ("CUI1" "MRREL") ("CUI" "MRSAT") ("LUI" "MRSAT") ("SUI" "MRSAT") ("CUI" "MRSTY") ("TUI" "MRSTY") ("CUI" "MRXNS_ENG") + ;; ("CUI" "MRCXT") ("KCUISUI" "MRCXT") ("KSRL" "MRCXT") + ("AUI" "MRHIER") ("PTR" "MRHIER") ("CUI" "MRHIER") ("CXN" "MRHIER") ("RELA" "MRHIER") ("PAUI" "MRHIER") + ("SAB" "MRHIER") #+ignore ("NSTR" "MRXNS_ENG" 10) ("CUI" "MRXNW_ENG") ("NWD" "MRXNW_ENG") ("WD" "MRXW_ENG") ("KCUISUI" "MRCONSO") ("KCUILUI" "MRCONSO") ("KCUILRL" "MRCONSO") - ("KLUILRL" "MRCONSO") ("KCUISUI" "MRCXT") + ("KLUILRL" "MRCONSO") ("KCUISUI" "MRSAT") ("KCUILUI" "MRSAT") ("KCUISUI" "MRXW_ENG") ("KCUISUI" "MRXNW_ENG") ("KCUISUI" "MRXNS_ENG") ("KCUISUI" "MRXW_NONENG") - ("KSRL" "MRCXT") ("KSRL" "MRDEF") ("KSRL" "MRRANK") + ("KSRL" "MRDEF") ("KSRL" "MRRANK") ("KSRL" "MRREL") ("KSRL" "MRSAT") ("KLRL" "MRCOC") - #+ignore ("KLRL" "MRLO") ;; deprecated ("KLRL" "MRSTY") ("KLRL" "MRXW_ENG") ("KLRL" "MRXNW_ENG") ("KLRL" "MRXNS_ENG") ("KLRL" "MRXW_NONENG") ;; LEX indices @@ -235,7 +236,7 @@ ("SRL" "MRSAB") ("RSAB" "MRSAB") ("VSAB" "MRSAB") ("RCUI" "MRSAB") ("VCUI" "MRSAB") ("LAT" "MRSAB") ("MAPSETCUI" "MRMAP") ("MAPSETCUI" "MRSMAP") - ("CUI" "MRHIER") ("AUI" "MRHIER") ("PAUI" "MRHIER")) + ("CUI" "MRHIER")) "Columns in files to index") diff --git a/sql-classes.lisp b/sql-classes.lisp index 293c961..d38df69 100644 --- a/sql-classes.lisp +++ b/sql-classes.lisp @@ -59,7 +59,7 @@ &key (lrl "KCUILRL") single distinct order like) (concatenate 'string - (format nil "select ~A~{~:@(~A~)~^,~} from ~:@(~A~)" + (format nil "select ~A~{~:@(~A~)~^,~} from ~:@(~A~)" (if distinct "distinct " "") fields table) (if where-name (format nil " where ~:@(~A~)" where-name) "") (if where-name @@ -82,7 +82,7 @@ "Query the UMLisp database. Return a list of umlisp objects whose name is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" `(,query-cmd - (query-string ,table ,fields ,srl ,where-name ,where-value + (query-string ,table ,fields ,srl ,where-name ,where-value :lrl ,lrl :single ,single :distinct ,distinct :order ,order :like ,like))) (defmacro umlisp-query-eval (table fields srl where-name where-value @@ -90,7 +90,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" "Query the UMLisp database. Return a list of umlisp objects whose name is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" `(mutex-sql-query - (query-string-eval ,table ,fields ,srl ,where-name ,where-value + (query-string-eval ,table ,fields ,srl ,where-name ,where-value :lrl ,lrl :single ,single :distinct ,distinct :order ,order :like ,like))) ;; only WHERE-VALUE and SRL are evaluated @@ -99,7 +99,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" order like (query-cmd 'mutex-sql-query)) &body body) (let ((value (gensym)) - (r (gensym))) + (r (gensym))) (if single `(let* ((,value ,where-value) (tuple (car (umlisp-query ,table ,fields ,srl ,where-name ,value @@ -247,7 +247,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-ucon-all (&key (srl *current-srl*)) "Return list of all ucon's" (with-sql-connection (db) - (clsql:map-query + (clsql:map-query 'list #'(lambda (tuple) (destructuring-bind (cui pfstr cuilrl) tuple @@ -275,7 +275,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun map-ucon-all (fn &key (srl *current-srl*)) "Map a function over all ucon's" (with-sql-connection (db) - (clsql:map-query + (clsql:map-query nil #'(lambda (tuple) (destructuring-bind (cui pfstr cuilrl) tuple @@ -304,12 +304,12 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (make-instance 'udoc :key dockey :value value :type type :expl expl))) (defun find-udoc-key-value (key value) - (let ((tuple (car (mutex-sql-query + (let ((tuple (car (mutex-sql-query (format nil "SELECT TYPE,EXPL FROM MRDOC WHERE DOCKEY='~A' AND VALUE='~A'" key value))))) (when tuple (make-instance 'udoc :key key :value value :type (first tuple) :expl (second tuple))))) - + (defun find-udoc-all () "Return all abbreviation documentation" (collect-umlisp-query (mrdoc (dockey value type expl) nil nil nil) @@ -386,18 +386,10 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-ucon-coc-cui2 (cui2 &key (srl *current-srl*)) "List of ucon with co-occurance cui2" (ensure-cui-integer cui2) - (mapcar + (mapcar #'(lambda (cui) (find-ucon-cui cui :srl srl)) (remove-duplicates (mapcar #'cui1 (find-ucoc-cui2 cui2 :srl srl))))) -(defun find-ulo-cui (cui &key (srl *current-srl*)) - "Return a list of ulo for cui" - (ensure-cui-integer cui) - (collect-umlisp-query (mrlo (isn fr un sui sna soui) srl cui cui - :lrl "KLRL") - (make-instance 'ulo :isn isn :fr (ensure-integer fr) :un un - :sui (ensure-integer sui) :sna sna :soui soui))) - (defun find-uterm-cui (cui &key (srl *current-srl*)) "Return a list of uterm for cui" @@ -410,7 +402,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-uterm-lui (lui &key (srl *current-srl*)) "Return a list of uterm for lui" (ensure-lui-integer lui) - (collect-umlisp-query (mrconso (cui lat ts kluilrl) srl lui lui + (collect-umlisp-query (mrconso (cui lat ts kluilrl) srl lui lui :lrl kluilrl :distinct t) (make-instance 'uterm :cui (ensure-integer cui) :lui lui :lat lat :ts ts :lrl (ensure-integer kluilrl)))) @@ -454,12 +446,12 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" :cuisui (make-cuisui (ensure-integer cui) sui) :suppress suppress :lui (ensure-integer lui) :lrl (ensure-integer ksuilrl)))) - + (defun find-ustr-sab (sab &key (srl *current-srl*)) "Return the list of ustr for sab" (collect-umlisp-query (mrconso (kcuisui) srl sab sab :lrl srl) (let ((cuisui (ensure-integer kcuisui))) - (apply #'find-ustr-cuisui + (apply #'find-ustr-cuisui (append (multiple-value-list (decompose-cuisui cuisui)) (list :srl srl)))))) @@ -467,7 +459,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-ustr-all (&key (srl *current-srl*)) "Return list of all ustr's" (with-sql-connection (db) - (clsql:map-query + (clsql:map-query 'list #'(lambda (tuple) (destructuring-bind (cui lui sui stt ksuilrl suppress pfstr) tuple @@ -548,7 +540,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" "' and lui='0' and sui='0'"))) (when srl (string-append ls " and KSRL<=" (prefixed-fixnum-string srl nil 3))) - (loop for tuple in (mutex-sql-query ls) collect + (loop for tuple in (mutex-sql-query ls) collect (destructuring-bind (code atn sab atv) tuple (make-instance 'usat :code code :atn atn :sab sab :atv atv))))) @@ -573,7 +565,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (collect-umlisp-query (mrsab (vcui rcui vsab rsab son sf sver vstart vend imeta rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc curver sabin ssn scit) nil nil nil) - (make-instance 'usab :vcui (ensure-integer vcui) + (make-instance 'usab :vcui (ensure-integer vcui) :rcui (ensure-integer rcui) :vsab vsab :rsab rsab :son son :sf sf :sver sver :vstart vstart :vend vend :imeta imeta :rmeta rmeta :slc slc :scc scc :srl (ensure-integer srl) @@ -588,7 +580,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" ttyl atnl lat cenc curver sabin ssn scit) nil key-name key :single t) - (make-instance 'usab :vcui (ensure-integer vcui) + (make-instance 'usab :vcui (ensure-integer vcui) :rcui (ensure-integer rcui) :vsab vsab :rsab rsab :son son :sf sf :sver sver :vstart vstart :vend vend :imeta imeta :rmeta rmeta :slc slc :scc scc :srl (ensure-integer srl) @@ -629,7 +621,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (ensure-tui-integer tui) (collect-umlisp-query (mrsty (cui) srl tui tui :lrl klrl :order (cui asc)) (find-ucon-cui (ensure-integer cui) :srl srl))) - + (defun find-ucon-word (word &key (srl *current-srl*) (like nil)) "Return list of ucons that match word. Optionally, use SQL's LIKE syntax" (collect-umlisp-query-eval ('mrxw_eng '(cui) srl 'wd word :like like :distinct t @@ -709,7 +701,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (let ((uobjs '())) (dolist (word (delimited-string-to-list str #\space)) (setq uobjs (append uobjs (funcall obj-lookup-fun word :srl srl)))) - (let ((sorted + (let ((sorted (funcall sort-fun str (delete-duplicates uobjs :test #'= :key key)))) (if (and (plusp (length sorted)) @@ -717,7 +709,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (multiword-match str (pfstr (first sorted)))) (first sorted) sorted)))) - + (defun find-ucon-multiword (str &key (srl *current-srl*) (only-exact-if-match t)) (find-uobj-multiword str #'find-ucon-word #'sort-score-pfstr-str @@ -732,7 +724,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (only-exact-if-match t)) (find-uobj-multiword str #'find-ustr-word #'sort-score-ustr-str #'sui srl only-exact-if-match)) - + (defun sort-score-pfstr-str (str uobjs) "Return list of sorted and scored ucons. Score by match of str to ucon-pfstr" (sort-score-umlsclass-str uobjs str #'pfstr)) @@ -745,7 +737,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" "Sort a list of objects based on scoring to a string" (let ((scored '())) (dolist (obj objs) - (push (list obj (score-multiword-match str (funcall lookup-func obj))) + (push (list obj (score-multiword-match str (funcall lookup-func obj))) scored)) (mapcar #'car (sort scored #'> :key #'cadr)))) @@ -766,7 +758,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-labr-eui (eui) (ensure-eui-integer eui) - (collect-umlisp-query (lrabr (bas abr eui2 bas2) nil eui eui) + (collect-umlisp-query (lrabr (bas abr eui2 bas2) nil eui eui) (make-instance 'labr :eui eui :bas bas :abr abr :bas2 bas2 :eui2 (ensure-integer eui2)))) @@ -815,7 +807,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-ltrm-eui (eui) (ensure-eui-integer eui) - (collect-umlisp-query (lrtrm (bas gen) nil eui eui) + (collect-umlisp-query (lrtrm (bas gen) nil eui eui) (make-instance 'ltrm :eui eui :bas bas :gen gen))) (defun find-ltyp-eui (eui) @@ -868,7 +860,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (with-sql-connection (conn) (ignore-errors (sql-execute "drop table USTATS" conn)) (sql-execute "create table USTATS (NAME varchar(160), COUNT bigint, SRL integer)" conn) - + (dotimes (srl 5) (insert-ustats-count conn "Concept Count" "MRCONSO" "distinct CUI" "KCUILRL" srl) (insert-ustats-count conn "Term Count" "MRCONSO" "distinct KCUILUI" "KCUILRL" srl) @@ -897,13 +889,13 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-count-table (conn table srl count-variable srl-control) (cond ((stringp srl-control) - (ensure-integer - (caar (sql-query (format nil "select count(~a) from ~a where ~a <= ~d" + (ensure-integer + (caar (sql-query (format nil "select count(~a) from ~a where ~a <= ~d" count-variable table srl-control srl) conn)))) ((null srl-control) (ensure-integer - (caar (sql-query (format nil "select count(~a) from ~a" + (caar (sql-query (format nil "select count(~a) from ~a" count-variable table ) conn)))) (t @@ -911,8 +903,8 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" 0))) (defun insert-ustats (conn name count srl) - (sql-execute (format nil "insert into USTATS (name,count,srl) values ('~a',~d,~d)" - name count (if srl srl 3)) + (sql-execute (format nil "insert into USTATS (name,count,srl) values ('~a',~d,~d)" + name count (if srl srl 3)) conn)) (defun find-ustats-all (&key (srl *current-srl*)) @@ -927,7 +919,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (make-instance 'ustats :name name :hits (ensure-integer count) :srl (ensure-integer srl))))) - + (defun find-ustats-srl (srl) (collect-umlisp-query (ustats (name count) nil srl srl :order (name asc)) (make-instance 'ustats :name name :hits (ensure-integer count)))) -- 2.34.1