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

HLDIE773.m

Go to the documentation of this file. 
  1. HLDIE773 ;CIOFO-O/LJA - Direct 772 & 773 Sets ; 11/18/2003 11:17
  1.  ;;1.6;HEALTH LEVEL SEVEN;**109,115**;Oct 13,1995
  1.  ;
  1.  ;
  1. F301 ; 773 - .01 - 0;1   [B] - DATE/TIME ENTERED
  1.  D UPD^HLDIE772(0,1,VALUE)
  1.  S XRF("B")=""
  1.  Q
  1.  ;
  1. F32 ; 773 - 2 - 0;2   [C,AH] - MESSAGE ID
  1.  D UPD^HLDIE772(0,2,VALUE)
  1.  S XRF("C")="",XRF("AH")=""
  1.  Q
  1.  ;
  1. F3202 ; 773 - 2.02 - 2;2 - FAST PURGE DT/TM
  1.  ; Only fire ^HLMA(AI) xref when STATUS is changed...
  1.  D UPD^HLDIE772(2,2,VALUE)
  1.  Q
  1.  ;
  1. F33 ; 773 - 3 - 0;3 - TRANSMISSION TYPE
  1.  D UPD^HLDIE772(0,3,VALUE)
  1.  Q
  1.  ;
  1. F34 ; 773 - 4 - 0;4 - PRIORITY
  1.  D UPD^HLDIE772(0,4,VALUE)
  1.  Q
  1.  ;
  1. F35 ; 773 - 5 - 0;5 - HEADER TYPE
  1.  D UPD^HLDIE772(0,5,VALUE)
  1.  Q
  1.  ;
  1. F36 ; 773 - 6 - 0;6   [AF] - INITIAL MESSAGE
  1.  D UPD^HLDIE772(0,6,VALUE)
  1.  S XRF("AF")=""
  1.  Q
  1.  ;
  1. F37 ; 773 - 7 - 0;7   [AC] - INITIAL MESSAGE
  1.  ; Under no circumstances should DD create AC; only by package!
  1.  D UPD^HLDIE772(0,7,VALUE)
  1.  Q
  1.  ;
  1. F38 ; 773 - 8 - 0;8 - SUBSCRIBER PROTOCOL
  1.  D UPD^HLDIE772(0,8,VALUE)
  1.  Q
  1.  ;
  1. F39 ; 773 - 9 - 0;9 - SECURITY
  1.  D UPD^HLDIE772(0,9,VALUE)
  1.  Q
  1.  ;
  1. F310 ; 773 - 10 - 2;1 - DON'T PURGE
  1.  D UPD^HLDIE772(2,1,VALUE)
  1.  Q
  1.  ;
  1. F311 ; 773 - 11 - 1;1 - CONTINUATION POINTER
  1.  D UPD^HLDIE772(1,1,VALUE)
  1.  Q
  1.  ;
  1. F312 ; 773 - 12 - 0;10 - ACKNOWLEDGEMENT TO
  1.  D UPD^HLDIE772(0,10,VALUE)
  1.  Q
  1.  ;
  1. F313 ; 773 - 13 - 0;11 - SENDING APPLICATION
  1.  D UPD^HLDIE772(0,11,VALUE)
  1.  Q
  1.  ;
  1. F314 ; 773 - 14 - 0;12   [ae->AH] - RECEIVING APPLICATION
  1.  D UPD^HLDIE772(0,12,VALUE)
  1.  S XRF("AH")=""
  1.  Q
  1.  ;
  1. F315 ; 773 - 15 - 0;13 - MESSAGE TYPE
  1.  D UPD^HLDIE772(0,13,VALUE)
  1.  Q
  1.  ;
  1. F316 ; 773 - 16 - 0;14 - EVENT TYPE
  1.  D UPD^HLDIE772(0,14,VALUE)
  1.  Q
  1.  ;
  1. F320 ; 773 - 20 - P;1   [AG,AI(index)] - STATUS
  1.  N LINK,WAY
  1.  ;
  1.  D UPD^HLDIE772("P",1,VALUE)
  1.  S XRF("AG")="",XRF("AI")=""
  1.  ;
  1.  ; Quit if status isn't being set to SUCCESSFULLY COMPLETED...
  1.  QUIT:VALUE'=3  ;->
  1.  ;
  1.  ; Get AC's logical link IEN from new field...
  1.  S WAY=$P($G(NODE(0,0)),U,3) QUIT:WAY']""  ;->
  1.  ;
  1.  S LINK=$S(WAY="O":$P($G(NODE(0,0)),U,7),1:$P($G(NODE(0,0)),U,17)) QUIT:LINK'>0  ;->
  1.  QUIT:+$G(IEN)'>0  ;->
  1.  ;
  1.  KILL ^HLMA("AC",WAY,LINK,+IEN)
  1.  ;
  1.  Q
  1.  ;
  1. F321 ; 773 - 21 - P;2 - STATUS UPDATE DATE/TIME
  1.  D UPD^HLDIE772("P",2,VALUE)
  1.  Q
  1.  ;
  1. F322 ; 773 - 22 - P;3 - ERROR MESSAGE
  1.  D UPD^HLDIE772("P",3,VALUE)
  1.  Q
  1.  ;
  1. F323 ; 773 - 23 - P;4 - ERROR TYPE
  1.  D UPD^HLDIE772("P",4,VALUE)
  1.  Q
  1.  ;
  1. F324 ; 773 - 24 - P;5 - TRANSMISSION ATTEMPTS
  1.  D UPD^HLDIE772("P",5,VALUE)
  1.  Q
  1.  ;
  1. F325 ; 773 - 25 - P;6 - OPEN ATTEMPTS
  1.  D UPD^HLDIE772("P",6,VALUE)
  1.  Q
  1.  ;
  1. F326 ; 773 - 26 - P;7 - ACK TIMEOUT
  1.  D UPD^HLDIE772("P",7,VALUE)
  1.  Q
  1.  ;
  1. F3100 ; 773 - 100 - S;1   [AD] - DATE/TIME PROCESSED
  1.  ; Only fire ^HLMA(AI) xref when STATUS is changed...
  1.  D UPD^HLDIE772("S",1,VALUE)
  1.  S XRF("AD")=""
  1.  Q
  1.  ;
  1. F3200 ; 773 - 200 - MSH - MSH
  1.  ; VALUE is set in EDITALL^HLDIE to the name of the local array
  1.  ; holding the MSH segment.  Use it...
  1.  N NO,TXT
  1.  ;
  1.  ; Set MSH itself into global...
  1.  S NO=0,NO(1)=""
  1.  F  S NO=$O(@VALUE@(NO)) Q:NO'>0  D
  1.  .  S TXT=$G(@VALUE@(NO)) QUIT:TXT']""  ;->
  1.  .  S ^HLMA(+IEN,"MSH",NO,0)=TXT
  1.  .  S NO(1)=NO
  1.  ;
  1.  ; Add MSH header...
  1.  S ^HLMA(+IEN,"MSH",0)="^773.01^"_NO(1)_"^"_NO(1)
  1.  ;
  1.  Q
  1.  ;
  1.  ; =================================================================
  1.  ;
  1. XRFAC ; AC XRF kills/sets...
  1.  ; Under no circumstances should DD create AC; only by package!
  1.  Q
  1.  ;
  1. XRFAD ; AD XRF kills/sets...
  1.  D XRFSET^HLDIE772(FILE,+IEN,"AD","S",1)
  1.  Q
  1.  ;
  1. XRFAF ; AF XRF kills/sets...
  1.  D XRFSET^HLDIE772(FILE,+IEN,"AF",0,6)
  1.  Q
  1.  ;
  1. XRFAG ; AG XRF kills/sets...
  1.  D XRFSET^HLDIE772(FILE,+IEN,"AG","P",1)
  1.  Q
  1.  ;
  1. XRFAH ; AH XRF kills/sets...
  1.  D XRFSETC^HLDIE772(FILE,+IEN,"AH",0,12,0,2)
  1.  Q
  1.  ;
  1. XRFAI ; AI INDEX code...
  1.  S STATUS=$P($G(NODE("P",1)),U)
  1.  D PXREF^HLUOPTF1(+$G(IEN),STATUS)
  1.  Q
  1.  ;
  1. XRFB ; B XRF kills/sets...
  1.  D XRFSET^HLDIE772(FILE,+IEN,"B",0,1)
  1.  Q
  1.  ;
  1. XRFC ; C XRF kills/sets...
  1.  D XRFSET^HLDIE772(FILE,IEN,"C",0,2)
  1.  Q
  1.  ;
  1. XRFFPD(IEN772,FPDOLD,FPDNEW) ; This API is called by XRFFPD^HLDIE772 when 
  1.  ; a 772 Fast Purge Date/time has been changed.  
  1.  ;
  1.  ; ASSUMPTION:  The Fast Purge Date/time should be the same in both
  1.  ;              772 and 773 entries.
  1.  ;
  1.  ; ASSUMPTION:  If the Fast Purge Date/time is changed in 773, the
  1.  ;              same value should be "echoed" (set into) file 772.
  1.  ;              and vice versa.
  1.  ;
  1.  ; ASSUMPTION:  The Fast Purge Date/time will NEVER be set unless
  1.  ;              the STATUS of both 772 and 773 entries is equal to
  1.  ;              SUCCESSFULLY COMPLETED.  (For this reason, the status
  1.  ;              will never be checked.
  1.  ;
  1.  ; The purpose of this call from 772 is to...
  1.  ;
  1.  ; * Kill all ^HLMA("AI") xrefs using the old Fast Purge Date/time
  1.  ;   for both files 772 and 773.
  1.  ; * Reset the Fast Purge Date/time in all 773 entries associated with
  1.  ;   the 772 entry whose Fast Purge Date/time field was just changed.
  1.  ; * Recreate the ^HLMA("AI") xrefs based on the new Fast Purge 
  1.  ;   Date/time.
  1.  ;
  1.  N IEN773
  1.  ;
  1.  ; Checks of data...  (Code commented per Jim Moore's suggestion. LJA)
  1.  ; QUIT:$G(^HL(772,+IEN772,0))']""  ;->
  1.  ; QUIT:FPDOLD'?7N1"."1.N  ;-> Check the original Fast Purge Date/time...
  1.  ; QUIT:FPDNEW'?7N1"."1.N  ;-> Check the new date...
  1.  ; QUIT:FPDOLD=FPDNEW  ;->  No change!
  1.  ;
  1.  ; Kill old 772 AI entry...
  1.  KILL ^HLMA("AI",FPDOLD,772,+IEN772) ; Kill 772 parent AI...
  1.  ;
  1.  ; Remove old 773 entries...
  1.  S IEN773=0
  1.  F  S IEN773=$O(^HLMA("B",+IEN772,IEN773)) Q:'IEN773  D
  1.  .  KILL ^HLMA("AI",FPDOLD,773,+IEN773) ; Kill 773 child AI...
  1.  .  S $P(^HLMA(+IEN773,2),U,2)=FPDNEW ; Set 773 to match 772...
  1.  ;
  1.  ; Now, all AI xrefs killed, and the Fast Purge Date/time in both 772
  1.  ; and 773 are set to the new value, so set the new xrefs...
  1.  S IEN773=0
  1.  F  S IEN773=$O(^HLMA("B",+IEN772,IEN773)) Q:'IEN773  D
  1.  .  D PXREF^HLUOPTF1(+IEN773,3)
  1.  ;
  1.  Q
  1.  ;
  1. XRFLLCT ; LLCNT^HLCSTCP(IEN870,3) XRF kills/sets...
  1.  ;XXX D LLCNT^HLCSTCP(IEN870,3)
  1.  Q
  1.  ;
  1. EOR ;HLDIE773 - Direct 772 & 773 Sets ; 11/18/2003 11:17