r11110: updates from old bdb repos

diff --git a/parse-rrf.lisp b/parse-rrf.lisp
index c34f3eec79ef9e54b7b04fb04a73df852f32a6a7..960653e5a9982960212966a699eef61f2df058ab 100644 (file)
--- a/parse-rrf.lisp
+++ b/parse-rrf.lisp
@@ -103,6 +103,7 @@
       ("PLUI" sql-u) ("PAUI" sql-u)
       ("CUI2" sql-u) ("CUI" sql-u) ("CXN" sql-s) ("FR" sql-i) ("LRL" sql-s)
       ("LUI" sql-u) ("MAX" sql-s) ("MIN" sql-s) ("RANK" sql-s) ("REF" sql-c)
+      ("PTR" sql-c)
       ("RNK" sql-s) ("RWS" sql-i) ("SRL" sql-s) ("SUI" sql-u) ("TUI" sql-u)
       ("MAPRANK" sql-s)
       ;;; Custom columns
@@ -159,6 +160,12 @@
        (lambda (x) (write-to-string (sab-srl (nth 10 x)))))
       ("MRRANK.RRF" "KSRL" "SMALLINT" 0
        (lambda (x) (write-to-string (sab-srl (nth 1 x)))))
+      ("MRHIER.RRF" "KSRL" "SMALLINT" 0
+       (lambda (x) (write-to-string (sab-srl (nth 4 x)))))
+      ("MRMAP.RRF" "KSRL" "SMALLINT" 0
+       (lambda (x) (write-to-string (sab-srl (nth 1 x)))))
+      ("MRSMAP.RRF" "KSRL" "SMALLINT" 0
+       (lambda (x) (write-to-string (sab-srl (nth 1 x)))))
       ("MRDEF.RRF" "KSRL" "SMALLINT" 0
        (lambda (x) (write-to-string (sab-srl (nth 4 x)))))
       #+nil  ("MRCXT.RRF" "KSRL" "SMALLINT" 0 (lambda (x) (write-to-string (sab-srl (nth 2 x)))))
@@ -179,11 +186,8 @@
                                                 (parse-ui (nth 2 x))
                                                 (parse-ui (nth 4 x)))))))
 
-      ;; FIXME: For MRREF and MRCOC, add lookups to KPFSTR2 using new MRCONSO index KPFENG
-
       #+nil  ("MRREL.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (nth 4 x)))))
       #+nil  ("MRCOC.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (nth 2 x)))))
