Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLDIE772

HLDIE772.m

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