sql-classes.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          sql-classes.lisp
   6 ;;;; Purpose:       Routines for reading UMLS objects from SQL database
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Apr 2000
   9 ;;;;
  10 ;;;; $Id: sql-classes.lisp,v 1.10 2002/11/12 18:05:00 kevin Exp $
  11 ;;;;
  12 ;;;; This file, part of UMLisp, is
  13 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
  14 ;;;;
  15 ;;;; UMLisp users are granted the rights to distribute and use this software
  16 ;;;; as governed by the terms of the GNU General Public License.
  17 ;;;; *************************************************************************
  18
  19 (in-package :umlisp)
  20 (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3)))
  21
  22
  23 (defvar *current-srl* nil)
  24 (defun current-srl ()
  25   *current-srl*)
  26 (defun current-srl! (srl)
  27   (setq *current-srl* srl))
  28
  29
  30 ;;; Accessors (read on demand)
  31
  32 ;; defines a slot-unbound method for class and slot-name, fills
  33 ;; the slot by calling reader function with the slot values of
  34 ;; the instance's reader-keys
  35 (defmacro def-lazy-reader (class slot-name reader &rest reader-keys)
  36   (let* ((the-slot-name (gensym))
  37          (the-class (gensym))
  38          (the-instance (gensym))
  39          (keys '()))
  40     (dolist (key reader-keys)
  41       (push (list 'slot-value the-instance (list 'quote key)) keys))
  42     (setq keys (nreverse keys))
  43     `(defmethod slot-unbound (,the-class (,the-instance ,class)
  44                                          (,the-slot-name (eql ',slot-name)))
  45        (declare (ignore ,the-class))
  46        (setf (slot-value ,the-instance ,the-slot-name)
  47            (,reader ,@keys)))))
  48
  49 (def-lazy-reader ucon s#term find-uterm-cui cui)
  50 (def-lazy-reader ucon s#def find-udef-cui cui)
  51 (def-lazy-reader ucon s#sty find-usty-cui cui)
  52 (def-lazy-reader ucon s#rel find-urel-cui cui)
  53 (def-lazy-reader ucon s#coc find-ucoc-cui cui)
  54 (def-lazy-reader ucon s#lo find-ulo-cui cui)
  55 (def-lazy-reader ucon s#atx find-uatx-cui cui)
  56 (def-lazy-reader ucon s#sat find-usat-ui cui)
  57
  58 ;; For uterms
  59 (def-lazy-reader uterm s#str find-ustr-cuilui cui lui)
  60 (def-lazy-reader uterm s#sat find-usat-ui cui lui)
  61
  62 ;; For ustrs
  63 (def-lazy-reader ustr s#sat find-usat-ui cui lui sui)
  64 (def-lazy-reader ustr s#cxt find-ucxt-cuisui cui sui)
  65 (def-lazy-reader ustr s#so find-uso-cuisui cui sui)
  66
  67 ;;; Object lookups
  68
  69 ;;; Lookup functions for uterms,ustr in ucons
  70
  71 (defun find-uterm-in-ucon (ucon lui)
  72   (find lui (s#term ucon) :key #'lui :test 'equal))
  73
  74 (defun find-ustr-in-uterm (uterm sui)
  75   (find sui (s#str uterm) :key #'sui :test 'equal))
  76
  77 (defun find-ustr-in-ucon (ucon sui)
  78   (let ((found-ustr nil))
  79     (dolist (uterm (s#term ucon))
  80       (unless found-ustr
  81         (dolist (ustr (s#str uterm))
  82           (unless found-ustr
  83             (when (string-equal sui (sui ustr))
  84               (setq found-ustr ustr))))))
  85     found-ustr))
  86
  87
  88 (defun find-ucon-cui (cui &key (srl *current-srl*))
  89   "Find ucon for a cui"
  90   (if (stringp cui)
  91       (setq cui (parse-cui cui)))
  92   (if cui
  93       (let ((ls (format nil "select KPFSTR,KCUILRL from MRCON where CUI=~d"
  94                         cui)))
  95         (if srl
  96             (string-append ls (format nil " and KCUILRL <= ~d limit 1" srl))
  97           (string-append ls " limit 1"))
  98         (kmrcl:awhen (car (mutex-sql-query ls))
  99                   (make-instance 'ucon :cui cui :pfstr (car kmrcl::it)
 100                                  :lrl (ensure-integer (cadr kmrcl::it)))))
 101     nil))
 102
 103 (defun find-ucon-lui (lui &key (srl *current-srl*))
 104   "Find list of ucon for lui"
 105   (if (stringp lui)
 106       (setq lui (parse-lui lui)))
 107   (if lui
 108       (let ((ucons '())
 109             (ls (format nil "select distinct CUI,KPFSTR,KCUILRL from MRCON where LUI=~d" lui)))
 110         (if srl
 111             (string-append ls (format nil " and KCUILRL <= ~d" srl)))
 112         (dolist (tuple (mutex-sql-query ls))
 113           (push (make-instance 'ucon :cui (ensure-integer (nth 0 tuple))
 114                                :pfstr (nth 1 tuple)
 115                                :lrl (ensure-integer (nth 2 tuple)))
 116                 ucons))
 117         (nreverse ucons))
 118     nil))
 119
 120 (defun find-ucon-sui (sui &key (srl *current-srl*))
 121   "Find list of ucon for sui"
 122   (if (stringp sui)
 123       (setq sui (parse-sui sui)))
 124   (if sui
 125       (let ((ucons '())
 126             (ls (format nil "select distinct CUI,KPFSTR,KCUILRL from MRCON where SUI=~d" sui)))
 127         (when srl
 128             (string-append ls (format nil " and KCUILRL <= ~d" srl)))
 129         (let ((tuples (mutex-sql-query ls)))
 130           (dolist (tuple tuples)
 131             (push (make-instance 'ucon :cui (ensure-integer (nth 0 tuple))
 132                                  :pfstr (nth 1 tuple)
 133                                  :lrl (ensure-integer (nth 2 tuple)))
 134                   ucons)))
 135     (nreverse ucons))
 136   nil))
 137
 138 (defun find-ucon-cuisui (cui sui &key (srl *current-srl*))
 139   "Find ucon for cui/sui"
 140   (if (stringp cui)
 141       (setq cui (parse-cui cui)))
 142   (if (stringp sui)
 143       (setq sui (parse-sui sui)))
 144   (if (and cui sui)
 145       (let ((ls (format nil "select distinct CUI,KPFSTR,KCUILRL from MRCON where KCUISUI=~d"
 146                         (make-cuisui cui sui))))
 147         (when srl
 148             (string-append ls (format nil " and KCUILRL <= ~d" srl)))
 149         (kmrcl:aif (car (mutex-sql-query ls))
 150              (make-instance 'ucon :cui (ensure-integer (nth 0 kmrcl::it))
 151                             :pfstr (nth 1 kmrcl::it)
 152                             :lrl (ensure-integer (nth 2 kmrcl::it)))
 153              nil))
 154     nil))
 155
 156 (defun find-ucon-str (str &key (srl *current-srl*))
 157   "Find ucon that are exact match for str"
 158   (if str
 159       (let ((ucons '())
 160             (ls (format nil "select distinct CUI,KPFSTR,KCUILRL from MRCON where STR='~a'" str)))
 161         (when srl
 162             (string-append ls " and KCUILRL <= ~d" srl))
 163         (dolist (tuple (mutex-sql-query ls))
 164           (push (make-instance 'ucon :cui (ensure-integer (nth 0 tuple))
 165                                :pfstr (nth 1 tuple)
 166                                :lrl (ensure-integer (nth 2 tuple))) ucons))
 167         (nreverse ucons))
 168     nil))
 169
 170 (defun find-ucon-all (&key (srl *current-srl*))
 171   "Return list of all ucon's"
 172   (let ((ls "select distinct CUI,KPFSTR,KCUILRL from MRCON"))
 173     (when srl
 174       (string-append ls (format nil " where KCUILRL <= ~d" srl)))
 175     (string-append ls " order by CUI asc")
 176     (with-sql-connection (db)
 177       (clsql:map-query
 178        'list
 179        #'(lambda (cui pfstr cuilrl)
 180            (make-instance 'ucon :cui (ensure-integer cui)
 181                           :pfstr pfstr
 182                           :lrl (ensure-integer cuilrl)))
 183        ls
 184        :database db))))
 185
 186 (defun map-ucon-all (fn &key (srl *current-srl*))
 187   "Return list of all ucon's"
 188   (let ((ls "select distinct CUI,KPFSTR,KCUILRL from MRCON"))
 189     (when srl
 190       (string-append ls (format nil " where KCUILRL <= ~d" srl)))
 191     (string-append ls " order by CUI asc")
 192     (with-sql-connection (db)
 193       (clsql:map-query
 194        nil
 195        #'(lambda (cui pfstr cuilrl)
 196            (funcall fn
 197                     (make-instance 'ucon :cui (ensure-integer cui)
 198                                    :pfstr pfstr
 199                                    :lrl (ensure-integer cuilrl))))
 200        ls
 201        :database db))))
 202
 203
 204 (defun find-udef-cui (cui &key (srl *current-srl*))
 205   "Return a list of udefs for cui"
 206   (let ((udefs '())
 207         (ls (format nil "select SAB,DEF from MRDEF where CUI=~d" cui)))
 208     (when srl
 209         (string-append ls (format nil " and KSRL <= ~d" srl)))
 210     (dolist (tuple (mutex-sql-query ls))
 211       (push (make-instance 'udef :sab (car tuple) :def (cadr tuple)) udefs))
 212     (nreverse udefs)))
 213
 214 (defun find-usty-cui (cui &key (srl *current-srl*))
 215   "Return a list of usty for cui"
 216   (let ((ustys '())
 217         (ls (format nil "select TUI,STY from MRSTY where CUI=~d" cui)))
 218     (when srl
 219         (string-append ls (format nil " and KLRL <= ~d" srl)))
 220     (dolist (tuple (mutex-sql-query ls))
 221       (push (make-instance 'usty :tui (ensure-integer (car tuple)) :sty (cadr tuple)) ustys))
 222     ustys))
 223
 224 (defun find-usty-word (word &key (srl *current-srl*))
 225   "Return a list of usty that match word"
 226   (let ((ustys '())
 227         (ls (format nil "select distinct TUI,STY from MRSTY where STY like '%~a%'" word)))
 228     (when srl
 229         (string-append ls (format nil " and KLRL <= ~d" srl)))
 230     (dolist (tuple (mutex-sql-query ls))
 231       (push (make-instance 'usty :tui (ensure-integer (car tuple)) :sty (cadr tuple)) ustys))
 232     ustys))
 233
 234 (defun find-urel-cui (cui &key (srl *current-srl*))
 235   "Return a list of urel for cui"
 236   (let ((urels '())
 237         (ls (format nil "select REL,CUI2,RELA,SAB,SL,MG,KPFSTR2 from MRREL where CUI1=~d" cui)))
 238     (when srl
 239         (string-append ls (format nil " and KSRL <= ~d" srl)))
 240     (dolist (tuple (mutex-sql-query ls))
 241       (push (make-instance 'urel
 242               :cui1 cui
 243               :rel (nth 0 tuple)
 244               :cui2 (ensure-integer (nth 1 tuple))
 245               :rela (nth 2 tuple)
 246               :sab (nth 3 tuple)
 247               :sl (nth 4 tuple)
 248               :mg (nth 5 tuple)
 249               :pfstr2 (nth 6 tuple))
 250             urels))
 251     (nreverse urels)))
 252
 253 (defun find-urel-cui2 (cui2 &key (srl *current-srl*))
 254   "Return a list of urel for cui2"
 255   (let ((urels '())
 256         (ls (format nil "select REL,CUI1,RELA,SAB,SL,MG,KPFSTR2 from MRREL where CUI2=~d" cui2)))
 257     (when srl
 258         (string-append ls (format nil " and SRL <= ~d" srl)))
 259     (dolist (tuple (mutex-sql-query ls))
 260       (push (make-instance 'urel
 261               :cui2 cui2
 262               :rel (nth 0 tuple)
 263               :cui1 (ensure-integer (nth 1 tuple))
 264               :rela (nth 2 tuple)
 265               :sab (nth 3 tuple)
 266               :sl (nth 4 tuple)
 267               :mg (nth 5 tuple)
 268               :pfstr2 (nth 6 tuple))
 269             urels))
 270     (nreverse urels)))
 271
 272 (defun find-ucon-rel-cui2 (cui2 &key (srl *current-srl*))
 273   (mapcar
 274    #'(lambda (cui) (find-ucon-cui cui :srl srl))
 275    (remove-duplicates (mapcar #'cui1 (find-urel-cui2 cui2 :srl srl)))))
 276
 277 (defun find-ucoc-cui (cui &key (srl *current-srl*))
 278   "Return a list of ucoc for cui"
 279   (let ((ucocs '())
 280         (ls (format nil "select CUI2,SOC,COT,COF,COA,KPFSTR2 from MRCOC where CUI1=~d" cui)))
 281     (when srl
 282         (string-append ls (format nil " and KLRL <= ~d" srl)))
 283     (string-append ls " order by COF asc")
 284     (dolist (tuple (mutex-sql-query ls))
 285       (let ((cui2 (ensure-integer (nth 0 tuple))))
 286         (when (zerop cui2)
 287           (setq cui2 nil))
 288         (push (make-instance 'ucoc :cui1 cui
 289                              :cui2 cui2
 290                              :soc (nth 1 tuple)
 291                              :cot (nth 2 tuple)
 292                              :cof (ensure-integer (nth 3 tuple))
 293                              :coa (nth 4 tuple)
 294                              :pfstr2 (nth 5 tuple))
 295               ucocs)))
 296     ucocs)) ;; akready ordered by SQL select
 297
 298 (defun find-ucoc-cui2 (cui2 &key (srl *current-srl*))
 299   "Return a list of ucoc for cui2"
 300   (let ((ucocs '())
 301         (ls (format nil "select CUI1,SOC,COT,COF,COA,KPFSTR2 from MRCOC where CUI2=~d" cui2)))
 302     (when srl
 303         (string-append ls (format nil " and KSRL <= ~d" srl)))
 304     (string-append ls " order by COF asc")
 305     (dolist (tuple (mutex-sql-query ls))
 306       (push (make-instance 'ucoc :cui1 (ensure-integer (nth 0 tuple))
 307                            :cui2 cui2
 308                            :soc (nth 1 tuple)
 309                            :cot (nth 2 tuple)
 310                            :cof (ensure-integer (nth 3 tuple))
 311                            :coa (nth 4 tuple)
 312                            :pfstr2 (nth 5 tuple))
 313             ucocs))
 314     ucocs)) ;; already ordered by SQL select
 315
 316 (defun find-ucon-coc-cui2 (cui2 &key (srl *current-srl*))
 317   "List of ucon with co-occurance cui2"
 318   (mapcar
 319    #'(lambda (cui) (find-ucon-cui cui :srl srl))
 320    (remove-duplicates (mapcar #'cui1 (find-ucoc-cui2 cui2 :srl srl)))))
 321
 322 (defun find-ulo-cui (cui &key (srl *current-srl*))
 323   "Return a list of ulo for cui"
 324   (let ((ulos '())
 325         (ls (format nil "select ISN,FR,UN,SUI,SNA,SOUI from MRLO where CUI=~d" cui)))
 326     (when srl
 327         (string-append ls (format nil " and KLRL <= ~d" srl)))
 328     (dolist (tuple (mutex-sql-query ls))
 329       (push (make-instance 'ulo :isn (nth 0 tuple)
 330                            :fr (ensure-integer (nth 1 tuple))
 331                            :un (nth 2 tuple)
 332                            :sui (ensure-integer (nth 3 tuple))
 333                            :sna (nth 4 tuple)
 334                            :soui (nth 5 tuple))
 335             ulos))
 336     (nreverse ulos)))
 337
 338 (defgeneric suistr (lo))
 339 (defmethod suistr ((lo ulo))
 340   "Return the string for a ulo object"
 341   (find-string-sui (sui lo)))
 342
 343 (defun find-uatx-cui (cui &key (srl *current-srl*))
 344   "Return a list of uatx for cui"
 345   (let ((uatxs '())
 346         (ls (format nil "select SAB,REL,ATX from MRATX where CUI=~d" cui)))
 347     (when srl
 348         (string-append ls (format nil " and KSRL <= ~d" srl)))
 349     (dolist (tuple (mutex-sql-query ls))
 350       (push (make-instance 'uatx :sab (nth 0 tuple)
 351                            :rel (nth 1 tuple)
 352                            :atx (nth 2 tuple))
 353             uatxs))
 354     (nreverse uatxs)))
 355
 356
 357 (defun find-uterm-cui (cui &key (srl *current-srl*))
 358   "Return a list of uterm for cui"
 359   (let ((uterms '())
 360         (ls (format nil "select distinct LUI,LAT,TS,KLUILRL from MRCON where CUI=~d" cui)))
 361     (when srl
 362         (string-append ls (format nil " and KLUILRL <= ~d" srl)))
 363     (dolist (tuple (mutex-sql-query ls))
 364       (push (make-instance 'uterm :lui (ensure-integer (nth 0 tuple))
 365                            :cui cui
 366                            :lat (nth 1 tuple)
 367                            :ts (nth 2 tuple)
 368                            :lrl (ensure-integer (nth 3 tuple)))
 369         uterms))
 370     (nreverse uterms)))
 371
 372 (defun find-uterm-lui (lui &key (srl *current-srl*))
 373   "Return a list of uterm for lui"
 374   (if (stringp lui)
 375       (setq lui (parse-lui lui)))
 376   (let ((uterms '())
 377         (ls (format nil "select distinct CUI,LAT,TS,KLUILRL from MRCON where LUI=~d" lui)))
 378     (when srl
 379         (string-append ls (format nil " and KLUILRL <= ~d" srl)))
 380     (dolist (tuple (mutex-sql-query ls))
 381       (push (make-instance 'uterm :cui (ensure-integer (nth 0 tuple))
 382                            :lui lui
 383                            :lat (nth 1 tuple)
 384                            :ts (nth 2 tuple)
 385                            :lrl (ensure-integer (nth 3 tuple)))
 386             uterms))
 387     (nreverse uterms)))
 388
 389 (defun find-uterm-cuilui (cui lui &key (srl *current-srl*))
 390   "Return single uterm for cui/lui"
 391   (let ((ls (format nil "select LAT,TS,KLUILRL from MRCON where KCUILUI=~d limit 1" (make-cuilui cui lui))))
 392     (when srl
 393         (string-append ls (format nil " and KLUILRL <= ~d" srl)))
 394     (kmrcl:aif (car (mutex-sql-query ls))
 395          (make-instance 'uterm :cui cui
 396                         :lui lui
 397                         :lat (nth 0 kmrcl::it)
 398                        :ts (nth 1 kmrcl::it)
 399                        :lrl (ensure-integer (nth 2 kmrcl::it)))
 400          nil)))
 401
 402 (defun find-ustr-cuilui (cui lui &key (srl *current-srl*))
 403   "Return a list of ustr for cui/lui"
 404   (declare (fixnum cui lui))
 405   (let ((ustrs '())
 406         (ls (format nil "select SUI,STT,STR,LRL from MRCON where KCUILUI=~d" (make-cuilui cui lui))))
 407     (when srl
 408         (string-append ls (format nil " and LRL <= ~d" srl)))
 409     (dolist (tuple (mutex-sql-query ls))
 410       (let* ((sui (ensure-integer (car tuple)))
 411              (ustr (make-instance 'ustr :sui sui
 412                                   :cui cui
 413                                   :cuisui (make-cuisui cui sui)
 414                                   :lui lui
 415                                   :stt (nth 1 tuple)
 416                                   :str (nth 2 tuple)
 417                                   :lrl (ensure-integer (nth 3 tuple)))))
 418         (push ustr ustrs)))
 419     (nreverse ustrs)))
 420
 421 (defun find-ustr-cuisui (cui sui &key (srl *current-srl*))
 422   "Return the single ustr for cuisui"
 423   (let ((ls (format nil "select LUI,STT,STR,LRL from MRCON where KCUISUI=~d"
 424                     (make-cuisui cui sui))))
 425     (when srl
 426         (string-append ls (format nil " and LRL <= ~d" srl)))
 427     (kmrcl:aif (car (mutex-sql-query ls))
 428          (make-instance 'ustr :sui sui
 429                         :cui cui
 430                         :cuisui (make-cuisui cui sui)
 431                         :lui (ensure-integer (nth 0 kmrcl::it))
 432                         :stt (nth 1 kmrcl::it)
 433                         :str (nth 2 kmrcl::it)
 434                         :lrl (ensure-integer (nth 3 kmrcl::it)))
 435          nil)))
 436
 437 (defun find-ustr-sui (sui &key (srl *current-srl*))
 438   "Return the list of ustr for sui"
 439   (if (stringp sui)
 440       (setq sui (parse-sui sui)))
 441   (let ((ustrs '())
 442         (ls (format nil "select CUI,LUI,STT,STR,LRL from MRCON where SUI=~d" sui)))
 443     (when srl
 444         (string-append ls (format nil " and LRL <= ~d" srl)))
 445     (dolist (tuple (mutex-sql-query ls))
 446       (let ((cui (ensure-integer (car tuple))))
 447         (push (make-instance 'ustr :sui sui
 448                              :cui cui
 449                              :cuisui (make-cuisui cui sui)
 450                              :lui (ensure-integer (nth 1 tuple))
 451                              :stt (nth 2 tuple)
 452                              :str (nth 3 tuple)
 453                              :lrl (ensure-integer (nth 4 tuple)))
 454         ustrs)))
 455     (nreverse ustrs)))
 456
 457 (defun find-ustr-sab (sab &key (srl *current-srl*))
 458   "Return the list of ustr for sab"
 459   (let ((ustrs '())
 460         (ls (format nil "select KCUISUI from MRSO where SAB='~a'" sab)))
 461     (when srl
 462         (string-append ls (format nil " and SRL <= ~d" srl)))
 463     (dolist (tuple (mutex-sql-query ls))
 464       (let ((cuisui (ensure-integer (car tuple))))
 465         (push (apply #'find-ustr-cuisui
 466                      (append
 467                       (multiple-value-list (decompose-cuisui cuisui))
 468                       (list :srl srl)))
 469               ustrs)))
 470     (nreverse ustrs)))
 471
 472 (defun find-ustr-all (&key (srl *current-srl*))
 473   "Return list of all ustr's"
 474   (let ((ls "select distinct CUI,LUI,SUI,STT,LRL,KPFSTR from MRCON"))
 475     (when srl
 476       (string-append ls (format nil " where LRL <= ~d" srl)))
 477     (string-append ls " order by SUI asc")
 478     (with-sql-connection (db)
 479       (clsql:map-query
 480        'list
 481        #'(lambda (cui lui sui stt lrl pfstr)
 482            (setq cui (ensure-integer cui))
 483            (setq lui (ensure-integer lui))
 484            (setq sui (ensure-integer sui))
 485            (setq lrl (ensure-integer lrl))
 486            (make-instance 'ustr :cui cui
 487                           :lui lui
 488                           :sui sui
 489                           :cuisui (make-cuisui cui sui)
 490                           :stt stt
 491                           :lrl lrl
 492                           :str pfstr))
 493        ls
 494        :database db))))
 495
 496 (defun find-string-sui (sui &key (srl *current-srl*))
 497   "Return the string associated with sui"
 498   (let ((ls (format nil "select STR from MRCON where SUI=~d" sui)))
 499     (when srl
 500       (string-append ls (format nil " and LRL <= ~d" srl)))
 501     (string-append ls " limit 1")
 502     (caar (mutex-sql-query ls))))
 503
 504 (defun find-uso-cuisui (cui sui &key (srl *current-srl*))
 505   (declare (fixnum cui sui))
 506   (let ((usos '())
 507         (ls (format nil "select SAB,CODE,SRL,TTY from MRSO where KCUISUI=~d"
 508                     (make-cuisui cui sui))))
 509     (when srl
 510         (string-append ls (format nil " and SRL <= ~d" srl)))
 511     (dolist (tuple (mutex-sql-query ls))
 512       (push (make-instance 'uso :sab (nth 0 tuple) :code (nth 1 tuple)
 513                            :srl (nth 2 tuple) :tty (nth 3 tuple))
 514             usos))
 515     (nreverse usos)))
 516
 517 (defun find-ucxt-cuisui (cui sui &key (srl *current-srl*))
 518   (declare (fixnum cui sui))
 519   (let ((ucxts '())
 520         (ls (format nil "select SAB,CODE,CXN,CXL,RNK,CXS,CUI2,HCD,RELA,XC from MRCXT where KCUISUI=~d"
 521                     (make-cuisui cui sui))))
 522     (when srl
 523         (string-append ls (format nil " and KSRL <= ~d" srl)))
 524     (dolist (tuple (mutex-sql-query ls))
 525       (push (make-instance 'ucxt :sab (nth 0 tuple)
 526                            :code (nth 1 tuple)
 527                            :cxn (ensure-integer (nth 2 tuple))
 528                            :cxl (nth 3 tuple)
 529                            :rnk (ensure-integer (nth 4 tuple))
 530                            :cxs (nth 5 tuple)
 531                            :cui2 (ensure-integer (nth 6 tuple))
 532                            :hcd (nth 7 tuple)
 533                            :rela (nth 8 tuple)
 534                            :xc (nth 9 tuple))
 535             ucxts))
 536     (nreverse ucxts)))
 537
 538 (defun find-usat-ui (cui &optional (lui nil) (sui nil) &key (srl *current-srl*))
 539   (let ((ls (format nil "select CODE,ATN,SAB,ATV from MRSAT where ")))
 540     (cond
 541      (sui (string-append ls (format nil "KCUISUI=~d" (make-cuisui cui sui))))
 542      (lui (string-append ls (format nil "KCUILUI=~d and sui=0" (make-cuilui cui lui))))
 543      (t (string-append ls (format nil "cui=~d and lui=0 and sui=0" cui))))
 544     (when srl
 545         (string-append ls (format nil " and KSRL <= ~d" srl)))
 546     (let ((usats '()))
 547       (dolist (tuple (mutex-sql-query ls))
 548         (push (make-instance 'usat :code (nth 0 tuple)
 549                              :atn (nth 1 tuple)
 550                              :sab (nth 2 tuple)
 551                              :atv (nth 3 tuple))
 552               usats))
 553       (nreverse usats))))
 554
 555
 556 (defun find-pfstr-cui (cui)
 557   (caar (mutex-sql-query (format nil "select KPFSTR from MRCON where CUI=~d limit 1" cui))))
 558
 559 (defun find-usty-tui (tui)
 560   "Find usty for tui"
 561   (setq tui (parse-tui tui))
 562     (kmrcl:aif (car (mutex-sql-query
 563                (format nil "select STY from MRSTY where TUI=~d limit 1" tui)))
 564          (make-instance 'usty :tui tui :sty (nth 0 kmrcl::it))
 565          nil))
 566
 567 (defun find-usty-sty (sty)
 568   "Find usty for a sty"
 569   (kmrcl:aif (car (mutex-sql-query
 570                 (format nil "select TUI from MRSTY where STY='~a' limit 1" sty)))
 571           (make-instance 'usty :tui (ensure-integer (nth 0 kmrcl::it)) :sty sty)
 572           nil))
 573
 574 (defun find-usty-all ()
 575   "Return list of usty's for all semantic types"
 576   (let ((ustys '()))
 577     (dolist (tuple (mutex-sql-query "select distinct TUI from MRSTY"))
 578       (push (find-usty-tui (nth 0 tuple)) ustys))
 579     (nreverse ustys)))
 580
 581 (defun find-usab-all ()
 582   "Find usab for a key"
 583   (let ((results '()))
 584     (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"))
 585       (destructuring-bind
 586             (vcui rcui vsab rsab son sf sver mstart mend imeta rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc curver sabin) tuple
 587         (push
 588          (make-instance 'usab :vcui (ensure-integer vcui)
 589                         :rcui (ensure-integer rcui)
 590                         :vsab vsab :rsab rsab :son son :sf sf :sver sver :mstart mstart
 591                         :mend mend :imeta imeta :rmeta rmeta :slc slc :scc scc
 592                         :srl (ensure-integer srl)
 593                         :tfr (ensure-integer tfr) :cfr (ensure-integer cfr)
 594                         :cxty cxty :ttyl ttyl :atnl atnl :lat lat :cenc cenc
 595                         :curver curver :sabin sabin)
 596          results)))
 597     (nreverse results)))
 598
 599 (defun find-usab-by-key (key-name key)
 600   "Find usab for a key"
 601   (aif (car (mutex-sql-query
 602              (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)))
 603        (destructuring-bind
 604            (vcui rcui vsab rsab son sf sver mstart mend imeta rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc curver sabin) it
 605          (make-instance 'usab :vcui (ensure-integer vcui)
 606                         :rcui (ensure-integer rcui)
 607                         :vsab vsab :rsab rsab :son son :sf sf :sver sver :mstart mstart
 608                         :mend mend :imeta imeta :rmeta rmeta :slc slc :scc scc
 609                         :srl (ensure-integer srl)
 610                         :tfr (ensure-integer tfr) :cfr (ensure-integer cfr)
 611                         :cxty cxty :ttyl ttyl :atnl atnl :lat lat :cenc cenc
 612                         :curver curver :sabin sabin))))
 613
 614 (defun find-usab-rsab (rsab)
 615   "Find usab for rsab"
 616   (find-usab-by-key "RSAB" rsab))
 617
 618 (defun find-usab-vsab (vsab)
 619   "Find usab for vsab"
 620   (find-usab-by-key "VSAB" vsab))
 621
 622 (defun find-cui-max ()
 623   (let ((cui (caar (mutex-sql-query "select max(CUI) from MRCON"))))
 624     (ensure-integer cui)))
 625
 626 ;;;; Cross table find functions
 627
 628 (defun find-ucon-tui (tui &key (srl *current-srl*))
 629   "Find list of ucon for tui"
 630   (when (stringp tui)
 631       (setq tui (parse-tui tui)))
 632   (let ((ucons '())
 633         (ls (format nil "select CUI from MRSTY where TUI=~d" tui)))
 634     (when srl
 635         (string-append ls (format nil " and KLRL <= ~d" srl)))
 636     (string-append ls " order by cui desc")
 637     (dolist (tuple (mutex-sql-query ls))
 638       (push (find-ucon-cui (ensure-integer (car tuple)) :srl srl) ucons))
 639     ucons))
 640
 641 (defun find-ucon-word (word &key (srl *current-srl*) (like nil))
 642   "Return list of ucons that match word. Optionally, use SQL's LIKE syntax"
 643   (let ((ucons '())
 644         (ls (format nil "select distinct cui from MRXW_ENG where wd~A'~A'"
 645                     (if like " LIKE " "=")
 646                     word)))
 647     (when srl
 648       (string-append ls (format nil " and KLRL <= ~d" srl)))
 649     (string-append ls " order by cui desc")
 650     (dolist (tuple (mutex-sql-query ls))
 651       (push (find-ucon-cui (car tuple) :srl srl) ucons))
 652     ucons))
 653
 654 (defun find-ucon-normalized-word (word &key (srl *current-srl*) (like nil))
 655   "Return list of ucons that match word, optionally use SQL's LIKE syntax"
 656   (let ((ucons '())
 657         (ls (format nil "select distinct cui from MRXNW_ENG where nwd~A'~A'"
 658                     (if like " LIKE " "=")
 659                     word)))
 660     (when srl
 661       (string-append ls (format nil " and KLRL <= ~d" srl)))
 662     (string-append ls " order by cui desc")
 663     (dolist (tuple (mutex-sql-query ls))
 664       (push (find-ucon-cui (car tuple) :srl srl) ucons))
 665     ucons))
 666
 667 (defun find-ustr-word (word &key (srl *current-srl*))
 668   "Return list of ustrs that match word"
 669   (let ((ustrs '())
 670         (ls (format nil "select cui,sui from MRXW_ENG where wd='~a'" word)))
 671     (when srl
 672         (string-append ls (format nil " and KLRL <= ~d" srl)))
 673     (string-append ls " order by cui desc,sui desc")
 674     (dolist (tuple (mutex-sql-query ls))
 675       (push (find-ustr-cuisui (ensure-integer (car tuple)) (ensure-integer (cadr tuple)) :srl srl)
 676             ustrs))
 677     ustrs))
 678
 679 (defun find-ustr-normalized-word (word &key (srl *current-srl*))
 680   "Return list of ustrs that match word"
 681   (let ((ustrs '())
 682         (ls (format nil "select cui,sui from MRXNW_ENG where nwd='~a'" word)))
 683     (when srl
 684         (string-append ls (format nil " and KLRL <= ~d" srl)))
 685     (string-append ls " order by cui desc,sui desc")
 686     (dolist (tuple (mutex-sql-query ls))
 687       (push (find-ustr-cuisui (ensure-integer (car tuple)) (ensure-integer (cadr tuple)) :srl srl)
 688             ustrs))
 689     ustrs))
 690
 691 ;; Special tables
 692
 693 (defun find-usrl-all ()
 694   (let ((usrls '())
 695         (tuples (mutex-sql-query "select SAB,SRL from USRL order by SAB desc")))
 696     (dolist (tuple tuples)
 697       (push (make-instance 'usrl :sab (nth 0 tuple)
 698                            :srl (ensure-integer (nth 1 tuple))) usrls))
 699     usrls))
 700
 701 ;;; Multiword lookup and score functions
 702
 703 (defun find-ucon-multiword (str &key (srl *current-srl*))
 704   "Return sorted list of ucon's that match a multiword string"
 705   (let* ((words (delimited-string-to-list str #\space))
 706          (ucons '()))
 707     (dolist (word words)
 708       (setq ucons (append ucons (find-ucon-word word :srl srl))))
 709     (sort-score-ucon-str str (delete-duplicates ucons :test #'eql :key #'cui))))
 710
 711 (defun find-ustr-multiword (str &key (srl *current-srl*))
 712   "Return sorted list of ustr's that match a multiword string"
 713   (let* ((words (delimited-string-to-list str #\space))
 714          (ustrs '()))
 715     (dolist (word words)
 716       (setq ustrs (append ustrs (find-ustr-word word :srl srl))))
 717     (sort-score-ustr-str str (delete-duplicates ustrs :test #'eql :key #'cui))))
 718
 719 (defun sort-score-ucon-str (str ucons)
 720   "Return list of sorted and scored ucons. Score by match of str to ucon-pfstr"
 721   (sort-score-umlsclass-str ucons str #'pfstr))
 722
 723 (defun sort-score-ustr-str (str ustrs)
 724   "Return list of sorted and scored ucons. Score by match of str to ucon-pfstr"
 725   (sort-score-umlsclass-str ustrs str #'str))
 726
 727 (defun sort-score-umlsclass-str (objs str lookup-func)
 728   "Sort a list of objects based on scoring to a string"
 729   (let ((scored '()))
 730     (dolist (obj objs)
 731       (push
 732        (list obj
 733              (score-multiword-match str (funcall lookup-func obj)))
 734        scored))
 735     (mapcar #'car (sort scored #'> :key #'cadr))))
 736
 737 (defun score-multiword-match (s1 s2)
 738   "Score a match between two strings with s1 being reference string"
 739   (let* ((word-list-1 (delimited-string-to-list s1 #\space))
 740          (word-list-2 (delimited-string-to-list s2 #\space))
 741          (n1 (length word-list-1))
 742          (n2 (length word-list-2))
 743          (unmatched n1)
 744          (score 0)
 745          (nlong 0)
 746          (nshort 0)
 747          short-list long-list)
 748     (declare (fixnum n1 n2 nshort nlong score unmatched))
 749     (if (> n1 n2)
 750         (progn
 751           (setq nlong n1)
 752           (setq nshort n2)
 753           (setq long-list word-list-1)
 754           (setq short-list word-list-2))
 755       (progn
 756         (setq nlong n2)
 757         (setq nshort n1)
 758         (setq long-list word-list-2)
 759         (setq short-list word-list-1)))
 760     (decf score (- nlong nshort)) ;; reduce score for extra words
 761     (dotimes (iword nshort)
 762       (declare (fixnum iword))
 763       (kmrcl:aif (position (nth iword short-list) long-list :test #'string-equal)
 764            (progn
 765              (incf score (- 10 (abs (- kmrcl::it iword))))
 766              (decf unmatched))))
 767     (decf score (* 2 unmatched))
 768     score))
 769
 770
 771 ;;; LEX SQL functions
 772
 773 (defun find-lexterm-eui (eui)
 774   (kmrcl:awhen (car (mutex-sql-query
 775                   (format nil "select WRD from LRWD where EUI=~d" eui)))
 776             (make-instance 'lexterm :eui eui :wrd (nth 0 kmrcl:it))))
 777
 778 (defun find-lexterm-word (wrd)
 779   (kmrcl:awhen (mutex-sql-query
 780              (format nil "select EUI from LRWD where WRD='~a'" wrd))
 781             (let ((terms '()))
 782               (dolist (tuple kmrcl:it)
 783                 (let ((eui (ensure-integer (nth 0 tuple))))
 784                   (push
 785                    (make-instance 'lexterm :eui eui :wrd (copy-seq wrd))
 786                    terms)))
 787               (nreverse terms))))
 788
 789 ;; LEXTERM accessors, read on demand
 790
 791 (def-lazy-reader lexterm s#abr find-labr-eui eui)
 792 (def-lazy-reader lexterm s#agr find-lagr-eui eui)
 793 (def-lazy-reader lexterm s#cmp find-lcmp-eui eui)
 794 (def-lazy-reader lexterm s#mod find-lmod-eui eui)
 795 (def-lazy-reader lexterm s#nom find-lnom-eui eui)
 796 (def-lazy-reader lexterm s#prn find-lprn-eui eui)
 797 (def-lazy-reader lexterm s#prp find-lprp-eui eui)
 798 (def-lazy-reader lexterm s#spl find-lspl-eui eui)
 799 (def-lazy-reader lexterm s#trm find-ltrm-eui eui)
 800 (def-lazy-reader lexterm s#typ find-ltyp-eui eui)
 801
 802 ;; LEX SQL Read functions
 803
 804 (defun find-labr-eui (eui)
 805     (kmrcl:awhen (mutex-sql-query
 806                (format nil "select BAS,ABR,EUI2,BAS2 from LRABR where EUI=~d" eui))
 807               (let ((results '()))
 808                 (dolist (tuple kmrcl::it)
 809                   (push
 810                    (make-instance 'labr :eui eui
 811                                   :bas (nth 0 tuple)
 812                                   :abr (nth 1 tuple)
 813                                   :eui2 (ensure-integer (nth 2 tuple))
 814                                   :bas2 (nth 3 tuple))
 815                    results))
 816                 (nreverse results))))
 817
 818 (defun find-labr-bas (bas)
 819   (kmrcl:awhen (mutex-sql-query
 820                (format nil "select EUI,ABR,EUI2,BAS2 from LRABR where BAS='~a'" bas))
 821               (let ((results '()))
 822                 (dolist (tuple kmrcl::it)
 823                   (push
 824                    (make-instance 'labr :eui (ensure-integer (nth 0 tuple))
 825                                   :bas (copy-seq bas)
 826                                   :abr (nth 1 tuple)
 827                                   :eui2 (ensure-integer (nth 2 tuple))
 828                                   :bas2 (nth 3 tuple))
 829                    results))
 830                 (nreverse results))))
 831
 832 (defun find-lagr-eui (eui)
 833   (kmrcl:awhen (mutex-sql-query
 834                (format nil "select STR,SCA,AGR,CIT,BAS from LRAGR where EUI=~d" eui))
 835               (let ((results '()))
 836                 (dolist (tuple kmrcl::it)
 837                   (push
 838                    (make-instance 'lagr
 839                                   :eui eui
 840                                   :str (nth 0 tuple)
 841                                   :sca (nth 1 tuple)
 842                                   :agr (nth 2 tuple)
 843                                   :cit (nth 3 tuple)
 844                                   :bas (nth 4 tuple))
 845                    results))
 846                 (nreverse results))))
 847
 848 (defun find-lcmp-eui (eui)
 849   (kmrcl:awhen (mutex-sql-query
 850                (format nil "select BAS,SCA,COM from LRCMP where EUI=~d" eui))
 851               (let ((results '()))
 852                 (dolist (tuple kmrcl::it)
 853                   (push
 854                    (make-instance 'lcmp
 855                                   :eui eui
 856                                   :bas (nth 0 tuple)
 857                                   :sca (nth 1 tuple)
 858                                   :com (nth 2 tuple))
 859                    results))
 860                 (nreverse results))))
 861
 862 (defun find-lmod-eui (eui)
 863   (kmrcl:awhen (mutex-sql-query
 864                (format nil "select BAS,SCA,PSN_MOD,FEA from LRMOD where EUI=~d" eui))
 865               (let ((results '()))
 866                 (dolist (tuple kmrcl::it)
 867                   (push
 868                    (make-instance 'lmod
 869                                   :eui eui
 870                                   :bas (nth 0 tuple)
 871                                   :sca (nth 1 tuple)
 872                                   :psnmod (nth 2 tuple)
 873                                   :fea (nth 3 tuple))
 874                    results))
 875                 (nreverse results))))
 876
 877 (defun find-lnom-eui (eui)
 878   (kmrcl:awhen (mutex-sql-query
 879                (format nil "select BAS,SCA,EUI2,BAS2,SCA2 from LRNOM where EUI=~d" eui))
 880               (let ((results '()))
 881                 (dolist (tuple kmrcl::it)
 882                   (push
 883                    (make-instance 'lnom
 884                                   :eui eui
 885                                   :bas (nth 0 tuple)
 886                                   :sca (nth 1 tuple)
 887                                   :eui2 (ensure-integer (nth 2 tuple))
 888                                   :bas2 (nth 3 tuple)
 889                                   :sca2 (nth 4 tuple))
 890                    results))
 891                 (nreverse results))))
 892
 893 (defun find-lprn-eui (eui)
 894   (kmrcl:awhen (mutex-sql-query
 895                (format nil "select BAS,NUM,GND,CAS,POS,QNT,FEA from LRPRN where EUI=~d" eui))
 896               (let ((results '()))
 897                 (dolist (tuple kmrcl::it)
 898                   (push
 899                    (make-instance 'lprn
 900                                   :eui eui
 901                                   :bas (nth 0 tuple)
 902                                   :num (nth 1 tuple)
 903                                   :gnd (nth 2 tuple)
 904                                   :cas (nth 3 tuple)
 905                                   :pos (nth 4 tuple)
 906                                   :qnt (nth 5 tuple)
 907                                   :fea (nth 6 tuple))
 908                    results))
 909                 (nreverse results))))
 910
 911 (defun find-lprp-eui (eui)
 912   (kmrcl:awhen (mutex-sql-query
 913                (format nil "select BAS,STR,SCA,FEA from LRPRP where EUI=~d" eui))
 914               (let ((results '()))
 915                 (dolist (tuple kmrcl::it)
 916                   (push
 917                    (make-instance 'lprp
 918                                   :eui eui
 919                                   :bas (nth 0 tuple)
 920                                   :str (nth 1 tuple)
 921                                   :sca (nth 2 tuple)
 922                                   :fea (nth 3 tuple))
 923                    results))
 924                 (nreverse results))))
 925
 926 (defun find-lspl-eui (eui)
 927   (kmrcl:awhen (mutex-sql-query
 928                (format nil "select SPV,BAS from LRSPL where EUI=~d" eui))
 929               (let ((results '()))
 930                 (dolist (tuple kmrcl::it)
 931                   (push
 932                    (make-instance 'lspl
 933                                   :eui eui
 934                                   :spv (nth 0 tuple)
 935                                   :bas (nth 1 tuple))
 936                    results))
 937                 (nreverse results))))
 938
 939
 940 (defun find-ltrm-eui (eui)
 941   (kmrcl:awhen (mutex-sql-query
 942                (format nil "select BAS,GEN from LRTRM where EUI=~d" eui))
 943               (let ((results '()))
 944                 (dolist (tuple kmrcl::it)
 945                   (push
 946                    (make-instance 'ltrm
 947                                   :eui eui
 948                                   :bas (nth 0 tuple)
 949                                   :gen (nth 1 tuple))
 950                    results))
 951                 (nreverse results))))
 952
 953 (defun find-ltyp-eui (eui)
 954   (kmrcl:awhen (mutex-sql-query
 955                (format nil "select BAS,SCA,TYP from LRTYP where EUI=~d" eui))
 956               (let ((results '()))
 957                 (dolist (tuple kmrcl::it)
 958                   (push
 959                    (make-instance 'ltyp
 960                                   :eui eui
 961                                   :bas (nth 0 tuple)
 962                                   :sca (nth 1 tuple)
 963                                   :typ (nth 2 tuple))
 964                    results))
 965                 (nreverse results))))
 966
 967 (defun find-lwd-wrd (wrd)
 968   (kmrcl:awhen (mutex-sql-query
 969              (format nil "select EUI from LRWD where WRD='~a'" wrd))
 970               (let ((results '()))
 971                 (dolist (tuple kmrcl::it)
 972                   (push (ensure-integer (nth 0 tuple)) results))
 973                 (make-instance 'lwd :wrd wrd
 974                                :euilist (nreverse results)))))
 975
 976 ;;; Semantic Network SQL access functions
 977
 978 (defun find-sdef-ui (ui)
 979   (kmrcl:awhen (car (mutex-sql-query
 980                   (format nil "select RT,STY_RL,STN_RTN,DEF,EX,UN,RH,ABR,RIN from SRDEF where UI=~d" ui)))
 981             (make-instance 'sdef :rt (nth 0 kmrcl::it)
 982                            :ui ui
 983                            :styrl (nth 1 kmrcl::it)
 984                            :stnrtn (nth 2 kmrcl::it)
 985                            :def (nth 3 kmrcl::it)
 986                            :ex (nth 4 kmrcl::it)
 987                            :un (nth 5 kmrcl::it)
 988                            :rh (nth 6 kmrcl::it)
 989                            :abr (nth 7 kmrcl::it)
 990                            :rin (nth 8 kmrcl::it))))
 991
 992 (defun find-sstre1-ui (ui)
 993   (kmrcl:awhen (mutex-sql-query
 994                (format nil "select UI2,UI3 from SRSTRE1 where UI=~d" ui))
 995               (let ((results '()))
 996                 (dolist (tuple kmrcl::it)
 997                   (push
 998                    (make-instance 'sstre1 :ui ui
 999                                   :ui2 (ensure-integer (nth 0 tuple))
1000                                   :ui3 (ensure-integer (nth 1 tuple)))
1001                    results))
1002                 (nreverse results))))
1003
1004 (defun find-sstre1-ui2 (ui2)
1005   (kmrcl:awhen (mutex-sql-query
1006                (format nil "select UI,UI3 from SRSTRE1 where UI2=~d" ui2))
1007               (let ((results '()))
1008                 (dolist (tuple kmrcl::it)
1009                   (push
1010                    (make-instance 'sstre1 :ui (ensure-integer (nth 0 tuple))
1011                                   :ui2 ui2
1012                                   :ui3 (ensure-integer (nth 1 tuple)))
1013                    results))
1014                 (nreverse results))))
1015
1016 (defun find-sstr-rl (rl)
1017   (kmrcl:awhen (mutex-sql-query
1018                (format nil "select STY_RL,STY_RL2,LS from SRSTRE where RL='~a'" rl))
1019               (let ((results '()))
1020                 (dolist (tuple kmrcl::it)
1021                   (push
1022                    (make-instance 'sstr
1023                                   :rl rl
1024                                   :styrl (nth 0 tuple)
1025                                   :styrl2 (nth 1 tuple)
1026                                   :ls (nth 2 tuple))
1027                    results))
1028                 (nreverse results))))
1029
1030
1031 (defun find-sstre2-sty (sty)
1032   (kmrcl:awhen (mutex-sql-query
1033              (format nil "select RL,STY2 from SRSTRE2 where STY='~a'" sty))
1034             (let ((results '()))
1035               (dolist (tuple kmrcl::it)
1036                 (push
1037                  (make-instance 'sstre2
1038                                 :sty (copy-seq sty)
1039                                 :rl (nth 0 tuple)
1040                                 :sty2 (nth 1 tuple))
1041                                 results))
1042                 (nreverse results))))
1043
1044 (defun find-sstr-styrl (styrl)
1045   (kmrcl:awhen (mutex-sql-query
1046                (format nil "select RL,STY_RL2,LS from SRSTR where RL='~a'" styrl))
1047               (let ((results '()))
1048                 (dolist (tuple kmrcl::it)
1049                   (push
1050                    (make-instance 'sstr :styrl styrl
1051                                   :rl (nth 0 tuple)
1052                                   :styrl2 (nth 1 tuple)
1053                                   :ls (nth 2 tuple))
1054                    results))
1055                 (nreverse results))))
1056
1057