From fab71e6fecf552789593d979b85cea58099f236d Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Fri, 4 Jun 2004 03:08:07 +0000 Subject: [PATCH] r9542: more 2004AA portage --- classes.lisp | 173 +++++++++++++++++++++++++++++------------------ parse-rrf.lisp | 8 ++- sql-classes.lisp | 114 ++++++++++++++++++++++++------- 3 files changed, 204 insertions(+), 91 deletions(-) diff --git a/classes.lisp b/classes.lisp index 24ba9d1..21213bd 100644 --- a/classes.lisp +++ b/classes.lisp @@ -37,14 +37,15 @@ ((rank :value-type fixnum :initarg :rank :reader rank) (sab :value-type string :initarg :sab :reader sab) (tty :value-type string :initarg :tty :reader tty) - (supres :value-type string :initarg :supres :reader supres)) + (suppres :value-type string :initarg :suppres :reader suppres)) (:metaclass hyperobject-class) (:user-name "Rank") - (:default-print-slots rank sab tty supres)) + (:default-print-slots rank sab tty suppres)) (defclass udef (umlsclass) ((def :value-type cdata :initarg :def :reader def) - (sab :value-type string :initarg :sab :reader sab :hyperlink find-usab-rsab)) + (sab :value-type string :initarg :sab :reader sab :hyperlink find-usab-rsab) + (suppress :value-type string :initarg :suppress :reader suppress)) (:metaclass hyperobject-class) (:user-name "Definition") (:default-print-slots sab def)) @@ -67,8 +68,8 @@ (son :value-type string :initarg :son :reader son) (sf :value-type string :initarg :sf :reader sf) (sver :value-type string :initarg :sver :reader sver) - (vstart :value-type string :initarg :vstart :reader vstart) - (vend :value-type string :initarg :vend :reader vend) + (mstart :value-type string :initarg :mstart :reader mstart) + (mend :value-type string :initarg :mend :reader mend) (imeta :value-type string :initarg :imeta :reader imeta) (rmeta :value-type string :initarg :rmeta :reader rmeta) (slc :value-type cdata :initarg :slc :reader slc) @@ -82,28 +83,51 @@ (lat :value-type string :initarg :lat :reader lat) (cenc :value-type string :initarg :cenc :reader cenc) (curver :value-type string :initarg :curver :reader curver) - (sabin :value-type string :initarg :sabin :reader sabin)) + (sabin :value-type string :initarg :sabin :reader sabin) + (ssn :value-type string :initarg :ssn :reader ssn) + (scit :value-type string :initarg :scit :reader scit)) (:metaclass hyperobject-class) (:user-name "Source Abbreviation") (:default-print-slots vcui rcui vsab rsab son sf sver vstart vend imeta rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc - curver sabin)) + curver sabin ssn scit)) (defclass ucxt (umlsclass) ((sab :value-type string :initarg :sab :reader sab :hyperlink find-usab-rsab) (code :value-type string :initarg :code :reader code) (cxn :value-type fixnum :initarg :cxn :reader cxn) (cxl :value-type string :initarg :cxl :reader cxl) + (rnk :value-type string :initarg :rnk :reader rnk) (cxs :value-type cdata :initarg :cxs :reader cxs) (cui2 :value-type fixnum :initarg :cui2 :reader cui2 :hyperlink find-ucon-cui :print-formatter fmt-cui) + (aui2 :value-type fixnum :initarg :aui2 :reader aui2 :hyperlink find-ucon-aui + :print-formatter fmt-aui) (hcd :value-type string :initarg :hcd :reader hcd) (rela :value-type string :initarg :rela :reader rela) - (xc :value-type string :initarg :xc :reader xc)) + (xc :value-type string :initarg :xc :reader xc) + (cvf :value-type string :initarg :cvf :reader cvf)) (:metaclass hyperobject-class) (:user-name "Context") (:default-print-slots sab code cxn cxl hcd rela xc cui2 cxs)) +(defclass uhier (umlsclass) + ((cui :value-type fixnum :initarg :cui :reader cui :hyperlink find-ucon-cui + :print-formatter fmt-cui) + (aui :value-type fixnum :initarg :aui :reader aui :hyperlink find-ucon-aui + :print-formatter fmt-aui) + (cxn :value-type fixnum :initarg :cxn :reader cxn) + (paui :value-type fixnum :initarg :paui :reader paui + :print-formatter fmt-aui) + (sab :value-type string :initarg :sab :reader sab :hyperlink find-usab-rsab) + (rela :value-type string :initarg :rela :reader rela) + (ptr :value-type string :initarg :ptr :reader ptr) + (hcd :value-type string :initarg :hcd :reader hcd) + (cvf :value-type string :initarg :cvf :reader cvf)) + (:metaclass hyperobject-class) + (:user-name "Context") + (:default-print-slots cxn paui sab rela ptr hcd)) + (defclass ustr (umlsclass) ((sui :value-type fixnum :initarg :sui :reader sui :print-formatter fmt-sui :hyperlink find-ustr-sui) @@ -115,12 +139,13 @@ (str :value-type cdata :initarg :str :reader str) (lrl :value-type fixnum :initarg :lrl :reader lrl) (stt :value-type string :initarg :stt :reader stt) + (suppress :value-type string :initarg :suppress :reader suppress) (s#so :reader s#so :subobject (find-uso-cuisui cui sui)) (s#sat :reader s#sat :subobject (find-usat-ui cui lui sui)) (s#cxt :reader s#cxt :subobject (find-ucxt-cuisui cui sui))) (:metaclass hyperobject-class) (:user-name "String") - (:default-print-slots sui stt lrl str)) + (:default-print-slots sui stt lrl str suppress)) (defclass uso (umlsclass) ((aui :value-type fixnum :initarg :aui :reader aui :print-formatter fmt-aui) @@ -176,27 +201,43 @@ (defclass urel (umlsclass) ((rel :value-type string :initarg :rel :reader rel :hyperlink find-brel-rel) (cui1 :value-type fixnum :initarg :cui1 :reader cui1 :print-formatter fmt-cui) + (aui1 :value-type fixnum :initarg :aui1 :reader aui1 :print-formatter fmt-aui) + (stype1 :value-type string :initarg :stype1 :reader stype1) (cui2 :value-type fixnum :initarg :cui2 :reader cui2 :hyperlink find-ucon-sui :print-formatter fmt-cui) + (aui2 :value-type fixnum :initarg :aui2 :reader aui2 :hyperlink find-ucon-aui + :print-formatter fmt-aui) (pfstr2 :value-type cdata :initarg :pfstr2 :reader pfstr2) + (stype2 :value-type string :initarg :stype2 :reader stype2) (rela :value-type string :initarg :rela :reader rela) + (rui :value-type string :initarg :rui :reader rui) + (srui :value-type string :initarg :srui :reader srui) (sab :value-type string :initarg :sab :reader sab :hyperlink find-usab-rsab) - (sl :value-type string :initarg :sl :reader sl)) + (sl :value-type string :initarg :sl :reader sl) + (rg :value-type string :initarg :rg :reader rg) + (dir :value-type string :initarg :dir :reader dir) + (suppress :value-type string :initarg :suppress :reader suppress) + (cvf :value-type string :initarg :cvf :reader cvf)) (:metaclass hyperobject-class) (:user-name "Relationship") - (:default-print-slots rel rela sab sl cui2 pfstr2)) + (:default-print-slots stype1 rel cui2 aui2 stype2 rela rui srui sab sl rg dir suppress pfstr2)) (defclass ucoc (umlsclass) ((cui1 :value-type fixnum :initarg :cui1 :reader cui1 :print-formatter fmt-cui) + (aui1 :value-type fixnum :initarg :aui1 :reader aui1 :print-formatter fmt-aui) (cui2 :value-type fixnum :initarg :cui2 :reader cui2 :print-formatter fmt-cui :hyperlink find-ucon-cui) + (aui2 :value-type fixnum :initarg :aui2 :reader aui2 :print-formatter fmt-aui + :hyperlink find-ucon-aui) (pfstr2 :value-type cdata :initarg :pfstr2 :reader pfstr2) + (sab :value-type string :initarg :sab :reader sab) (cot :value-type string :initarg :cot :reader cot) (cof :value-type fixnum :initarg :cof :reader cof) - (coa :value-type cdata :initarg :coa :reader coa)) + (coa :value-type cdata :initarg :coa :reader coa) + (cvf :value-type string :initarg :cvf :reader cvf)) (:metaclass hyperobject-class) (:user-name "Co-occuring Concept") - (:default-print-slots cot cof coa cui2 pfstr2)) + (:default-print-slots cot cof coa cui2 aui2 sab pfstr2)) (defclass ucon (umlsclass) @@ -215,6 +256,60 @@ (:user-name "Concept") (:default-print-slots cui lrl pfstr)) +(defclass udoc (umlsclass) + ((key :value-type string :initarg :key :reader key) + (value :value-type cdata :initarg :value :reader value) + (type :value-type cdata :initarg :type :reader etype) + (expl :value-type cdata :initarg :expl :reader expl)) + (:metaclass hyperobject-class) + (:user-name "Abbreviation Documentation") + (:default-print-slots key value type expl)) + +(defclass umap (umlsclass) + ((mapsetcui :value-type fixnum :initarg :mapsetcui :reader mapsetcui) + (mapsetsab :value-type string :initarg :mapsetsab :reader mapsetsab) + (mapsubsetid :value-type string :initarg :mapsubsetid :reader mapsubsetid) + ;; fixme: will convert to integer + (maprank :value-type string :initarg :maprank :reader maprank) + (fromid :value-type string :initarg :fromid :reader fromid) + (fromsid :value-type string :initarg :fromsid :reader fromsid) + (fromexpr :value-type string :initarg :fromexpr :reader fromexpr) + (fromtype :value-type string :initarg :fromtype :reader fromtype) + (fromrule :value-type string :initarg :fromrule :reader fromrule) + (fromres :value-type string :initarg :fromres :reader fromres) + (rel :value-type string :initarg :rel :reader rel) + (rela :value-type string :initarg :rela :reader rela) + (toid :value-type string :initarg :toid :reader toid) + (tosid :value-type string :initarg :tosid :reader tosid) + (toexpr :value-type string :initarg :toexpr :reader toexpr) + (totype :value-type string :initarg :totype :reader totype) + (torule :value-type string :initarg :torule :reader torule) + (tores :value-type string :initarg :tores :reader tores) + (maprule :value-type string :initarg :maprule :reader maprule) + (maptype :value-type string :initarg :maptype :reader maptype) + (mapatn :value-type string :initarg :mapatn :reader mapatn) + (mapatv :value-type string :initarg :mapatv :reader mapatv) + (cvf :value-type string :initarg :cvf :reader cvf)) + (:metaclass hyperobject-class) + (:user-name "Mapping") + (:default-print-slots mapsetcui mapsetsab mapsubsetid maprank fromid fromsid fromexpr fromtype + fromrule fromres rel rela toid tosid toexpr totype torule tores maprule + maptype mapatn mapatv)) + +(defclass usmap (umlsclass) + ((mapsetcui :value-type fixnum :initarg :mapsetcui :reader mapsetcui) + (mapsetsab :value-type string :initarg :mapsetsab :reader mapsetsab) + (fromexpr :value-type string :initarg :fromexpr :reader fromexpr) + (fromtype :value-type string :initarg :fromtype :reader fromtype) + (rel :value-type string :initarg :rel :reader rel) + (rela :value-type string :initarg :rela :reader rela) + (toexpr :value-type string :initarg :toexpr :reader toexpr) + (totype :value-type string :initarg :totype :reader totype) + (cvf :value-type string :initarg :cvf :reader cvf)) + (:metaclass hyperobject-class) + (:user-name "Simple Mapping") + (:default-print-slots mapsetcui mapsetsab fromexpr fromtype rel rela toexpr totype)) + (defclass uxw (umlsclass) ((wd :value-type string :initarg :wd :reader wd) (cui :value-type fixnum :initform nil :initarg :cui :reader cui :print-formatter fmt-cui) @@ -442,55 +537,3 @@ (:default-print-slots name hits srl) (:documentation "Custom Table: UMLS Database statistics.")) - -(defclass bsab (umlsclass) - ((sab :value-type string :initarg :sab :reader sab - :hyperlink find-ustr-sab - :hyperlink-parameters (("subobjects" . "no"))) - (name :value-type string :initarg :name :reader name) - (hits :value-type fixnum :initarg :hits :reader hits - :user-name "count" - :print-formatter fmt-comma-integer)) - (:metaclass hyperobject-class) - (:default-initargs :sab nil :name nil :hits nil) - (:user-name "Source of Abbreviation") - (:default-print-slots sab name hits) - (:documentation "Bonus SAB file")) - -(defclass btty (umlsclass) - ((tty :value-type string :initarg :tty :reader tty) - (name :value-type string :initarg :name :reader name) - (hits :value-type fixnum :initarg :hits :reader hits - :user-name "count" - :print-formatter fmt-comma-integer)) - (:metaclass hyperobject-class) - (:default-initargs :tty nil :name nil :hits nil) - (:user-name "Bonus TTY") - (:default-print-slots tty name hits) - (:documentation "Bonus TTY file")) - -(defclass brel (umlsclass) - ((sab :value-type string :initarg :sab :reader sab) - (sl :value-type string :initarg :sl :reader sl) - (rel :value-type string :initarg :rel :reader rel) - (rela :value-type string :initarg :rela :reader rela) - (hits :value-type fixnum :initarg :hits :reader hits - :user-name "count" - :print-formatter fmt-comma-integer)) - (:metaclass hyperobject-class) - (:default-initargs :sab nil :sl nil :rel nil :rela nil :hits nil) - (:user-name "Bonus REL") - (:default-print-slots sab sl rel rela hits) - (:documentation "Bonus REL file")) - -(defclass batn (umlsclass) - ((sab :value-type string :initarg :sab :reader sab) - (atn :value-type string :initarg :atn :reader atn) - (hits :value-type fixnum :initarg :hits :reader hits - :user-name "count" - :print-formatter fmt-comma-intger)) - (:metaclass hyperobject-class) - (:default-initargs :sab nil :atn nil) - (:user-name "Bonus ATN") - (:default-print-slots sab atn hits) - (:documentation "Bonus ATN file")) diff --git a/parse-rrf.lisp b/parse-rrf.lisp index 0f89b14..145b13c 100644 --- a/parse-rrf.lisp +++ b/parse-rrf.lisp @@ -98,10 +98,11 @@ (defparameter +col-datatypes+ '(("AV" sql-f) ("BTS" sql-i) ("CLS" sql-i) ("COF" sql-i) ("CUI1" sql-u) ("AUI" sql-u) ("AUI1" sql-u) ("AUI2" sql-u) ("PCUI" sql-u) - ("PLUI" sql-u) + ("PLUI" sql-u) ("PAUI" sql-u) ("CUI2" sql-u) ("CUI" sql-u) ("CXN" sql-s) ("FR" sql-i) ("LRL" sql-s) ("LUI" sql-u) ("MAX" sql-s) ("MIN" sql-s) ("RANK" sql-s) ("REF" sql-c) ("RNK" sql-s) ("RWS" sql-i) ("SRL" sql-s) ("SUI" sql-u) ("TUI" sql-u) + ("MAPRANK" sql-s) ;;; Custom columns ("KCUISUI" sql-l) ("KCUILUI" sql-l) ("KCUILRL" sql-i) ("KLUILRL" sql-i) ("KSUILRL" sql-i) @@ -112,6 +113,7 @@ ("UI" sql-u) ("UI2" sql-u) ("UI3" sql-u) ;; New fields for 2002AD ("RCUI" sql-u) ("VCUI" sql-u) ("CFR" sql-i) ("TFR" sql-i) + ;; New fields for 2004AA ("MAPSETCUI" sql-u) ) "SQL data types for each non-string column") @@ -228,8 +230,10 @@ ("UI" "SRSTRE1") ("UI2" "SRSTRE1") ("UI3" "SRSTRE1") ("STY_RL" "SRDEF") ("RT" "SRDEF") ("STY_RL" "SRSTR") ("STY_RL2" "SRSTR") ("RL" "SRSTR") + ("SRL" "MRSAB") ("RSAB" "MRSAB") ("VSAB" "MRSAB") ("RCUI" "MRSAB") - ("VCUI" "MRSAB") ("LAT" "MRSAB")) + ("VCUI" "MRSAB") ("LAT" "MRSAB") ("MAPSETCUI" "MRMAP") ("MAPSETCUI" "MRSMAP") + ("CUI" "MRHIER") ("AUI" "MRHIER") ("PAUI" "MRHIER")) "Columns in files to index") diff --git a/sql-classes.lisp b/sql-classes.lisp index 165e531..2b7869c 100644 --- a/sql-classes.lisp +++ b/sql-classes.lisp @@ -220,6 +220,13 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (make-instance 'ucon :cui (ensure-integer cui) :pfstr kpfstr :lrl (ensure-integer kcuilrl)))) +(defun find-ucon-aui (aui &key (srl *current-srl*)) + "Find list of ucon for aui" + (ensure-sui-integer aui) + (collect-umlisp-query (mrconso (cui kpfstr kcuilrl) srl aui aui :distinct t) + (make-instance 'ucon :cui (ensure-integer cui) :pfstr kpfstr + :lrl (ensure-integer kcuilrl)))) + (defun find-ucon-cuisui (cui sui &key (srl *current-srl*)) "Find ucon for cui/sui" (ensure-cui-integer cui) @@ -283,8 +290,30 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-udef-cui (cui &key (srl *current-srl*)) "Return a list of udefs for cui" (ensure-cui-integer cui) - (collect-umlisp-query (mrdef (sab def) srl cui cui :lrl "KSRL") - (make-instance 'udef :sab sab :def def))) + (collect-umlisp-query (mrdef (sab def suppress) srl cui cui :lrl "KSRL") + (make-instance 'udef :sab sab :def def :suppress suppress))) + +(defun find-udoc-key (key) + "Return list of abbreviation documentation for a key" + (collect-umlisp-query (mrdoc (value type expl) nil dockey key) + (make-instance 'udoc :key key :value value :type type :expl expl))) + +(defun find-udoc-value (value) + "Return abbreviation documentation" + (collect-umlisp-query (mrdoc (dockey type expl) nil value value) + (make-instance 'udoc :key dockey :value value :type type :expl expl))) + +(defun find-udoc-key-value (key value) + (let ((tuple (car (mutex-sql-query + (format nil "SELECT TYPE,EXPL FROM MRDOC WHERE DOCKEY='~A' AND VALUE='~A'" + key value))))) + (when tuple + (make-instance 'udoc :key key :value value :type (first tuple) :expl (second tuple))))) + +(defun find-udoc-all () + "Return all abbreviation documentation" + (collect-umlisp-query (mrdoc (dockey value type expl) nil nil nil) + (make-instance 'udoc :key dockey :value value :type type :expl expl))) (defun find-usty-cui (cui &key (srl *current-srl*)) "Return a list of usty for cui" @@ -301,11 +330,12 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-urel-cui (cui &key (srl *current-srl*)) "Return a list of urel for cui" (ensure-cui-integer cui) - (collect-umlisp-query (mrrel (rel cui2 rela sab sl kpfstr2) srl cui1 - cui :lrl "KSRL") - (make-instance 'urel :cui1 cui :rel rel - :cui2 (ensure-integer cui2) :rela rela :sab sab :sl sl - :pfstr2 kpfstr2))) + (collect-umlisp-query (mrrel (aui1 rel stype1 cui2 aui2 stype2 rela rui srui sab sl rg dir suppress cvf kpfstr2) + srl cui1 cui :lrl "KSRL") + (make-instance 'urel :cui1 cui :aui1 (ensure-integer aui1) :stype1 stype1 :rel rel + :cui2 (ensure-integer cui2) :aui2 (ensure-integer aui2) :stype2 stype2 + :rui rui :srui srui :rela rela :sab sab :sl sl :rg rg :dir dir + :suppress suppress :cvf cvf :pfstr2 kpfstr2))) (defun find-cui2-urel-cui (cui &key (srl *current-srl*)) "Return a list of urel for cui" @@ -317,10 +347,11 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-urel-cui2 (cui2 &key (srl *current-srl*)) "Return a list of urel for cui2" (ensure-cui-integer cui2) - (collect-umlisp-query (mrrel (rel cui1 rela sab sl kpfstr2) srl cui2 - cui2 :lrl "KSRL") - (make-instance 'urel :cui2 cui2 :rel rel - :cui1 (ensure-integer cui1) :rela rela :sab sab :sl sl + (collect-umlisp-query (mrrel (rel cui1 aui1 stype1 aui2 stype2 rela rui srui sab sl rg dir suppress cvf kpfstr2) + srl cui2 cui2 :lrl "KSRL") + (make-instance 'urel :cui2 cui2 :rel rel :aui2 (ensure-integer aui2) :stype2 stype2 :rui rui :srui srui + :stype1 stype1 :cui1 (ensure-integer cui1) :aui1 (ensure-integer aui1) + :rela rela :sab sab :sl sl :rg rg :dir dir :suppress suppress :cvf cvf :pfstr2 kpfstr2))) (defun find-ucon-rel-cui2 (cui2 &key (srl *current-srl*)) @@ -332,22 +363,24 @@ 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" (ensure-cui-integer cui) - (collect-umlisp-query (mrcoc (cui2 cot cof coa kpfstr2) srl cui1 + (collect-umlisp-query (mrcoc (aui1 cui2 aui2 sab cot cof coa kpfstr2) srl cui1 cui :lrl klrl :order (cof asc)) (setq cui2 (ensure-integer cui2)) (when (eql 0 cui2) (setq cui2 nil)) - (make-instance 'ucoc :cui1 cui :cui2 (ensure-integer cui2) - :cot cot :cof (ensure-integer cof) :coa coa + (make-instance 'ucoc :cui1 cui :aui1 (ensure-integer aui1) + :cui2 (ensure-integer cui2) :aui2 (ensure-integer aui2) + :cot cot :cof (ensure-integer cof) :coa coa :sab sab :pfstr2 kpfstr2))) (defun find-ucoc-cui2 (cui2 &key (srl *current-srl*)) "Return a list of ucoc for cui2" (ensure-cui-integer cui2) - (collect-umlisp-query (mrcoc (cui1 cot cof coa kpfstr2) srl cui2 + (collect-umlisp-query (mrcoc (cui1 aui1 aui2 sab cot cof coa kpfstr2) srl cui2 cui2 :lrl klrl :order (cof asc)) (when (zerop cui2) (setq cui2 nil)) (make-instance 'ucoc :cui1 (ensure-integer cui1) :cui2 cui2 - :cot cot :cof (ensure-integer cof) :coa coa + :aui1 (ensure-integer aui1) :aui2 (ensure-integer aui2) + :sab sab :cot cot :cof (ensure-integer cof) :coa coa :pfstr2 kpfstr2))) (defun find-ucon-coc-cui2 (cui2 &key (srl *current-srl*)) @@ -396,29 +429,30 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" "Return a list of ustr for cui/lui" (ensure-cui-integer cui) (ensure-lui-integer lui) - (collect-umlisp-query (mrconso (sui stt str ksuilrl) srl kcuilui + (collect-umlisp-query (mrconso (sui stt str suppress ksuilrl) srl kcuilui (make-cuilui cui lui) :lrl ksuilrl) (make-instance 'ustr :sui (ensure-integer sui) :cui cui :lui lui - :cuisui (make-cuisui cui sui) :stt stt :str str + :cuisui (make-cuisui cui sui) :stt stt :str str :suppress suppress :lrl (ensure-integer ksuilrl)))) (defun find-ustr-cuisui (cui sui &key (srl *current-srl*)) "Return the single ustr for cuisui" (ensure-cui-integer cui) (ensure-sui-integer sui) - (collect-umlisp-query (mrconso (lui stt str ksuilrl) srl kcuisui + (collect-umlisp-query (mrconso (lui stt str suppress ksuilrl) srl kcuisui (make-cuisui cui sui) :lrl lsuilrl :single t) (make-instance 'ustr :sui sui :cui cui :cuisui (make-cuisui cui sui) - :lui (ensure-integer lui) :stt stt :str str + :lui (ensure-integer lui) :stt stt :str str :suppress suppress :lrl (ensure-integer ksuilrl)))) (defun find-ustr-sui (sui &key (srl *current-srl*)) "Return the list of ustr for sui" (ensure-sui-integer sui) - (collect-umlisp-query (mrconso (cui lui stt str ksuilrl) srl sui sui + (collect-umlisp-query (mrconso (cui lui stt str suppress ksuilrl) srl sui sui :lrl ksuilrl) (make-instance 'ustr :sui sui :cui cui :stt stt :str str :cuisui (make-cuisui (ensure-integer cui) sui) + :suppress suppress :lui (ensure-integer lui) :lrl (ensure-integer ksuilrl)))) (defun find-ustr-sab (sab &key (srl *current-srl*)) @@ -436,12 +470,13 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (clsql:map-query 'list #'(lambda (tuple) - (destructuring-bind (cui lui sui stt ksuilrl pfstr) tuple + (destructuring-bind (cui lui sui stt ksuilrl suppress pfstr) tuple (make-instance 'ustr :cui (ensure-integer cui) :lui (ensure-integer lui) :sui (ensure-integer sui) :stt stt :str pfstr :cuisui (make-cuisui (ensure-integer cui) (ensure-integer sui)) + :suppress suppress :lrl (ensure-integer ksuilrl)))) (query-string mrconso (cui lui sui stt ksuilrl kpfstr) srl nil nil :lrl ksuilrl :distinct t @@ -479,6 +514,23 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" :rela rela :xc xc :cui2 (ensure-integer cui2)))) +(defun find-uhier-cui (cui &key (srl *current-srl*)) + (ensure-cui-integer cui) + (collect-umlisp-query (mrhier (aui cxn paui sab rela ptr hcd cvf) + srl cui cui :lrl ksrl) + (make-instance 'uhier :cui cui :aui (ensure-integer aui) + :cxn (ensure-integer cxn) + :paui (ensure-integer paui) + :sab sab :rela rela :ptr ptr :hcd hcd :cvf cvf))) + +(defun find-uhier-all (&key (srl *current-srl*)) + (collect-umlisp-query (mrhier (cui aui cxn paui sab rela ptr hcd cvf) + srl nil nil :lrl ksrl) + (make-instance 'uhier :cui cui :aui (ensure-integer aui) + :cxn (ensure-integer cxn) + :paui (ensure-integer paui) + :sab sab :rela rela :ptr ptr :hcd hcd :cvf cvf))) + (defun find-usat-ui (cui &optional (lui nil) (sui nil) &key (srl *current-srl*)) (ensure-cui-integer cui) (ensure-lui-integer lui) @@ -519,14 +571,14 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" "Find usab for a key" (collect-umlisp-query (mrsab (vcui rcui vsab rsab son sf sver vstart vend imeta rmeta slc scc srl tfr cfr cxty ttyl atnl lat - cenc curver sabin) nil nil nil) + cenc curver sabin ssn scit) nil nil nil) (make-instance 'usab :vcui (ensure-integer vcui) :rcui (ensure-integer rcui) :vsab vsab :rsab rsab :son son :sf sf :sver sver :vstart vstart :vend vend :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))) + :curver curver :sabin sabin :ssn ssn :scit scit))) (defun find-usab-by-key (key-name key) "Find usab for a key" @@ -553,6 +605,20 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-cui-max () (ensure-integer (caar (mutex-sql-query "select max(CUI) from MRCON")))) +(defun find-umap-cui (cui) + (ensure-cui-integer cui) + (collect-umlisp-query (mrmap (mapsetsab mapsubsetid maprank fromid fromsid fromexpr + fromtype fromrule fromres rel rela toid tosid + toexpr totype torule tores maprule maptype + mapatn mapatv cvf) + nil mapsetcui cui) + (make-instance 'umap :mapsetcui cui :mapsetsab mapsetsab :mapsubsetid mapsubsetid + :maprank (ensure-integer maprank) :fromid fromid :fromsid fromsid + :fromexpr fromexpr :fromtype fromtype :fromrule fromrule :fromres fromres + :rel rel :rela rela :toid toid :tosid tosid :toexpr toexpr :totype totype + :torule torule :tores tores :maprule maprule :maptype maptype :mapatn mapatn + :mapatv mapatv :cvf cvf))) + ;;;; Cross table find functions (defun find-ucon-tui (tui &key (srl *current-srl*)) -- 2.34.1