HLOTLNK ;IRMFO-ALB/CJM - APIs for the HL Logical Link file;03/24/2004 14:43
;;1.6;HEALTH LEVEL SEVEN;**126,130,131**;Oct 13, 1995;Build 10
;
SETSHUT(LINKIEN) ;
;sets the shutdown flag (can not fail - if the link doesn't exist, by definition its shutdown)
Q:'$G(LINKIEN) 1
Q:'$D(^HLCS(870,LINKIEN,0)) 1
S $P(^HLCS(870,LINKIEN,0),"^",16)=1
Q 1
SETOPEN(LINKIEN) ;
;clears the shutdown flag, returns 1 on success, 0 on failure
Q:'$G(LINKIEN) 0
Q:'$D(^HLCS(870,LINKIEN,0)) 0
S $P(^HLCS(870,LINKIEN,0),"^",16)=""
Q 1
;
IFSHUT(LINKNAME) ;
;returns 1 if the link was shut down to HLO
N IEN,LINK
S LINK=$P($G(LINKNAME),":")
Q:LINK=""
S IEN=$O(^HLCS(870,"B",LINK,0))
Q:'IEN 1
Q:$P($G(^HLCS(870,IEN,0)),"^",16) 1
Q 0
;
DOMAIN(LINKIEN) ;
;Returns the domain associated with this link
;
Q:'$G(LINKIEN) ""
N NODE,DOMAIN
S DOMAIN=""
S NODE=$G(^HLCS(870,LINKIEN,0))
I $P(NODE,"^",7) D
.S DOMAIN=$P($G(^DIC(4.2,$P(NODE,"^",7),0)),"^")
.S DOMAIN=$S($L(DOMAIN):"HL7."_DOMAIN,1:"")
I '$L(DOMAIN) S DOMAIN=$P(NODE,"^",8)
Q DOMAIN
PORT(LINKIEN) ;
;Returns the HLO port associated with this link
;
Q:'$G(LINKIEN) ""
N NODE,PORT
S NODE=$G(^HLCS(870,LINKIEN,400))
S PORT=$P(NODE,"^",8)
S:'PORT PORT=$S($P($G(^HLD(779.1,1,0)),"^",3)="P":5001,1:5026)
Q PORT
;
PORT2(LINKNAME) ;given the name of the link, returns its HLO port
Q $$PORT($O(^HLCS(870,"B",LINKNAME,0)))
;
STATNUM(LINKIEN) ;
;Given the ien of the link, this function returns the station #.
;
Q:'$G(LINKIEN) ""
N INST
S INST=$P($G(^HLCS(870,LINKIEN,0)),"^",2)
Q:'INST ""
Q $P($G(^DIC(4,INST,99)),"^")
;
FINDLINK(STATN) ;
;Returns the link ien based on the station # =STATN
;The link found must have a name starting with "VA", as these are
;reserved for officially released links associated with VHA institutions
;** EXCEPTION** MPIVA is an official link associated with 200M
;
Q:'$L($G(STATN)) 0
;
N NAME,IEN
S (NAME,IEN)=""
F S NAME=$O(^HLCS(870,"AC",STATN,NAME)) Q:NAME="" I (NAME'="VA-VIE"),($E(NAME,1,2)="VA")!(NAME="MPIVA") S IEN=$O(^HLCS(870,"AC",STATN,NAME,0)) Q
Q IEN
;
GETLINK(LINKNAME,LINK) ;
N IEN
S IEN=$O(^HLCS(870,"B",LINKNAME,0))
I IEN Q $$GET(IEN,.LINK)
I LINKNAME="HLO DEFAULT LISTENER" D Q 1
.N NODE
.S LINK("NAME")=LINKNAME
.S LINK("IEN")=0
.S LINK("SHUTDOWN")=""
.S LINK("LLP")="TCP"
.S LINK("SERVER")="1^"_"M"
.S NODE=$G(^HLD(779.1,1,0))
.S LINK("DOMAIN")=$P(NODE,"^",1)
.S LINK("PORT")=$S($P(NODE,"^",3)="P":5001,$P(NODE,"^",3)="T":5026,1:"")
.S LINK("IP")=""
Q 0
GET(IEN,LINK) ;
N NODE,PTR
K LINK
S NODE=$G(^HLCS(870,IEN,0))
Q:NODE="" 0
S LINK("NAME")=$P(NODE,"^")
S LINK("IEN")=IEN
S LINK("SHUTDOWN")=+$P(NODE,"^",16)
I $P(NODE,"^",7) D
.S LINK("DOMAIN")=$P(^DIC(4.2,$P(NODE,"^",7),0),"^")
.S LINK("DOMAIN")=$S($L(LINK("DOMAIN")):"HL7."_LINK("DOMAIN"),1:"")
I $G(LINK("DOMAIN"))="" S LINK("DOMAIN")=$P(NODE,"^",8)
S PTR=$P(NODE,"^",3)
S LINK("LLP")=$S('PTR:"",1:$P($G(^HLCS(869.1,PTR,0)),"^"))
S LINK("SERVER")=""
I LINK("LLP")="TCP" D
.S LINK("SERVER")=1
.S NODE=$G(^HLCS(870,IEN,400))
.S LINK("IP")=$P(NODE,"^")
.S LINK("PORT")=$P(NODE,"^",8)
.S:'LINK("PORT") LINK("PORT")=$S($P($G(^HLD(779.1,1,0)),"^",3)="P":5001,1:5026)
.S:$P(NODE,"^",3)="C" LINK("SERVER")=0
.I LINK("SERVER") S LINK("SERVER")=LINK("SERVER")_"^"_$P(NODE,"^",3)
Q 1
;
SET1(LINK,MDOMAIN) ;
N DOMAIN
Q:'$L(MDOMAIN)
S DOMAIN=$P($G(^DIC(4.2,MDOMAIN,0)),"^")
S DOMAIN=$S($L(DOMAIN):"HL7."_DOMAIN,1:"")
I DOMAIN'="" S ^HLCS(870,"AD","TCP",DOMAIN,LINK)=""
Q
KILL1(LINK,MDOMAIN) ;
N DOMAIN
Q:'$L(MDOMAIN)
S DOMAIN=$P($G(^DIC(4.2,MDOMAIN,0)),"^")
S DOMAIN=$S($L(DOMAIN):"HL7."_DOMAIN,1:"")
I DOMAIN'="" K ^HLCS(870,"AD","TCP",DOMAIN,LINK)
Q
SET2(LINK,DOMAIN) ;
I DOMAIN'="" S ^HLCS(870,"AD","TCP",DOMAIN,LINK)=""
Q
KILL2(LINK,DOMAIN) ;
I DOMAIN'="" K ^HLCS(870,"AD","TCP",DOMAIN,LINK)
Q
SET3(LINK,DEVICE) ;
Q:'DEVICE
S ^HLCS(870,"AD","HLLP",DEVICE,LINK)=""
Q
KILL3(LINK,DEVICE) ;
Q:'DEVICE
S ^HLCS(870,"AD","HLLP",DEVICE,LINK)=""
Q
LLP(LINKNAME) ;
;finds the type of LLP for a named link
N IEN,LLP
S IEN=$O(^HLCS(870,"B",LINKNAME,0))
Q:'IEN ""
S LLP=$P($G(^HLCS(870,IEN,0)),"^",3)
Q:'LLP ""
Q $P($G(^HLCS(869.1,LLP,0)),"^")
;
DEVICE(LINKNAME) ;
N IEN
S IEN=$O(^HLCS(870,"B",LINKNAME,0))
Q:'IEN ""
Q $P($G(^HLCS(870,IEN,200)),"^")
;
RTRNLNK(COMP1,COMP2,COMP3) ;
;based on the sending facility from the original header, this function finds the return link, or "" if not successful
;Inputs:
; COMP1,COMP2,COMP3 - 3 components of the sending facility from the original message
;
N LINK,IEN
S LINK=""
I $G(COMP3)="DNS",$P($G(COMP2),":")]"" S LINK=$O(^HLCS(870,"AD","TCP",$P(COMP2,":"),""))
I LINK="",$L($G(COMP1)) S IEN=$$FINDLINK(COMP1) S:IEN LINK=$P($G(^HLCS(870,IEN,0)),"^")
Q LINK
;
;HLLP is not implemented in HLO
;I LLP="HLLP" N DEVICE S DEVICE=$$DEVICE(FROMLINK) I DEVICE Q $O(^HLCS(870,"AD","TCP",DEVICE,""))
;Q ""
;
CHKLINK(LINK) ;
Q:'$L(LINK) 0
Q:'$O(^HLCS(870,"B",LINK,0)) 0
Q 1
HLOTLNK ;IRMFO-ALB/CJM - APIs for the HL Logical Link file;03/24/2004 14:43
+1 ;;1.6;HEALTH LEVEL SEVEN;**126,130,131**;Oct 13, 1995;Build 10
+2 ;
SETSHUT(LINKIEN) ;
+1 ;sets the shutdown flag (can not fail - if the link doesn't exist, by definition its shutdown)
+2 IF '$GET(LINKIEN)
QUIT 1
+3 IF '$DATA(^HLCS(870,LINKIEN,0))
QUIT 1
+4 SET $PIECE(^HLCS(870,LINKIEN,0),"^",16)=1
+5 QUIT 1
SETOPEN(LINKIEN) ;
+1 ;clears the shutdown flag, returns 1 on success, 0 on failure
+2 IF '$GET(LINKIEN)
QUIT 0
+3 IF '$DATA(^HLCS(870,LINKIEN,0))
QUIT 0
+4 SET $PIECE(^HLCS(870,LINKIEN,0),"^",16)=""
+5 QUIT 1
+6 ;
IFSHUT(LINKNAME) ;
+1 ;returns 1 if the link was shut down to HLO
+2 NEW IEN,LINK
+3 SET LINK=$PIECE($GET(LINKNAME),":")
+4 IF LINK=""
QUIT
+5 SET IEN=$ORDER(^HLCS(870,"B",LINK,0))
+6 IF 'IEN
QUIT 1
+7 IF $PIECE($GET(^HLCS(870,IEN,0)),"^",16)
QUIT 1
+8 QUIT 0
+9 ;
DOMAIN(LINKIEN) ;
+1 ;Returns the domain associated with this link
+2 ;
+3 IF '$GET(LINKIEN)
QUIT ""
+4 NEW NODE,DOMAIN
+5 SET DOMAIN=""
+6 SET NODE=$GET(^HLCS(870,LINKIEN,0))
+7 IF $PIECE(NODE,"^",7)
Begin DoDot:1
+8 SET DOMAIN=$PIECE($GET(^DIC(4.2,$PIECE(NODE,"^",7),0)),"^")
+9 SET DOMAIN=$SELECT($LENGTH(DOMAIN):"HL7."_DOMAIN,1:"")
End DoDot:1
+10 IF '$LENGTH(DOMAIN)
SET DOMAIN=$PIECE(NODE,"^",8)
+11 QUIT DOMAIN
PORT(LINKIEN) ;
+1 ;Returns the HLO port associated with this link
+2 ;
+3 IF '$GET(LINKIEN)
QUIT ""
+4 NEW NODE,PORT
+5 SET NODE=$GET(^HLCS(870,LINKIEN,400))
+6 SET PORT=$PIECE(NODE,"^",8)
+7 IF 'PORT
SET PORT=$SELECT($PIECE($GET(^HLD(779.1,1,0)),"^",3)="P":5001,1:5026)
+8 QUIT PORT
+9 ;
PORT2(LINKNAME) ;given the name of the link, returns its HLO port
+1 QUIT $$PORT($ORDER(^HLCS(870,"B",LINKNAME,0)))
+2 ;
STATNUM(LINKIEN) ;
+1 ;Given the ien of the link, this function returns the station #.
+2 ;
+3 IF '$GET(LINKIEN)
QUIT ""
+4 NEW INST
+5 SET INST=$PIECE($GET(^HLCS(870,LINKIEN,0)),"^",2)
+6 IF 'INST
QUIT ""
+7 QUIT $PIECE($GET(^DIC(4,INST,99)),"^")
+8 ;
FINDLINK(STATN) ;
+1 ;Returns the link ien based on the station # =STATN
+2 ;The link found must have a name starting with "VA", as these are
+3 ;reserved for officially released links associated with VHA institutions
+4 ;** EXCEPTION** MPIVA is an official link associated with 200M
+5 ;
+6 IF '$LENGTH($GET(STATN))
QUIT 0
+7 ;
+8 NEW NAME,IEN
+9 SET (NAME,IEN)=""
+10 FOR
SET NAME=$ORDER(^HLCS(870,"AC",STATN,NAME))
IF NAME=""
QUIT
IF (NAME'="VA-VIE")
IF ($EXTRACT(NAME,1,2)="VA")!(NAME="MPIVA")
SET IEN=$ORDER(^HLCS(870,"AC",STATN,NAME,0))
QUIT
+11 QUIT IEN
+12 ;
GETLINK(LINKNAME,LINK) ;
+1 NEW IEN
+2 SET IEN=$ORDER(^HLCS(870,"B",LINKNAME,0))
+3 IF IEN
QUIT $$GET(IEN,.LINK)
+4 IF LINKNAME="HLO DEFAULT LISTENER"
Begin DoDot:1
+5 NEW NODE
+6 SET LINK("NAME")=LINKNAME
+7 SET LINK("IEN")=0
+8 SET LINK("SHUTDOWN")=""
+9 SET LINK("LLP")="TCP"
+10 SET LINK("SERVER")="1^"_"M"
+11 SET NODE=$GET(^HLD(779.1,1,0))
+12 SET LINK("DOMAIN")=$PIECE(NODE,"^",1)
+13 SET LINK("PORT")=$SELECT($PIECE(NODE,"^",3)="P":5001,$PIECE(NODE,"^",3)="T":5026,1:"")
+14 SET LINK("IP")=""
End DoDot:1
QUIT 1
+15 QUIT 0
GET(IEN,LINK) ;
+1 NEW NODE,PTR
+2 KILL LINK
+3 SET NODE=$GET(^HLCS(870,IEN,0))
+4 IF NODE=""
QUIT 0
+5 SET LINK("NAME")=$PIECE(NODE,"^")
+6 SET LINK("IEN")=IEN
+7 SET LINK("SHUTDOWN")=+$PIECE(NODE,"^",16)
+8 IF $PIECE(NODE,"^",7)
Begin DoDot:1
+9 SET LINK("DOMAIN")=$PIECE(^DIC(4.2,$PIECE(NODE,"^",7),0),"^")
+10 SET LINK("DOMAIN")=$SELECT($LENGTH(LINK("DOMAIN")):"HL7."_LINK("DOMAIN"),1:"")
End DoDot:1
+11 IF $GET(LINK("DOMAIN"))=""
SET LINK("DOMAIN")=$PIECE(NODE,"^",8)
+12 SET PTR=$PIECE(NODE,"^",3)
+13 SET LINK("LLP")=$SELECT('PTR:"",1:$PIECE($GET(^HLCS(869.1,PTR,0)),"^"))
+14 SET LINK("SERVER")=""
+15 IF LINK("LLP")="TCP"
Begin DoDot:1
+16 SET LINK("SERVER")=1
+17 SET NODE=$GET(^HLCS(870,IEN,400))
+18 SET LINK("IP")=$PIECE(NODE,"^")
+19 SET LINK("PORT")=$PIECE(NODE,"^",8)
+20 IF 'LINK("PORT")
SET LINK("PORT")=$SELECT($PIECE($GET(^HLD(779.1,1,0)),"^",3)="P":5001,1:5026)
+21 IF $PIECE(NODE,"^",3)="C"
SET LINK("SERVER")=0
+22 IF LINK("SERVER")
SET LINK("SERVER")=LINK("SERVER")_"^"_$PIECE(NODE,"^",3)
End DoDot:1
+23 QUIT 1
+24 ;
SET1(LINK,MDOMAIN) ;
+1 NEW DOMAIN
+2 IF '$LENGTH(MDOMAIN)
QUIT
+3 SET DOMAIN=$PIECE($GET(^DIC(4.2,MDOMAIN,0)),"^")
+4 SET DOMAIN=$SELECT($LENGTH(DOMAIN):"HL7."_DOMAIN,1:"")
+5 IF DOMAIN'=""
SET ^HLCS(870,"AD","TCP",DOMAIN,LINK)=""
+6 QUIT
KILL1(LINK,MDOMAIN) ;
+1 NEW DOMAIN
+2 IF '$LENGTH(MDOMAIN)
QUIT
+3 SET DOMAIN=$PIECE($GET(^DIC(4.2,MDOMAIN,0)),"^")
+4 SET DOMAIN=$SELECT($LENGTH(DOMAIN):"HL7."_DOMAIN,1:"")
+5 IF DOMAIN'=""
KILL ^HLCS(870,"AD","TCP",DOMAIN,LINK)
+6 QUIT
SET2(LINK,DOMAIN) ;
+1 IF DOMAIN'=""
SET ^HLCS(870,"AD","TCP",DOMAIN,LINK)=""
+2 QUIT
KILL2(LINK,DOMAIN) ;
+1 IF DOMAIN'=""
KILL ^HLCS(870,"AD","TCP",DOMAIN,LINK)
+2 QUIT
SET3(LINK,DEVICE) ;
+1 IF 'DEVICE
QUIT
+2 SET ^HLCS(870,"AD","HLLP",DEVICE,LINK)=""
+3 QUIT
KILL3(LINK,DEVICE) ;
+1 IF 'DEVICE
QUIT
+2 SET ^HLCS(870,"AD","HLLP",DEVICE,LINK)=""
+3 QUIT
LLP(LINKNAME) ;
+1 ;finds the type of LLP for a named link
+2 NEW IEN,LLP
+3 SET IEN=$ORDER(^HLCS(870,"B",LINKNAME,0))
+4 IF 'IEN
QUIT ""
+5 SET LLP=$PIECE($GET(^HLCS(870,IEN,0)),"^",3)
+6 IF 'LLP
QUIT ""
+7 QUIT $PIECE($GET(^HLCS(869.1,LLP,0)),"^")
+8 ;
DEVICE(LINKNAME) ;
+1 NEW IEN
+2 SET IEN=$ORDER(^HLCS(870,"B",LINKNAME,0))
+3 IF 'IEN
QUIT ""
+4 QUIT $PIECE($GET(^HLCS(870,IEN,200)),"^")
+5 ;
RTRNLNK(COMP1,COMP2,COMP3) ;
+1 ;based on the sending facility from the original header, this function finds the return link, or "" if not successful
+2 ;Inputs:
+3 ; COMP1,COMP2,COMP3 - 3 components of the sending facility from the original message
+4 ;
+5 NEW LINK,IEN
+6 SET LINK=""
+7 IF $GET(COMP3)="DNS"
IF $PIECE($GET(COMP2),":")]""
SET LINK=$ORDER(^HLCS(870,"AD","TCP",$PIECE(COMP2,":"),""))
+8 IF LINK=""
IF $LENGTH($GET(COMP1))
SET IEN=$$FINDLINK(COMP1)
IF IEN
SET LINK=$PIECE($GET(^HLCS(870,IEN,0)),"^")
+9 QUIT LINK
+10 ;
+11 ;HLLP is not implemented in HLO
+12 ;I LLP="HLLP" N DEVICE S DEVICE=$$DEVICE(FROMLINK) I DEVICE Q $O(^HLCS(870,"AD","TCP",DEVICE,""))
+13 ;Q ""
+14 ;
CHKLINK(LINK) ;
+1 IF '$LENGTH(LINK)
QUIT 0
+2 IF '$ORDER(^HLCS(870,"B",LINK,0))
QUIT 0
+3 QUIT 1
