Updates for compatibility with new umweb

diff --git a/class-support.lisp b/class-support.lisp
index 7892abed792da14ea9dfcb75bcccce4e51593dbf..0352c742f0b5523876603b003ae1c92b4b4a96e9 100644 (file)
--- a/class-support.lisp
+++ b/class-support.lisp
@@ -70,7 +70,7 @@
     (if (>= s 10000000)
         (prefixed-fixnum-string s #\S 8)
       (prefixed-fixnum-string s #\S 7))))
-    
+
 (defmethod fmt-sui ((s integer))
   (if (>= s 10000000)
       (prefixed-fixnum-string s #\S 8)
@@ -283,8 +283,20 @@
 (defun rel-abbr-info (rel)
   (nth-value 0 (gethash (string-downcase rel) *rel-info-table*)))
 
-(defun filter-urels-by-rel (urels rel)
-  (remove-if-not (lambda (urel) (string-equal rel (rel urel))) urels))
+(defun filter-urels-by-rel (urels rel &key (remove-duplicate-pfstr2 t) (sort :pfstr2))
+  (let ((f (remove-if-not (lambda (urel) (string-equal rel (rel urel))) urels)))
+    (when remove-duplicate-pfstr2
+      (setq f (remove-duplicates f :test 'equal :key 'u::pfstr2)))
+    (if sort
+        (sort (copy-seq f) 'string-lessp :key 'u::pfstr2)
+        f)))
+
+(defun filter-ucocs (ucocs &key (remove-duplicate-pfstr2 t) (sort :pfstr2))
+  (when remove-duplicate-pfstr2
+    (setq ucocs (remove-duplicates ucocs :test 'equal :key 'u::pfstr2)))
+    (if sort
+        (sort (copy-seq ucocs) 'string-lessp :key 'u::pfstr2)
+        ucocs))
 
 
 (defvar +language-abbreviations+
@@ -355,5 +367,3 @@
 (dolist (c '(urank udef usat uso ucxt ustr uterm usty urel ucoc uatx uconso uxw uxnw uxns lexterm labr lagr lcmp lmod lnom lprn lprp lspl ltrm ltyp lwd sdef sstr sstre1 sstre2 usrl))
     (let ((cl (find-class c)))
       (clos:finalize-inheritance cl)))
-
-

diff --git a/classes.lisp b/classes.lisp
index 2860498210891f385db04c9a7f77acc956f52184..05af0fbf36fe4fc0ceb49dcbbe01796453cd1c1c 100644 (file)
--- a/classes.lisp
+++ b/classes.lisp
@@ -556,4 +556,3 @@
   (:user-name "UMLS Statistic")
   (:default-print-slots name hits srl)
   (:documentation "Custom Table: UMLS Database statistics."))
-

diff --git a/sql-classes.lisp b/sql-classes.lisp
index b1373f004d8f14140bc9d1e5d10ed746a8e3f54d..78ae763f18e9a88b14c572612df4fc8c36e847b8 100644 (file)
--- a/sql-classes.lisp
+++ b/sql-classes.lisp
@@ -285,7 +285,8 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-uconso-sui (sui &key sab (srl *current-srl*))
   "Find uconso for a sui. If set SAB, the without-pfstr is on by default"
   (ensure-sui-integer sui)
-  (unless (and sui (stringp sab))
+;;  (unless (and sui (stringp sab))
+  (unless sui
     (return-from find-uconso-sui nil))
 
   (collect-umlisp-query (mrconso (cui lat ts lui stt sui ispref aui saui scui sdui sab tty code str
@@ -555,7 +556,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   (ensure-cui-integer cui)
   (ensure-lui-integer lui)
   (collect-umlisp-query (mrconso (sui stt str suppress ksuilrl) srl kcuilui
-                                 (make-cuilui cui lui) :lrl ksuilrl)
+                                 (make-cuilui cui lui) :lrl ksuilrl :distinct t)
                 (make-instance 'ustr :sui (ensure-integer sui) :cui cui :lui lui
                    :cuisui (make-cuisui cui sui) :stt stt :str str :suppress suppress
                    :lrl (ensure-integer ksuilrl))))
@@ -578,7 +579,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   "Return the list of ustr for sui"
   (ensure-sui-integer sui)
   (collect-umlisp-query (mrconso (cui lui stt str suppress ksuilrl) srl sui sui
-                            :lrl ksuilrl)
+                            :lrl ksuilrl :distinct t)
     (make-instance 'ustr :sui sui :cui cui :stt stt :str str
                    :cuisui (make-cuisui (ensure-integer cui) sui)
                    :suppress suppress
@@ -1157,4 +1158,3 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-ustats-srl (srl)
   (collect-umlisp-query (ustats (name count) nil srl srl :order (name asc))
                            (make-instance 'ustats :name name :hits (ensure-integer count))))
-