(number "='~D'")
(null " IS NULL")
(t
- (if like " LINK '%~A%""='~A'")))
+ (if like " LIKE '%~A%'" "='~A'")))
where-value)
"")
(if filter (concatenate 'string " AND " filter) nil)
:kcuisui kcuisui :kcuilui kcuilui :kcuilrl kcuilrl :kluilrl kluilrl
:ksuilrl ksuilrl)))
+(defun find-uconso-cuisui (cuisui &key sab (srl *current-srl*))
+ "Find uconso for a cuisui."
+ (collect-umlisp-query (mrconso (cui lat ts lui stt sui ispref aui saui scui sdui sab tty code str
+ srl suppress cvf kpfeng kcuisui kcuilui kcuilrl
+ kluilrl ksuilrl) srl kcuisui cuisui
+ :filter (if sab (concatenate 'string "SAB='" sab "'") nil))
+ (make-instance 'uconso :cui cui :lat lat :ts ts :lui lui :stt stt :sui sui :ispref ispref
+ :aui aui :saui saui :scui scui :sdui sdui :sab sab :tty tty :code code
+ :str str :srl srl :suppress suppress :cvf cvf :kpfeng kpfeng
+ :kcuisui kcuisui :kcuilui kcuilui :kcuilrl kcuilrl :kluilrl kluilrl
+ :ksuilrl ksuilrl)))
+
(defun find-uconso-code (code &key first sab (srl *current-srl*) (like nil))
"Return list of uconso objects that match code. Optional, filter for SAB. Optionally, use SQL's LIKE syntax"
(make-instance 'ucon :cui (ensure-integer cui) :pfstr (find-pfstr-cui cui)
:lrl (ensure-integer kcuilrl))))
-(defun find-ucon-cuisui (cui sui &key (srl *current-srl*))
+(defun find-ucon-cuisui (cuisui &key (srl *current-srl*))
+ "Find ucon for cui/sui"
+ (collect-umlisp-query (mrconso (cui kcuilrl) srl kcuisui cuisui)
+ (make-instance 'ucon :cui cui
+ :pfstr (find-pfstr-cui cui)
+ :lrl (ensure-integer kcuilrl))))
+
+(defun find-ucon-cui-sui (cui sui &key (srl *current-srl*))
"Find ucon for cui/sui"
(ensure-cui-integer cui)
(ensure-sui-integer sui)
(when (and cui sui)
- (collect-umlisp-query (mrconso (kcuilrl) srl kcuisui
- (make-cuisui cui sui))
- (make-instance 'ucon :cui cui
- :pfstr (find-pfstr-cui cui)
- :lrl (ensure-integer kcuilrl)))))
+ (find-ucon-cui-sui cui sui :srl srl)))
(defun find-ucon-str (str &key (srl *current-srl*))
"Find ucon that are exact match for str"
:cuisui (make-cuisui cui sui) :stt stt :str str :suppress suppress
:lrl (ensure-integer ksuilrl))))
-(defun find-ustr-cuisui (cui sui &key (srl *current-srl*))
+(defun find-ustr-cuisui (cuisui &key (srl *current-srl*))
"Return the single ustr for cuisui"
- (ensure-cui-integer cui)
- (ensure-sui-integer sui)
- (collect-umlisp-query (mrconso (lui stt str suppress ksuilrl) srl kcuisui
- (make-cuisui cui sui) :lrl lsuilrl :single t)
- (make-instance 'ustr :sui sui :cui cui :cuisui (make-cuisui cui sui)
+ (collect-umlisp-query (mrconso (cui lui sui stt str suppress ksuilrl) srl kcuisui
+ cuisui :lrl lsuilrl :single t)
+ (make-instance 'ustr :sui sui :cui cui :cuisui cuisui
:lui (ensure-integer lui) :stt stt :str str :suppress suppress
:lrl (ensure-integer ksuilrl))))
+(defun find-ustr-cui-sui (cui sui &key (srl *current-srl*))
+ "Return the single ustr for cuisui"
+ (ensure-cui-integer cui)
+ (ensure-sui-integer sui)
+ (find-ustr-cuisui (make-cuisui cui sui) :srl srl))
+
(defun find-ustr-sui (sui &key (srl *current-srl*))
"Return the list of ustr for sui"
(ensure-sui-integer sui)
"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
- (append
- (multiple-value-list (decompose-cuisui cuisui))
- (list :srl srl))))))
+ (find-ustr-cuisui cuisui :srl srl))))
(defun find-ustr-all (&key (srl *current-srl*))
"Return list of all ustr's"
(defun find-uso-cuisui (cui sui &key (srl *current-srl*))
(ensure-sui-integer sui)
(ensure-cui-integer cui)
- (collect-umlisp-query (mrconso (aui sab code srl tty saui sdui scui lat str)
+ (collect-umlisp-query (mrconso (aui sab code srl tty saui sdui scui lat str ts)
srl kcuisui (make-cuisui cui sui) :lrl srl)
(make-instance 'uso :aui aui :sab sab :code code :srl srl :tty tty
:cui cui :sui sui :saui saui :sdui sdui :scui scui
- :lat lat :str str)))
+ :lat lat :str str :ts ts)))
(defun find-uso-cui (cui &key (srl *current-srl*) (english-only nil) limit)
(ensure-cui-integer cui)
:cxty cxty :ttyl ttyl :atnl atnl :lat lat :cenc cenc
:curver curver :sabin sabin :ssn ssn :scit scit)))
-(defun find-usab-by-key (key-name key)
+(defun find-usab-by-key (key-name key &key current)
"Find usab for a key"
(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
ssn scit)
- nil key-name key :single t)
+ nil key-name key :single t
+ :filter (when current "RMETA=''"))
(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
:curver curver :sabin sabin
:ssn ssn :scit scit)))
-(defun find-usab-rsab (rsab)
+(defun find-usab-rsab (rsab &key (current t))
"Find usab for rsab"
(find-usab-by-key 'rsab rsab))
-(defun find-usab-vsab (vsab)
+(defun find-usab-vsab (vsab &key (current t))
"Find usab for vsab"
(find-usab-by-key 'vsab vsab))
(setq uconsos (nconc uconsos (find-uconso-sui sui :sab sab))))
(remove-duplicates uconsos :key 'cui)))
(t
- (collect-umlisp-query-eval ('mrxw_eng '(cui) srl 'wd word :like like :distinct t
- :lrl 'klrl :order '(cui asc))
- (find-uconso-cui cui :srl srl)))))
+ (collect-umlisp-query-eval ('mrxw_eng '(kcuisui) srl 'wd word :like like
+ :lrl 'klrl :order '(kcuisui asc))
+ (find-uconso-cuisui kcuisui :srl srl)))))
(defun find-ucon-word (word &key sab (srl *current-srl*) (like nil))
"Return list of ucon that match word in matching SAB. Optionally, use SQL's LIKE syntax"
"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))
+ sui))
(defun find-ustr-word (word &key sab (srl *current-srl*) (like nil))
"Return list of ustr that match word in matching SAB. Optionally, use SQL's LIKE syntax"
""))
(if srl (format nil " AND KCUILRL <= ~D" srl) ""))))
(loop for tuple in (mutex-sql-query query)
- collect (destructuring-bind (sui cui lui str lrl stt suppress cuisui) tuple
- (make-instance 'ustr :sui sui :cui cui :lui lui :str str :lrl lrl
- :stt stt :suppress suppress :cuisui cuisui)))))
+ collect (destructuring-bind (sui cui lui str lrl stt suppress cuisui) tuple
+ (make-instance 'ustr :sui sui :cui cui :lui lui :str str :lrl lrl
+ :stt stt :suppress suppress :cuisui cuisui)))))
(t
- (collect-umlisp-query (mrxw_eng (cui sui) srl wd word :lrl klrl
+ (collect-umlisp-query (mrxw_eng (kcuisui) srl wd word :lrl klrl
:order (cui asc sui asc))
- (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl)))))
+ (find-ustr-cuisui kcuisui :srl srl)))))
(defun find-ustr-normalized-word (word &key (srl *current-srl*))
"Return list of ustrs that match word"
- (collect-umlisp-query (mrxnw_eng (cui sui) srl nwd word :lrl klrl
+ (collect-umlisp-query (mrxnw_eng (kcuisui) srl nwd word :lrl klrl
:order (cui asc sui asc))
- (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl)))
+ (find-ustr-cuisui kcuisui :srl srl)))
(defun find-uterm-word (word &key (srl *current-srl*))
"Return list of uterms that match word"
(defun find-ustr-noneng-word (word &key (srl *current-srl*))
"Return list of ustrs that match non-english word"
- (collect-umlisp-query (mrxw_noneng (cui sui) srl wd word :lrl klrl
+ (collect-umlisp-query (mrxw_noneng (kcuisui) srl wd word :lrl klrl
:order (cui asc sui asc))
- (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl)))
+ (find-ustr-cuisui kcuisui :srl srl)))
;; Special tables
only-exact-if-match limit &key extra-lookup-args)
(let ((uobjs '()))
(dolist (word (delimited-string-to-list str #\space))
- (setq uobjs (append uobjs (apply obj-lookup-fun word :srl srl extra-lookup-args))))
+ (setq uobjs (append uobjs
+ (kmrcl:flatten (apply obj-lookup-fun word :srl srl extra-lookup-args)))))
(let ((sorted
(funcall sort-fun str
(delete-duplicates uobjs :test #'= :key key))))
(ignore-errors (sql-execute "drop table USTATS" conn))
(sql-execute "create table USTATS (NAME varchar(160), COUNT bigint, SRL integer)" conn)
- (dotimes (srl 5)
+ (dolist (srl '(0 1 2 3 4 9))
(insert-ustats-count conn "Concept Count" "MRCONSO" "distinct CUI" "KCUILRL" srl)
(insert-ustats-count conn "Term Count" "MRCONSO" "distinct KCUILUI" "KCUILRL" srl)
(insert-ustats-count conn "Distinct Term Count" "MRCONSO" "distinct LUI" "KLUILRL" srl)