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