| 1 | HLDIE772 ;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 | ;
|
|---|
| 10 | F201 ; 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 | ;
|
|---|
| 15 | F22 ; 772 - 2 - 0;2 - SERVER APPLICATION
|
|---|
| 16 | D UPD(0,2,VALUE)
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | F2202 ; 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 | ;
|
|---|
| 24 | F23 ; 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 | ;
|
|---|
| 33 | F24 ; 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 | ;
|
|---|
| 39 | F25 ; 772 - 5 - 0;5 - RELATED MAILMAN MESSAGE
|
|---|
| 40 | D UPD(0,5,VALUE)
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | F26 ; 772 - 6 - 0;6 [C,AH] - MESSAGE ID
|
|---|
| 44 | D UPD(0,6,VALUE)
|
|---|
| 45 | S XRF("AH")="",XRF("C")=""
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | F27 ; 772 - 7 - 0;7 - ACKNOWLEDGMENT TO
|
|---|
| 49 | D UPD(0,7,VALUE)
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | F28 ; 772 - 8 - 0;8 [AI] - PARENT MESSAGE
|
|---|
| 53 | D UPD(0,8,VALUE)
|
|---|
| 54 | S XRF("AI")=""
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | F29 ; 772 - 9 - 0;9 - PRIORITY
|
|---|
| 58 | D UPD(0,9,VALUE)
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | F210 ; 772 - 10 - 0;10 - RELATED EVENT PROTOCOL
|
|---|
| 62 | D UPD(0,10,VALUE)
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | F211 ; 772 - 11 - 0;11 [AXMITOUT1] - LOGICAL LINK
|
|---|
| 66 | D UPD(0,11,VALUE)
|
|---|
| 67 | S XRF("AXMIT")=""
|
|---|
| 68 | Q
|
|---|
| 69 | ;
|
|---|
| 70 | F212 ; 772 - 12 - 0;12 - SECURITY
|
|---|
| 71 | D UPD(0,12,VALUE)
|
|---|
| 72 | Q
|
|---|
| 73 | ;
|
|---|
| 74 | F213 ; 772 - 13 - 1;1 - CONTINUATION POINTER
|
|---|
| 75 | D UPD(1,1,VALUE)
|
|---|
| 76 | Q
|
|---|
| 77 | ;
|
|---|
| 78 | F214 ; 772 - 14 - 0;14 - MESSAGE TYPE
|
|---|
| 79 | D UPD(0,14,VALUE)
|
|---|
| 80 | Q
|
|---|
| 81 | ;
|
|---|
| 82 | F215 ; 772 - 15 - 2;1 - DON'T PURGE
|
|---|
| 83 | D UPD(2,1,VALUE)
|
|---|
| 84 | Q
|
|---|
| 85 | ;
|
|---|
| 86 | F216 ; 772 - 16 - 0;13 - NAMESPACE
|
|---|
| 87 | D UPD(0,13,VALUE)
|
|---|
| 88 | Q
|
|---|
| 89 | ;
|
|---|
| 90 | F220 ; 772 - 20 - P;1 [AF,AXMITOUT2] - STATUS
|
|---|
| 91 | D UPD("P",1,VALUE)
|
|---|
| 92 | S XRF("AF")="",XRF("AXMIT")=""
|
|---|
| 93 | Q
|
|---|
| 94 | ;
|
|---|
| 95 | F221 ; 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 | ;
|
|---|
| 101 | F222 ; 772 - 22 - P;3 - ERROR MESSAGE
|
|---|
| 102 | D UPD("P",3,VALUE)
|
|---|
| 103 | Q
|
|---|
| 104 | ;
|
|---|
| 105 | F223 ; 772 - 23 - P;4 - ERROR TYPE
|
|---|
| 106 | D UPD("P",4,VALUE)
|
|---|
| 107 | Q
|
|---|
| 108 | ;
|
|---|
| 109 | F226 ; 772 - 26 - P;7 - ACK TIMEOUT
|
|---|
| 110 | D UPD("P",7,VALUE)
|
|---|
| 111 | Q
|
|---|
| 112 | ;
|
|---|
| 113 | F2100 ; 772 - 100 - S;1 - NO. OF CHARACTERS IN MESSAGE
|
|---|
| 114 | D UPD("S",1,VALUE)
|
|---|
| 115 | Q
|
|---|
| 116 | ;
|
|---|
| 117 | F2101 ; 772 - 101 - S;2 - NO. OF EVENTS IN MESSAGE
|
|---|
| 118 | D UPD("S",2,VALUE)
|
|---|
| 119 | Q
|
|---|
| 120 | ;
|
|---|
| 121 | F2102 ; 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 | ;
|
|---|
| 129 | XRFAC ; 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 | ;
|
|---|
| 148 | XRFAF ; AF XREF kills/sets...
|
|---|
| 149 | D XRFSET(FILE,+IEN,"AF","P",1)
|
|---|
| 150 | Q
|
|---|
| 151 | ;
|
|---|
| 152 | XRFAH ; AH XREF kills/sets...
|
|---|
| 153 | D XRFSETC(FILE,+IEN,"AH",0,3,0,6)
|
|---|
| 154 | Q
|
|---|
| 155 | ;
|
|---|
| 156 | XRFAI ; AI XREF kills/sets...
|
|---|
| 157 | D XRFSET(FILE,+IEN,"AI",0,8)
|
|---|
| 158 | Q
|
|---|
| 159 | ;
|
|---|
| 160 | XRFAXMIT ; 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 | ;
|
|---|
| 177 | XRFB ; B XREF kills/sets...
|
|---|
| 178 | D XRFSET(FILE,+IEN,"B",0,1)
|
|---|
| 179 | Q
|
|---|
| 180 | ;
|
|---|
| 181 | XRFC ; C XREF kills/sets...
|
|---|
| 182 | D XRFSET(FILE,+IEN,"C",0,6)
|
|---|
| 183 | Q
|
|---|
| 184 | ;
|
|---|
| 185 | ;
|
|---|
| 186 | XRFSET(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 | ;
|
|---|
| 213 | XRFSETC(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 | ;
|
|---|
| 242 | UPD(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 | ;
|
|---|
| 256 | EOR ;HLDIE772 - Direct 772 & 773 Sets ; 11/18/2003 11:17
|
|---|
