source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLDIE772.m@ 1261

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

initial load of WorldVistAEHR

File size: 6.0 KB
Line 
1HLDIE772 ;CIOFO-O/LJA - Direct 772 & 773 Sets ; 11/18/2003 11:17
2 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13,1995
3 ;
4 ;
5 ; =================================================================
6 ;
7 ; The fields beginning with F2 have a common format...
8 ; [F]=Field, [2]=772, [01]=field#.01 & [2]=field#2
9 ;
10F201 ; 772 - .01 - 0;1 [B] - DATE/TIME ENTERED
11 D UPD(0,1,VALUE) ; Sets the NODE(node,1) node...
12 S XRF("B")="" ; Sets the XRF(xrf) node...
13 Q
14 ;
15F22 ; 772 - 2 - 0;2 - SERVER APPLICATION
16 D UPD(0,2,VALUE)
17 Q
18 ;
19F2202 ; 772 - 2.02 - 2;2 - FAST PURGE DT/TM
20 ; Only fire the ^HLMA(A)I xref when STATUS in 773 is changed...
21 D UPD(2,2,VALUE)
22 Q
23 ;
24F23 ; 772 - 3 - 0;3 [ae->AC,AH] - CLIENT APPLICATION
25 ;
26 ; ae->AC is in xref logic, but shouldn't be there! So, not set.
27 ; AH xref logic is not in DD, but should be!
28 ;
29 D UPD(0,3,VALUE)
30 S XRF("AH")="",XRF("AC")=""
31 Q
32 ;
33F24 ; 772 - 4 - 0;4 [AC] - TRANSMISSION TYPE
34 ; AC is in xref logic, but shouldn't be there! So, not set.
35 D UPD(0,4,VALUE)
36 S XRF("AC")=""
37 Q
38 ;
39F25 ; 772 - 5 - 0;5 - RELATED MAILMAN MESSAGE
40 D UPD(0,5,VALUE)
41 Q
42 ;
43F26 ; 772 - 6 - 0;6 [C,AH] - MESSAGE ID
44 D UPD(0,6,VALUE)
45 S XRF("AH")="",XRF("C")=""
46 Q
47 ;
48F27 ; 772 - 7 - 0;7 - ACKNOWLEDGMENT TO
49 D UPD(0,7,VALUE)
50 Q
51 ;
52F28 ; 772 - 8 - 0;8 [AI] - PARENT MESSAGE
53 D UPD(0,8,VALUE)
54 S XRF("AI")=""
55 Q
56 ;
57F29 ; 772 - 9 - 0;9 - PRIORITY
58 D UPD(0,9,VALUE)
59 Q
60 ;
61F210 ; 772 - 10 - 0;10 - RELATED EVENT PROTOCOL
62 D UPD(0,10,VALUE)
63 Q
64 ;
65F211 ; 772 - 11 - 0;11 [AXMITOUT1] - LOGICAL LINK
66 D UPD(0,11,VALUE)
67 S XRF("AXMIT")=""
68 Q
69 ;
70F212 ; 772 - 12 - 0;12 - SECURITY
71 D UPD(0,12,VALUE)
72 Q
73 ;
74F213 ; 772 - 13 - 1;1 - CONTINUATION POINTER
75 D UPD(1,1,VALUE)
76 Q
77 ;
78F214 ; 772 - 14 - 0;14 - MESSAGE TYPE
79 D UPD(0,14,VALUE)
80 Q
81 ;
82F215 ; 772 - 15 - 2;1 - DON'T PURGE
83 D UPD(2,1,VALUE)
84 Q
85 ;
86F216 ; 772 - 16 - 0;13 - NAMESPACE
87 D UPD(0,13,VALUE)
88 Q
89 ;
90F220 ; 772 - 20 - P;1 [AF,AXMITOUT2] - STATUS
91 D UPD("P",1,VALUE)
92 S XRF("AF")="",XRF("AXMIT")=""
93 Q
94 ;
95F221 ; 772 - 21 - P;2 [ad->AC] - DATE/TIME PROCESSED
96 ; ad->AC is in xref logic, but shouldn't be there! So, not set.
97 D UPD("P",2,VALUE)
98 S XRF("AC")=""
99 Q
100 ;
101F222 ; 772 - 22 - P;3 - ERROR MESSAGE
102 D UPD("P",3,VALUE)
103 Q
104 ;
105F223 ; 772 - 23 - P;4 - ERROR TYPE
106 D UPD("P",4,VALUE)
107 Q
108 ;
109F226 ; 772 - 26 - P;7 - ACK TIMEOUT
110 D UPD("P",7,VALUE)
111 Q
112 ;
113F2100 ; 772 - 100 - S;1 - NO. OF CHARACTERS IN MESSAGE
114 D UPD("S",1,VALUE)
115 Q
116 ;
117F2101 ; 772 - 101 - S;2 - NO. OF EVENTS IN MESSAGE
118 D UPD("S",2,VALUE)
119 Q
120 ;
121F2102 ; 772 - 102 - S;3 - TRANSMISSION TIME
122 D UPD("S",3,VALUE)
123 Q
124 ;
125 ; =================================================================
126 ;
127 ; The XRF fields all have a common format XRF_xrf
128 ;
129XRFAC ; AC XREF kills/sets...
130 N APP2,APP3,DTPROC,SET,TTYPE
131 ;
132 ; The xref should be created ONLY if D/T PROCESSED is not present
133 ; in the new data. The KILL logic based on the pre-change data
134 ; is always executed...
135 ;
136 ; D/T PROC'D check of new data to determine whether SET should occur...
137 S X=NODE(0,1),APP2=$P(X,U,2),APP3=$P(X,U,3),TTYPE=$P(X,U,4)
138 S DTPROC=$P(NODE("P",1),U,2)
139 S SET=0 ; Default
140 I APP3,TTYPE="O",'DTPROC S SET=1
141 ;
142 ; Do appropriate SETs and KILLs...
143 D XRFSETC(FILE,+IEN,"AC",0,4,0,3,SET)
144 ; SET controls whether new xref SET. KILLs always occur...
145 ;
146 Q
147 ;
148XRFAF ; AF XREF kills/sets...
149 D XRFSET(FILE,+IEN,"AF","P",1)
150 Q
151 ;
152XRFAH ; AH XREF kills/sets...
153 D XRFSETC(FILE,+IEN,"AH",0,3,0,6)
154 Q
155 ;
156XRFAI ; AI XREF kills/sets...
157 D XRFSET(FILE,+IEN,"AI",0,8)
158 Q
159 ;
160XRFAXMIT ; A-XMIT-OUT XREF kills/sets...
161 N IEN870,SET,STAT,STATCODE
162 ;
163 ;
164 ; Get status IEN and CODE...
165 S STAT=+NODE("P",1),STATCODE=$P($G(^HL(771.6,+STAT,0)),U,2)
166 ;
167 ; Get logical link IEN...
168 S IEN870=$P(NODE(0,1),U,11)
169 ;
170 ; Now, determine whether SETs should occur...
171 S SET=$S(STAT>0&(IEN870>0)&(STATCODE="PT"):1,1:0)
172 ;
173 D XRFSET(FILE,+IEN,"A-XMIT-OUT",0,11,SET)
174 ;
175 Q
176 ;
177XRFB ; B XREF kills/sets...
178 D XRFSET(FILE,+IEN,"B",0,1)
179 Q
180 ;
181XRFC ; C XREF kills/sets...
182 D XRFSET(FILE,+IEN,"C",0,6)
183 Q
184 ;
185 ;
186XRFSET(FILE,IEN,XRF,ND,PCE,SET) ; Perform sets and (2 subscript xrf) kills...
187 ;
188 ; Note: change stored for evaluation into NODE("XRF")...
189 ;
190 N RUN,VAL
191 ;
192 ; Should XREF be created based on new data?
193 ; If SET not defined, it should be SET=1 (to set)...
194 S SET=$S('$D(SET):1,1:+$G(SET))
195 ;
196 ; Set KILL values based on original data before XRF set...
197 S RUN=0 ; Pre-value...
198 S VAL=$P(NODE(ND,RUN),U,+PCE) I VAL]"" D
199 . S NODE("XRF","KILL",XRF,VAL,+IEN)=""
200 . I FILE=772 KILL ^HL(772,XRF,VAL,+IEN)
201 . I FILE=773 KILL ^HLMA(XRF,VAL,+IEN)
202 ;
203 ; Set SET values based on post-change data...
204 S RUN=1 ; Post-value...
205 I SET D ; Should SETs be executed? (This is the CONDITIONAL)
206 . S VAL=$P(NODE(ND,RUN),U,+PCE) I VAL]"" D
207 . . S NODE("XRF","SET",XRF,VAL,+IEN)=""
208 . . I FILE=772 S ^HL(772,XRF,VAL,+IEN)=""
209 . . I FILE=773 S ^HLMA(XRF,VAL,+IEN)=""
210 ;
211 Q
212 ;
213XRFSETC(FILE,IEN,XRF,ND1,PC1,ND2,PC2,SET) ; [C]omplex (3 subscript) XREF set/kill...
214 N RUN,VAL1,VAL2
215 ;
216 ; Note: change stored for evaluation into NODE("XRF")...
217 ;
218 ; Define SET for later...
219 S SET=$S('$D(SET):1,1:+$G(SET))
220 ;
221 ; Set KILL values based on original data before XRF set...
222 S RUN=0 ; Pre-value...
223 S VAL1=$P(NODE(ND1,RUN),U,+PC1) I VAL1]"" D
224 . S VAL2=$P(NODE(ND2,RUN),U,+PC2) I VAL2]"" D
225 . . S NODE("XRF","KILL",XRF,VAL1,VAL2,+IEN)=""
226 . . I FILE=772 KILL ^HL(772,XRF,VAL1,VAL2,+IEN)
227 . . I FILE=773 KILL ^HLMA(XRF,VAL1,VAL2,+IEN)
228 ;
229 ; Set SET values based on post-change data...
230 S RUN=1 ; Pre-value...
231 I SET D
232 . S VAL1=$P(NODE(ND1,RUN),U,+PC1) I VAL1]"" D
233 . . S VAL2=$P(NODE(ND2,RUN),U,+PC2) I VAL2]"" D
234 . . . S NODE("XRF","SET",XRF,VAL1,VAL2,+IEN)=""
235 . . . I FILE=772 S ^HL(772,XRF,VAL1,VAL2,+IEN)=""
236 . . . I FILE=773 S ^HLMA(XRF,VAL1,VAL2,+IEN)=""
237 ;
238 Q
239 ;
240 ; =================================================================
241 ;
242UPD(ND,PCE,VAL) ; Update NODE(1) piece of data...
243 ;
244 ; Is the field being changed? If not, quit...
245 QUIT:$P(NODE(ND,0),U,PCE)=VAL ;->
246 ;
247 ; Update node...
248 S $P(NODE(ND,1),U,PCE)=VAL
249 ;
250 ; Count number pieces changed on each node...
251 S NODE("CHG",ND)=$G(NODE("CHG",ND))+1
252 S NODE("CHG",ND,PCE)=""
253 ;
254 Q
255 ;
256EOR ;HLDIE772 - Direct 772 & 773 Sets ; 11/18/2003 11:17
Note: See TracBrowser for help on using the repository browser.