XTIDCTX ;OAKCIOFO/JLG - TERM/CONCEPT CONTEXT directories ;04/20/2005 15:12
;;7.3;TOOLKIT;**93**;Apr 25, 1995
; Reference to global "^DD" supported by IA #4634
Q
; encapsulates the location (directory) of term/concept
; references based on FILE/FIELD.
; It eventually encapsulates the retrieval of
; specific term/concept references (TERM defined in XTIDTERM) based
; on the internal reference (IREF).
; There are two current implementations: one for terms defined
; as "set of codes"; the other defined in VistA files that have
; been updated to contain VUID-related data in their DD.
; CTX and TERM are passed by reference in all the subroutines
;
CONTEXT(TFILE,TFIELD,CTX) ; determine and create context impl
; returns new CTX array
; CTX("TYPE")=<"SET" or "TABLE" or "ROOT">
; CTX("TERM FILE#")=<TFILE or "">
; CTX("TERM FIELD#")=<TFIELD or "">
; CTX("SOURCE FILE#")=<8985.1 or TFILE or "">
; CTX("TERMSTATUS SUBFILE#")=
; <subfile for the multi-valued field
; 99.991, EFFECTIVE DATE/TIME or "">
N TTYPE
Q:$D(CTX)
S TFILE=$G(TFILE),TFIELD=$G(TFIELD)
S TTYPE=$$GETTYPE(TFILE,TFIELD)
Q:TTYPE=""
I TTYPE="SET" D CONTEXT^XTIDSET(TFILE,TFIELD,.CTX) Q
I TTYPE="TABLE" D CONTEXT^XTIDTBL(TFILE,.01,.CTX) Q
I TTYPE="ROOT" D ROOTCTX(.CTX) Q
Q
;
VALIDREF(CTX,TIREF) ; validate IREF
; validate internal reference against given CTX
N VALID S VALID=1
Q:'$D(CTX) 'VALID
I CTX("TYPE")="SET" D Q VALID
. S VALID=$$VALIDREF^XTIDSET(.CTX,$G(TIREF))
;
I CTX("TYPE")="TABLE" D Q VALID
. S VALID=$$VALIDREF^XTIDTBL(.CTX,$G(TIREF))
;
Q 'VALID
FINDTERM(CTX,TIREF,TERM) ; find term
; find the single term reference for given term IREF
; return TERM data as new TERM array
; IREF is unique within a given CTX, except for "RO0T" context
; on success, attach CTX to TERM array
Q:'$D(CTX)!($D(TERM))
I CTX("TYPE")="SET" D FINDTERM^XTIDSET(.CTX,$G(TIREF),.TERM)
I CTX("TYPE")="TABLE" D FINDTERM^XTIDTBL(.CTX,$G(TIREF),.TERM)
; don't find term reference for "ROOT" type, where IREF is not unique
; on success, attach CTX to TERM
I $D(TERM) M TERM("CTX")=CTX
Q
;
NEWTERM(CTX,TIREF,VUID) ; create a new term reference with given VUID
; only for "set of codes"
; on success (term entry), new TERM array is returned
; create a new entry in the Kernel (8985.1) file only (set of codes)
N SUCCESS
S TIREF=$G(TIREF),VUID=+$G(VUID)
Q:'$D(CTX)!('VUID) 0
; create new term reference entry only for "set of codes"
Q:CTX("TYPE")'="SET" 0
Q $$NEWTERM^XTIDSET(.CTX,TIREF,VUID)
;
GETTERM(CTX,FILE,IENS,TERM) ; get term
; return TERM data as new TERM array
; called from CTX implementations only
; subroutine might be moved to XTIDTERM
; D GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT,MSG_ROOT)
N DIERR,MSG
S FILE=+$G(FILE),IENS=$G(IENS)
; ensure only CTX implementations use this for callback
Q:'$D(CTX)!($D(TERM))!('FILE)!(IENS']"")
D GETS^DIQ(FILE,IENS,"**","IR","TERM","MSG")
Q:$D(MSG("DIERR"))
Q
;
SRCHTRMS(CTX,VUID,XTCARR,MASTER) ; search term reference entries
; search term reference entries based on VUID and its context
S VUID=$G(VUID),XTCARR=$G(XTCARR),MASTER=+$G(MASTER)
; CTX must be defined
Q:'$D(CTX)!(XTCARR']"")!('VUID)
I CTX("TYPE")="SET" D SRCHTRMS^XTIDSET(.CTX,VUID,XTCARR,MASTER) Q
I CTX("TYPE")="TABLE" D SRCHTRMS^XTIDTBL(.CTX,VUID,XTCARR,MASTER) Q
I CTX("TYPE")="ROOT" D Q
. ; each CTX implementation should contribute to XTCARR array
. N FL
. ; search "set of codes" first
. ; temporarily set context info
. S CTX("TYPE")="SET"
. S CTX("SOURCE FILE#")=8985.1
. D SRCHTRMS^XTIDSET(.CTX,VUID,XTCARR,MASTER)
. ; search all "table" files
. ; temporarily set context info
. S CTX("TYPE")="TABLE"
. S FL=0
. F S FL=$O(^DIC(FL)) Q:'FL D
. . Q:'$D(^DD(FL,99.991))
. . Q:FL=8985.1
. . S CTX("SOURCE FILE#")=FL
. . S CTX("TERM FILE#")=FL
. . S CTX("TERM FIELD#")=.01
. . D SRCHTRMS^XTIDTBL(.CTX,VUID,XTCARR,MASTER)
. ;
. ; reset context info
. S CTX("TYPE")="ROOT"
. S CTX("SOURCE FILE#")=""
. S CTX("TERM FILE#")=""
. S CTX("TERM FIELD#")=""
;
Q
;
ADDTARRY(XTC2ARR,FILE,FIELD,IREF,VALUE) ;
; adds element and value to XTC2ARR array (by name)
; called by CTX implementations of SRCHTRMS()
; increased count
N COUNT
S COUNT=$G(@XTC2ARR)
S @XTC2ARR@(+$G(FILE),+$G(FIELD),$G(IREF))=$G(VALUE)
S @XTC2ARR=COUNT+1
Q
;
GETTYPE(FILE,FIELD) ; determine type of context
; based on FILE and FIELD combination
; D FIELD^DID(FILE,FIELD,FLAGS,ATTRIBUTES,TARGET_ROOT,MSG_ROOT)
N DIERR,ATTR,MSG,TYPE
S FILE=+$G(FILE),FIELD=$G(FIELD)
S TYPE=""
; file may be empty in GETIREF^XTID use-case
I 'FILE S TYPE="ROOT" Q TYPE
; determine if "table" type, by checking VUID DD
I FIELD=""!(FIELD=.01) D
. N VFIELD
. S VFIELD=99.99 ; test existence of VUID field
. D FIELD^DID(FILE,VFIELD,"","LABEL","ATTR","MSG")
. ;Q:$D(MSG("DIERR")) ; INVALID type returned
. I $G(ATTR("LABEL"))="VUID" S TYPE="TABLE"
;
Q:TYPE'="" TYPE
; determine if FIELD is a SET OF CODES
; D FIELD^DID(FILE,FIELD,"","TYPE","ATTR","MSG")
; Q:$D(MSG("DIERR")) TYPE
; I $G(ATTR("TYPE"))="SET" S TYPE="SET" Q TYPE
; DS requested to assume "SET"
S TYPE="SET"
Q TYPE
;
ROOTCTX(CTX) ; set up Context for "ROOT" type
; called from CONTEXT^XTIDCTX(TFILE,TFIELD,CTX)
; called only when TFILE is not defined
S CTX("TYPE")="ROOT"
S CTX("TERM FILE#")=""
S CTX("TERM FIELD#")=""
; the default source file
S CTX("SOURCE FILE#")=""
; TERMSTATUS 99.991, EFFECTIVE DATE/TIME subfile
S CTX("TERMSTATUS SUBFILE#")=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTIDCTX 5658 printed Dec 13, 2024@02:41:06 Page 2
XTIDCTX ;OAKCIOFO/JLG - TERM/CONCEPT CONTEXT directories ;04/20/2005 15:12
+1 ;;7.3;TOOLKIT;**93**;Apr 25, 1995
+2 ; Reference to global "^DD" supported by IA #4634
+3 QUIT
+4 ; encapsulates the location (directory) of term/concept
+5 ; references based on FILE/FIELD.
+6 ; It eventually encapsulates the retrieval of
+7 ; specific term/concept references (TERM defined in XTIDTERM) based
+8 ; on the internal reference (IREF).
+9 ; There are two current implementations: one for terms defined
+10 ; as "set of codes"; the other defined in VistA files that have
+11 ; been updated to contain VUID-related data in their DD.
+12 ; CTX and TERM are passed by reference in all the subroutines
+13 ;
CONTEXT(TFILE,TFIELD,CTX) ; determine and create context impl
+1 ; returns new CTX array
+2 ; CTX("TYPE")=<"SET" or "TABLE" or "ROOT">
+3 ; CTX("TERM FILE#")=<TFILE or "">
+4 ; CTX("TERM FIELD#")=<TFIELD or "">
+5 ; CTX("SOURCE FILE#")=<8985.1 or TFILE or "">
+6 ; CTX("TERMSTATUS SUBFILE#")=
+7 ; <subfile for the multi-valued field
+8 ; 99.991, EFFECTIVE DATE/TIME or "">
+9 NEW TTYPE
+10 if $DATA(CTX)
QUIT
+11 SET TFILE=$GET(TFILE)
SET TFIELD=$GET(TFIELD)
+12 SET TTYPE=$$GETTYPE(TFILE,TFIELD)
+13 if TTYPE=""
QUIT
+14 IF TTYPE="SET"
DO CONTEXT^XTIDSET(TFILE,TFIELD,.CTX)
QUIT
+15 IF TTYPE="TABLE"
DO CONTEXT^XTIDTBL(TFILE,.01,.CTX)
QUIT
+16 IF TTYPE="ROOT"
DO ROOTCTX(.CTX)
QUIT
+17 QUIT
+18 ;
VALIDREF(CTX,TIREF) ; validate IREF
+1 ; validate internal reference against given CTX
+2 NEW VALID
SET VALID=1
+3 if '$DATA(CTX)
QUIT 'VALID
+4 IF CTX("TYPE")="SET"
Begin DoDot:1
+5 SET VALID=$$VALIDREF^XTIDSET(.CTX,$GET(TIREF))
End DoDot:1
QUIT VALID
+6 ;
+7 IF CTX("TYPE")="TABLE"
Begin DoDot:1
+8 SET VALID=$$VALIDREF^XTIDTBL(.CTX,$GET(TIREF))
End DoDot:1
QUIT VALID
+9 ;
+10 QUIT 'VALID
FINDTERM(CTX,TIREF,TERM) ; find term
+1 ; find the single term reference for given term IREF
+2 ; return TERM data as new TERM array
+3 ; IREF is unique within a given CTX, except for "RO0T" context
+4 ; on success, attach CTX to TERM array
+5 if '$DATA(CTX)!($DATA(TERM))
QUIT
+6 IF CTX("TYPE")="SET"
DO FINDTERM^XTIDSET(.CTX,$GET(TIREF),.TERM)
+7 IF CTX("TYPE")="TABLE"
DO FINDTERM^XTIDTBL(.CTX,$GET(TIREF),.TERM)
+8 ; don't find term reference for "ROOT" type, where IREF is not unique
+9 ; on success, attach CTX to TERM
+10 IF $DATA(TERM)
MERGE TERM("CTX")=CTX
+11 QUIT
+12 ;
NEWTERM(CTX,TIREF,VUID) ; create a new term reference with given VUID
+1 ; only for "set of codes"
+2 ; on success (term entry), new TERM array is returned
+3 ; create a new entry in the Kernel (8985.1) file only (set of codes)
+4 NEW SUCCESS
+5 SET TIREF=$GET(TIREF)
SET VUID=+$GET(VUID)
+6 if '$DATA(CTX)!('VUID)
QUIT 0
+7 ; create new term reference entry only for "set of codes"
+8 if CTX("TYPE")'="SET"
QUIT 0
+9 QUIT $$NEWTERM^XTIDSET(.CTX,TIREF,VUID)
+10 ;
GETTERM(CTX,FILE,IENS,TERM) ; get term
+1 ; return TERM data as new TERM array
+2 ; called from CTX implementations only
+3 ; subroutine might be moved to XTIDTERM
+4 ; D GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT,MSG_ROOT)
+5 NEW DIERR,MSG
+6 SET FILE=+$GET(FILE)
SET IENS=$GET(IENS)
+7 ; ensure only CTX implementations use this for callback
+8 if '$DATA(CTX)!($DATA(TERM))!('FILE)!(IENS']"")
QUIT
+9 DO GETS^DIQ(FILE,IENS,"**","IR","TERM","MSG")
+10 if $DATA(MSG("DIERR"))
QUIT
+11 QUIT
+12 ;
SRCHTRMS(CTX,VUID,XTCARR,MASTER) ; search term reference entries
+1 ; search term reference entries based on VUID and its context
+2 SET VUID=$GET(VUID)
SET XTCARR=$GET(XTCARR)
SET MASTER=+$GET(MASTER)
+3 ; CTX must be defined
+4 if '$DATA(CTX)!(XTCARR']"")!('VUID)
QUIT
+5 IF CTX("TYPE")="SET"
DO SRCHTRMS^XTIDSET(.CTX,VUID,XTCARR,MASTER)
QUIT
+6 IF CTX("TYPE")="TABLE"
DO SRCHTRMS^XTIDTBL(.CTX,VUID,XTCARR,MASTER)
QUIT
+7 IF CTX("TYPE")="ROOT"
Begin DoDot:1
+8 ; each CTX implementation should contribute to XTCARR array
+9 NEW FL
+10 ; search "set of codes" first
+11 ; temporarily set context info
+12 SET CTX("TYPE")="SET"
+13 SET CTX("SOURCE FILE#")=8985.1
+14 DO SRCHTRMS^XTIDSET(.CTX,VUID,XTCARR,MASTER)
+15 ; search all "table" files
+16 ; temporarily set context info
+17 SET CTX("TYPE")="TABLE"
+18 SET FL=0
+19 FOR
SET FL=$ORDER(^DIC(FL))
if 'FL
QUIT
Begin DoDot:2
+20 if '$DATA(^DD(FL,99.991))
QUIT
+21 if FL=8985.1
QUIT
+22 SET CTX("SOURCE FILE#")=FL
+23 SET CTX("TERM FILE#")=FL
+24 SET CTX("TERM FIELD#")=.01
+25 DO SRCHTRMS^XTIDTBL(.CTX,VUID,XTCARR,MASTER)
End DoDot:2
+26 ;
+27 ; reset context info
+28 SET CTX("TYPE")="ROOT"
+29 SET CTX("SOURCE FILE#")=""
+30 SET CTX("TERM FILE#")=""
+31 SET CTX("TERM FIELD#")=""
End DoDot:1
QUIT
+32 ;
+33 QUIT
+34 ;
ADDTARRY(XTC2ARR,FILE,FIELD,IREF,VALUE) ;
+1 ; adds element and value to XTC2ARR array (by name)
+2 ; called by CTX implementations of SRCHTRMS()
+3 ; increased count
+4 NEW COUNT
+5 SET COUNT=$GET(@XTC2ARR)
+6 SET @XTC2ARR@(+$GET(FILE),+$GET(FIELD),$GET(IREF))=$GET(VALUE)
+7 SET @XTC2ARR=COUNT+1
+8 QUIT
+9 ;
GETTYPE(FILE,FIELD) ; determine type of context
+1 ; based on FILE and FIELD combination
+2 ; D FIELD^DID(FILE,FIELD,FLAGS,ATTRIBUTES,TARGET_ROOT,MSG_ROOT)
+3 NEW DIERR,ATTR,MSG,TYPE
+4 SET FILE=+$GET(FILE)
SET FIELD=$GET(FIELD)
+5 SET TYPE=""
+6 ; file may be empty in GETIREF^XTID use-case
+7 IF 'FILE
SET TYPE="ROOT"
QUIT TYPE
+8 ; determine if "table" type, by checking VUID DD
+9 IF FIELD=""!(FIELD=.01)
Begin DoDot:1
+10 NEW VFIELD
+11 ; test existence of VUID field
SET VFIELD=99.99
+12 DO FIELD^DID(FILE,VFIELD,"","LABEL","ATTR","MSG")
+13 ;Q:$D(MSG("DIERR")) ; INVALID type returned
+14 IF $GET(ATTR("LABEL"))="VUID"
SET TYPE="TABLE"
End DoDot:1
+15 ;
+16 if TYPE'=""
QUIT TYPE
+17 ; determine if FIELD is a SET OF CODES
+18 ; D FIELD^DID(FILE,FIELD,"","TYPE","ATTR","MSG")
+19 ; Q:$D(MSG("DIERR")) TYPE
+20 ; I $G(ATTR("TYPE"))="SET" S TYPE="SET" Q TYPE
+21 ; DS requested to assume "SET"
+22 SET TYPE="SET"
+23 QUIT TYPE
+24 ;
ROOTCTX(CTX) ; set up Context for "ROOT" type
+1 ; called from CONTEXT^XTIDCTX(TFILE,TFIELD,CTX)
+2 ; called only when TFILE is not defined
+3 SET CTX("TYPE")="ROOT"
+4 SET CTX("TERM FILE#")=""
+5 SET CTX("TERM FIELD#")=""
+6 ; the default source file
+7 SET CTX("SOURCE FILE#")=""
+8 ; TERMSTATUS 99.991, EFFECTIVE DATE/TIME subfile
+9 SET CTX("TERMSTATUS SUBFILE#")=""
+10 QUIT
+11 ;
