Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XTIDCTX

XTIDCTX.m

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