source: FOIAVistA/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTIDSET.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1XTIDSET ;OAKCIOFO/JLG - SET OF CODES CONTEXT ;04/25/2005 15:12
2 ;;7.3;TOOLKIT;**93**;Apr 25, 1995
3 Q
4 ; Context implementation for "set of codes"
5 ; CTX and TERM are passed by ref in all calls
6CONTEXT(TFILE,TFIELD,CTX) ; set up Context for "set of codes" type
7 ; called from CONTEXT^XTIDCTX(TFILE,TFIELD,CTX)
8 ; returns a valid new CTX array
9 S TFILE=+$G(TFILE),TFIELD=$G(TFIELD)
10 Q:'TFILE!($D(CTX))
11 S CTX("TYPE")="SET"
12 S CTX("TERM FILE#")=TFILE
13 S CTX("TERM FIELD#")=TFIELD
14 ; the default source file
15 S CTX("SOURCE FILE#")=8985.1
16 ; TERMSTATUS 99.991, EFFECTIVE DATE/TIME subfile
17 S CTX("TERMSTATUS SUBFILE#")=8985.11
18 Q
19 ;
20VALIDREF(CTX,TIREF) ; validate the term, internal ref
21 ; test TIREF is a valid value in set of codes
22 Q:'$D(CTX)!($G(TIREF)']"") 0
23 ; as requested by DS, no need for this restrictive validation
24 ; as some terms to be filed in "set of codes" kernel file
25 ; may not yet exist in their original file.
26 ;Q $$MEMBER(CTX("TERM FILE#"),CTX("TERM FIELD#"),TIREF)
27 Q 1
28 ;
29FINDTERM(CTX,TIREF,TERM) ; find term in given context
30 ; called from FINDTERM^XTIDCTX(CTX,TIREF,TERM)
31 ; return TERM data as new TERM array
32 N IENS
33 Q:'$D(CTX)!($D(TERM))
34 Q:'$$VALIDREF(.CTX,$G(TIREF))
35 S IENS=$$GETIENS($G(TIREF))
36 Q:IENS']""
37 D GETTERM^XTIDCTX(.CTX,CTX("SOURCE FILE#"),IENS,.TERM)
38 Q
39 ;
40NEWTERM(CTX,TIREF,VUID) ; create new term index entry
41 ; called from NEWTERM^XTIDCTX(CTX,TIREF,VUID,TERM)
42 ; D UPDATE^DIE(FLAGS,FDA_ROOT,IEN_ROOT,MSG_ROOT)
43 N DIERR,FILE,SFILE,FLAGS,MASTER,MSG,MYFDA,MYIEN,SUCCESS
44 S TIREF=$G(TIREF),VUID=+$G(VUID)
45 Q:'$D(CTX)!($D(TERM))!('VUID) 0
46 Q:'$$VALIDREF(.CTX,TIREF) 0
47 S SUCCESS=0,FLAGS="KS"
48 S MASTER=1
49 I $$DUPLMSTR^XTIDTERM(CTX("TERM FILE#"),CTX("TERM FIELD#"),VUID) D
50 . S MASTER=0
51 S FILE=CTX("SOURCE FILE#")
52 S SFILE=CTX("TERMSTATUS SUBFILE#")
53 S MYFDA(FILE,"+1,",.01)=CTX("TERM FILE#")
54 S MYFDA(FILE,"+1,",.02)=CTX("TERM FIELD#")
55 S MYFDA(FILE,"+1,",.03)=TIREF
56 S MYFDA(FILE,"+1,",99.99)=VUID
57 S MYFDA(FILE,"+1,",99.98)=MASTER
58 D UPDATE^DIE(FLAGS,"MYFDA","MYIEN","MSG")
59 S:'$D(MSG("DIERR")) SUCCESS=1
60 ; success, build TERM and return
61 Q SUCCESS
62 ;
63SRCHTRMS(CTX,VUID,XTSARR,MASTER) ; search term index entries
64 ; called from SEARCH^XTIDCTX(CTX,VUID,XTCARR,MASTER)
65 N DIERR,FILE,XTC,FIELD
66 S VUID=$G(VUID),MASTER=+$G(MASTER)
67 Q:$G(CTX("TYPE"))'="SET"!('VUID)
68 S FILE=$G(CTX("TERM FILE#"))
69 S FIELD=$G(CTX("TERM FIELD#"))
70 ; search in ^XTID(8985.1,"C",VUID,FILE,FIELD,FLAG,IEN)=""
71 Q:'$D(^XTID(8985.1,"C",VUID))
72 M XTC=^XTID(8985.1,"C",VUID)
73 ; search everywhere
74 I FILE="" D Q
75 . F S FILE=$O(XTC(FILE)) Q:'FILE D L1
76 ;
77 I FILE,FIELD="" D L1 Q
78 I FILE,FIELD D L2 Q
79 ;
80 Q
81 ;
82L1 ;
83 N FIELD
84 S FIELD="" F S FIELD=$O(XTC(FILE,FIELD)) Q:'FIELD D L2
85 Q
86 ;
87L2 ;
88 N IEN,MSTR,IREF,STATUS
89 S MSTR="" F S MSTR=$O(XTC(FILE,FIELD,MSTR)) Q:MSTR="" D
90 . S IEN=0 F S IEN=$O(XTC(FILE,FIELD,MSTR,IEN)) Q:'IEN D
91 . . I MASTER,MSTR=0 Q
92 . . S IREF=$P($G(^XTID(8985.1,IEN,0)),"^",3)
93 . . S STATUS=$$GETSTAT^XTID(FILE,FIELD,IREF,"")
94 . . S STATUS=STATUS_"^"_MSTR
95 . . D ADDTARRY^XTIDCTX(XTSARR,FILE,FIELD,IREF,STATUS)
96 . ;
97 ;
98 Q
99 ;
100GETIENS(TIREF) ; find term's ien/IENS
101 ; find term entry and return IENS
102 ; $$FIND1^DIC(FILE,IENS,FLAGS,[.]VALUE,[.]INDEXES,.SCREEN,MSG_ROOT)
103 N DIERR,FILE,FLAGS,INDEXES,MSG,RIEN,VALUE
104 S FILE=CTX("SOURCE FILE#"),FLAGS="KQX",INDEXES="",RIEN=""
105 S VALUE(1)=CTX("TERM FILE#")
106 S VALUE(2)=CTX("TERM FIELD#")
107 S VALUE(3)=TIREF
108 ; get record IEN
109 ;S RIEN=$$FIND1^DIC(FILE,"",FLAGS,.VALUE,INDEXES,"","MSG")
110 S RIEN=$O(^XTID(FILE,"B",VALUE(1),VALUE(2),VALUE(3),0))
111 Q:RIEN RIEN_","
112 Q RIEN
113 ;
114MEMBER(FILE,FIELD,VALUE) ; valid member in "set of codes"?
115 ; validate VALUE for this FIELD
116 ; for validation purposes only, RESULT not used
117 ; D VAL^DIE(FILE,IENS,FIELD,FLAGS,VALUE,.RESULT,FDA_ROOT,MSG_ROOT)
118 N DIERR,FLAGS,IENS,MSG,RESULT,SUCCESS
119 S SUCCESS=0
120 S FLAGS="U",IENS="+1,"
121 D VAL^DIE(CTX("TERM FILE#"),IENS,CTX("TERM FIELD#"),FLAGS,VALUE,.RESULT,"","MSG")
122 S:'$D(MSG("DIERR")) SUCCESS=1
123 Q SUCCESS
124 ;
Note: See TracBrowser for help on using the repository browser.