From b63c73280f39e4612e00d9d3426b72c31f2f7637 Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Fri, 2 May 2003 21:24:19 +0000
Subject: [PATCH] r4741: *** empty log message ***

---
 sql-classes.lisp | 880 +++++++++++++++--------------------------------
 1 file changed, 285 insertions(+), 595 deletions(-)

diff --git a/sql-classes.lisp b/sql-classes.lisp
index 161b9cd..e3804d6 100644
--- a/sql-classes.lisp
+++ b/sql-classes.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: sql-classes.lisp,v 1.16 2003/05/02 18:47:53 kevin Exp $
+;;;; $Id: sql-classes.lisp,v 1.17 2003/05/02 21:24:19 kevin Exp $
 ;;;;
 ;;;; This file, part of UMLisp, is
 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
@@ -46,244 +46,167 @@
 	      (setq found-ustr ustr))))))
     found-ustr))
 
+(defmacro with-umlisp-query ((table fields srl where-name where-value
+			    &key (lrlname "KCUILRL") distinct single terminal like)
+			     &body body)
+  (let ((query (gensym)))
+    `(unless (and ,where-name (not ,where-value)) 
+       (let ((,query (umlisp-query ,table ,fields ,srl ,where-name ,where-value
+				   :lrlname ,lrlname :single ,single :distinct ,distinct
+				   :terminal ,terminal :like ,like)))
+	 (if ,single
+	     (let ((tuple (car ,query)))
+	       (when tuple 
+		 ,@body))
+	   (loop
+	       for tuple in ,query
+	       collect
+		 ,@body))))))
+    
 (defun umlisp-query (table fields srl where-name where-value
-		     &key (lrlname "KCUILRL") final)
+		     &key (lrlname "KCUILRL") single distinct terminal like)
   "Query the UMLisp database. Return a list of umlisp objects whose name
 is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
-  (when where-value
+  (when (or (not where-name) where-value)
     (mutex-sql-query
-     (query-string table fields srl where-name where-value lrlname final))))
+     (query-string table fields srl where-name where-value 
+		   :lrlname lrlname :single single :distinct distinct :terminal terminal :like like))))
 
   
 (defun query-string (table fields &optional srl where-name where-value
-		     (lrlname "KCUILRL") final)
-  (let ((qs (format nil "select ~{~:@(~A~)~^,~} from ~:@(~A~)" fields table)))
+		     &key (lrlname "KCUILRL") single distinct terminal like)
+  (let ((qs (format nil "select ~A~{~:@(~A~)~^,~} from ~:@(~A~)" 
+		    (if distinct "distinct " "")
+		    fields table)))
     (when where-name
       (setq qs (concatenate 'string qs
 			    (format nil
 				    (if (stringp where-value)
-					" where ~A='~A'"
-					" where ~A=~A")
-				    where-name where-value))))
+					(if like
+					    " where ~A like '%~A%'"
+					  " where ~A='~A'")
+				      " where ~A=~A")
+				    where-name  where-value))))
     (when srl
       (setq qs (concatenate 'string qs (format nil " and ~:@(~A~) <= ~D"
 					       lrlname srl))))
-    (when final
-      (setq qs (concatenate 'string qs " " final)))
+    (when terminal
+      (setq qs (concatenate 'string qs " " terminal)))
+    (when single
+      (setq qs (concatenate 'string qs " limit 1")))
     qs))
 
 (defun find-ucon-cui (cui &key (srl *current-srl*))
   "Find ucon for a cui"
-  (loop
-   (for tuple in (umlisp-query 'mrcon '(kpfstr kcuilrl) srl
-			       'cui (parse-cui cui) :final "limit 1")
-	collect
-	(make-instance 'ucon :cui (parse-cui cui)
-		       :pfstr (car tuple) 
-		       :lrl (ensure-integer (cadr tuple))))))
-
-(defun find-ucon-cui-old (cui &key (srl *current-srl*))
-  "Find ucon for a cui"
-  (when (stringp cui) (setq cui (parse-cui cui)))
-  (when cui
-    (let ((ls
-	   (maybe-add-srl
-	    (format nil "select KPFSTR,KCUILRL from MRCON where CUI=~d" cui)
-	    srl :final "limit 1")))
-      (awhen (car (mutex-sql-query ls))
-	     (make-instance 'ucon :cui cui :pfstr (car it) 
-			    :lrl (ensure-integer (cadr it)))))))
+  (with-umlisp-query ('mrcon '(kpfstr kcuilrl) srl 'cui (parse-cui cui) :single t)
+    (make-instance 'ucon :cui (parse-cui cui)
+		   :pfstr (car tuple) 
+		   :lrl (ensure-integer (cadr tuple)))))
+
 
 (defun find-ucon-cui-sans-pfstr (cui &key (srl *current-srl*))
   "Find ucon for a cui"
-  (when (stringp cui) (setq cui (parse-cui cui)))
-  (when cui
-    (let ((ls (maybe-add-srl
-	       (format nil "select KCUILRL from MRCON where CUI=~d" cui)
-	       srl :final "limit 1")))
-      (awhen (car (mutex-sql-query ls))
-	     (make-instance 'ucon :cui cui
-			    :lrl (ensure-integer (car it))
-			    :pfstr nil)))))
+  (with-umlisp-query ('mrcon '(kcuilrl) srl 'cui (parse-cui cui) :single t)
+    (make-instance 'ucon :cui (parse-cui cui)
+		   :lrl (ensure-integer (car tuple))
+		   :pfstr nil)))
 
 (defun find-pfstr-cui (cui &key (srl *current-srl*))
   "Find preferred string for a cui"
-  (when (stringp cui) (setq cui (parse-cui cui)))
-  (when cui
-      (let ((ls (maybe-add-srl
-		 (format nil "select KPFSTR from MRCON where CUI=~d" cui)
-		 srl :final "limit 1")))
-	(awhen (car (mutex-sql-query ls))
-	       (car it)))))
+  (with-umlisp-query ('mrcon '(kpfstr) srl 'cui (parse-cui cui) :single t)
+    (car tuple)))
 
 (defun find-ucon-lui (lui &key (srl *current-srl*))
   "Find list of ucon for lui"
-  (when (stringp lui) (setq lui (parse-lui lui)))
-  (when lui
-      (let ((ucons '())
-	    (ls
-	     (maybe-add-srl
-	      (format nil "select distinct CUI,KPFSTR,KCUILRL from MRCON where LUI=~d" lui)
-	      srl)))
-	(dolist (tuple (mutex-sql-query ls))
-	  (destructuring-bind (cui pfstr lrl) tuple
-	    (push (make-instance 'ucon :cui (ensure-integer cui)
-				 :pfstr pfstr
-				 :lrl (ensure-integer lrl))
-		  ucons)))
-	(nreverse ucons))))
+  (with-umlisp-query ('mrcon '(cui kpfstr kcuilrl) srl 'lui (parse-lui lui) :distinct t)
+    (destructuring-bind (cui pfstr lrl) tuple
+      (make-instance 'ucon :cui (ensure-integer cui)
+		     :pfstr pfstr
+		     :lrl (ensure-integer lrl)))))
 
 (defun find-ucon-sui (sui &key (srl *current-srl*))
   "Find list of ucon for sui"
-  (when (stringp sui) (setq sui (parse-sui sui)))
-  (when sui
-    (let ((ucons '())
-	  (ls (maybe-add-srl
-	       (format nil "select distinct CUI,KPFSTR,KCUILRL from MRCON where SUI=~d" sui)
-	       srl)))
-      (let ((tuples (mutex-sql-query ls)))
-	(dolist (tuple tuples)
-	  (destructuring-bind (cui pfstr lrl) tuple
-	    (push (make-instance 'ucon :cui (ensure-integer cui)
-				 :pfstr pfstr
-				 :lrl (ensure-integer lrl))
-		  ucons))))
-      (nreverse ucons))))
+  (with-umlisp-query ('mrcon '(cui kpfstr kcuilrl) srl 'sui (parse-sui sui) :distinct t)
+    (destructuring-bind (cui pfstr lrl) tuple
+      (make-instance 'ucon :cui (ensure-integer cui)
+		     :pfstr pfstr
+		     :lrl (ensure-integer lrl)))))
 
 (defun find-ucon-cuisui (cui sui &key (srl *current-srl*))
   "Find ucon for cui/sui"
-  (when (stringp cui) (setq cui (parse-cui cui)))
-  (when (stringp sui) (setq sui (parse-sui sui)))
   (when (and cui sui)
-    (let ((ls
-	   (maybe-add-srl
-	    (format nil "select distinct CUI,KPFSTR,KCUILRL from MRCON where KCUISUI=~d"
-		      (make-cuisui cui sui))
-	    srl)))
-      (awhen (car (mutex-sql-query ls))
-	     (destructuring-bind (cui pfstr lrl) it
-	       (make-instance 'ucon :cui (ensure-integer cui)
-			      :pfstr pfstr
-			      :lrl (ensure-integer lrl)))))))
+    (with-umlisp-query ('mrcon '(cui kpfstr kcuilrl) srl 'kcuisui 
+			       (make-cuisui (parse-cui cui) (parse-sui sui)))
+      (destructuring-bind (cui pfstr lrl) tuple
+	(make-instance 'ucon :cui (ensure-integer cui)
+		       :pfstr pfstr
+		       :lrl (ensure-integer lrl))))))
 
 (defun find-ucon-str (str &key (srl *current-srl*))
   "Find ucon that are exact match for str"
-  (when str
-    (let ((ucons '())
-	  (ls (maybe-add-srl
-	       (format nil "select distinct CUI,KPFSTR,KCUILRL from MRCON where STR='~a'" str)
-	       srl)))
-      (dolist (tuple (mutex-sql-query ls))
-	(destructuring-bind (cui pfstr lrl) tuple
-	  (push (make-instance 'ucon :cui (ensure-integer cui) 
-			       :pfstr pfstr
-			       :lrl (ensure-integer lrl))
-		ucons)))
-	(nreverse ucons))))
+  (with-umlisp-query ('mrcon '(cui kpfstr kcuilrl) srl 'str str :distinct t)
+    (destructuring-bind (cui pfstr lrl) tuple
+      (make-instance 'ucon :cui (ensure-integer cui) 
+		     :pfstr pfstr
+		     :lrl (ensure-integer lrl)))))
 
 (defun find-ucon-all (&key (srl *current-srl*))
   "Return list of all ucon's"
-  (let ((ls (maybe-add-srl "select distinct CUI,KPFSTR,KCUILRL from MRCON"
-			   srl)))
-    (string-append ls " order by CUI asc")
-    (with-sql-connection (db)
-      (clsql:map-query 
-       'list
-       #'(lambda (cui pfstr cuilrl)
-	   (make-instance 'ucon :cui (ensure-integer cui)
-			  :pfstr pfstr
-			  :lrl (ensure-integer cuilrl)))
-       ls
-       :database db))))
+  (with-sql-connection (db)
+    (clsql:map-query 
+     'list
+     #'(lambda (cui pfstr cuilrl)
+	 (make-instance 'ucon :cui (ensure-integer cui)
+			:pfstr pfstr
+			:lrl (ensure-integer cuilrl)))
+     (query-string 'mrcon '(cui kpfstr kcuilrl) srl nil nil :terminal "order by CUI asc" :distinct t)
+     :database db)))
 
 (defun map-ucon-all (fn &key (srl *current-srl*))
-  "Return list of all ucon's"
-  (let ((ls (maybe-add-srl "select distinct CUI,KPFSTR,KCUILRL from MRCON"
-			   srl :final "order by CUI asc")))
-    (with-sql-connection (db)
-      (clsql:map-query 
-       nil
-       #'(lambda (cui pfstr cuilrl)
-	   (funcall fn
-		    (make-instance 'ucon :cui (ensure-integer cui)
-				   :pfstr pfstr
-				   :lrl (ensure-integer cuilrl))))
-       ls
-       :database db))))
+  "Map a function over all ucon's"
+  (with-sql-connection (db)
+    (clsql:map-query 
+     nil
+     #'(lambda (cui pfstr cuilrl)
+	 (funcall fn
+		  (make-instance 'ucon :cui (ensure-integer cui)
+				 :pfstr pfstr
+				 :lrl (ensure-integer cuilrl))))
+     (query-string 'mrcon '(cui kpfstr kcuilrl) srl nil nil :terminal "order by CUI asc" :distinct t)
+     :database db)))
 
 
 (defun find-udef-cui (cui &key (srl *current-srl*))
   "Return a list of udefs for cui"
-  (let ((udefs '())
-	(ls (maybe-add-srl
-	     (format nil "select SAB,DEF from MRDEF where CUI=~d" cui)
-	     srl :var "KSRL")))
-    (dolist (tuple (mutex-sql-query ls))
-      (destructuring-bind (sab def) tuple
-	(push (make-instance 'udef :sab sab :def def) udefs)))
-    (nreverse udefs)))
+  (with-umlisp-query ('mrdef '(sab def) srl 'cui (parse-cui cui) :lrlname "KSRL")
+    (destructuring-bind (sab def) tuple
+      (make-instance 'udef :sab sab :def def))))
 
 (defun find-usty-cui (cui &key (srl *current-srl*))
   "Return a list of usty for cui"
-  (let ((ustys '())
-	(ls (maybe-add-srl
-	     (format nil "select TUI,STY from MRSTY where CUI=~d" cui)
-	     srl :var "KLRL")))
-    (dolist (tuple (mutex-sql-query ls))
-      (destructuring-bind (tui sty) tuple
-	(push (make-instance 'usty :tui (ensure-integer tui) :sty sty) ustys)))
-    ustys))
+  (with-umlisp-query ('mrsty '(tui sty) srl 'cui (parse-cui cui) :lrlname "KLRL")
+    (destructuring-bind (tui sty) tuple
+      (make-instance 'usty :tui (ensure-integer tui) :sty sty))))
 
 (defun find-usty-word (word &key (srl *current-srl*))
   "Return a list of usty that match word"
-  (let ((ustys '())
-	(ls (maybe-add-srl
-	     (format nil "select distinct TUI,STY from MRSTY where STY like '%~a%'" word)
-	     srl :var "KLRL")))
-    (dolist (tuple (mutex-sql-query ls))
-      (destructuring-bind (tui sty) tuple
-	(push (make-instance 'usty :tui (ensure-integer tui) :sty sty) ustys)))
-    ustys))
+  (with-umlisp-query ('mrsty '(tui sty) srl 'sty word :lrlname 'klrl :like t :distinct t)
+    (destructuring-bind (tui sty) tuple
+	(make-instance 'usty :tui (ensure-integer tui) :sty sty))))
 
 (defun find-urel-cui (cui &key (srl *current-srl*))
   "Return a list of urel for cui"
-  (let ((urels '())
-	(ls (maybe-add-srl
-	     (format nil "select REL,CUI2,RELA,SAB,SL,MG,KPFSTR2 from MRREL where CUI1=~d" cui)
-	     srl :var "KSRL")))
-    (dolist (tuple (mutex-sql-query ls))
-      (destructuring-bind (rel cui2 rela sab sl mg pfstr2) tuple
-	(push (make-instance 'urel 
-			     :cui1 cui
-			     :rel rel
-			     :cui2 (ensure-integer cui2)
-			     :rela rela
-			     :sab sab
-			     :sl sl
-			     :mg mg
-			     :pfstr2 pfstr2)
-	      urels)))
-    (nreverse urels)))
+  (with-umlisp-query ('mrrel '(rel cui2 rela sab sl mg kpfstr2) srl 'cui1 (parse-cui cui) :lrlname "KSRL")
+    (destructuring-bind (rel cui2 rela sab sl mg pfstr2) tuple
+      (make-instance 'urel :cui1 (parse-cui cui) :rel rel :cui2 (ensure-integer cui2) :rela rela
+		     :sab sab :sl sl :mg mg :pfstr2 pfstr2))))
 
 (defun find-urel-cui2 (cui2 &key (srl *current-srl*))
   "Return a list of urel for cui2"
-  (let ((urels '())
-	(ls (maybe-add-srl
-	     (format nil "select REL,CUI1,RELA,SAB,SL,MG,KPFSTR2 from MRREL where CUI2=~d" cui2)
-	     srl :var "SRL")))
-    (dolist (tuple (mutex-sql-query ls))
-      (destructuring-bind (rel cui1 rela sab sl mg pfstr2) tuple
-	(push (make-instance 'urel 
-			     :cui2 cui2
-			     :rel rel
-			     :cui1 (ensure-integer cui1)
-			     :rela rela
-			     :sab sab
-			     :sl sl
-			     :mg mg
-			     :pfstr2 pfstr2)
-	      urels)))
-    (nreverse urels)))
+  (with-umlisp-query ('mrrel '(rel cui1 rela sab sl mg kpfstr2) srl 'cui2 (parse-cui cui2) :lrlname "KSRL")
+    (destructuring-bind (rel cui1 rela sab sl mg pfstr2) tuple
+      (make-instance 'urel :cui2 (parse-cui cui2) :rel rel :cui1 (ensure-integer cui1) :rela rela
+			     :sab sab :sl sl :mg mg :pfstr2 pfstr2))))
 
 (defun find-ucon-rel-cui2 (cui2 &key (srl *current-srl*))
   (mapcar 
@@ -292,42 +215,23 @@ 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"
-  (let ((ucocs '())
-	(ls (maybe-add-srl
-	     (format nil "select CUI2,SOC,COT,COF,COA,KPFSTR2 from MRCOC where CUI1=~d" cui)
-	     srl :var "KLRL" :final "order by COF asc")))
-    (dolist (tuple (mutex-sql-query ls))
-      (destructuring-bind (cui2 soc cot cof coa pfstr2) tuple
-	(setq cui2 (ensure-integer cui2))
-	(when (zerop cui2) (setq cui2 nil))
-	(push (make-instance 'ucoc :cui1 cui
-			     :cui2 cui2
-			     :soc soc
-			     :cot cot
-			     :cof (ensure-integer cof)
-			     :coa coa
-			     :pfstr2 pfstr2)
-	      ucocs)))
-    ucocs)) ;; akready ordered by SQL select
+  (with-umlisp-query ('mrcoc '(cui2 soc cot cof coa kpfstr2) srl 'cui1 (parse-cui cui) 
+			     :lrlname "KSRL" :terminal "order by COF asc")
+    (destructuring-bind (cui2 soc cot cof coa pfstr2) tuple
+      (setq cui2 (ensure-integer cui2))
+      (when (zerop cui2) (setq cui2 nil))
+      (make-instance 'ucoc :cui1 (parse-cui cui) :cui2 (ensure-integer cui2) :soc soc :cot cot
+		     :cof (ensure-integer cof) :coa coa :pfstr2 pfstr2))))
 
 (defun find-ucoc-cui2 (cui2 &key (srl *current-srl*))
   "Return a list of ucoc for cui2"
-  (let ((ucocs '())
-	(ls (format nil "select CUI1,SOC,COT,COF,COA,KPFSTR2 from MRCOC where CUI2=~d" cui2)))
-    (when srl
-	(string-append ls (format nil " and KSRL <= ~d" srl)))
-    (string-append ls " order by COF asc")
-    (dolist (tuple (mutex-sql-query ls))
-      (destructuring-bind (cui1 soc cot cof coa pfstr2) tuple
-	(push (make-instance 'ucoc :cui1 (ensure-integer cui1)
-			     :cui2 cui2
-			     :soc soc
-			     :cot cot
-			     :cof (ensure-integer cof)
-			     :coa coa
-			     :pfstr2 pfstr2)
-	      ucocs)))
-    ucocs)) ;; already ordered by SQL select
+  (with-umlisp-query ('mrcoc '(cui1 soc cot cof coa kpfstr2) srl 'cui2 (parse-cui cui2) 
+			     :lrlname "KSRL" :terminal "order by COF asc")
+    (destructuring-bind (cui1 soc cot cof coa pfstr2) tuple
+      (setq cui2 (ensure-integer cui2))
+      (when (zerop cui2) (setq cui2 nil))
+      (make-instance 'ucoc :cui1 (ensure-integer cui1) :cui2 (parse-cui cui2) :soc soc :cot cot
+		     :cof (ensure-integer cof) :coa coa :pfstr2 pfstr2))))
 
 (defun find-ucon-coc-cui2 (cui2 &key (srl *current-srl*))
   "List of ucon with co-occurance cui2"
@@ -337,20 +241,10 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 
 (defun find-ulo-cui (cui &key (srl *current-srl*))
   "Return a list of ulo for cui"
-  (let ((ulos '())
-	(ls (format nil "select ISN,FR,UN,SUI,SNA,SOUI from MRLO where CUI=~d" cui)))
-    (when srl
-	(string-append ls (format nil " and KLRL <= ~d" srl)))
-    (dolist (tuple (mutex-sql-query ls))
+  (with-umlisp-query ('mrlo '(isn fr un sui sna soui) srl 'cui (parse-cui cui) :lrlname "KLRL")
       (destructuring-bind (isn fr un sui sna soui) tuple
-	(push (make-instance 'ulo :isn isn
-			     :fr (ensure-integer fr)
-			     :un un
-			     :sui (ensure-integer sui)
-			     :sna sna
-			     :soui soui)
-	      ulos)))
-    (nreverse ulos)))
+	(make-instance 'ulo :isn isn :fr (ensure-integer fr) :un un :sui (ensure-integer sui) :sna sna
+			     :soui soui))))
 
 (defgeneric suistr (lo))
 (defmethod suistr ((lo ulo))
@@ -359,118 +253,70 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 
 (defun find-uatx-cui (cui &key (srl *current-srl*))
   "Return a list of uatx for cui"
-  (let ((uatxs '())
-	(ls (format nil "select SAB,REL,ATX from MRATX where CUI=~d" cui)))
-    (when srl
-	(string-append ls (format nil " and KSRL <= ~d" srl)))
-    (dolist (tuple (mutex-sql-query ls))
-      (destructuring-bind (sab rel atx) tuple
-	(push (make-instance 'uatx :sab sab :rel rel :atx atx) uatxs)))
-    (nreverse uatxs)))
+  (with-umlisp-query ('mratx '(sab rel atx) srl 'cui (parse-cui cui) :lrlname 'ksrl)
+    (destructuring-bind (sab rel atx) tuple
+      (make-instance 'uatx :sab sab :rel rel :atx atx))))
 
 
 (defun find-uterm-cui (cui &key (srl *current-srl*))
   "Return a list of uterm for cui"
-  (let ((uterms '())
-	(ls (format nil "select distinct LUI,LAT,TS,KLUILRL from MRCON where CUI=~d" cui)))
-    (when srl
-	(string-append ls (format nil " and KLUILRL <= ~d" srl)))
-    (dolist (tuple (mutex-sql-query ls))
-      (destructuring-bind (lui lat ts lrl) tuple
-	(push (make-instance 'uterm :lui (ensure-integer lui) :cui cui
-			     :lat lat :ts ts :lrl (ensure-integer lrl))
-	      uterms)))
-    (nreverse uterms)))
+  (with-umlisp-query ('mrcon '(lui lat ts kluilrl) srl 'cui (parse-cui cui) :lrlname 'kluilrl
+			     :distinct t)
+    (destructuring-bind (lui lat ts lrl) tuple
+      (make-instance 'uterm :lui (ensure-integer lui) :cui (parse-cui cui)
+		     :lat lat :ts ts :lrl (ensure-integer lrl)))))
 
 (defun find-uterm-lui (lui &key (srl *current-srl*))
   "Return a list of uterm for lui"
-  (if (stringp lui)
-      (setq lui (parse-lui lui)))
-  (let ((uterms '())
-	(ls (format nil "select distinct CUI,LAT,TS,KLUILRL from MRCON where LUI=~d" lui)))
-    (when srl
-	(string-append ls (format nil " and KLUILRL <= ~d" srl)))
-    (dolist (tuple (mutex-sql-query ls))
-      (destructuring-bind (cui lat ts lrl) tuple
-	(push (make-instance 'uterm :cui (ensure-integer cui) :lui lui
-			     :lat lat :ts ts :lrl (ensure-integer lrl))
-	      uterms)))
-    (nreverse uterms)))
+  (with-umlisp-query ('mrcon '(cui lat ts kluilrl) srl 'lui (parse-lui lui) 
+			     :lrlname 'kluilrl :distinct t)
+    (destructuring-bind (cui lat ts lrl) tuple
+      (make-instance 'uterm :cui (ensure-integer cui) :lui (parse-lui lui)
+		     :lat lat :ts ts :lrl (ensure-integer lrl)))))
+
 
 (defun find-uterm-cuilui (cui lui &key (srl *current-srl*))
   "Return single uterm for cui/lui"
-  (let ((ls (format nil "select LAT,TS,KLUILRL from MRCON where KCUILUI=~d limit 1" (make-cuilui cui lui))))
-    (when srl (string-append ls (format nil " and KLUILRL <= ~d" srl)))
-    (awhen (car (mutex-sql-query ls))
-	   (destructuring-bind (lat ts lrl) it
-	     (make-instance 'uterm :cui cui :lui lui :lat lat :ts ts 
-			    :lrl (ensure-integer lrl))))))
+  (with-umlisp-query ('mrcon '(lat ts kluilrl) srl 'kcuilui
+			     (make-cuilui (parse-cui cui) (parse-lui lui))
+			     :lrlname 'kluilrl :single t)
+    (destructuring-bind (lat ts lrl) tuple
+      (make-instance 'uterm :cui cui :lui lui :lat lat :ts ts :lrl (ensure-integer lrl)))))
 
 (defun find-ustr-cuilui (cui lui &key (srl *current-srl*))
   "Return a list of ustr for cui/lui"
-  (declare (fixnum cui lui))
-  (let ((ustrs '())
-	(ls (format nil "select SUI,STT,STR,LRL from MRCON where KCUILUI=~d" (make-cuilui cui lui))))
-    (when srl (string-append ls (format nil " and LRL <= ~d" srl)))
-    (dolist (tuple (mutex-sql-query ls))
-      (destructuring-bind (sui stt str lrl) tuple
-	(push
-	 (make-instance 'ustr :sui (ensure-integer sui) :cui cui :lui lui
-			:cuisui (make-cuisui cui sui) :stt stt :str str
-			:lrl (ensure-integer lrl))
-	 ustrs)))
-    (nreverse ustrs)))
+  (with-umlisp-query ('mrcon '(sui stt str lrl) srl 'kcuilui (make-cuilui cui lui) :lrlname 'lrl)
+    (destructuring-bind (sui stt str lrl) tuple
+      (make-instance 'ustr :sui (ensure-integer sui) :cui cui :lui lui
+		     :cuisui (make-cuisui cui sui) :stt stt :str str
+		     :lrl (ensure-integer lrl)))))
 
 (defun find-ustr-cuisui (cui sui &key (srl *current-srl*))
   "Return the single ustr for cuisui"
-  (let ((ls (format nil "select LUI,STT,STR,LRL from MRCON where KCUISUI=~d"
-		    (make-cuisui cui sui))))
-    (when srl (string-append ls (format nil " and LRL <= ~d" srl)))
-    (awhen (car (mutex-sql-query ls))
-	   (destructuring-bind (lui stt str lrl) it
-	     (make-instance 'ustr :sui sui :cui cui
-			    :cuisui (make-cuisui cui sui)
-			    :lui (ensure-integer lui) :stt stt :str str
-			    :lrl (ensure-integer lrl))))))
+  (with-umlisp-query ('mrcon '(lui stt str lrl) srl 'kcuisui (make-cuisui cui sui) :lrlname 'lrl :single t)
+    (destructuring-bind (lui stt str lrl) tuple
+      (make-instance 'ustr :sui sui :cui cui :cuisui (make-cuisui cui sui)
+		     :lui (ensure-integer lui) :stt stt :str str :lrl (ensure-integer lrl)))))
 
 (defun find-ustr-sui (sui &key (srl *current-srl*))
   "Return the list of ustr for sui"
-  (if (stringp sui)
-      (setq sui (parse-sui sui)))
-  (let ((ustrs '())
-	(ls (format nil "select CUI,LUI,STT,STR,LRL from MRCON where SUI=~d" sui)))
-    (when srl (string-append ls (format nil " and LRL <= ~d" srl)))
-    (dolist (tuple (mutex-sql-query ls))
-      (destructuring-bind (cui lui stt str lrl) tuple
-	(setq cui (ensure-integer cui))
-	(push (make-instance 'ustr :sui sui :cui cui :stt stt :str str
-			     :cuisui (make-cuisui cui sui)
-			     :lui (ensure-integer lui)
-			     :lrl (ensure-integer lrl))
-	      ustrs)))
-    (nreverse ustrs)))
+  (with-umlisp-query ('mrcon '(cui lui stt str lrl) srl 'sui (parse-sui sui) :lrlname 'lrl)
+    (destructuring-bind (cui lui stt str lrl) tuple
+      (make-instance 'ustr :sui sui :cui cui :stt stt :str str
+		     :cuisui (make-cuisui (ensure-integer cui) (parse-sui sui))
+		     :lui (ensure-integer lui)
+		     :lrl (ensure-integer lrl)))))
       
 (defun find-ustr-sab (sab &key (srl *current-srl*))
   "Return the list of ustr for sab"
-  (let ((ustrs '())
-	(ls (format nil "select KCUISUI from MRSO where SAB='~a'" sab)))
-    (when srl
-	(string-append ls (format nil " and SRL <= ~d" srl)))
-    (dolist (tuple (mutex-sql-query ls))
-      (let ((cuisui (ensure-integer (car tuple))))
-	(push (apply #'find-ustr-cuisui 
-		     (append
-		      (multiple-value-list (decompose-cuisui cuisui))
-		      (list :srl srl)))
-	      ustrs)))
-    (nreverse ustrs)))
+  (with-umlisp-query ('mrso '(kcuisui) srl 'sab sab :lrlname 'srl)
+    (let ((cuisui (ensure-integer (car tuple))))
+      (apply #'find-ustr-cuisui 
+	     (append
+	      (multiple-value-list (decompose-cuisui cuisui)) (list :srl srl))))))
 
 (defun find-ustr-all (&key (srl *current-srl*))
   "Return list of all ustr's"
-  (let ((ls "select distinct CUI,LUI,SUI,STT,LRL,KPFSTR from MRCON"))
-    (when srl
-      (string-append ls (format nil " where LRL <= ~d" srl)))
-    (string-append ls " order by SUI asc")
     (with-sql-connection (db)
       (clsql:map-query 
        'list
@@ -486,46 +332,29 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 			  :stt stt
 			  :lrl lrl
 			  :str pfstr))
-       ls
-       :database db))))
+       (query-string 'mrcon '(cui lui sui stt lrl kpfstr) srl nil nil :lrlname 'lrl :distinct t
+		     :terminal "order by SUI asc")
+       :database db)))
 
 (defun find-string-sui (sui &key (srl *current-srl*))
   "Return the string associated with sui"
-  (let ((ls (format nil "select STR from MRCON where SUI=~d" sui)))
-    (when srl
-      (string-append ls (format nil " and LRL <= ~d" srl)))
-    (string-append ls " limit 1")
-    (caar (mutex-sql-query ls))))
+  (with-umlisp-query ('mrcon '(str) srl 'sui sui :lrlname 'lrl :single t)
+    (car tuple)))
 
 (defun find-uso-cuisui (cui sui &key (srl *current-srl*))
-  (declare (fixnum cui sui))
-  (let ((usos '())
-	(ls (format nil "select SAB,CODE,SRL,TTY from MRSO where KCUISUI=~d"
-		    (make-cuisui cui sui))))
-    (when srl
-	(string-append ls (format nil " and SRL <= ~d" srl)))
-    (dolist (tuple (mutex-sql-query ls))
-      (destructuring-bind (sab code srl tty) tuple
-	(push (make-instance 'uso :sab sab :code code :srl srl :tty tty)
-	      usos)))
-    (nreverse usos)))
+  (with-umlisp-query ('mrso '(sab code srl tty) srl 'kcuisui (make-cuisui cui sui) :lrlname 'srl)
+    (destructuring-bind (sab code srl tty) tuple
+      (make-instance 'uso :sab sab :code code :srl srl :tty tty))))
 
 (defun find-ucxt-cuisui (cui sui &key (srl *current-srl*))
-  (declare (fixnum cui sui))
-  (let ((ucxts '())
-	(ls (format nil "select SAB,CODE,CXN,CXL,RNK,CXS,CUI2,HCD,RELA,XC from MRCXT where KCUISUI=~d" 
-		    (make-cuisui cui sui))))
-    (when srl
-	(string-append ls (format nil " and KSRL <= ~d" srl)))
-    (dolist (tuple (mutex-sql-query ls))
-      (destructuring-bind (sab code cxn cxl rnk cxs cui2 hcd rela xc) tuple
-	(push (make-instance 'ucxt :sab sab :code code
-			     :cxn (ensure-integer cxn)
-			     :cxl cxl :cxs cxs :hcd hcd :rela rela :xc xc
-			     :rnk (ensure-integer rnk)
-			     :cui2 (ensure-integer cui2))
-	      ucxts)))
-    (nreverse ucxts)))
+  (with-umlisp-query ('mrcxt '(sab code cxn cxl rnk cxs cui2 hcd rela cx) srl 'kcuisui
+			     (make-cuisui cui sui) :lrlname 'ksrl)
+    (destructuring-bind (sab code cxn cxl rnk cxs cui2 hcd rela xc) tuple
+      (make-instance 'ucxt :sab sab :code code
+		     :cxn (ensure-integer cxn)
+		     :cxl cxl :cxs cxs :hcd hcd :rela rela :xc xc
+		     :rnk (ensure-integer rnk)
+		     :cui2 (ensure-integer cui2)))))
 
 (defun find-usat-ui (cui &optional (lui nil) (sui nil) &key (srl *current-srl*))
   (let ((ls (format nil "select CODE,ATN,SAB,ATV from MRSAT where ")))
@@ -545,56 +374,46 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 
 (defun find-usty-tui (tui)
   "Find usty for tui"
-  (setq tui (parse-tui tui)) 
-  (awhen (car (mutex-sql-query 
-	       (format nil "select STY from MRSTY where TUI=~d limit 1" tui)))
-	 (make-instance 'usty :tui tui :sty (car it))))
+  (with-umlisp-query ('mrsty '(sty) nil 'tui (parse-tui tui) :single t)
+    (make-instance 'usty :tui (parse-tui tui) :sty (car tuple))))
 
 (defun find-usty-sty (sty)
   "Find usty for a sty"
-  (awhen (car (mutex-sql-query 
-	       (format nil "select TUI from MRSTY where STY='~a' limit 1" sty)))
-	 (make-instance 'usty :tui (ensure-integer (car it)) :sty sty)))
+  (with-umlisp-query ('mrsty '(tui) nil 'sty sty :single t)
+    (make-instance 'usty :tui (ensure-integer (car tuple)) :sty sty)))
 
 (defun find-usty-all ()
   "Return list of usty's for all semantic types"
-  (let ((ustys '()))
-    (dolist (tuple (mutex-sql-query "select distinct TUI from MRSTY"))
-      (push (find-usty-tui (nth 0 tuple)) ustys))
-    (nreverse ustys)))
+  (with-umlisp-query ('mrsty '(tui) nil nil nil :distinct t)
+    (find-usty-tui (car tuple))))
 
 (defun find-usab-all ()
   "Find usab for a key"
-  (let ((results '()))
-    (dolist (tuple (mutex-sql-query "select VCUI,RCUI,VSAB,RSAB,SON,SF,SVER,MSTART,MEND,IMETA,RMETA,SLC,SCC,SRL,TFR,CFR,CXTY,TTYL,ATNL,LAT,CENC,CURVER,SABIN from MRSAB"))
-      (destructuring-bind
-	    (vcui rcui vsab rsab son sf sver mstart mend imeta rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc curver sabin) tuple
-	(push 
-	 (make-instance 'usab :vcui (ensure-integer vcui) 
-			:rcui (ensure-integer rcui)
-			:vsab vsab :rsab rsab :son son :sf sf :sver sver :mstart mstart
-			:mend mend :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)
-	 results)))
-    (nreverse results)))
+  (with-umlisp-query ('mrsab '(vcui rcui vsab rsab son sf sver mstart mend imeta rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc curver sabin) nil nil nil)
+    (destructuring-bind
+	(vcui rcui vsab rsab son sf sver mstart mend imeta rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc curver sabin) tuple
+      (make-instance 'usab :vcui (ensure-integer vcui) 
+		     :rcui (ensure-integer rcui)
+		     :vsab vsab :rsab rsab :son son :sf sf :sver sver :mstart mstart
+		     :mend mend :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))))
 
 (defun find-usab-by-key (key-name key)
   "Find usab for a key"
-  (aif (car (mutex-sql-query 
-	     (format nil "select VCUI,RCUI,VSAB,RSAB,SON,SF,SVER,MSTART,MEND,IMETA,RMETA,SLC,SCC,SRL,TFR,CFR,CXTY,TTYL,ATNL,LAT,CENC,CURVER,SABIN from MRSAB where ~A='~A'" key-name key)))
-       (destructuring-bind
-	   (vcui rcui vsab rsab son sf sver mstart mend imeta rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc curver sabin) it
-	 (make-instance 'usab :vcui (ensure-integer vcui) 
-			:rcui (ensure-integer rcui)
-			:vsab vsab :rsab rsab :son son :sf sf :sver sver :mstart mstart
-			:mend mend :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))))
+  (with-umlisp-query ('mrsab '(vcui rcui vsab rsab son sf sver mstart mend imeta rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc curver sabin) nil key-name key :single t)
+    (destructuring-bind
+	(vcui rcui vsab rsab son sf sver mstart mend imeta rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc curver sabin) tuple
+      (make-instance 'usab :vcui (ensure-integer vcui) 
+		     :rcui (ensure-integer rcui)
+		     :vsab vsab :rsab rsab :son son :sf sf :sver sver :mstart mstart
+		     :mend mend :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))))
 
 (defun find-usab-rsab (rsab)
   "Find usab for rsab"
@@ -605,21 +424,14 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   (find-usab-by-key "VSAB" vsab))
 
 (defun find-cui-max ()
-  (let ((cui (caar (mutex-sql-query "select max(CUI) from MRCON"))))
-    (ensure-integer cui)))
+  (ensure-integer (caar (mutex-sql-query "select max(CUI) from MRCON"))))
 
 ;;;; Cross table find functions
 
 (defun find-ucon-tui (tui &key (srl *current-srl*))
   "Find list of ucon for tui"
-  (when (stringp tui) (setq tui (parse-tui tui)))
-  (let ((ucons '())
-	(ls (format nil "select CUI from MRSTY where TUI=~d" tui)))
-    (when srl (string-append ls (format nil " and KLRL <= ~d" srl)))
-    (string-append ls " order by cui desc")
-    (dolist (tuple (mutex-sql-query ls))
-      (push (find-ucon-cui (ensure-integer (car tuple)) :srl srl) ucons))
-    ucons))
+  (with-umlisp-query ('mrsty '(cui) srl 'tui (parse-tui tui) :lrlname 'klrl :terminal "order by cui desc")
+    (find-ucon-cui (ensure-integer (car tuple)) :srl srl)))
   
 (defun find-ucon-word (word &key (srl *current-srl*) (like nil))
   "Return list of ucons that match word. Optionally, use SQL's LIKE syntax"
@@ -647,40 +459,25 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 
 (defun find-ustr-word (word &key (srl *current-srl*))
   "Return list of ustrs that match word"
-  (let ((ustrs '())
-	(ls (format nil "select cui,sui from MRXW_ENG where wd='~a'" word)))
-    (when srl (string-append ls (format nil " and KLRL <= ~d" srl)))
-    (string-append ls " order by cui desc,sui desc")
-    (dolist (tuple (mutex-sql-query ls))
-      (destructuring-bind (cui sui) tuple
-	(push (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui)
-				:srl srl)
-	      ustrs)))
-    ustrs))
+  (with-umlisp-query ('mrxw_eng '(cui sui) srl 'wd word
+				:lrlname 'klrl
+				:terminal "order by cui desc, sui desc")
+    (destructuring-bind (cui sui) tuple
+      (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl))))
 
 (defun find-ustr-normalized-word (word &key (srl *current-srl*))
   "Return list of ustrs that match word"
-  (let ((ustrs '())
-	(ls (format nil "select cui,sui from MRXNW_ENG where nwd='~a'" word)))
-    (when srl
-	(string-append ls (format nil " and KLRL <= ~d" srl)))
-    (string-append ls " order by cui desc,sui desc")
-    (dolist (tuple (mutex-sql-query ls))
-      (destructuring-bind (cui sui) tuple
-	(push (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui)
-				:srl srl)
-	      ustrs)))
-    ustrs))
+  (with-umlisp-query ('mrxnw_eng '(cui sui) srl 'nwd word :lrlname 'klrl
+				 :terminal "order by cui desc, sui desc")
+    (destructuring-bind (cui sui) tuple
+      (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) ;srl srl))))
 
 ;; Special tables
 
 (defun find-usrl-all ()
-  (let ((usrls '())
-	(tuples (mutex-sql-query "select SAB,SRL from USRL order by SAB desc")))
-    (dolist (tuple tuples)
-      (destructuring-bind (sab srl) tuple
-	(push (make-instance 'usrl :sab sab :srl (ensure-integer srl)) usrls)))
-    usrls))
+  (with-umlisp-query ('usrl '(sab srl) nil nil nil :terminal "order by sab desc")
+    (destructuring-bind (sab srl) tuple
+      (make-instance 'usrl :sab sab :srl (ensure-integer srl)) usrls)))
 
 ;;; Multiword lookup and score functions
 
@@ -755,219 +552,112 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 ;;; LEX SQL functions
 
 (defun find-lexterm-eui (eui)
-  (awhen (car (mutex-sql-query
-	       (format nil "select WRD from LRWD where EUI=~d" eui)))
-	    (make-instance 'lexterm :eui eui :wrd (car it))))
+  (with-umlisp-query ('lrwd '(wrd) nil 'eui eui :single t)
+    (make-instance 'lexterm :eui eui :wrd (car tuple))))
 
 (defun find-lexterm-word (wrd)
-  (let ((tuples (mutex-sql-query
-		 (format nil "select EUI from LRWD where WRD='~a'" wrd)))
-	(terms '()))
-    (dolist (tuple tuples)
-      (push (make-instance 'lexterm :eui (ensure-integer (car tuple))
-			   :wrd (copy-seq wrd))
-	    terms))
-    (nreverse terms)))
+  (with-umlisp-query ('lrwd '(eui) nil 'wrd wrd)
+    (make-instance 'lexterm :eui (ensure-integer (car tuple))
+		   :wrd (copy-seq wrd))))
 
 ;; LEX SQL Read functions
 
 (defun find-labr-eui (eui)
-  (let ((tuples
-	 (mutex-sql-query 
-	  (format nil "select BAS,ABR,EUI2,BAS2 from LRABR where EUI=~d" eui)))
-	(results '()))
-    (dolist (tuple tuples)
-      (destructuring-bind (bas abr eui2 bas2) tuple
-	(push (make-instance 'labr :eui eui :bas bas :abr abr :bas2 bas2
-			     :eui2 (ensure-integer eui2))
-	      results)))
-    (nreverse results)))
+  (with-umlisp-query ('lrabr '(bas abr eui2 bas2) nil 'eui eui) 
+    (destructuring-bind (bas abr eui2 bas2) tuple
+      (make-instance 'labr :eui eui :bas bas :abr abr :bas2 bas2
+		     :eui2 (ensure-integer eui2)))))
 
 (defun find-labr-bas (bas)
-  (let ((tuples
-	 (mutex-sql-query 
-	  (format nil "select EUI,ABR,EUI2,BAS2 from LRABR where BAS='~a'"
-		  bas)))
-	(results '()))
-    (dolist (tuple tuples)
-      (destructuring-bind (eui abr eui2 bas2) tuple 
-	(push
-	 (make-instance 'labr :eui (ensure-integer eui) :abr abr :bas2 bas2
-			:bas (copy-seq bas) :eui2 (ensure-integer eui2))
-	 results)))
-    (nreverse results)))
+  (with-umlisp-query ('labr '(eui abr eui2 bas2) nil 'bas bas)
+    (destructuring-bind (eui abr eui2 bas2) tuple 
+      (make-instance 'labr :eui (ensure-integer eui) :abr abr :bas2 bas2
+		     :bas (copy-seq bas) :eui2 (ensure-integer eui2)))))
 
 (defun find-lagr-eui (eui)
-  (let ((tuples
-	 (mutex-sql-query 
-	  (format nil "select STR,SCA,AGR,CIT,BAS from LRAGR where EUI=~d" eui)))
-	(results '()))
-    (dolist (tuple tuples)
-      (destructuring-bind (str sca agr cit bas) tuple
-	(push (make-instance 'lagr :eui eui :str str :sca sca :agr agr 
-			     :cit cit :bas bas)
-	      results)))
-    (nreverse results)))
+  (with-umlisp-query ('lragr '(str sca agr cit bas) nil 'eui eui)
+    (destructuring-bind (str sca agr cit bas) tuple
+      (make-instance 'lagr :eui eui :str str :sca sca :agr agr
+		     :cit cit :bas bas))))
 
 (defun find-lcmp-eui (eui)
-  (let ((tuples (mutex-sql-query 
-		 (format nil "select BAS,SCA,COM from LRCMP where EUI=~d" eui)))
-	(results '()))
-    (dolist (tuple tuples)
-      (destructuring-bind (bas sca com) tuple
-	(push (make-instance 'lcmp :eui eui :bas bas :sca sca :com com)
-	      results)))
-    (nreverse results)))
+  (with-umlisp-query ('lrcmp '(bas sca com) nil 'eui eui)
+    (destructuring-bind (bas sca com) tuple
+      (make-instance 'lcmp :eui eui :bas bas :sca sca :com com))))
 
 (defun find-lmod-eui (eui)
-  (let ((tuples
-	 (mutex-sql-query 
-	  (format nil
-		  "select BAS,SCA,PSN_MOD,FEA from LRMOD where EUI=~d" eui)))
-	(results '()))
-    (dolist (tuple tuples)
-      (destructuring-bind (bas sca psnmod fea) tuple
-	(push (make-instance 'lmod :eui eui :bas bas :sca sca :psnmod psnmod
-			     :fea fea)
-	      results)))
-    (nreverse results)))
+  (with-umlisp-query ('lrmod '(bas sca psn_mod fea) nil 'eui eui)
+    (destructuring-bind (bas sca psnmod fea) tuple
+      (make-instance 'lmod :eui eui :bas bas :sca sca :psnmod psnmod :fea fea))))
 
 (defun find-lnom-eui (eui)
-  (let ((tuples
-	 (mutex-sql-query 
-	  (format
-	   nil "select BAS,SCA,EUI2,BAS2,SCA2 from LRNOM where EUI=~d" eui)))
-	(results '()))
-    (dolist (tuple tuples)
+  (with-umlisp-query ('lrnom '(bas sca eui2 bas2 sca2) nil 'eui eui)
       (destructuring-bind (bas sca eui2 bas2 sca2) tuple
-	(push
-	 (make-instance 'lnom :eui eui :bas bas :sca sca :bas2 bas2 :sca2 sca2
-			:eui2 (ensure-integer eui2))
-	 results)))
-    (nreverse results)))
+	(make-instance 'lnom :eui eui :bas bas :sca sca :bas2 bas2 :sca2 sca2
+		       :eui2 (ensure-integer eui2)))))
 
 (defun find-lprn-eui (eui)
-  (let ((tuples
-	 (mutex-sql-query 
-	  (format
-	   nil
-	   "select BAS,NUM,GND,CAS,POS,QNT,FEA from LRPRN where EUI=~d" eui)))
-	(results '()))
-    (dolist (tuple tuples)
-      (destructuring-bind (bas num gnd cas pos qnt fea) tuple
-	(push (make-instance 'lprn :eui eui :bas bas :num num :gnd gnd
-			     :cas cas :pos pos :qnt qnt :fea fea)
-	      results)))
-    (nreverse results)))
+  (with-umlisp-query ('lrprn '(bas num gnd cas pos qnt fea) nil 'eui eui)
+    (destructuring-bind (bas num gnd cas pos qnt fea) tuple
+      (make-instance 'lprn :eui eui :bas bas :num num :gnd gnd
+		     :cas cas :pos pos :qnt qnt :fea fea))))
 
 (defun find-lprp-eui (eui)
-  (let ((tuples
-	 (mutex-sql-query 
-	  (format nil "select BAS,STR,SCA,FEA from LRPRP where EUI=~d" eui)))
-	(results '()))
-    (dolist (tuple tuples)
-      (destructuring-bind (bas str sca fea) tuple
-	(push
-	 (make-instance 'lprp :eui eui :bas bas :str str :sca sca :fea fea)
-	 results)))
-    (nreverse results)))
+  (with-umlisp-query ('lrprp '(bas str sca fea) nil 'eui eui)
+    (destructuring-bind (bas str sca fea) tuple
+      (make-instance 'lprp :eui eui :bas bas :str str :sca sca :fea fea))))
 
 (defun find-lspl-eui (eui)
-  (let ((tuples (mutex-sql-query 
-		 (format nil "select SPV,BAS from LRSPL where EUI=~d" eui)))
-	(results '()))
-    (dolist (tuple tuples)
-      (destructuring-bind (spv bas) tuple
-	(push (make-instance 'lspl :eui eui :spv spv :bas bas) results)))
-    (nreverse results)))
+  (with-umlisp-query ('lrspl '(spv bas) nil 'eui eui)
+    (destructuring-bind (spv bas) tuple
+      (make-instance 'lspl :eui eui :spv spv :bas bas))))
 
 (defun find-ltrm-eui (eui)
-  (let ((tuples (mutex-sql-query 
-		 (format nil "select BAS,GEN from LRTRM where EUI=~d" eui)))
-	(results '()))
-    (dolist (tuple tuples)
-      (destructuring-bind (bas gen) tuple
-	(push (make-instance 'ltrm :eui eui :bas bas :gen gen) results)))
-    (nreverse results)))
+  (with-umlisp-query ('lrtrm '(bas gen) nil 'eui eui) 
+    (make-instance 'ltrm :eui eui :bas bas :gen gen)))
 
 (defun find-ltyp-eui (eui)
-  (let ((tuples (mutex-sql-query 
-		 (format nil "select BAS,SCA,TYP from LRTYP where EUI=~d" eui)))
-	(results '()))
-    (dolist (tuple tuples)
-      (destructuring-bind (bas sca typ) tuple
-	  (push (make-instance 'ltyp :eui eui :bas bas :sca sca :typ typ)
-		results)))
-    (nreverse results)))
+  (with-umlisp-query ('lrtyp '(bas sca typ) nil 'eui eui)
+    (destructuring-bind (bas sca typ) tuple
+      (make-instance 'ltyp :eui eui :bas bas :sca sca :typ typ))))
 
 (defun find-lwd-wrd (wrd)
-  (let ((tuples (mutex-sql-query 
-		 (format nil "select EUI from LRWD where WRD='~a'" wrd)))
-	(results '()))
-    (dolist (tuple tuples)
-      (push (ensure-integer (car tuple)) results))
-    (make-instance 'lwd :wrd wrd :euilist (nreverse results))))
+  (make-instance 'lwd :wrd
+		 :euilist (with-umlisp-query ('lrwd '(eui) nil 'wrd wrd)
+			    (ensure-integer (car tuple)))))
 
 ;;; Semantic Network SQL access functions
  
 (defun find-sdef-ui (ui)
-  (awhen (car (mutex-sql-query 
-		  (format nil "select RT,STY_RL,STN_RTN,DEF,EX,UN,RH,ABR,RIN from SRDEF where UI=~d" ui)))
-	 (destructuring-bind (rt styrl stnrtn def ex un rh abr rin) it
-	   (make-instance 'sdef :rt rt :ui ui :styrl styrl :stnrtn stnrtn
-			   :def def :ex ex :un un :rh rh :abr abr :rin rin))))
+  (with-umlisp-query ('srdef '(rt sty_rl stn_rtn def ex un rh abr rin)
+			     nil 'ui ui :single t)
+    (destructuring-bind (rt styrl stnrtn def ex un rh abr rin) tuple
+      (make-instance 'sdef :rt rt :ui ui :styrl styrl :stnrtn stnrtn
+		     :def def :ex ex :un un :rh rh :abr abr :rin rin))))
 
 (defun find-sstre1-ui (ui)
-  (let ((tuples (mutex-sql-query 
-		 (format nil "select UI2,UI3 from SRSTRE1 where UI=~d" ui)))
-	(results '()))
-    (dolist (tuple tuples)
-      (destructuring-bind (ui2 ui3) tuple
-	(push (make-instance 'sstre1 :ui ui :ui2 (ensure-integer ui2)
-			     :ui3 (ensure-integer ui3))
-	      results)))
-    (nreverse results)))
+  (with-umlisp-query ('srstre1 '(ui2 ui3) nil 'ui ui)
+    (destructuring-bind (ui2 ui3) tuple
+      (make-instance 'sstre1 :ui ui :ui2 (ensure-integer ui2)
+		     :ui3 (ensure-integer ui3)))))
 
 (defun find-sstre1-ui2 (ui2)
-  (let ((tuples (mutex-sql-query 
-		 (format nil "select UI,UI3 from SRSTRE1 where UI2=~d" ui2)))
-	(results '()))
-    (dolist (tuple tuples)
-      (destructuring-bind (ui ui3) tuple
-	(push (make-instance 'sstre1 :ui (ensure-integer ui) :ui2 ui2
-			     :ui3 (ensure-integer ui3))
-	      results)))
-    (nreverse results)))
+  (with-umlisp-query ('srstre1 '(ui ui3) nil 'ui2 ui2)
+    (destructuring-bind (ui ui3) tuple
+      (make-instance 'sstre1 :ui (ensure-integer ui) :ui2 ui2
+		     :ui3 (ensure-integer ui3)))))
 
 (defun find-sstr-rl (rl)
-  (let ((tuples
-	 (mutex-sql-query 
-	  (format nil "select STY_RL,STY_RL2,LS from SRSTRE where RL='~a'" rl)))
-	(results '()))
-    (dolist (tuple tuples)
-      (destructuring-bind (styrl styrl2 ls) tuple
-	(push (make-instance 'sstr :rl rl :styrl styrl :styrl2 styrl2 :ls ls)
-	      results)))
-    (nreverse results)))
-
+  (with-umlisp-query ('srstre '(sty_rl sty_rl2 ls) nil 'rl rl)
+    (destructuring-bind (styrl styrl2 ls) tuple
+      (make-instance 'sstr :rl rl :styrl styrl :styrl2 styrl2 :ls ls))))
 
 (defun find-sstre2-sty (sty)
-  (let ((tuples (mutex-sql-query 
-		 (format nil "select RL,STY2 from SRSTRE2 where STY='~a'" sty)))
-	(results '()))
-    (dolist (tuple tuples)
-      (destructuring-bind (rl sty2) tuple
-	(push (make-instance 'sstre2 :sty (copy-seq sty) :rl rl :sty2 sty2)
-	      results)))
-    (nreverse results)))
+  (with-umlisp-query ('srstre2 '(rl sty2) nil 'sty sty)
+    (destructuring-bind (rl sty2) tuple
+      (make-instance 'sstre2 :sty (copy-seq sty) :rl rl :sty2 sty2))))
 
 (defun find-sstr-styrl (styrl)
-  (let ((tuples
-	 (mutex-sql-query 
-	  (format nil "select RL,STY_RL2,LS from SRSTR where RL='~a'" styrl)))
-	(results '()))
-    (dolist (tuple tuples)
-      (destructuring-bind (rl styrl2 ls) tuple
-      (push (make-instance 'sstr :styrl styrl :rl rl :styrl2 styrl2 :ls ls)
-	    results)))
-    (nreverse results)))
+  (with-umlisp-query ('srstr '(rl sty_rl2 ls) nil 'styrl styrl)
+    (destructuring-bind (rl styrl2 ls) tuple
+      (make-instance 'sstr :styrl styrl :rl rl :styrl2 styrl2 :ls ls))))
-- 
2.34.1