X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql-classes.lisp;h=b1373f004d8f14140bc9d1e5d10ed746a8e3f54d;hb=cd3b91a343663cc9f12fd551e454de552be9ff9d;hp=8031ace4553584dfdf6f2e3411881cdae0f41bd8;hpb=5f22946ec144f413cd4306bc60daad9658fced72;p=umlisp.git diff --git a/sql-classes.lisp b/sql-classes.lisp index 8031ace..b1373f0 100644 --- a/sql-classes.lisp +++ b/sql-classes.lisp @@ -563,7 +563,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-ustr-cuisui (cuisui &key (srl *current-srl*)) "Return the single ustr for cuisui" (collect-umlisp-query (mrconso (cui lui sui stt str suppress ksuilrl) srl kcuisui - cuisui :lrl lsuilrl :single t) + cuisui :lrl ksuilrl :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)))) @@ -626,20 +626,20 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-uso-cui (cui &key (srl *current-srl*) (english-only nil) limit) (ensure-cui-integer cui) - (collect-umlisp-query (mrconso (aui sab code srl tty saui sdui scui lat str sui) + (collect-umlisp-query (mrconso (aui sab code srl tty saui sdui scui lat str sui ts) srl cui cui :lrl srl :limit limit :filter (when english-only "LAT='ENG'")) (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-aui (aui &key (srl *current-srl*)) (ensure-sui-integer aui) (collect-umlisp-query (mrconso (sab cui sui code srl tty saui sdui scui lat - str) srl aui aui :lrl srl :single t) + str ts) srl aui aui :lrl srl :single t) (make-instance 'uso :aui aui :cui cui :sab sab :code code :srl srl :tty tty :sui sui :saui saui :sdui sdui :scui scui :lat lat - :str str))) + :str str :ts ts))) (defun find-uhier-cui (cui &key (srl *current-srl*)) (ensure-cui-integer cui) @@ -911,8 +911,8 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" only-exact-if-match limit &key extra-lookup-args) (let ((uobjs '())) (dolist (word (delimited-string-to-list str #\space)) - (setq uobjs (append uobjs - (kmrcl:flatten (apply obj-lookup-fun word :srl srl extra-lookup-args))))) + (setq uobjs (nconc 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))))