RAHLROUT.m

RAHLROUT ;HIRMFO/CRT - Rad/Nuc Med HL7 Interfaces Routing Logic

 ;;5.0;Radiology/Nuclear Medicine;**25**;Mar 16, 1998

 ;

RADIV ; Get the Division from the HL7 message, Piece 3 of Piece 21 of OBR.

 ;

 N I,J,RAPC,RAHLAPP

 S RADVSN=0,RAPC=21

 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=$P(X,$E(HL("ECH")),3)

 .I $L(HLNODE,HL("FS"))<RAPC D

 ..S RAPC=RAPC+1-$L(HLNODE,HL("FS"))

 ..S J=0 F  S J=$O(HLNODE(J)) Q:'J  Q:$L(HLNODE(J),HL("FS"))'<RAPC  D

 ...S RAPC=RAPC+1-$L(HLNODE(J),HL("FS"))

 ..N X

 ..S X=$P(HLNODE(J),HL("FS"),RAPC)

 ..D FORMAT^RAHLTCPB

 ..S RADVSN=$P(X,$E(HL("ECH")),3)

 ;

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

RAHLROUT  ;HIRMFO/CRT - Rad/Nuc Med HL7 Interfaces Routing Logic

 +1       ;;5.0;Radiology/Nuclear Medicine;**25**;Mar 16, 1998

 +2       ;

RADIV     ; Get the Division from the HL7 message, Piece 3 of Piece 21 of OBR.

 +1       ;

 +2        NEW I,J,RAPC,RAHLAPP

 +3        SET RADVSN=0

           SET RAPC=21

 +4        FOR I=1:1

               XECUTE HLNEXT

               IF HLQUIT'>0

                   QUIT 

               Begin DoDot:1

 +5                IF $PIECE(HLNODE,HL("FS"))'="OBR"

                       QUIT 

 +6                IF $LENGTH(HLNODE,HL("FS"))'<RAPC

                       Begin DoDot:2

 +7                        NEW X

 +8                        SET X=$PIECE(HLNODE,HL("FS"),RAPC)

 +9                        DO FORMAT^RAHLTCPB

 +10                       SET RADVSN=$PIECE(X,$EXTRACT(HL("ECH")),3)

                       End DoDot:2

 +11               IF $LENGTH(HLNODE,HL("FS"))<RAPC

                       Begin DoDot:2

 +12                       SET RAPC=RAPC+1-$LENGTH(HLNODE,HL("FS"))

 +13                       SET J=0

                           FOR 

                               SET J=$ORDER(HLNODE(J))

                               IF 'J

                                   QUIT 

                               IF $LENGTH(HLNODE(J),HL("FS"))'<RAPC

                                   QUIT 

                               Begin DoDot:3

 +14                               SET RAPC=RAPC+1-$LENGTH(HLNODE(J),HL("FS"))

                               End DoDot:3

 +15                       NEW X

 +16                       SET X=$PIECE(HLNODE(J),HL("FS"),RAPC)

 +17                       DO FORMAT^RAHLTCPB

 +18                       SET RADVSN=$PIECE(X,$EXTRACT(HL("ECH")),3)

                       End DoDot:2

               End DoDot:1

               IF RADVSN

                   QUIT 

 +19      ;

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