HLCSHDR2 ;CIOFO-SF/JC Enhanced message headers ;07/28/99 15:02
;;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCSHDR2 1229 printed Dec 13, 2024@01:56:34 Page 2
HLCSHDR2 ;CIOFO-SF/JC Enhanced message headers ;07/28/99 15:02
+1 ;;1.6;HEALTH LEVEL SEVEN;**57**;Oct 13, 1995
+2 ;OUTBOUND-CALLED BY HLCSHDR1 (TCP ONLY)
+3 ; CALLED BY HLCSHDR
+4 ;
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
