source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTIDCTX.m@ 1766

Last change on this file since 1766 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.4 KB
Line 
1XTIDCTX ;OAKCIOFO/JLG - TERM/CONCEPT CONTEXT directories ;04/20/2005 15:12
2 ;;7.3;TOOLKIT;**93**;Apr 25, 1995
3 ; Reference to global "^DD" supported by IA #4634
4 Q
5 ; encapsulates the location (directory) of term/concept
6 ; references based on FILE/FIELD.
7 ; It eventually encapsulates the retrieval of
8 ; specific term/concept references (TERM defined in XTIDTERM) based
9 ; on the internal reference (IREF).
10 ; There are two current implementations: one for terms defined
11 ; as "set of codes"; the other defined in VistA files that have
12 ; been updated to contain VUID-related data in their DD.
13 ; CTX and TERM are passed by reference in all the subroutines
14 ;
15CONTEXT(TFILE,TFIELD,CTX) ; determine and create context impl
16 ; returns new CTX array
17 ; CTX("TYPE")=<"SET" or "TABLE" or "ROOT">
18 ; CTX("TERM FILE#")=<TFILE or "">
19 ; CTX("TERM FIELD#")=<TFIELD or "">
20 ; CTX("SOURCE FILE#")=<8985.1 or TFILE or "">
21 ; CTX("TERMSTATUS SUBFILE#")=
22 ; <subfile for the multi-valued field
23 ; 99.991, EFFECTIVE DATE/TIME or "">
24 N TTYPE
25 Q:$D(CTX)
26 S TFILE=$G(TFILE),TFIELD=$G(TFIELD)
27 S TTYPE=$$GETTYPE(TFILE,TFIELD)
28 Q:TTYPE=""
29 I TTYPE="SET" D CONTEXT^XTIDSET(TFILE,TFIELD,.CTX) Q
30 I TTYPE="TABLE" D CONTEXT^XTIDTBL(TFILE,.01,.CTX) Q
31 I TTYPE="ROOT" D ROOTCTX(.CTX) Q
32 Q
33 ;
34VALIDREF(CTX,TIREF) ; validate IREF
35 ; validate internal reference against given CTX
36 N VALID S VALID=1
37 Q:'$D(CTX) 'VALID
38 I CTX("TYPE")="SET" D Q VALID
39 . S VALID=$$VALIDREF^XTIDSET(.CTX,$G(TIREF))
40 ;
41 I CTX("TYPE")="TABLE" D Q VALID
42 . S VALID=$$VALIDREF^XTIDTBL(.CTX,$G(TIREF))
43 ;
44 Q 'VALID
45FINDTERM(CTX,TIREF,TERM) ; find term
46 ; find the single term reference for given term IREF
47 ; return TERM data as new TERM array
48 ; IREF is unique within a given CTX, except for "RO0T" context
49 ; on success, attach CTX to TERM array
50 Q:'$D(CTX)!($D(TERM))
51 I CTX("TYPE")="SET" D FINDTERM^XTIDSET(.CTX,$G(TIREF),.TERM)
52 I CTX("TYPE")="TABLE" D FINDTERM^XTIDTBL(.CTX,$G(TIREF),.TERM)
53 ; don't find term reference for "ROOT" type, where IREF is not unique
54 ; on success, attach CTX to TERM
55 I $D(TERM) M TERM("CTX")=CTX
56 Q
57 ;
58NEWTERM(CTX,TIREF,VUID) ; create a new term reference with given VUID
59 ; only for "set of codes"
60 ; on success (term entry), new TERM array is returned
61 ; create a new entry in the Kernel (8985.1) file only (set of codes)
62 N SUCCESS
63 S TIREF=$G(TIREF),VUID=+$G(VUID)
64 Q:'$D(CTX)!('VUID) 0
65 ; create new term reference entry only for "set of codes"
66 Q:CTX("TYPE")'="SET" 0
67 Q $$NEWTERM^XTIDSET(.CTX,TIREF,VUID)
68 ;
69GETTERM(CTX,FILE,IENS,TERM) ; get term
70 ; return TERM data as new TERM array
71 ; called from CTX implementations only
72 ; subroutine might be moved to XTIDTERM
73 ; D GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT,MSG_ROOT)
74 N DIERR,MSG
75 S FILE=+$G(FILE),IENS=$G(IENS)
76 ; ensure only CTX implementations use this for callback
77 Q:'$D(CTX)!($D(TERM))!('FILE)!(IENS']"")
78 D GETS^DIQ(FILE,IENS,"**","IR","TERM","MSG")
79 Q:$D(MSG("DIERR"))
80 Q
81 ;
82SRCHTRMS(CTX,VUID,XTCARR,MASTER) ; search term reference entries
83 ; search term reference entries based on VUID and its context
84 S VUID=$G(VUID),XTCARR=$G(XTCARR),MASTER=+$G(MASTER)
85 ; CTX must be defined
86 Q:'$D(CTX)!(XTCARR']"")!('VUID)
87 I CTX("TYPE")="SET" D SRCHTRMS^XTIDSET(.CTX,VUID,XTCARR,MASTER) Q
88 I CTX("TYPE")="TABLE" D SRCHTRMS^XTIDTBL(.CTX,VUID,XTCARR,MASTER) Q
89 I CTX("TYPE")="ROOT" D Q
90 . ; each CTX implementation should contribute to XTCARR array
91 . N FL
92 . ; search "set of codes" first
93 . ; temporarily set context info
94 . S CTX("TYPE")="SET"
95 . S CTX("SOURCE FILE#")=8985.1
96 . D SRCHTRMS^XTIDSET(.CTX,VUID,XTCARR,MASTER)
97 . ; search all "table" files
98 . ; temporarily set context info
99 . S CTX("TYPE")="TABLE"
100 . S FL=0
101 . F S FL=$O(^DIC(FL)) Q:'FL D
102 . . Q:'$D(^DD(FL,99.991))
103 . . Q:FL=8985.1
104 . . S CTX("SOURCE FILE#")=FL
105 . . S CTX("TERM FILE#")=FL
106 . . S CTX("TERM FIELD#")=.01
107 . . D SRCHTRMS^XTIDTBL(.CTX,VUID,XTCARR,MASTER)
108 . ;
109 . ; reset context info
110 . S CTX("TYPE")="ROOT"
111 . S CTX("SOURCE FILE#")=""
112 . S CTX("TERM FILE#")=""
113 . S CTX("TERM FIELD#")=""
114 ;
115 Q
116 ;
117ADDTARRY(XTC2ARR,FILE,FIELD,IREF,VALUE) ;
118 ; adds element and value to XTC2ARR array (by name)
119 ; called by CTX implementations of SRCHTRMS()
120 ; increased count
121 N COUNT
122 S COUNT=$G(@XTC2ARR)
123 S @XTC2ARR@(+$G(FILE),+$G(FIELD),$G(IREF))=$G(VALUE)
124 S @XTC2ARR=COUNT+1
125 Q
126 ;
127GETTYPE(FILE,FIELD) ; determine type of context
128 ; based on FILE and FIELD combination
129 ; D FIELD^DID(FILE,FIELD,FLAGS,ATTRIBUTES,TARGET_ROOT,MSG_ROOT)
130 N DIERR,ATTR,MSG,TYPE
131 S FILE=+$G(FILE),FIELD=$G(FIELD)
132 S TYPE=""
133 ; file may be empty in GETIREF^XTID use-case
134 I 'FILE S TYPE="ROOT" Q TYPE
135 ; determine if "table" type, by checking VUID DD
136 I FIELD=""!(FIELD=.01) D
137 . N VFIELD
138 . S VFIELD=99.99 ; test existence of VUID field
139 . D FIELD^DID(FILE,VFIELD,"","LABEL","ATTR","MSG")
140 . ;Q:$D(MSG("DIERR")) ; INVALID type returned
141 . I $G(ATTR("LABEL"))="VUID" S TYPE="TABLE"
142 ;
143 Q:TYPE'="" TYPE
144 ; determine if FIELD is a SET OF CODES
145 ; D FIELD^DID(FILE,FIELD,"","TYPE","ATTR","MSG")
146 ; Q:$D(MSG("DIERR")) TYPE
147 ; I $G(ATTR("TYPE"))="SET" S TYPE="SET" Q TYPE
148 ; DS requested to assume "SET"
149 S TYPE="SET"
150 Q TYPE
151 ;
152ROOTCTX(CTX) ; set up Context for "ROOT" type
153 ; called from CONTEXT^XTIDCTX(TFILE,TFIELD,CTX)
154 ; called only when TFILE is not defined
155 S CTX("TYPE")="ROOT"
156 S CTX("TERM FILE#")=""
157 S CTX("TERM FIELD#")=""
158 ; the default source file
159 S CTX("SOURCE FILE#")=""
160 ; TERMSTATUS 99.991, EFFECTIVE DATE/TIME subfile
161 S CTX("TERMSTATUS SUBFILE#")=""
162 Q
163 ;
Note: See TracBrowser for help on using the repository browser.