X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql-classes.lisp;h=9e71b0f7b09972c0dcc41a68fce99b222e31857a;hb=f761dc1d39bb92917db53f935348f79e4db95e40;hp=f76ebffd52330f6c9c373a30999446c72aae68e6;hpb=3adc623f33431f3c6b447a97ae26a4b9c36ac376;p=umlisp.git diff --git a/sql-classes.lisp b/sql-classes.lisp index f76ebff..9e71b0f 100644 --- a/sql-classes.lisp +++ b/sql-classes.lisp @@ -7,7 +7,7 @@ ;;;; Author: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: sql-classes.lisp,v 1.73 2003/05/06 09:05:43 kevin Exp $ +;;;; $Id: sql-classes.lisp,v 1.75 2003/05/07 22:53:36 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -270,14 +270,14 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" :mg mg :pfstr2 kpfstr2))) (defun find-ucon-rel-cui2 (cui2 &key (srl *current-srl*)) - (mapcar - #'(lambda (cui) (find-ucon-cui cui :srl srl)) - (remove-duplicates (mapcar #'cui1 (find-urel-cui2 cui2 :srl srl))))) + (loop for cui in (remove-duplicates + (mapcar #'cui1 (find-urel-cui2 cui2 :srl srl))) + collect (find-ucon-cui cui :srl srl))) (defun find-ucoc-cui (cui &key (srl *current-srl*)) "Return a list of ucoc for cui" (with-umlisp-query (mrcoc (cui2 soc cot cof coa kpfstr2) srl cui1 - (parse-cui cui) :lrl "KSRL" :order (cof asc)) + (parse-cui cui) :lrl klrl :order (cof asc)) (setq cui2 (ensure-integer cui2)) (when (zerop cui2) (setq cui2 nil)) (make-instance 'ucoc :cui1 (parse-cui cui) :cui2 (ensure-integer cui2) @@ -287,7 +287,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-ucoc-cui2 (cui2 &key (srl *current-srl*)) "Return a list of ucoc for cui2" (with-umlisp-query (mrcoc (cui1 soc cot cof coa kpfstr2) srl cui2 - (parse-cui cui2) :lrl "KSRL" :order (cof asc)) + (parse-cui cui2) :lrl klrl :order (cof asc)) (setq cui2 (ensure-integer cui2)) (when (zerop cui2) (setq cui2 nil)) (make-instance 'ucoc :cui1 (ensure-integer cui1) :cui2 (parse-cui cui2) @@ -307,11 +307,6 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (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)) - "Return the string for a ulo object" - (find-string-sui (sui lo))) - (defun find-uatx-cui (cui &key (srl *current-srl*)) "Return a list of uatx for cui" (with-umlisp-query (mratx (sab rel atx) srl cui (parse-cui cui) :lrl ksrl)