-      #+use-mrctx  ("MRCXT.RRF" "KCUISUI" "BIGINT" 0 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 1 x))))))
       ("MRSAT.RRF" "KCUILUI" "BIGINT" 0
        (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 1 x))))))
       ("MRSAT.RRF" "KCUISUI" "BIGINT" 0
@@ -210,8 +214,7 @@
       ("CUI1" "MRREL") ("CUI" "MRSAT") ("LUI" "MRSAT") ("SUI" "MRSAT")
       ("CUI" "MRSTY")
       ("TUI" "MRSTY") ("CUI" "MRXNS_ENG")
-      ;; ("CUI" "MRCXT") ("KCUISUI" "MRCXT") ("KSRL" "MRCXT")
-      ("AUI" "MRHIER") ("PTR" "MRHIER") ("CUI" "MRHIER") ("CXN" "MRHIER") ("RELA" "MRHIER") ("PAUI" "MRHIER")
+      ("AUI" "MRHIER") ("PTR" "MRHIER" 255) ("CUI" "MRHIER") ("CXN" "MRHIER") ("RELA" "MRHIER") ("PAUI" "MRHIER")
       ("SAB" "MRHIER")
       #+ignore ("NSTR" "MRXNS_ENG" 10)
       ("CUI" "MRXNW_ENG") ("NWD" "MRXNW_ENG") ("WD" "MRXW_ENG")

diff --git a/sql-classes.lisp b/sql-classes.lisp
index d38df6928f2281b8bdfff217b03dc8df58636ad6..2c8c93eb760cda10257ac11e68dac2788ca6af77 100644 (file)
--- a/sql-classes.lisp
+++ b/sql-classes.lisp
@@ -187,9 +187,17 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-ucon-cui (cui &key (srl *current-srl*))
   "Find ucon for a cui"
   (ensure-cui-integer cui)
-  (collect-umlisp-query (mrconso (kpfstr kcuilrl) srl cui cui :single t)
-    (make-instance 'ucon :cui cui :pfstr kpfstr
-                  :lrl (ensure-integer kcuilrl))))
+  (unless cui (return-from find-ucon-cui nil))
+
+  (let ((tuple (car (mutex-sql-query "SELECT kcuilrl,str FROM MRCONSO WHERE CUI=~D AND KPFENG=1 AND SRL<=~D"
+                                     cui srl))))
+    (unless tuple
+      (setq tuple (car (mutex-sql-query "SELECT kcuilrl,str FROM MRCONSO WHERE CUI=~D AND SRL<=~D"
+                                        cui srl))))
+    (unless tuple
+      (return-from find-ucon-cui nil))
+    (make-instance 'ucon :cui cui :pfstr (second tuple)
+                   :lrl (ensure-integer (first tuple)))))
 
 (defun find-ucon-cui-sans-pfstr (cui &key (srl *current-srl*))
   "Find ucon for a cui"
@@ -201,30 +209,45 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-pfstr-cui (cui &key (srl *current-srl*))
   "Find preferred string for a cui"
   (ensure-cui-integer cui)
-  (collect-umlisp-query (mrconso (kpfstr) srl cui cui :single t)
-    kpfstr))
-
+  (or
+    (caar (mutex-sql-query
+           (format nil "SELECT str FROM MRCONSO WHERE CUI=~D AND KPFENG=1 AND SLR<=~D"
+                   cui srl)))
+    (caar (mutex-sql-query
+           (format nil "SELECT str FROM MRCONSO WHERE CUI=~D AND SLR<=~D"
+                   cui srl)))))
 
 (defun find-ucon-lui (lui &key (srl *current-srl*))
   "Find list of ucon for lui"
   (ensure-lui-integer lui)
-  (collect-umlisp-query (mrconso (cui kpfstr kcuilrl) srl lui lui
+  (collect-umlisp-query (mrconso (cui kcuilrl) srl lui lui
                            :distinct t)
-    (make-instance 'ucon :cui (ensure-integer cui) :pfstr kpfstr
-                  :lrl (ensure-integer kcuilrl))))
+     (make-instance 'ucon :cui (ensure-integer cui) :pfstr (find-pfstr-cui cui)
+                  :lrl (ensure-integer kcuilrl)))
+  (unless lui (return-from find-ucon-lui nil))
+
+  (let ((tuple (car (mutex-sql-query "SELECT cui,kcuilrl,str FROM MRCONSO WHERE LUI=~D AND KPFENG=1 AND SRL<=~D"
+                                     lui srl))))
+    (unless tuple
+      (setq tuple (car (mutex-sql-query "SELECT cui,kcuilrl,str FROM MRCONSO WHERE LUI=~D AND SRL<=~D"
+                                        lui srl))))
+    (unless tuple
+      (return-from find-ucon-lui nil))
+    (make-instance 'ucon :cui (first tuple) :pfstr (third tuple)
+                   :lrl (ensure-integer (third tuple)))))
 
 (defun find-ucon-sui (sui &key (srl *current-srl*))
   "Find list of ucon for sui"
   (ensure-sui-integer sui)
-  (collect-umlisp-query (mrconso (cui kpfstr kcuilrl) srl sui sui :distinct t)
-    (make-instance 'ucon :cui (ensure-integer cui) :pfstr kpfstr
+  (collect-umlisp-query (mrconso (cui kcuilrl) srl sui sui :distinct t)
+    (make-instance 'ucon :cui (ensure-integer cui) :pfstr (find-pfstr-cui cui)
                   :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
+  (collect-umlisp-query (mrconso (cui kcuilrl) srl aui aui :distinct t)
+    (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*))
@@ -232,16 +255,16 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   (ensure-cui-integer cui)
   (ensure-sui-integer sui)
   (when (and cui sui)
-    (collect-umlisp-query (mrconso (kpfstr kcuilrl) srl kcuisui
+    (collect-umlisp-query (mrconso (kcuilrl) srl kcuisui
                              (make-cuisui cui sui))
       (make-instance 'ucon :cui cui
-                    :pfstr kpfstr
+                    :pfstr (find-pfstr-cui cui)
                     :lrl (ensure-integer kcuilrl)))))
 
 (defun find-ucon-str (str &key (srl *current-srl*))
   "Find ucon that are exact match for str"
-  (collect-umlisp-query (mrconso (cui kpfstr kcuilrl) srl str str :distinct t)
-    (make-instance 'ucon :cui (ensure-integer cui) :pfstr kpfstr
+  (collect-umlisp-query (mrconso (cui kcuilrl) srl str str :distinct t)
+    (make-instance 'ucon :cui (ensure-integer cui) :pfstr (find-pfstr-cui cui)
                   :lrl (ensure-integer kcuilrl))))
 
 (defun find-ucon-all (&key (srl *current-srl*))
@@ -250,20 +273,20 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
     (clsql:map-query
      'list
      #'(lambda (tuple)
-        (destructuring-bind (cui pfstr cuilrl) tuple
+        (destructuring-bind (cui cuilrl) tuple
             (make-instance 'ucon :cui (ensure-integer cui)
-                           :pfstr pfstr
-                       :lrl (ensure-integer cuilrl))))
-     (query-string mrconso (cui kpfstr kcuilrl) srl nil nil
+                           :pfstr (find-pfstr-cui cui)
+                            :lrl (ensure-integer cuilrl))))
+     (query-string mrconso (cui kcuilrl) srl nil nil
                   :order (cui asc) :distinct t)
      :database db)))
 
 (defun find-ucon-all2 (&key (srl *current-srl*))
   "Return list of all ucon's"
-  (collect-umlisp-query (mrconso (cui kpfstr kcuilrl) srl nil nil :order (cui asc)
+  (collect-umlisp-query (mrconso (cui kcuilrl) srl nil nil :order (cui asc)
                            :distinct t)
     (make-instance 'ucon :cui (ensure-integer cui)
-                  :pfstr kpfstr
+                  :pfstr (find-pfstr-cui cui)
                   :lrl (ensure-integer kcuilrl))))
 
 (defun find-cui-ucon-all (&key (srl *current-srl*))
@@ -278,11 +301,11 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
     (clsql:map-query
      nil
      #'(lambda (tuple)
-        (destructuring-bind (cui pfstr cuilrl) tuple
+        (destructuring-bind (cui cuilrl) tuple
           (funcall fn (make-instance 'ucon :cui (ensure-integer cui)
-                                     :pfstr pfstr
+                                     :pfstr (find-pfstr-cui cui)
                                      :lrl (ensure-integer cuilrl)))))
-     (query-string mrconso (cui kpfstr kcuilrl) srl nil nil :order (cui asc)
+     (query-string mrconso (cui kcuilrl) srl nil nil :order (cui asc)
                   :distinct t)
      :database db)))
 
@@ -330,12 +353,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 (aui1 rel stype1 cui2 aui2 stype2 rela rui srui sab sl rg dir suppress cvf kpfstr2)
+  (collect-umlisp-query (mrrel (aui1 rel stype1 cui2 aui2 stype2 rela rui srui sab sl rg dir suppress cvf)
                               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)))
+                  :suppress suppress :cvf cvf :pfstr2 (find-pfstr-cui cui2))))
 
 (defun find-cui2-urel-cui (cui &key (srl *current-srl*))
   "Return a list of urel for cui"
@@ -347,12 +370,12 @@ 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 aui1 stype1 aui2 stype2 rela rui srui sab sl rg dir suppress cvf kpfstr2)
+  (collect-umlisp-query (mrrel (rel cui1 aui1 stype1 aui2 stype2 rela rui srui sab sl rg dir suppress cvf)
                               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)))
+                  :pfstr2 (find-pfstr-cui cui2))))
 
 (defun find-ucon-rel-cui2 (cui2 &key (srl *current-srl*))
   (ensure-cui-integer cui2)
@@ -363,25 +386,25 @@ 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 (aui1 cui2 aui2 sab cot cof coa kpfstr2) srl cui1
+  (collect-umlisp-query (mrcoc (aui1 cui2 aui2 sab cot cof coa) 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 :aui1 (ensure-integer aui1)
                   :cui2 (ensure-integer cui2) :aui2 (ensure-integer aui2)
                   :cot cot :cof (ensure-integer cof) :coa coa :sab sab
-                  :pfstr2 kpfstr2)))
+                  :pfstr2 (find-pfstr-cui cui2))))
 
 (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 aui1 aui2 sab cot cof coa kpfstr2) srl cui2
