X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql-classes.lisp;h=2b7869cb3438a2bcae33eab850b628a532276b15;hb=fab71e6fecf552789593d979b85cea58099f236d;hp=165e5317533c697fa3dc2575997b99d1e79901b7;hpb=e8237c217aecf6887edddbe2ef7fe15134660a34;p=umlisp.git diff --git a/sql-classes.lisp b/sql-classes.lisp index 165e531..2b7869c 100644 --- a/sql-classes.lisp +++ b/sql-classes.lisp @@ -220,6 +220,13 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (make-instance 'ucon :cui (ensure-integer cui) :pfstr kpfstr :lrl (ensure-integer kcuilrl)))) +(defun find-ucon-aui (aui &key (srl *current-srl*)) + "Find list of ucon for aui" + (ensure-sui-integer aui) + (collect-umlisp-query (mrconso (cui kpfstr kcuilrl) srl aui aui :distinct t) + (make-instance 'ucon :cui (ensure-integer cui) :pfstr kpfstr + :lrl (ensure-integer kcuilrl)))) + (defun find-ucon-cuisui (cui sui &key (srl *current-srl*)) "Find ucon for cui/sui" (ensure-cui-integer cui) @@ -283,8 +290,30 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-udef-cui (cui &key (srl *current-srl*)) "Return a list of udefs for cui" (ensure-cui-integer cui) - (collect-umlisp-query (mrdef (sab def) srl cui cui :lrl "KSRL") - (make-instance 'udef :sab sab :def def))) + (collect-umlisp-query (mrdef (sab def suppress) srl cui cui :lrl "KSRL") + (make-instance 'udef :sab sab :def def :suppress suppress))) + +(defun find-udoc-key (key) + "Return list of abbreviation documentation for a key" + (collect-umlisp-query (mrdoc (value type expl) nil dockey key) + (make-instance 'udoc :key key :value value :type type :expl expl))) + +(defun find-udoc-value (value) + "Return abbreviation documentation" + (collect-umlisp-query (mrdoc (dockey type expl) nil value value) + (make-instance 'udoc :key dockey :value value :type type :expl expl))) + +(defun find-udoc-key-value (key value) + (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) + (make-instance 'udoc :key dockey :value value :type type :expl expl))) (defun find-usty-cui (cui &key (srl *current-srl*)) "Return a list of usty for cui" @@ -301,11 +330,12 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-urel-cui (cui &key (srl *current-srl*)) "Return a list of urel for cui" (ensure-cui-integer cui) - (collect-umlisp-query (mrrel (rel cui2 rela sab sl kpfstr2) srl cui1 - cui :lrl "KSRL") - (make-instance 'urel :cui1 cui :rel rel - :cui2 (ensure-integer cui2) :rela rela :sab sab :sl sl - :pfstr2 kpfstr2))) + (collect-umlisp-query (mrrel (aui1 rel stype1 cui2 aui2 stype2 rela rui srui sab sl rg dir suppress cvf kpfstr2) + srl cui1 cui :lrl "KSRL") + (make-instance 'urel :cui1 cui :aui1 (ensure-integer aui1) :stype1 stype1 :rel rel + :cui2 (ensure-integer cui2) :aui2 (ensure-integer aui2) :stype2 stype2 + :rui rui :srui srui :rela rela :sab sab :sl sl :rg rg :dir dir + :suppress suppress :cvf cvf :pfstr2 kpfstr2))) (defun find-cui2-urel-cui (cui &key (srl *current-srl*)) "Return a list of urel for cui" @@ -317,10 +347,11 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-urel-cui2 (cui2 &key (srl *current-srl*)) "Return a list of urel for cui2" (ensure-cui-integer cui2) - (collect-umlisp-query (mrrel (rel cui1 rela sab sl kpfstr2) srl cui2 - cui2 :lrl "KSRL") - (make-instance 'urel :cui2 cui2 :rel rel - :cui1 (ensure-integer cui1) :rela rela :sab sab :sl sl + (collect-umlisp-query (mrrel (rel cui1 aui1 stype1 aui2 stype2 rela rui srui sab sl rg dir suppress cvf kpfstr2) + srl cui2 cui2 :lrl "KSRL") + (make-instance 'urel :cui2 cui2 :rel rel :aui2 (ensure-integer aui2) :stype2 stype2 :rui rui :srui srui + :stype1 stype1 :cui1 (ensure-integer cui1) :aui1 (ensure-integer aui1) + :rela rela :sab sab :sl sl :rg rg :dir dir :suppress suppress :cvf cvf :pfstr2 kpfstr2))) (defun find-ucon-rel-cui2 (cui2 &key (srl *current-srl*)) @@ -332,22 +363,24 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-ucoc-cui (cui &key (srl *current-srl*)) "Return a list of ucoc for cui" (ensure-cui-integer cui) - (collect-umlisp-query (mrcoc (cui2 cot cof coa kpfstr2) srl cui1 + (collect-umlisp-query (mrcoc (aui1 cui2 aui2 sab cot cof coa kpfstr2) srl cui1 cui :lrl klrl :order (cof asc)) (setq cui2 (ensure-integer cui2)) (when (eql 0 cui2) (setq cui2 nil)) - (make-instance 'ucoc :cui1 cui :cui2 (ensure-integer cui2) - :cot cot :cof (ensure-integer cof) :coa coa + (make-instance 'ucoc :cui1 cui :aui1 (ensure-integer aui1) + :cui2 (ensure-integer cui2) :aui2 (ensure-integer aui2) + :cot cot :cof (ensure-integer cof) :coa coa :sab sab :pfstr2 kpfstr2))) (defun find-ucoc-cui2 (cui2 &key (srl *current-srl*)) "Return a list of ucoc for cui2" (ensure-cui-integer cui2) - (collect-umlisp-query (mrcoc (cui1 cot cof coa kpfstr2) srl cui2 + (collect-umlisp-query (mrcoc (cui1 aui1 aui2 sab cot cof coa kpfstr2) srl cui2 cui2 :lrl klrl :order (cof asc)) (when (zerop cui2) (setq cui2 nil)) (make-instance 'ucoc :cui1 (ensure-integer cui1) :cui2 cui2 - :cot cot :cof (ensure-integer cof) :coa coa + :aui1 (ensure-integer aui1) :aui2 (ensure-integer aui2) + :sab sab :cot cot :cof (ensure-integer cof) :coa coa :pfstr2 kpfstr2))) (defun find-ucon-coc-cui2 (cui2 &key (srl *current-srl*)) @@ -396,29 +429,30 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" "Return a list of ustr for cui/lui" (ensure-cui-integer cui) (ensure-lui-integer lui) - (collect-umlisp-query (mrconso (sui stt str ksuilrl) srl kcuilui + (collect-umlisp-query (mrconso (sui stt str suppress ksuilrl) srl kcuilui (make-cuilui cui lui) :lrl ksuilrl) (make-instance 'ustr :sui (ensure-integer sui) :cui cui :lui lui - :cuisui (make-cuisui cui sui) :stt stt :str 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*)) "Return the single ustr for cuisui" (ensure-cui-integer cui) (ensure-sui-integer sui) - (collect-umlisp-query (mrconso (lui stt str ksuilrl) srl kcuisui + (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) - :lui (ensure-integer lui) :stt stt :str str + :lui (ensure-integer lui) :stt stt :str str :suppress suppress :lrl (ensure-integer ksuilrl)))) (defun find-ustr-sui (sui &key (srl *current-srl*)) "Return the list of ustr for sui" (ensure-sui-integer sui) - (collect-umlisp-query (mrconso (cui lui stt str ksuilrl) srl sui sui + (collect-umlisp-query (mrconso (cui lui stt str suppress ksuilrl) srl sui sui :lrl ksuilrl) (make-instance 'ustr :sui sui :cui cui :stt stt :str str :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*)) @@ -436,12 +470,13 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (clsql:map-query 'list #'(lambda (tuple) - (destructuring-bind (cui lui sui stt ksuilrl pfstr) tuple + (destructuring-bind (cui lui sui stt ksuilrl suppress pfstr) tuple (make-instance 'ustr :cui (ensure-integer cui) :lui (ensure-integer lui) :sui (ensure-integer sui) :stt stt :str pfstr :cuisui (make-cuisui (ensure-integer cui) (ensure-integer sui)) + :suppress suppress :lrl (ensure-integer ksuilrl)))) (query-string mrconso (cui lui sui stt ksuilrl kpfstr) srl nil nil :lrl ksuilrl :distinct t @@ -479,6 +514,23 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" :rela rela :xc xc :cui2 (ensure-integer cui2)))) +(defun find-uhier-cui (cui &key (srl *current-srl*)) + (ensure-cui-integer cui) + (collect-umlisp-query (mrhier (aui cxn paui sab rela ptr hcd cvf) + srl cui cui :lrl ksrl) + (make-instance 'uhier :cui cui :aui (ensure-integer aui) + :cxn (ensure-integer cxn) + :paui (ensure-integer paui) + :sab sab :rela rela :ptr ptr :hcd hcd :cvf cvf))) + +(defun find-uhier-all (&key (srl *current-srl*)) + (collect-umlisp-query (mrhier (cui aui cxn paui sab rela ptr hcd cvf) + srl nil nil :lrl ksrl) + (make-instance 'uhier :cui cui :aui (ensure-integer aui) + :cxn (ensure-integer cxn) + :paui (ensure-integer paui) + :sab sab :rela rela :ptr ptr :hcd hcd :cvf cvf))) + (defun find-usat-ui (cui &optional (lui nil) (sui nil) &key (srl *current-srl*)) (ensure-cui-integer cui) (ensure-lui-integer lui) @@ -519,14 +571,14 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" "Find usab for a key" (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) + cenc curver sabin ssn scit) nil nil nil) (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) :tfr (ensure-integer tfr) :cfr (ensure-integer cfr) :cxty cxty :ttyl ttyl :atnl atnl :lat lat :cenc cenc - :curver curver :sabin sabin))) + :curver curver :sabin sabin :ssn ssn :scit scit))) (defun find-usab-by-key (key-name key) "Find usab for a key" @@ -553,6 +605,20 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-cui-max () (ensure-integer (caar (mutex-sql-query "select max(CUI) from MRCON")))) +(defun find-umap-cui (cui) + (ensure-cui-integer cui) + (collect-umlisp-query (mrmap (mapsetsab mapsubsetid maprank fromid fromsid fromexpr + fromtype fromrule fromres rel rela toid tosid + toexpr totype torule tores maprule maptype + mapatn mapatv cvf) + nil mapsetcui cui) + (make-instance 'umap :mapsetcui cui :mapsetsab mapsetsab :mapsubsetid mapsubsetid + :maprank (ensure-integer maprank) :fromid fromid :fromsid fromsid + :fromexpr fromexpr :fromtype fromtype :fromrule fromrule :fromres fromres + :rel rel :rela rela :toid toid :tosid tosid :toexpr toexpr :totype totype + :torule torule :tores tores :maprule maprule :maptype maptype :mapatn mapatn + :mapatv mapatv :cvf cvf))) + ;;;; Cross table find functions (defun find-ucon-tui (tui &key (srl *current-srl*))