Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLCSHDR2

HLCSHDR2.m

Go to the documentation of this file.
  1. HLCSHDR2 ;CIOFO-SF/JC Enhanced message headers ;07/28/99 15:02
  1. ;;1.6;HEALTH LEVEL SEVEN;**57**;Oct 13, 1995
  1. ;OUTBOUND-CALLED BY HLCSHDR1 (TCP ONLY)
  1. ; CALLED BY HLCSHDR
  1. ;
  1. GEN ;If enabled, stuff INSTITUTION and DOMAIN in facility field of header
  1. S HLCS=$E(EC,1)
  1. ;get site parameters
  1. S HLPARAM=$$PARAM^HLCS2,HLDOM=$P(HLPARAM,U,2),HLINST=$P(HLPARAM,U,6),HLPROD=$P(HLPARAM,U,3)
  1. Q
  1. EP ;Get required sending facility
  1. ;get LOCAL SERVER LINK info from Domain entry (HL7 site params)
  1. I $G(SERFAC)="" S SERFAC=HLINST_HLCS_HLDOM_HLCS_"DNS"
  1. Q
  1. S ;update receiving facility with domain pointer in 870
  1. I $G(CLNTFAC)="" D
  1. .I $G(LOGLINK)]"" S HLOGLINK=LOGLINK
  1. .;I no logical link defined, use local site params
  1. .I $G(HLOGLINK)="" D Q
  1. ..S CLNTFAC=HLINST_HLCS_HLDOM_HLCS_"DNS"
  1. .D LINK(HLOGLINK)
  1. .S CLNTFAC=HLCINS_HLCS_HLCDOM_HLCS_"DNS"
  1. Q
  1. S (HLCSTCP,HLIP,HLCINS,HLCDOM)=""
  1. I 'HLLINK,HLLINK]"" D
  1. .S HLLINK=$O(^HLCS(870,"B",HLLINK,0))
  1. S (HLCINS,HLCDOM)="Unknown"
  1. S HLCINS=$P(^HLCS(870,HLLINK,0),U,2)
  1. S HLCDOM=$P(^HLCS(870,HLLINK,0),U,7)
  1. I HLCINS S HLCINS=$P($G(^DIC(4,HLCINS,99)),U)
  1. I HLCDOM S HLCDOM=$P(^DIC(4.2,HLCDOM,0),U)
  1. ;
  1. Q