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

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

initial load of WorldVistAEHR
File size: 5.1 KB
RevLine 
[613]1XTID1 ;OAKCIOFO/JLG - Implementation of API set in XTID ;04/20/2005 15:12
2 ;;7.3;TOOLKIT;**93**;Apr 25, 1995
3 ; Reference to $$SCREEN^HDISVF01 supported by IA #4640
4 Q
5GETVUID ;
6 ; called from GETVUID^XTID(TFILE,TFIELD,TIREF)
7 N CTX,TERM,VUID
8 S TFILE=+$G(TFILE),TFIELD=+$G(TFIELD),TIREF=$G(TIREF)
9 S:'TFIELD TFIELD=.01
10 D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
11 Q:'$D(CTX) "0^invalid combination of FILE/FIELD"
12 D FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
13 Q:'$D(TERM) "0^TERM IREF doesn't exist in this FILE/FIELD context"
14 S VUID=$$GETVUID^XTIDTERM(.TERM)
15 Q:'$G(VUID) "0^TERM index did not contain VUID value"
16 Q VUID
17 ;
18GETSTAT ;
19 ; called from GETSTAT^XTID(TFILE,TFIELD,TIREF,TDATE)
20 N CTX,STATUS,TERM
21 S TFILE=+$G(TFILE),TFIELD=+$G(TFIELD),TIREF=$G(TIREF)
22 S:'$G(TDATE) TDATE=$$NOW^XLFDT
23 S:'TFIELD TFIELD=.01
24 D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
25 Q:'$D(CTX) "^invalid combination of FILE/FIELD"
26 D FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
27 Q:'$D(TERM) "^TERM IREF doesn't exist in this FILE/FIELD context"
28 S STATUS=""
29 S STATUS=$$GETSTAT^XTIDTERM(.TERM,TDATE)
30 Q:STATUS']"" ""
31 Q STATUS
32 ;
33GETMASTR ;
34 ; called from GETMASTR^XTID(TFILE,TFIELD,TIREF)
35 N CTX,TERM,MASTR
36 S TFILE=+$G(TFILE),TFIELD=+$G(TFIELD),TIREF=$G(TIREF)
37 S:'TFIELD TFIELD=.01
38 D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
39 Q:'$D(CTX) "0^invalid combination of FILE/FIELD"
40 D FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
41 Q:'$D(TERM) "0^TERM IREF doesn't exist in this FILE/FIELD context"
42 S MASTR=""
43 S MASTR=$$GETMASTR^XTIDTERM(.TERM)
44 Q:MASTR']"" ""
45 Q MASTR
46 ;
47SETVUID ;
48 ; called from SETVUID^XTID(TFILE,TFIELD,TIREF,TVUID)
49 N CTX,TERM,SUCCESS,OLDVUID
50 S TFILE=+$G(TFILE),TFIELD=+$G(TFIELD),TIREF=$G(TIREF),TVUID=$G(TVUID)
51 S:'TFIELD TFIELD=.01
52 S SUCCESS=0
53 D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
54 Q:'$D(CTX) "0^invalid combination of FILE/FIELD"
55 Q:'$$VALIDREF^XTIDCTX(.CTX,TIREF) "0^TERM IREF doesn't exist in this FILE/FIELD context"
56 D FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
57 ;
58 ; create new term index entry in "set of codes" not in "tables"
59 I '$D(TERM) S SUCCESS=$$NEWTERM^XTIDCTX(.CTX,TIREF,TVUID) Q SUCCESS
60 ;
61 ; TERM exists
62 ; existing entries with empty VUID-related data
63 ; determine existing value of VUID
64 S OLDVUID=$$GETVUID^XTIDTERM(.TERM)
65 I OLDVUID S SUCCESS=$$RPLVUID(OLDVUID,TVUID) Q SUCCESS
66 ; 'OLDVUID
67 ; set VUID for the first time for existing entry
68 S SUCCESS=$$NEWVUID()
69 Q SUCCESS
70 ;
71SETSTAT ;
72 ; called from SETSTAT^XTID(TFILE,TFIELD,TIREF,TSTAT,TDATE)
73 N CTX,TERM
74 S TFILE=+$G(TFILE),TFIELD=+$G(TFIELD),TIREF=$G(TIREF),TSTAT=+$G(TSTAT)
75 S:'$G(TDATE) TDATE=$$NOW^XLFDT
76 S:'TFIELD TFIELD=.01
77 D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
78 Q:'$D(CTX) "0^invalid combination of FILE/FIELD"
79 D FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
80 Q:'$D(TERM) "0^TERM IREF doesn't exist in this FILE/FIELD context"
81 Q:'$$GETVUID^XTIDTERM(.TERM) "0^VUID value must exist before setting STATUS info"
82 Q:'$$SETSTAT^XTIDTERM(.TERM,TSTAT,TDATE) "0^unable to set status for the term index"
83 Q 1
84 ;
85SETMASTR ;
86 ; called from SETMASTR^XTID(TFILE,TFIELD,TIREF,TMASTER)
87 ; constraint: only one entry could be master for given
88 ; reference term, must check success after setting master
89 N CTX,TERM,NEWMASTR
90 S TFILE=+$G(TFILE),TFIELD=+$G(TFIELD),TIREF=$G(TIREF)
91 S TMASTER=+$G(TMASTER)
92 S:'TFIELD TFIELD=.01
93 D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
94 Q:'$D(CTX) "0^invalid combination of FILE/FIELD"
95 D FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
96 Q:'$D(TERM) "0^TERM IREF doesn't exist in this FILE/FIELD context"
97 Q:'$$GETVUID^XTIDTERM(.TERM) "0^VUID value must exist before setting master flag"
98 Q:'$$SETMASTR^XTIDTERM(.TERM,TMASTER) "0^unable to set master flag for the term index"
99 ; check success based on constraint
100 S NEWMASTR=$$GETMASTR^XTID(TFILE,TFIELD,TIREF)
101 Q:NEWMASTR'=TMASTER "0^pre-existing master entry"
102 Q 1
103 ;
104GETIREF ;
105 ; called from GETIREF^XTID(TFILE,TFIELD,TVUID,TARRAY,TMASTER)
106 N CTX,TERM
107 S TFILE=+$G(TFILE),TFIELD=$G(TFIELD),TVUID=$G(TVUID)
108 S TMASTER=+$G(TMASTER)
109 Q:$G(TARRAY)']""
110 D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
111 I '$D(CTX) S @TARRAY@("ERROR")="invalid FILE/FIELD combination" Q
112 S @TARRAY=0
113 D SRCHTRMS^XTIDCTX(.CTX,TVUID,TARRAY,TMASTER)
114 Q
115 ;
116SCREEN ;
117 ; called from SCREEN^XTID(TFILE,TFIELD,TIREF,TDATE)
118 N SCREEN,STATUS,ACTIVE
119 S SCREEN=1
120 S:'$G(TDATE) TDATE=$$NOW^XLFDT
121 S SCREEN=$$SCREEN^HDISVF01(+$G(TFILE),+$G(TFIELD),+$G(TDATE))
122 Q:'SCREEN SCREEN
123 S STATUS=$$GETSTAT^XTID(+$G(TFILE),+$G(TFIELD),$G(TIREF),+$G(TDATE))
124 S ACTIVE=$P(STATUS,"^",1)
125 S SCREEN=$S(ACTIVE:0,1:1)
126 Q SCREEN
127 ;
128RPLVUID(OLDV,NEWV) ;
129 ; called from SETVUID(TFILE,TFIELD,TIREF,TVUID)
130 ; existing TERM index entry with VUID value
131 N SUCCESS S SUCCESS=1
132 I OLDV=NEWV Q SUCCESS
133 ; replace existing VUID value
134 I '$$SETVUID^XTIDTERM(.TERM,NEWV) D Q SUCCESS
135 . S SUCCESS="0^unable to replace VUID value to existing term entry" Q
136 ;
137 Q SUCCESS
138 ;
139NEWVUID() ;
140 ; called from SETVUID(TFILE,TFIELD,TIREF,TVUID)
141 ; set VUID value to existing TERM entry
142 ; for the first time
143 N MASTER,SUCCESS
144 S SUCCESS=1,MASTER=1
145 I '$$SETVUID^XTIDTERM(.TERM,TVUID) D Q SUCCESS
146 . S SUCCESS="0^unable to add VUID value to existing term entry"
147 ;
148 ; set master=1 default, will be overridden if duplicate master
149 I '$$SETMASTR^XTIDTERM(.TERM,MASTER) D Q SUCCESS
150 . S SUCCESS="0^unable to add MASTER VUID value to existing term entry"
151 ;
152 Q SUCCESS
153 ;
Note: See TracBrowser for help on using the repository browser.