From: Kevin M. Rosenberg <kevin@rosenberg.net>
Date: Tue, 9 Apr 2013 07:35:50 +0000 (-0600)
Subject: Updates for compatibility with new umweb
X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=commitdiff_plain;h=7f30522f16a7c528b5a0f0ee493bbb0cb1aef77b

Updates for compatibility with new umweb
---

diff --git a/class-support.lisp b/class-support.lisp
index 7892abe..0352c74 100644
--- 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 2860498..05af0fb 100644
--- 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 b1373f0..78ae763 100644
--- 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))))
-