r9542: more 2004AA portage
[umlisp.git] / sql-classes.lisp
index 165e5317533c697fa3dc2575997b99d1e79901b7..2b7869cb3438a2bcae33eab850b628a532276b15 100644 (file)
@@ -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*))