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

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

initial load of WorldVistAEHR

File size: 4.5 KB
RevLine 
[613]1XTIDTERM ;OAKCIOFO/JLG - TERM/CONCEPT index entry ;03/18/2005 15:12
2 ;;7.3;TOOLKIT;**93**;Apr 25, 1995
3 Q
4 ; encapsulates a term/concept index entry for both
5 ; "set of codes" and "table" indexes
6 ; it interfaces through FileMan
7 ; TERM is by reference and is in FDA format + CTX data
8 ; only exceptions are $$GETSTAT and $$SETSTAT
9 ; FDA format is left for convenience but future
10 ; implementations might customize it.
11 ; TERM is passed by ref in all calls
12GETVUID(TERM) ; return VUID value
13 ;
14 N FILE,IENS
15 Q:'$D(TERM)
16 S FILE=TERM("CTX","SOURCE FILE#")
17 S IENS=$O(TERM(FILE,""))
18 Q $G(TERM(FILE,IENS,"VUID","I"))
19 ;
20GETMASTR(TERM) ; return MASTER VUID value
21 ;
22 N FILE,IENS
23 Q:'$D(TERM)
24 S FILE=TERM("CTX","SOURCE FILE#")
25 S IENS=$O(TERM(FILE,""))
26 Q $G(TERM(FILE,IENS,"MASTER ENTRY FOR VUID","I"))
27 ;
28GETSTAT(TERM,DATE) ; return MASTER VUID value
29 ;
30 N FILE,SFILE,IENS,STATUS
31 Q:'$D(TERM)
32 S:'$G(DATE) DATE=$$NOW^XLFDT
33 S FILE=TERM("CTX","SOURCE FILE#")
34 S SFILE=TERM("CTX","TERMSTATUS SUBFILE#")
35 S IENS=","_$O(TERM(FILE,""))
36 S STATUS=$$FINDSTAT(SFILE,IENS,DATE)
37 ;I 'STATUS Q "^status not found for given date/time"
38 Q $P(STATUS,"^",2,4)
39 ;
40SETVUID(TERM,VUID) ; set new VUID to existing TERM
41 ;
42 N DIERR,FLAGS,FILE,IENS,MSG,MYFDA,SUCCESS
43 S VUID=$G(VUID)
44 Q:'$D(TERM)!('VUID) 0
45 ; check constraints first
46 Q:$$CNSTR1() 0
47 S SUCCESS=0,FLAGS="KS"
48 S FILE=TERM("CTX","SOURCE FILE#")
49 S IENS=$O(TERM(+FILE,""))
50 Q:IENS']"" SUCCESS
51 S MYFDA(FILE,IENS,99.99)=VUID
52 D FILE^DIE(FLAGS,"MYFDA","MSG")
53 I '$D(MSG("DIERR")) D
54 . S SUCCESS=1
55 . ; update the cached TERM array
56 . S TERM(FILE,IENS,"VUID","I")=VUID
57 ;
58 Q SUCCESS
59 ;
60SETMASTR(TERM,MVUID) ; set MASTER ENTRY flag to existing TERM
61 ;
62 N DIERR,FLAGS,FILE,IENS,MSG,MYFDA,SUCCESS
63 S MVUID=+$G(MVUID)
64 Q:'$D(TERM) 0
65 ; check constraints first and override VUID flag
66 I MVUID,$$CNSTR2() S MVUID=0
67 S FILE=TERM("CTX","SOURCE FILE#")
68 S IENS=$O(TERM(+FILE,""))
69 Q:IENS']"" 0
70 S SUCCESS=0,FLAGS="KS"
71 S MYFDA(FILE,IENS,99.98)=MVUID
72 D FILE^DIE(FLAGS,"MYFDA","MSG")
73 I '$D(MSG("DIERR")) D
74 . S SUCCESS=1
75 . ; update the cached TERM array
76 . S TERM(FILE,IENS,"MASTER ENTRY FOR VUID","I")=MVUID
77 ;
78 Q SUCCESS
79 ;
80SETSTAT(TERM,STATUS,DATE) ; set status
81 ; set status and date for the given term
82 N DIERR,FLAGS,FILE,SFILE,MYFDA,MSG,SUCCESS,IENS
83 S STATUS=$G(STATUS),DATE=$G(DATE)
84 Q:'$D(TERM)!(STATUS']"") 0
85 S SUCCESS=0,FLAGS="KS"
86 S STATUS=+$G(STATUS)
87 S:'$G(DATE) DATE=$$NOW^XLFDT
88 S FILE=TERM("CTX","SOURCE FILE#")
89 S SFILE=TERM("CTX","TERMSTATUS SUBFILE#")
90 S IENS="?+1,"_$O(TERM(FILE,""))
91 S MYFDA(SFILE,IENS,.01)=DATE
92 S MYFDA(SFILE,IENS,.02)=STATUS
93 D UPDATE^DIE(FLAGS,"MYFDA","","MSG")
94 S:'$D(MSG("DIERR")) SUCCESS=1
95 Q SUCCESS
96 ;
97FINDSTAT(FILE,IENS,DATE) ; find status info
98 ; find status of term for given DATE
99 ; D LIST^DIC(FILE,IENS,FIELDS,FLAGS,NUMBER,[.]FROM,[.]PART,INDEX,[.]SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOT)
100 N DIERR,FIELDS,FLAGS,FROM,MSG,MYSTAT,NUMBER,STATUS
101 S STATUS="^^^"
102 S:'$G(DATE) DATE=$$NOW^XLFDT
103 S FROM=DATE+.000001
104 S FIELDS="@;.01IE;.02IE",FLAGS="B",NUMBER=1
105 D LIST^DIC(FILE,IENS,FIELDS,FLAGS,NUMBER,FROM,"","","","","MYSTAT","MSG")
106 Q:$D(MSG("DIERR")) STATUS
107 I $D(MYSTAT("DILIST","ID",1)) D
108 . N ESTAT,IDATE,IENSTAT,ISTAT
109 . S IENSTAT=$G(MYSTAT("DILIST",2,1))
110 . S ISTAT=$G(MYSTAT("DILIST","ID",1,.02,"I"))
111 . S ESTAT=$G(MYSTAT("DILIST","ID",1,.02,"E"))
112 . S IDATE=$G(MYSTAT("DILIST","ID",1,.01,"I"))
113 . S STATUS=IENSTAT_"^"_ISTAT_"^"_IDATE_"^"_ESTAT
114 ;
115 Q STATUS
116 ;
117DUPLMSTR(FILE,FIELD,TVUID) ; check duplicates
118 ; used to determine existence of duplicate
119 ; entries with the same VUID and master flag
120 ; can potentially use this from DD trigger
121 N XTTARR,DUPL
122 S DUPL=0
123 D GETIREF^XTID(FILE,FIELD,TVUID,"XTTARR",1)
124 I +$G(XTTARR) S DUPL=1
125 Q DUPL
126 ;
127CNSTR1() ; check constraints when setting VUID
128 ; called from SETVUID()
129 ; only one MASTER ENTRY FOR VUID can exist
130 N CONSTR,DUPL,MFLAG,TFILE,TFIELD
131 S CONSTR=1
132 S MFLAG=$$GETMASTR(.TERM)
133 Q:'MFLAG 'CONSTR ; no constraint
134 S TFILE=TERM("CTX","TERM FILE#")
135 S TFIELD=TERM("CTX","TERM FIELD#")
136 S DUPL=$$DUPLMSTR(TFILE,TFIELD,VUID)
137 Q:'DUPL 'CONSTR ; no constraint
138 Q CONSTR ; constrained
139 ;
140CNSTR2() ; check constraints when setting MASTER ENTRY flag
141 ; called from SETMASTR()
142 ; only one MASTER ENTRY FOR VUID can exist
143 N CONSTR,DUPL,MFLAG,TFILE,TFIELD,TVUID
144 S CONSTR=1
145 S MFLAG=$$GETMASTR(.TERM)
146 Q:MFLAG 'CONSTR ; TERM is already MASTER
147 S TFILE=TERM("CTX","TERM FILE#")
148 S TFIELD=TERM("CTX","TERM FIELD#")
149 S TVUID=$$GETVUID(.TERM)
150 S DUPL=$$DUPLMSTR(TFILE,TFIELD,TVUID)
151 Q:'DUPL 'CONSTR ; no constraint
152 Q CONSTR ; constrained
153 ;
Note: See TracBrowser for help on using the repository browser.