+  (collect-umlisp-query (mrcoc (cui1 aui1 aui2 sab cot cof coa) srl cui2
                            cui2 :lrl klrl :order (cof asc))
     (when (zerop cui2) (setq cui2 nil))
     (make-instance 'ucoc :cui1 (ensure-integer cui1) :cui2 cui2
                   :aui1 (ensure-integer aui1) :aui2 (ensure-integer aui2)
                   :sab sab :cot cot :cof (ensure-integer cof) :coa coa
-                  :pfstr2 kpfstr2)))
+                  :pfstr2 (find-pfstr-cui cui2))))
 
 (defun find-ucon-coc-cui2 (cui2 &key (srl *current-srl*))
   "List of ucon with co-occurance cui2"
@@ -462,15 +485,15 @@ 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 suppress pfstr) tuple
+          (destructuring-bind (cui lui sui stt ksuilrl suppress) tuple
             (make-instance 'ustr :cui (ensure-integer cui)
                            :lui (ensure-integer lui) :sui (ensure-integer sui)
-                           :stt stt :str pfstr
+                           :stt stt :str (find-pfstr-cui cui)
                            :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
+       (query-string mrconso (cui lui sui stt ksuilrl) srl nil nil :lrl ksuilrl
                     :distinct t
                     :order (sui asc))
        :database db)))
