HLCSHDR2.m

HLCSHDR2 ;CIOFO-SF/JC Enhanced message headers ;07/28/99  15:02 [ 04/02/2003   8:38 AM ]

 ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003

 ;;1.6;HEALTH LEVEL SEVEN;**57**;Oct 13, 1995

 ;OUTBOUND-CALLED BY HLCSHDR1 (TCP ONLY)

 ;         CALLED BY HLCSHDR

 ;

GEN ;If enabled, stuff INSTITUTION and DOMAIN in facility field of header

 S HLCS=$E(EC,1)

 ;get site parameters

 S HLPARAM=$$PARAM^HLCS2,HLDOM=$P(HLPARAM,U,2),HLINST=$P(HLPARAM,U,6),HLPROD=$P(HLPARAM,U,3)

 Q

EP ;Get required sending facility

 ;get LOCAL SERVER LINK info from Domain entry (HL7 site params)

 I $G(SERFAC)="" S SERFAC=HLINST_HLCS_HLDOM_HLCS_"DNS"

 Q

S ;update receiving facility with domain pointer in 870

 I $G(CLNTFAC)="" D

 .I $G(LOGLINK)]"" S HLOGLINK=LOGLINK

 .;I no logical link defined, use local site params

 .I $G(HLOGLINK)="" D  Q

 ..S CLNTFAC=HLINST_HLCS_HLDOM_HLCS_"DNS"

 .D LINK(HLOGLINK)

 .S CLNTFAC=HLCINS_HLCS_HLCDOM_HLCS_"DNS"

 Q

LINK(HLLINK) ;Returns HL7 link info from file 870

 S (HLCSTCP,HLIP,HLCINS,HLCDOM)=""

 I 'HLLINK,HLLINK]"" D

 .S HLLINK=$O(^HLCS(870,"B",HLLINK,0))

 S (HLCINS,HLCDOM)="Unknown"

 S HLCINS=$P(^HLCS(870,HLLINK,0),U,2)

 S HLCDOM=$P(^HLCS(870,HLLINK,0),U,7)

 I HLCINS S HLCINS=$P($G(^DIC(4,HLCINS,99)),U)

 I HLCDOM S HLCDOM=$P(^DIC(4.2,HLCDOM,0),U)

 ;

 Q

HLCSHDR2  ;CIOFO-SF/JC Enhanced message headers ;07/28/99  15:02 [ 04/02/2003   8:38 AM ]

 +1       ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003

 +2       ;;1.6;HEALTH LEVEL SEVEN;**57**;Oct 13, 1995

 +3       ;OUTBOUND-CALLED BY HLCSHDR1 (TCP ONLY)

 +4       ;         CALLED BY HLCSHDR

 +5       ;

GEN       ;If enabled, stuff INSTITUTION and DOMAIN in facility field of header

 +1        SET HLCS=$EXTRACT(EC,1)

 +2       ;get site parameters

 +3        SET HLPARAM=$$PARAM^HLCS2

           SET HLDOM=$PIECE(HLPARAM,U,2)

           SET HLINST=$PIECE(HLPARAM,U,6)

           SET HLPROD=$PIECE(HLPARAM,U,3)

 +4        QUIT 

EP        ;Get required sending facility

 +1       ;get LOCAL SERVER LINK info from Domain entry (HL7 site params)

 +2        IF $GET(SERFAC)=""

               SET SERFAC=HLINST_HLCS_HLDOM_HLCS_"DNS"

 +3        QUIT 

S         ;update receiving facility with domain pointer in 870

 +1        IF $GET(CLNTFAC)=""

               Begin DoDot:1

 +2                IF $GET(LOGLINK)]""

                       SET HLOGLINK=LOGLINK

 +3       ;I no logical link defined, use local site params

 +4                IF $GET(HLOGLINK)=""

                       Begin DoDot:2

 +5                        SET CLNTFAC=HLINST_HLCS_HLDOM_HLCS_"DNS"

                       End DoDot:2

                       QUIT 

 +6                DO LINK(HLOGLINK)

 +7                SET CLNTFAC=HLCINS_HLCS_HLCDOM_HLCS_"DNS"

               End DoDot:1

 +8        QUIT 

LINK(HLLINK) ;Returns HL7 link info from file 870

 +1        SET (HLCSTCP,HLIP,HLCINS,HLCDOM)=""

 +2        IF 'HLLINK

               IF HLLINK]""

                   Begin DoDot:1

 +3                    SET HLLINK=$ORDER(^HLCS(870,"B",HLLINK,0))

                   End DoDot:1

 +4        SET (HLCINS,HLCDOM)="Unknown"

 +5        SET HLCINS=$PIECE(^HLCS(870,HLLINK,0),U,2)

 +6        SET HLCDOM=$PIECE(^HLCS(870,HLLINK,0),U,7)

 +7        IF HLCINS

               SET HLCINS=$PIECE($GET(^DIC(4,HLCINS,99)),U)

 +8        IF HLCDOM

               SET HLCDOM=$PIECE(^DIC(4.2,HLCDOM,0),U)

 +9       ;

 +10       QUIT