HLDIE772 ;CIOFO-O/LJA - Direct 772 & 773 Sets ; 11/18/2003 11:17
;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13,1995
;
;
; =================================================================
;
; The fields beginning with F2 have a common format...
; [F]=Field, [2]=772, [01]=field#.01 & [2]=field#2
;
F201 ; 772 - .01 - 0;1 [B] - DATE/TIME ENTERED
D UPD(0,1,VALUE) ; Sets the NODE(node,1) node...
S XRF("B")="" ; Sets the XRF(xrf) node...
Q
;
F22 ; 772 - 2 - 0;2 - SERVER APPLICATION
D UPD(0,2,VALUE)
Q
;
F2202 ; 772 - 2.02 - 2;2 - FAST PURGE DT/TM
; Only fire the ^HLMA(A)I xref when STATUS in 773 is changed...
D UPD(2,2,VALUE)
Q
;
F23 ; 772 - 3 - 0;3 [ae->AC,AH] - CLIENT APPLICATION
;
; ae->AC is in xref logic, but shouldn't be there! So, not set.
; AH xref logic is not in DD, but should be!
;
D UPD(0,3,VALUE)
S XRF("AH")="",XRF("AC")=""
Q
;
F24 ; 772 - 4 - 0;4 [AC] - TRANSMISSION TYPE
; AC is in xref logic, but shouldn't be there! So, not set.
D UPD(0,4,VALUE)
S XRF("AC")=""
Q
;
F25 ; 772 - 5 - 0;5 - RELATED MAILMAN MESSAGE
D UPD(0,5,VALUE)
Q
;
F26 ; 772 - 6 - 0;6 [C,AH] - MESSAGE ID
D UPD(0,6,VALUE)
S XRF("AH")="",XRF("C")=""
Q
;
F27 ; 772 - 7 - 0;7 - ACKNOWLEDGMENT TO
D UPD(0,7,VALUE)
Q
;
F28 ; 772 - 8 - 0;8 [AI] - PARENT MESSAGE
D UPD(0,8,VALUE)
S XRF("AI")=""
Q
;
F29 ; 772 - 9 - 0;9 - PRIORITY
D UPD(0,9,VALUE)
Q
;
F210 ; 772 - 10 - 0;10 - RELATED EVENT PROTOCOL
D UPD(0,10,VALUE)
Q
;
F211 ; 772 - 11 - 0;11 [AXMITOUT1] - LOGICAL LINK
D UPD(0,11,VALUE)
S XRF("AXMIT")=""
Q
;
F212 ; 772 - 12 - 0;12 - SECURITY
D UPD(0,12,VALUE)
Q
;
F213 ; 772 - 13 - 1;1 - CONTINUATION POINTER
D UPD(1,1,VALUE)
Q
;
F214 ; 772 - 14 - 0;14 - MESSAGE TYPE
D UPD(0,14,VALUE)
Q
;
F215 ; 772 - 15 - 2;1 - DON'T PURGE
D UPD(2,1,VALUE)
Q
;
F216 ; 772 - 16 - 0;13 - NAMESPACE
D UPD(0,13,VALUE)
Q
;
F220 ; 772 - 20 - P;1 [AF,AXMITOUT2] - STATUS
D UPD("P",1,VALUE)
S XRF("AF")="",XRF("AXMIT")=""
Q
;
F221 ; 772 - 21 - P;2 [ad->AC] - DATE/TIME PROCESSED
; ad->AC is in xref logic, but shouldn't be there! So, not set.
D UPD("P",2,VALUE)
S XRF("AC")=""
Q
;
F222 ; 772 - 22 - P;3 - ERROR MESSAGE
D UPD("P",3,VALUE)
Q
;
F223 ; 772 - 23 - P;4 - ERROR TYPE
D UPD("P",4,VALUE)
Q
;
F226 ; 772 - 26 - P;7 - ACK TIMEOUT
D UPD("P",7,VALUE)
Q
;
F2100 ; 772 - 100 - S;1 - NO. OF CHARACTERS IN MESSAGE
D UPD("S",1,VALUE)
Q
;
F2101 ; 772 - 101 - S;2 - NO. OF EVENTS IN MESSAGE
D UPD("S",2,VALUE)
Q
;
F2102 ; 772 - 102 - S;3 - TRANSMISSION TIME
D UPD("S",3,VALUE)
Q
;
; =================================================================
;
; The XRF fields all have a common format XRF_xrf
;
XRFAC ; AC XREF kills/sets...
N APP2,APP3,DTPROC,SET,TTYPE
;
; The xref should be created ONLY if D/T PROCESSED is not present
; in the new data. The KILL logic based on the pre-change data
; is always executed...
;
; D/T PROC'D check of new data to determine whether SET should occur...
S X=NODE(0,1),APP2=$P(X,U,2),APP3=$P(X,U,3),TTYPE=$P(X,U,4)
S DTPROC=$P(NODE("P",1),U,2)
S SET=0 ; Default
I APP3,TTYPE="O",'DTPROC S SET=1
;
; Do appropriate SETs and KILLs...
D XRFSETC(FILE,+IEN,"AC",0,4,0,3,SET)
; SET controls whether new xref SET. KILLs always occur...
;
Q
;
XRFAF ; AF XREF kills/sets...
D XRFSET(FILE,+IEN,"AF","P",1)
Q
;
XRFAH ; AH XREF kills/sets...
D XRFSETC(FILE,+IEN,"AH",0,3,0,6)
Q
;
XRFAI ; AI XREF kills/sets...
D XRFSET(FILE,+IEN,"AI",0,8)
Q
;
XRFAXMIT ; A-XMIT-OUT XREF kills/sets...
N IEN870,SET,STAT,STATCODE
;
;
; Get status IEN and CODE...
S STAT=+NODE("P",1),STATCODE=$P($G(^HL(771.6,+STAT,0)),U,2)
;
; Get logical link IEN...
S IEN870=$P(NODE(0,1),U,11)
;
; Now, determine whether SETs should occur...
S SET=$S(STAT>0&(IEN870>0)&(STATCODE="PT"):1,1:0)
;
D XRFSET(FILE,+IEN,"A-XMIT-OUT",0,11,SET)
;
Q
;
XRFB ; B XREF kills/sets...
D XRFSET(FILE,+IEN,"B",0,1)
Q
;
XRFC ; C XREF kills/sets...
D XRFSET(FILE,+IEN,"C",0,6)
Q
;
;
XRFSET(FILE,IEN,XRF,ND,PCE,SET) ; Perform sets and (2 subscript xrf) kills...
;
; Note: change stored for evaluation into NODE("XRF")...
;
N RUN,VAL
;
; Should XREF be created based on new data?
; If SET not defined, it should be SET=1 (to set)...
S SET=$S('$D(SET):1,1:+$G(SET))
;
; Set KILL values based on original data before XRF set...
S RUN=0 ; Pre-value...
S VAL=$P(NODE(ND,RUN),U,+PCE) I VAL]"" D
. S NODE("XRF","KILL",XRF,VAL,+IEN)=""
. I FILE=772 KILL ^HL(772,XRF,VAL,+IEN)
. I FILE=773 KILL ^HLMA(XRF,VAL,+IEN)
;
; Set SET values based on post-change data...
S RUN=1 ; Post-value...
I SET D ; Should SETs be executed? (This is the CONDITIONAL)
. S VAL=$P(NODE(ND,RUN),U,+PCE) I VAL]"" D
. . S NODE("XRF","SET",XRF,VAL,+IEN)=""
. . I FILE=772 S ^HL(772,XRF,VAL,+IEN)=""
. . I FILE=773 S ^HLMA(XRF,VAL,+IEN)=""
;
Q
;
XRFSETC(FILE,IEN,XRF,ND1,PC1,ND2,PC2,SET) ; [C]omplex (3 subscript) XREF set/kill...
N RUN,VAL1,VAL2
;
; Note: change stored for evaluation into NODE("XRF")...
;
; Define SET for later...
S SET=$S('$D(SET):1,1:+$G(SET))
;
; Set KILL values based on original data before XRF set...
S RUN=0 ; Pre-value...
S VAL1=$P(NODE(ND1,RUN),U,+PC1) I VAL1]"" D
. S VAL2=$P(NODE(ND2,RUN),U,+PC2) I VAL2]"" D
. . S NODE("XRF","KILL",XRF,VAL1,VAL2,+IEN)=""
. . I FILE=772 KILL ^HL(772,XRF,VAL1,VAL2,+IEN)
. . I FILE=773 KILL ^HLMA(XRF,VAL1,VAL2,+IEN)
;
; Set SET values based on post-change data...
S RUN=1 ; Pre-value...
I SET D
. S VAL1=$P(NODE(ND1,RUN),U,+PC1) I VAL1]"" D
. . S VAL2=$P(NODE(ND2,RUN),U,+PC2) I VAL2]"" D
. . . S NODE("XRF","SET",XRF,VAL1,VAL2,+IEN)=""
. . . I FILE=772 S ^HL(772,XRF,VAL1,VAL2,+IEN)=""
. . . I FILE=773 S ^HLMA(XRF,VAL1,VAL2,+IEN)=""
;
Q
;
; =================================================================
;
UPD(ND,PCE,VAL) ; Update NODE(1) piece of data...
;
; Is the field being changed? If not, quit...
QUIT:$P(NODE(ND,0),U,PCE)=VAL ;->
;
; Update node...
S $P(NODE(ND,1),U,PCE)=VAL
;
; Count number pieces changed on each node...
S NODE("CHG",ND)=$G(NODE("CHG",ND))+1
S NODE("CHG",ND,PCE)=""
;
Q
;
EOR ;HLDIE772 - Direct 772 & 773 Sets ; 11/18/2003 11:17
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLDIE772 6451 printed Oct 16, 2024@17:58:03 Page 2
HLDIE772 ;CIOFO-O/LJA - Direct 772 & 773 Sets ; 11/18/2003 11:17
+1 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13,1995
+2 ;
+3 ;
+4 ; =================================================================
+5 ;
+6 ; The fields beginning with F2 have a common format...
+7 ; [F]=Field, [2]=772, [01]=field#.01 & [2]=field#2
+8 ;
F201 ; 772 - .01 - 0;1 [B] - DATE/TIME ENTERED
+1 ; Sets the NODE(node,1) node...
DO UPD(0,1,VALUE)
+2 ; Sets the XRF(xrf) node...
SET XRF("B")=""
+3 QUIT
+4 ;
F22 ; 772 - 2 - 0;2 - SERVER APPLICATION
+1 DO UPD(0,2,VALUE)
+2 QUIT
+3 ;
F2202 ; 772 - 2.02 - 2;2 - FAST PURGE DT/TM
+1 ; Only fire the ^HLMA(A)I xref when STATUS in 773 is changed...
+2 DO UPD(2,2,VALUE)
+3 QUIT
+4 ;
F23 ; 772 - 3 - 0;3 [ae->AC,AH] - CLIENT APPLICATION
+1 ;
+2 ; ae->AC is in xref logic, but shouldn't be there! So, not set.
+3 ; AH xref logic is not in DD, but should be!
+4 ;
+5 DO UPD(0,3,VALUE)
+6 SET XRF("AH")=""
SET XRF("AC")=""
+7 QUIT
+8 ;
F24 ; 772 - 4 - 0;4 [AC] - TRANSMISSION TYPE
+1 ; AC is in xref logic, but shouldn't be there! So, not set.
+2 DO UPD(0,4,VALUE)
+3 SET XRF("AC")=""
+4 QUIT
+5 ;
F25 ; 772 - 5 - 0;5 - RELATED MAILMAN MESSAGE
+1 DO UPD(0,5,VALUE)
+2 QUIT
+3 ;
F26 ; 772 - 6 - 0;6 [C,AH] - MESSAGE ID
+1 DO UPD(0,6,VALUE)
+2 SET XRF("AH")=""
SET XRF("C")=""
+3 QUIT
+4 ;
F27 ; 772 - 7 - 0;7 - ACKNOWLEDGMENT TO
+1 DO UPD(0,7,VALUE)
+2 QUIT
+3 ;
F28 ; 772 - 8 - 0;8 [AI] - PARENT MESSAGE
+1 DO UPD(0,8,VALUE)
+2 SET XRF("AI")=""
+3 QUIT
+4 ;
F29 ; 772 - 9 - 0;9 - PRIORITY
+1 DO UPD(0,9,VALUE)
+2 QUIT
+3 ;
F210 ; 772 - 10 - 0;10 - RELATED EVENT PROTOCOL
+1 DO UPD(0,10,VALUE)
+2 QUIT
+3 ;
F211 ; 772 - 11 - 0;11 [AXMITOUT1] - LOGICAL LINK
+1 DO UPD(0,11,VALUE)
+2 SET XRF("AXMIT")=""
+3 QUIT
+4 ;
F212 ; 772 - 12 - 0;12 - SECURITY
+1 DO UPD(0,12,VALUE)
+2 QUIT
+3 ;
F213 ; 772 - 13 - 1;1 - CONTINUATION POINTER
+1 DO UPD(1,1,VALUE)
+2 QUIT
+3 ;
F214 ; 772 - 14 - 0;14 - MESSAGE TYPE
+1 DO UPD(0,14,VALUE)
+2 QUIT
+3 ;
F215 ; 772 - 15 - 2;1 - DON'T PURGE
+1 DO UPD(2,1,VALUE)
+2 QUIT
+3 ;
F216 ; 772 - 16 - 0;13 - NAMESPACE
+1 DO UPD(0,13,VALUE)
+2 QUIT
+3 ;
F220 ; 772 - 20 - P;1 [AF,AXMITOUT2] - STATUS
+1 DO UPD("P",1,VALUE)
+2 SET XRF("AF")=""
SET XRF("AXMIT")=""
+3 QUIT
+4 ;
F221 ; 772 - 21 - P;2 [ad->AC] - DATE/TIME PROCESSED
+1 ; ad->AC is in xref logic, but shouldn't be there! So, not set.
+2 DO UPD("P",2,VALUE)
+3 SET XRF("AC")=""
+4 QUIT
+5 ;
F222 ; 772 - 22 - P;3 - ERROR MESSAGE
+1 DO UPD("P",3,VALUE)
+2 QUIT
+3 ;
F223 ; 772 - 23 - P;4 - ERROR TYPE
+1 DO UPD("P",4,VALUE)
+2 QUIT
+3 ;
F226 ; 772 - 26 - P;7 - ACK TIMEOUT
+1 DO UPD("P",7,VALUE)
+2 QUIT
+3 ;
F2100 ; 772 - 100 - S;1 - NO. OF CHARACTERS IN MESSAGE
+1 DO UPD("S",1,VALUE)
+2 QUIT
+3 ;
F2101 ; 772 - 101 - S;2 - NO. OF EVENTS IN MESSAGE
+1 DO UPD("S",2,VALUE)
+2 QUIT
+3 ;
F2102 ; 772 - 102 - S;3 - TRANSMISSION TIME
+1 DO UPD("S",3,VALUE)
+2 QUIT
+3 ;
+4 ; =================================================================
+5 ;
+6 ; The XRF fields all have a common format XRF_xrf
+7 ;
XRFAC ; AC XREF kills/sets...
+1 NEW APP2,APP3,DTPROC,SET,TTYPE
+2 ;
+3 ; The xref should be created ONLY if D/T PROCESSED is not present
+4 ; in the new data. The KILL logic based on the pre-change data
+5 ; is always executed...
+6 ;
+7 ; D/T PROC'D check of new data to determine whether SET should occur...
+8 SET X=NODE(0,1)
SET APP2=$PIECE(X,U,2)
SET APP3=$PIECE(X,U,3)
SET TTYPE=$PIECE(X,U,4)
+9 SET DTPROC=$PIECE(NODE("P",1),U,2)
+10 ; Default
SET SET=0
+11 IF APP3
IF TTYPE="O"
IF 'DTPROC
SET SET=1
+12 ;
+13 ; Do appropriate SETs and KILLs...
+14 DO XRFSETC(FILE,+IEN,"AC",0,4,0,3,SET)
+15 ; SET controls whether new xref SET. KILLs always occur...
+16 ;
+17 QUIT
+18 ;
XRFAF ; AF XREF kills/sets...
+1 DO XRFSET(FILE,+IEN,"AF","P",1)
+2 QUIT
+3 ;
XRFAH ; AH XREF kills/sets...
+1 DO XRFSETC(FILE,+IEN,"AH",0,3,0,6)
+2 QUIT
+3 ;
XRFAI ; AI XREF kills/sets...
+1 DO XRFSET(FILE,+IEN,"AI",0,8)
+2 QUIT
+3 ;
XRFAXMIT ; A-XMIT-OUT XREF kills/sets...
+1 NEW IEN870,SET,STAT,STATCODE
+2 ;
+3 ;
+4 ; Get status IEN and CODE...
+5 SET STAT=+NODE("P",1)
SET STATCODE=$PIECE($GET(^HL(771.6,+STAT,0)),U,2)
+6 ;
+7 ; Get logical link IEN...
+8 SET IEN870=$PIECE(NODE(0,1),U,11)
+9 ;
+10 ; Now, determine whether SETs should occur...
+11 SET SET=$SELECT(STAT>0&(IEN870>0)&(STATCODE="PT"):1,1:0)
+12 ;
+13 DO XRFSET(FILE,+IEN,"A-XMIT-OUT",0,11,SET)
+14 ;
+15 QUIT
+16 ;
XRFB ; B XREF kills/sets...
+1 DO XRFSET(FILE,+IEN,"B",0,1)
+2 QUIT
+3 ;
XRFC ; C XREF kills/sets...
+1 DO XRFSET(FILE,+IEN,"C",0,6)
+2 QUIT
+3 ;
+4 ;
XRFSET(FILE,IEN,XRF,ND,PCE,SET) ; Perform sets and (2 subscript xrf) kills...
+1 ;
+2 ; Note: change stored for evaluation into NODE("XRF")...
+3 ;
+4 NEW RUN,VAL
+5 ;
+6 ; Should XREF be created based on new data?
+7 ; If SET not defined, it should be SET=1 (to set)...
+8 SET SET=$SELECT('$DATA(SET):1,1:+$GET(SET))
+9 ;
+10 ; Set KILL values based on original data before XRF set...
+11 ; Pre-value...
SET RUN=0
+12 SET VAL=$PIECE(NODE(ND,RUN),U,+PCE)
IF VAL]""
Begin DoDot:1
+13 SET NODE("XRF","KILL",XRF,VAL,+IEN)=""
+14 IF FILE=772
KILL ^HL(772,XRF,VAL,+IEN)
+15 IF FILE=773
KILL ^HLMA(XRF,VAL,+IEN)
End DoDot:1
+16 ;
+17 ; Set SET values based on post-change data...
+18 ; Post-value...
SET RUN=1
+19 ; Should SETs be executed? (This is the CONDITIONAL)
IF SET
Begin DoDot:1
+20 SET VAL=$PIECE(NODE(ND,RUN),U,+PCE)
IF VAL]""
Begin DoDot:2
+21 SET NODE("XRF","SET",XRF,VAL,+IEN)=""
+22 IF FILE=772
SET ^HL(772,XRF,VAL,+IEN)=""
+23 IF FILE=773
SET ^HLMA(XRF,VAL,+IEN)=""
End DoDot:2
End DoDot:1
+24 ;
+25 QUIT
+26 ;
XRFSETC(FILE,IEN,XRF,ND1,PC1,ND2,PC2,SET) ; [C]omplex (3 subscript) XREF set/kill...
+1 NEW RUN,VAL1,VAL2
+2 ;
+3 ; Note: change stored for evaluation into NODE("XRF")...
+4 ;
+5 ; Define SET for later...
+6 SET SET=$SELECT('$DATA(SET):1,1:+$GET(SET))
+7 ;
+8 ; Set KILL values based on original data before XRF set...
+9 ; Pre-value...
SET RUN=0
+10 SET VAL1=$PIECE(NODE(ND1,RUN),U,+PC1)
IF VAL1]""
Begin DoDot:1
+11 SET VAL2=$PIECE(NODE(ND2,RUN),U,+PC2)
IF VAL2]""
Begin DoDot:2
+12 SET NODE("XRF","KILL",XRF,VAL1,VAL2,+IEN)=""
+13 IF FILE=772
KILL ^HL(772,XRF,VAL1,VAL2,+IEN)
+14 IF FILE=773
KILL ^HLMA(XRF,VAL1,VAL2,+IEN)
End DoDot:2
End DoDot:1
+15 ;
+16 ; Set SET values based on post-change data...
+17 ; Pre-value...
SET RUN=1
+18 IF SET
Begin DoDot:1
+19 SET VAL1=$PIECE(NODE(ND1,RUN),U,+PC1)
IF VAL1]""
Begin DoDot:2
+20 SET VAL2=$PIECE(NODE(ND2,RUN),U,+PC2)
IF VAL2]""
Begin DoDot:3
+21 SET NODE("XRF","SET",XRF,VAL1,VAL2,+IEN)=""
+22 IF FILE=772
SET ^HL(772,XRF,VAL1,VAL2,+IEN)=""
+23 IF FILE=773
SET ^HLMA(XRF,VAL1,VAL2,+IEN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+24 ;
+25 QUIT
+26 ;
+27 ; =================================================================
+28 ;
UPD(ND,PCE,VAL) ; Update NODE(1) piece of data...
+1 ;
+2 ; Is the field being changed? If not, quit...
+3 ;->
if $PIECE(NODE(ND,0),U,PCE)=VAL
QUIT
+4 ;
+5 ; Update node...
+6 SET $PIECE(NODE(ND,1),U,PCE)=VAL
+7 ;
+8 ; Count number pieces changed on each node...
+9 SET NODE("CHG",ND)=$GET(NODE("CHG",ND))+1
+10 SET NODE("CHG",ND,PCE)=""
+11 ;
+12 QUIT
+13 ;
EOR ;HLDIE772 - Direct 772 & 773 Sets ; 11/18/2003 11:17