@@ -867,11 +890,11 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
       (insert-ustats-count conn "Distinct Term Count" "MRCONSO" "distinct LUI" "KLUILRL" srl)
       (insert-ustats-count conn "String Count" "MRCONSO" "*" "KSUILRL" srl)
       (insert-ustats-count conn "Distinct String Count" "MRCONSO" "distinct SUI" "KSUILRL" srl)
-      (insert-ustats-count conn "Context Count" "MRCXT" "*" "KSRL" srl)
+      (insert-ustats-count conn "Hierarchcy" "MRHIER" "*" "KSRL" srl)
+      (insert-ustats-count conn "Mappings" "MRMAP" "*" "KSRL" srl)
+      (insert-ustats-count conn "Simple Mappings" "MRSMAP" "*" "KSRL" srl)
       (insert-ustats-count conn "Co-occuring Concept Count" "MRCOC" "*" "KLRL" srl)
       (insert-ustats-count conn "Definition Count" "MRDEF" "*" "KSRL" srl)
-      #+ignore
-      (insert-ustats-count conn "Locator Count" "MRLO" "*" "KLRL" srl)
       (insert-ustats-count conn "Rank Count" "MRRANK" "*" "KSRL" srl)
       (insert-ustats-count conn "Relationship Count" "MRREL" "*" "KSRL" srl)
       (insert-ustats-count conn "Semantic Type Count" "MRSTY" "*" "KLRL" srl)