RAHLROUT ;HIRMFO/CRT - Rad/Nuc Med HL7 Interfaces Routing Logic; Aug 28, 2020@10:06:28
;;5.0;Radiology/Nuclear Medicine;**25,173**;Mar 16, 1998;Build 1
;
RADIV ; Get the Division from the HL7 message, Piece 3 of Piece 21 of OBR.
;
I '$D(HL("FS")) D ;p173/KLM HL array may have been killed except HL("EIDS")
.S HL="HLS(""HLS"")"
.D INIT^HLFNC2($G(RAEID),.HL,$G(INT))
.Q
N I,J,RAPC,RAHLAPP
S RADVSN=0,RAPC=$S(HL("VER")>2.3:22,1:21) ;p173 division moved to OBR21 in v2.4
I HL("VER")>2.3 N RAECH S RAECH="`"
F I=1:1 X HLNEXT Q:HLQUIT'>0 D Q:RADVSN
.Q:$P(HLNODE,HL("FS"))'="OBR"
.I $L(HLNODE,HL("FS"))>RAPC D
..N X
..S X=$P(HLNODE,HL("FS"),RAPC)
..D FORMAT^RAHLTCPB
..S RADVSN=$S(HL("VER")>2.3:+$P(X,RAECH,3),1:$P(X,$E(HL("ECH")),3)) ;p173 non-standard dilimiter used in v2.4
..Q
.;p173 HLNODE could be split ON the piece we need
.I $L(HLNODE,HL("FS"))<RAPC D
..N RANODE M RANODE=HLNODE
..S J=0 F S J=$O(RANODE(J)) Q:'J D Q:$L(RANODE(J),HL("FS"))>RAPC
...S RANODE=RANODE_RANODE(J)
...Q
..N X
..S X=$P(RANODE,HL("FS"),RAPC)
..D FORMAT^RAHLTCPB
..S RADVSN=$S(HL("VER")>2.3:+$P(X,RAECH,3),1:$P(X,$E(HL("ECH")),3)) ;p173 non-standard dilimiter used in v2.4
..Q
.Q
;
RAHLL ; Check field .129 in Division File #79 for specific interfaces.
;
; If Receiving App listed as interface for this division, set and quit.
;
S RAHLAPP=$P($G(^ORD(101,+HL("EIDS"),770)),"^",2)
Q:'RAHLAPP
I $D(^RA(79,+RADVSN,"HL7","B",+RAHLAPP)) D LINK(HL("EIDS")) Q
;
; Otherwise just QUIT, no message will be created for this SUBSCRIBER.
Q
;
LINK(IEN) ; Return LINK information for subscriber
; INPUT - IEN: IEN of protocol file
; OUTPUT - SUBSCRIBER PROTOCOL^LOGICAL LINK in HLL("LINKS",1)
;
S IEN=$G(IEN) Q:(IEN="")
;
; Make sure this is a subscriber type
Q:$P($G(^ORD(101,IEN,0)),"^",4)'="S"
;
S HLL("LINKS",1)=$P(^ORD(101,IEN,0),"^")_"^"_$P($G(^HLCS(870,+$P(^ORD(101,IEN,770),"^",7),0)),"^")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAHLROUT 1976 printed Apr 09, 2024@21:41:41 Page 2
RAHLROUT ;HIRMFO/CRT - Rad/Nuc Med HL7 Interfaces Routing Logic; Aug 28, 2020@10:06:28
+1 ;;5.0;Radiology/Nuclear Medicine;**25,173**;Mar 16, 1998;Build 1
+2 ;
RADIV ; Get the Division from the HL7 message, Piece 3 of Piece 21 of OBR.
+1 ;
+2 ;p173/KLM HL array may have been killed except HL("EIDS")
IF '$DATA(HL("FS"))
Begin DoDot:1
+3 SET HL="HLS(""HLS"")"
+4 DO INIT^HLFNC2($GET(RAEID),.HL,$GET(INT))
+5 QUIT
End DoDot:1
+6 NEW I,J,RAPC,RAHLAPP
+7 ;p173 division moved to OBR21 in v2.4
SET RADVSN=0
SET RAPC=$SELECT(HL("VER")>2.3:22,1:21)
+8 IF HL("VER")>2.3
NEW RAECH
SET RAECH="`"
+9 FOR I=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
Begin DoDot:1
+10 if $PIECE(HLNODE,HL("FS"))'="OBR"
QUIT
+11 IF $LENGTH(HLNODE,HL("FS"))>RAPC
Begin DoDot:2
+12 NEW X
+13 SET X=$PIECE(HLNODE,HL("FS"),RAPC)
+14 DO FORMAT^RAHLTCPB
+15 ;p173 non-standard dilimiter used in v2.4
SET RADVSN=$SELECT(HL("VER")>2.3:+$PIECE(X,RAECH,3),1:$PIECE(X,$EXTRACT(HL("ECH")),3))
+16 QUIT
End DoDot:2
+17 ;p173 HLNODE could be split ON the piece we need
+18 IF $LENGTH(HLNODE,HL("FS"))<RAPC
Begin DoDot:2
+19 NEW RANODE
MERGE RANODE=HLNODE
+20 SET J=0
FOR
SET J=$ORDER(RANODE(J))
if 'J
QUIT
Begin DoDot:3
+21 SET RANODE=RANODE_RANODE(J)
+22 QUIT
End DoDot:3
if $LENGTH(RANODE(J),HL("FS"))>RAPC
QUIT
+23 NEW X
+24 SET X=$PIECE(RANODE,HL("FS"),RAPC)
+25 DO FORMAT^RAHLTCPB
+26 ;p173 non-standard dilimiter used in v2.4
SET RADVSN=$SELECT(HL("VER")>2.3:+$PIECE(X,RAECH,3),1:$PIECE(X,$EXTRACT(HL("ECH")),3))
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
if RADVSN
QUIT
+29 ;
RAHLL ; Check field .129 in Division File #79 for specific interfaces.
+1 ;
+2 ; If Receiving App listed as interface for this division, set and quit.
+3 ;
+4 SET RAHLAPP=$PIECE($GET(^ORD(101,+HL("EIDS"),770)),"^",2)
+5 if 'RAHLAPP
QUIT
+6 IF $DATA(^RA(79,+RADVSN,"HL7","B",+RAHLAPP))
DO LINK(HL("EIDS"))
QUIT
+7 ;
+8 ; Otherwise just QUIT, no message will be created for this SUBSCRIBER.
+9 QUIT
+10 ;
LINK(IEN) ; Return LINK information for subscriber
+1 ; INPUT - IEN: IEN of protocol file
+2 ; OUTPUT - SUBSCRIBER PROTOCOL^LOGICAL LINK in HLL("LINKS",1)
+3 ;
+4 SET IEN=$GET(IEN)
if (IEN="")
QUIT
+5 ;
+6 ; Make sure this is a subscriber type
+7 if $PIECE($GET(^ORD(101,IEN,0)),"^",4)'="S"
QUIT
+8 ;
+9 SET HLL("LINKS",1)=$PIECE(^ORD(101,IEN,0),"^")_"^"_$PIECE($GET(^HLCS(870,+$PIECE(^ORD(101,IEN,770),"^",7),0)),"^")
+10 QUIT
