X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql-classes.lisp;h=2841201aa8a5917aa21e08d99331c203065dc57a;hb=aeade16272b79115d3f307906c7a3e9597137e97;hp=34cbd2a17041c011c4c828931f8ee6b0cfba04d9;hpb=da70bc391acaeb38f7c2b2e9085a2a6fc49a9bea;p=umlisp.git diff --git a/sql-classes.lisp b/sql-classes.lisp index 34cbd2a..2841201 100644 --- a/sql-classes.lisp +++ b/sql-classes.lisp @@ -2,12 +2,12 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: sql-classes.lisp -;;;; Purpose: Routines for reading UMLS objects from SQL database -;;;; Author: Kevin M. Rosenberg -;;;; Date Started: Apr 2000 +;;;; Name: sql-classes.lisp +;;;; Purpose: Routines for reading UMLS objects from SQL database +;;;; Author: Kevin M. Rosenberg +;;;; Created: Apr 2000 ;;;; -;;;; $Id: sql-classes.lisp,v 1.90 2003/07/21 11:22:51 kevin Exp $ +;;;; $Id$ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2003 by Kevin M. Rosenberg, M.D. @@ -43,9 +43,9 @@ ,@(when %%where `((typecase ,where-value (fixnum - (prefixed-fixnum-string ,where-value #\= 10)) + (concatenate 'string "='" (prefixed-fixnum-string ,where-value #\0 10) "'")) (number - (concatenate 'string "=" (write-to-string ,where-value))) + (concatenate 'string "='" (write-to-string ,where-value) "'")) (null " is null") (t @@ -256,6 +256,12 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" :pfstr kpfstr :lrl (ensure-integer kcuilrl)))) +(defun find-cui-ucon-all (&key (srl *current-srl*)) + "Return list of CUIs for all ucons" + (collect-umlisp-query (mrcon (cui) srl nil nil :order (cui asc) + :distinct t) + cui)) + (defun map-ucon-all (fn &key (srl *current-srl*)) "Map a function over all ucon's" (with-sql-connection (db) @@ -298,6 +304,13 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" :cui2 (ensure-integer cui2) :rela rela :sab sab :sl sl :mg mg :pfstr2 kpfstr2))) +(defun find-cui2-urel-cui (cui &key (srl *current-srl*)) + "Return a list of urel for cui" + (ensure-cui-integer cui) + (collect-umlisp-query (mrrel (cui2) srl cui1 + cui :lrl "KSRL") + cui2)) + (defun find-urel-cui2 (cui2 &key (srl *current-srl*)) "Return a list of urel for cui2" (ensure-cui-integer cui2) @@ -319,7 +332,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (collect-umlisp-query (mrcoc (cui2 soc cot cof coa kpfstr2) srl cui1 cui :lrl klrl :order (cof asc)) (setq cui2 (ensure-integer cui2)) - (when (zerop cui2) (setq cui2 nil)) + (when (eql 0 cui2) (setq cui2 nil)) (make-instance 'ucoc :cui1 cui :cui2 (ensure-integer cui2) :soc soc :cot cot :cof (ensure-integer cof) :coa coa :pfstr2 kpfstr2))) @@ -466,13 +479,14 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (ensure-sui-integer sui) (let ((ls "select CODE,ATN,SAB,ATV from MRSAT where ")) (cond - (sui (string-append ls "KCUISUI=" - (integer-string (make-cuisui cui sui) 14))) - (lui (string-append ls "KCUILUI=" + (sui (string-append ls "KCUISUI='" + (integer-string (make-cuisui cui sui) 14) + "'")) + (lui (string-append ls "KCUILUI='" (integer-string (make-cuilui cui lui) 14) - " and sui=0")) - (t (string-append ls "cui=" (prefixed-fixnum-string cui nil 7) - " and lui=0 and sui=0"))) + "' and sui='0'")) + (t (string-append ls "cui='" (prefixed-fixnum-string cui nil 7) + "' 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 @@ -497,12 +511,12 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-usab-all () "Find usab for a key" - (collect-umlisp-query (mrsab (vcui rcui vsab rsab son sf sver mstart mend imeta + (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) nil nil nil) (make-instance 'usab :vcui (ensure-integer vcui) :rcui (ensure-integer rcui) :vsab vsab :rsab rsab :son son - :sf sf :sver sver :mstart mstart :mend mend :imeta imeta + :sf sf :sver sver :vstart vstart :vend vend :imeta imeta :rmeta rmeta :slc slc :scc scc :srl (ensure-integer srl) :tfr (ensure-integer tfr) :cfr (ensure-integer cfr) :cxty cxty :ttyl ttyl :atnl atnl :lat lat :cenc cenc @@ -510,13 +524,13 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-usab-by-key (key-name key) "Find usab for a key" - (collect-umlisp-query-eval ('mrsab '(vcui rcui vsab rsab son sf sver mstart - mend imeta rmeta slc scc srl tfr cfr cxty + (collect-umlisp-query-eval ('mrsab '(vcui rcui vsab rsab son sf sver vstart + vend imeta rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc curver sabin) nil key-name key :single t) (make-instance 'usab :vcui (ensure-integer vcui) :rcui (ensure-integer rcui) :vsab vsab :rsab rsab :son son - :sf sf :sver sver :mstart mstart :mend mend :imeta imeta + :sf sf :sver sver :vstart vstart :vend vend :imeta imeta :rmeta rmeta :slc slc :scc scc :srl (ensure-integer srl) :tfr (ensure-integer tfr) :cfr (ensure-integer cfr) :cxty cxty :ttyl ttyl :atnl atnl :lat lat :cenc cenc @@ -553,6 +567,24 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" :lrl 'klrl :order '(cui asc)) (find-ucon-cui cui :srl srl))) +(defun find-cui-normalized-word (word &key (srl *current-srl*) (like nil)) + "Return list of cui that match word, optionally use SQL's LIKE syntax" + (collect-umlisp-query-eval ('mrxnw_eng '(cui) srl 'nwd word :like like :distinct t + :lrl 'klrl :order '(cui asc)) + cui)) + +(defun find-lui-normalized-word (word &key (srl *current-srl*) (like nil)) + "Return list of cui that match word, optionally use SQL's LIKE syntax" + (collect-umlisp-query-eval ('mrxnw_eng '(lui) srl 'nwd word :like like :distinct t + :lrl 'klrl :order '(cui asc)) + lui)) + +(defun find-sui-normalized-word (word &key (srl *current-srl*) (like nil)) + "Return list of cui that match word, optionally use SQL's LIKE syntax" + (collect-umlisp-query-eval ('mrxnw_eng '(sui) srl 'nwd word :like like :distinct t + :lrl 'klrl :order '(cui asc)) + sui)) + (defun find-ustr-word (word &key (srl *current-srl*)) "Return list of ustrs that match word" (collect-umlisp-query (mrxw_eng (cui sui) srl wd word :lrl klrl @@ -717,9 +749,9 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (make-instance 'ltyp :eui eui :bas bas :sca sca :typ typ))) (defun find-lwd-wrd (wrd) - (make-instance 'lwd :wrd + (make-instance 'lwd :wrd wrd :euilist (collect-umlisp-query (lrwd (eui) nil wrd wrd) - (ensure-integer eui)))) + (ensure-integer eui)))) ;;; Semantic Network SQL access functions @@ -759,7 +791,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun make-ustats () (with-sql-connection (conn) - (sql-execute "drop table if exists USTATS" conn) + (ignore-errors (sql-execute "drop table USTATS" conn)) (sql-execute "create table USTATS (NAME varchar(160), COUNT bigint, SRL integer)" conn) (dotimes (srl 4) @@ -813,11 +845,18 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" conn)) (defun find-ustats-all (&key (srl *current-srl*)) - (collect-umlisp-query (ustats (name count srl) nil srl srl - :order (name asc)) - (make-instance 'ustats :name name :hits (ensure-integer count) - :srl (ensure-integer srl)))) - + (if srl + (collect-umlisp-query (ustats (name count srl) nil srl srl + :order (name asc)) + (make-instance 'ustats :name name + :hits (ensure-integer count) + :srl (ensure-integer srl))) + (collect-umlisp-query (ustats (name count srl) nil nil nil + :order (name asc)) + (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))))