HLOASUB ;IRMFO-ALB/CJM - Subscription Registry ;08/17/2009
;;1.6;HEALTH LEVEL SEVEN;**126,146**;Oct 13, 1995;Build 16
;Per VHA Directive 2004-038, this routine should not be modified.
;
CREATE(OWNER,DESCRIP,ERROR) ;
;This API is used to create a new entry in the HLO Subscription Registry.
;Input:
; OWNER - (required) The name of the owning application. The name of the owner. It should be prefixed with the package namespace to ensure uniqueness.
; DESCRIPTION - (optional) a brief (1 line) description
;Output:
; Function returns new file 779.4 ien, or 0 if error
; ERROR (optional, pass by reference) an message on error
;
N IEN,DATA
K ERROR
I '$L($G(OWNER)) S ERROR="OWNER NOT SPECIFIED" Q 0
L +^HLD(779.4,0):60
I '$T S ERROR="UNABLE TO LOCK THE HL7 SUBSCRIPTION REGISTRY" Q 0
S IEN=$O(^HLD(779.4,":"),-1),IEN=IEN+1
L -^HLD(779.4,0)
S DATA(.01)=IEN
S DATA(.02)=OWNER
S DATA(.03)=$G(DESCRIP)
Q $$ADD^HLOASUB1(779.4,,.DATA,.ERROR,IEN)
;
ONLIST(IEN,LINKIEN,APPNAME,FAC1,FAC2,FAC3) ;
;Determines whether the recipient is already on the subscription list.
;Input:
; IEN - (required) ien of the subscription list
; LINKIEN - ien of the logical link
; APPNAME - receiving application
; FAC1 - component 1 of the receiving facility
; FAC2 - component 2
; FAC3 - component 3
;Output:
; Function returns 0 if not found, otherwise the ien in the subfile
;
Q +$O(^HLD(779.4,IEN,2,"AD",APPNAME,LINKIEN,FAC1_FAC2_FAC3,0))
;
ADD(IEN,WHO,ERROR) ;
;Adds a new recipient to the list of recipients for this Subscription Registry Entry.
;Input:
; IEN- the ien of the entry in the HL7 SUBSCRIPTION REGISTRY file.
; WHO (pass by reference) an array containing the information for a single new
; recipient to be added to the list. These subscripts are allowed:
;
; "RECEIVING APPLICATION" - (string, 60 char max, required)
;
; EXACTLY ONE of these parameters must be provided to identify the Receiving Facility:
;
; "FACILITY LINK IEN" - ien of the logical link
; "FACILITY LINK NAME" - name of the logical link
; "INSTITUTION IEN" - ptr to the INSTITUTION file
; "STATION NUMBER" - station # with suffix
;
; EXACTLY ONE of these MAY be provided - optionally - to identify the interface engine to route the message through:
;
; *"IE LINK IEN" (obsolete) ptr to a logical link for the interface engine
; *"IE LINK NAME" (obsolete) - name of the logical link for the interface engine
; "MIDDLEWARE LINK IEN" - a ptr to a logical link for the middleware
; "MIDDLEWARE LINK NAME" - name of the logical link for the middleware
;
;
;Output:
; Function returns on success the ien of the recipient on the RECIPIENTS multiple , or 0 on failure
; WHO - left undefined when this function returns
; ERROR (optional, pass by reference) These error messages may be returned:
;SUBSCRIPTION REGISTRY ENTRY NOT FOUND
;RECEIVING FACILTY LOGICAL LINK NOT FOUND
;RECEIVING APPLICATION NOT FOUND
;MIDDLEWARE ENGINE LOGICAL LINK PROVIDED BUT NOT FOUND
;FAILED TO ACTIVATE SUBSCRIBER
;
N PARMS,SUBIEN,DATA,DA,OK
K ERROR
S OK=0
D
.I '$G(IEN) S ERROR="SUBSCRIPITION REGISTRY ENTRY NOT FOUND" Q
.Q:'$$CHECKWHO^HLOASUB1(.WHO,.PARMS,.ERROR)
.S SUBIEN=$$ONLIST^HLOASUB1(IEN,.WHO)
.I SUBIEN S OK=1 D Q
..S DA=SUBIEN,DA(1)=IEN
..I $P(^HLD(779.4,IEN,2,SUBIEN,1),"^",2) S DATA(1.01)=$$NOW^XLFDT,DATA(1.02)="" S OK=$$UPD^HLOASUB1(779.41,.DA,.DATA) I 'OK S ERROR="FAILED TO ACTIVATE SUBSCRIBER"
.;
.S DA(1)=IEN
.S DATA(.01)=PARMS("RECEIVING APPLICATION")
.S DATA(.021)=PARMS("RECEIVING FACILITY","LINK IEN")
.I PARMS("LINK IEN"),PARMS("LINK IEN")'=PARMS("RECEIVING FACILITY","LINK IEN") S DATA(.02)=PARMS("LINK IEN")
.S DATA(.03)=PARMS("RECEIVING FACILITY",1)
.S DATA(.04)=PARMS("RECEIVING FACILITY",2)
.S DATA(.05)=PARMS("RECEIVING FACILITY",3)
.S DATA(1.01)=$$NOW^XLFDT
.S OK=$$ADD^HLOASUB1(779.41,.DA,.DATA,.ERROR)
K WHO
Q OK
;
NEXT(IEN,RECIP) ;
;gets the next recipient on the list. It ignores recipients
;that have a value for the DT/TM DELETED field.
;Input:
; IEN (required) - the IEN assigned to this subscription
; RECIP - if empty, it gets the first recipient on the list, else it uses the value of RECIP("SUBIEN") to find the next recipient
;Output:
;RECIP(pass by reference, required) - returns the next recipient on the list. These subscripts are returned:
; "LINK IEN" - IEN of link overwhich to transmit the message (could be middleware)
; "LINK NAME" - its name
; "RECEIVING APPLICATION"
; ("RECEIVING FACILITY",1) - Component 1
; ("RECEIVING FACILITY",2) - Component 2
; ("RECEIVING FACILITY",3) - Component 2
; "SUBIEN" - the ien in the multiple, used to find the next on the list.
;Function Value - IEN in the subfile on success, 0 if there are no more recipients found on the list (in which case, set "SUBIEN"=-1, set all other subscripts to ""
;
N LAST,NEXT,NODE,LINKIEN,OLD
S LAST=+$G(RECIP("SUBIEN"))
Q:(LAST=-1) 0
Q:'$G(IEN) 0
S NEXT=$O(^HLD(779.4,IEN,2,"AC",LAST))
I 'NEXT D Q 0
.S RECIP("RECEIVING APPLICATION")=""
.S RECIP("LINK IEN")=""
.S RECIP("LINK NAME")=""
.S RECIP("RECEIVING FACILITY",1)=""
.S RECIP("RECEIVING FACILITY",2)=""
.S RECIP("RECEIVING FACILITY",3)=""
.S RECIP("SUBIEN")=-1
;
S RECIP("SUBIEN")=NEXT
S NODE=$G(^HLD(779.4,IEN,2,NEXT,0))
S LINKIEN=+$P(NODE,"^",2)
I 'LINKIEN S LINKIEN=+$P(NODE,"^",6)
S RECIP("LINK IEN")=LINKIEN
S RECIP("LINK NAME")=$P($G(^HLCS(870,LINKIEN,0)),"^")
S RECIP("RECEIVING APPLICATION")=$P(NODE,"^")
;
;**P146 START CJM
;the station #, domain, or port may have changed
S OLD("RECEIVING FACILITY",1)=$P(NODE,"^",3)
S OLD("RECEIVING FACILITY",2)=$P(NODE,"^",4)
S OLD("RECEIVING FACILITY",3)="DNS"
S LINKIEN=$P(NODE,"^",6)
I 'LINKIEN M RECIP=OLD Q NEXT
S RECIP("RECEIVING FACILITY",1)=$$STATNUM^HLOTLNK(LINKIEN)
S RECIP("RECEIVING FACILITY",2)=$$DOMAIN^HLOTLNK(LINKIEN)_":"_$$PORT^HLOTLNK(LINKIEN)
S RECIP("RECEIVING FACILITY",3)="DNS"
I (RECIP("RECEIVING FACILITY",1)'=OLD("RECEIVING FACILITY",1))!(RECIP("RECEIVING FACILITY",2)'=OLD("RECEIVING FACILITY",2)) D
.N DA,DATA
.S DATA(.03)=RECIP("RECEIVING FACILITY",1)
.S DATA(.04)=RECIP("RECEIVING FACILITY",2)
.S DATA(.05)="DNS"
.S DA=NEXT,DA(1)=IEN
.I $$UPD^HLOASUB1(779.41,.DA,.DATA)
;**P146 END CJM
Q NEXT
;
END(IEN,WHO) ;will terminate a recipient from the list.The sub-record isn't
;deleted, but the DATE/TIME TERMINATED field is entered with the current
; date/time
;Input:
; IEN - the ien of the HL7 Subscription Registry entry (required)
; WHO - (required, pass by reference) If WHO("SUBIEN") is defined, then it should be the ien of the sub-record to be terminated. Otherwise, set the parameters as per $$ADD.
;Output:
; Function returns 1 on success, 0 on failure
; WHO - left undefined when the function returns
;
N SUBIEN,DATA,DA,OK
S OK=0
D
.S SUBIEN=0
.Q:'$G(IEN)
.I $G(WHO("SUBIEN")) D
..S SUBIEN=WHO("SUBIEN")
.E D
..N PARMS
..S:$$CHECKWHO^HLOASUB1(.WHO,.PARMS) SUBIEN=$$ONLIST^HLOASUB1(IEN,.WHO)
.I 'SUBIEN S OK=1 Q
.S DA(1)=IEN,DA=SUBIEN
.S DATA(1.02)=$$NOW^XLFDT
.S OK=$$UPD^HLOASUB1(779.41,.DA,.DATA)
K WHO
Q OK
;
DELETE(IEN) ;Deletes the entry in the HL7 Subscription Registry.
Q $$DELETE^HLOASUB1(779.4,$G(IEN))
;
;**P146 START CJM
ADDFAC(IEN,SUBIEN) ;
;Adds to the recipient sub-record components 1,2,3 of the Receiving
;Facility field of the message header.
;Input:
; IEN- the ien of the entry in the HL7 SUBSCRIPTION REGISTRY file.
; SUBIEN - ien in the multiple
;
;
N PARMS,WHO,DATA,DA,NODE
S NODE=$G(^HLD(779.4,+IEN,2,+SUBIEN,0))
S WHO("RECEIVING APPLICATION")=$P(NODE,"^",1)
S WHO("IE LINK IEN")=$P(NODE,"^",2)
S WHO("FACILITY LINK IEN")=$P(NODE,"^",6)
I '$$CHECKWHO^HLOASUB1(.WHO,.PARMS,.ERROR) W !,ERROR,! Q
S DA=SUBIEN,DA(1)=IEN
I '$P($G(^HLD(779.4,+IEN,2,+SUBIEN,1)),"^") S DATA(1.01)=$$NOW^XLFDT
S DATA(.03)=PARMS("RECEIVING FACILITY",1)
S DATA(.04)=PARMS("RECEIVING FACILITY",2)
S DATA(.05)=PARMS("RECEIVING FACILITY",3)
I '$$UPD^HLOASUB1(779.41,.DA,.DATA,.ERROR) W !,ERROR,!
Q
;
TLINK(IEN,SUBIEN) ;
;returns the link overwhich to transmit for this subscriber
;
N NODE,DLINK,MLINK
S NODE=$G(^HLD(779.4,IEN,2,SUBIEN,0))
S DLINK=$P(NODE,"^",6)
S MLINK=$P(NODE,"^",2)
I MLINK,MLINK'=DLINK Q +MLINK
Q +DLINK
;**P146 END CJM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOASUB 8520 printed Nov 22, 2024@17:08:40 Page 2
HLOASUB ;IRMFO-ALB/CJM - Subscription Registry ;08/17/2009
+1 ;;1.6;HEALTH LEVEL SEVEN;**126,146**;Oct 13, 1995;Build 16
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
CREATE(OWNER,DESCRIP,ERROR) ;
+1 ;This API is used to create a new entry in the HLO Subscription Registry.
+2 ;Input:
+3 ; OWNER - (required) The name of the owning application. The name of the owner. It should be prefixed with the package namespace to ensure uniqueness.
+4 ; DESCRIPTION - (optional) a brief (1 line) description
+5 ;Output:
+6 ; Function returns new file 779.4 ien, or 0 if error
+7 ; ERROR (optional, pass by reference) an message on error
+8 ;
+9 NEW IEN,DATA
+10 KILL ERROR
+11 IF '$LENGTH($GET(OWNER))
SET ERROR="OWNER NOT SPECIFIED"
QUIT 0
+12 LOCK +^HLD(779.4,0):60
+13 IF '$TEST
SET ERROR="UNABLE TO LOCK THE HL7 SUBSCRIPTION REGISTRY"
QUIT 0
+14 SET IEN=$ORDER(^HLD(779.4,":"),-1)
SET IEN=IEN+1
+15 LOCK -^HLD(779.4,0)
+16 SET DATA(.01)=IEN
+17 SET DATA(.02)=OWNER
+18 SET DATA(.03)=$GET(DESCRIP)
+19 QUIT $$ADD^HLOASUB1(779.4,,.DATA,.ERROR,IEN)
+20 ;
ONLIST(IEN,LINKIEN,APPNAME,FAC1,FAC2,FAC3) ;
+1 ;Determines whether the recipient is already on the subscription list.
+2 ;Input:
+3 ; IEN - (required) ien of the subscription list
+4 ; LINKIEN - ien of the logical link
+5 ; APPNAME - receiving application
+6 ; FAC1 - component 1 of the receiving facility
+7 ; FAC2 - component 2
+8 ; FAC3 - component 3
+9 ;Output:
+10 ; Function returns 0 if not found, otherwise the ien in the subfile
+11 ;
+12 QUIT +$ORDER(^HLD(779.4,IEN,2,"AD",APPNAME,LINKIEN,FAC1_FAC2_FAC3,0))
+13 ;
ADD(IEN,WHO,ERROR) ;
+1 ;Adds a new recipient to the list of recipients for this Subscription Registry Entry.
+2 ;Input:
+3 ; IEN- the ien of the entry in the HL7 SUBSCRIPTION REGISTRY file.
+4 ; WHO (pass by reference) an array containing the information for a single new
+5 ; recipient to be added to the list. These subscripts are allowed:
+6 ;
+7 ; "RECEIVING APPLICATION" - (string, 60 char max, required)
+8 ;
+9 ; EXACTLY ONE of these parameters must be provided to identify the Receiving Facility:
+10 ;
+11 ; "FACILITY LINK IEN" - ien of the logical link
+12 ; "FACILITY LINK NAME" - name of the logical link
+13 ; "INSTITUTION IEN" - ptr to the INSTITUTION file
+14 ; "STATION NUMBER" - station # with suffix
+15 ;
+16 ; EXACTLY ONE of these MAY be provided - optionally - to identify the interface engine to route the message through:
+17 ;
+18 ; *"IE LINK IEN" (obsolete) ptr to a logical link for the interface engine
+19 ; *"IE LINK NAME" (obsolete) - name of the logical link for the interface engine
+20 ; "MIDDLEWARE LINK IEN" - a ptr to a logical link for the middleware
+21 ; "MIDDLEWARE LINK NAME" - name of the logical link for the middleware
+22 ;
+23 ;
+24 ;Output:
+25 ; Function returns on success the ien of the recipient on the RECIPIENTS multiple , or 0 on failure
+26 ; WHO - left undefined when this function returns
+27 ; ERROR (optional, pass by reference) These error messages may be returned:
+28 ;SUBSCRIPTION REGISTRY ENTRY NOT FOUND
+29 ;RECEIVING FACILTY LOGICAL LINK NOT FOUND
+30 ;RECEIVING APPLICATION NOT FOUND
+31 ;MIDDLEWARE ENGINE LOGICAL LINK PROVIDED BUT NOT FOUND
+32 ;FAILED TO ACTIVATE SUBSCRIBER
+33 ;
+34 NEW PARMS,SUBIEN,DATA,DA,OK
+35 KILL ERROR
+36 SET OK=0
+37 Begin DoDot:1
+38 IF '$GET(IEN)
SET ERROR="SUBSCRIPITION REGISTRY ENTRY NOT FOUND"
QUIT
+39 if '$$CHECKWHO^HLOASUB1(.WHO,.PARMS,.ERROR)
QUIT
+40 SET SUBIEN=$$ONLIST^HLOASUB1(IEN,.WHO)
+41 IF SUBIEN
SET OK=1
Begin DoDot:2
+42 SET DA=SUBIEN
SET DA(1)=IEN
+43 IF $PIECE(^HLD(779.4,IEN,2,SUBIEN,1),"^",2)
SET DATA(1.01)=$$NOW^XLFDT
SET DATA(1.02)=""
SET OK=$$UPD^HLOASUB1(779.41,.DA,.DATA)
IF 'OK
SET ERROR="FAILED TO ACTIVATE SUBSCRIBER"
End DoDot:2
QUIT
+44 ;
+45 SET DA(1)=IEN
+46 SET DATA(.01)=PARMS("RECEIVING APPLICATION")
+47 SET DATA(.021)=PARMS("RECEIVING FACILITY","LINK IEN")
+48 IF PARMS("LINK IEN")
IF PARMS("LINK IEN")'=PARMS("RECEIVING FACILITY","LINK IEN")
SET DATA(.02)=PARMS("LINK IEN")
+49 SET DATA(.03)=PARMS("RECEIVING FACILITY",1)
+50 SET DATA(.04)=PARMS("RECEIVING FACILITY",2)
+51 SET DATA(.05)=PARMS("RECEIVING FACILITY",3)
+52 SET DATA(1.01)=$$NOW^XLFDT
+53 SET OK=$$ADD^HLOASUB1(779.41,.DA,.DATA,.ERROR)
End DoDot:1
+54 KILL WHO
+55 QUIT OK
+56 ;
NEXT(IEN,RECIP) ;
+1 ;gets the next recipient on the list. It ignores recipients
+2 ;that have a value for the DT/TM DELETED field.
+3 ;Input:
+4 ; IEN (required) - the IEN assigned to this subscription
+5 ; RECIP - if empty, it gets the first recipient on the list, else it uses the value of RECIP("SUBIEN") to find the next recipient
+6 ;Output:
+7 ;RECIP(pass by reference, required) - returns the next recipient on the list. These subscripts are returned:
+8 ; "LINK IEN" - IEN of link overwhich to transmit the message (could be middleware)
+9 ; "LINK NAME" - its name
+10 ; "RECEIVING APPLICATION"
+11 ; ("RECEIVING FACILITY",1) - Component 1
+12 ; ("RECEIVING FACILITY",2) - Component 2
+13 ; ("RECEIVING FACILITY",3) - Component 2
+14 ; "SUBIEN" - the ien in the multiple, used to find the next on the list.
+15 ;Function Value - IEN in the subfile on success, 0 if there are no more recipients found on the list (in which case, set "SUBIEN"=-1, set all other subscripts to ""
+16 ;
+17 NEW LAST,NEXT,NODE,LINKIEN,OLD
+18 SET LAST=+$GET(RECIP("SUBIEN"))
+19 if (LAST=-1)
QUIT 0
+20 if '$GET(IEN)
QUIT 0
+21 SET NEXT=$ORDER(^HLD(779.4,IEN,2,"AC",LAST))
+22 IF 'NEXT
Begin DoDot:1
+23 SET RECIP("RECEIVING APPLICATION")=""
+24 SET RECIP("LINK IEN")=""
+25 SET RECIP("LINK NAME")=""
+26 SET RECIP("RECEIVING FACILITY",1)=""
+27 SET RECIP("RECEIVING FACILITY",2)=""
+28 SET RECIP("RECEIVING FACILITY",3)=""
+29 SET RECIP("SUBIEN")=-1
End DoDot:1
QUIT 0
+30 ;
+31 SET RECIP("SUBIEN")=NEXT
+32 SET NODE=$GET(^HLD(779.4,IEN,2,NEXT,0))
+33 SET LINKIEN=+$PIECE(NODE,"^",2)
+34 IF 'LINKIEN
SET LINKIEN=+$PIECE(NODE,"^",6)
+35 SET RECIP("LINK IEN")=LINKIEN
+36 SET RECIP("LINK NAME")=$PIECE($GET(^HLCS(870,LINKIEN,0)),"^")
+37 SET RECIP("RECEIVING APPLICATION")=$PIECE(NODE,"^")
+38 ;
+39 ;**P146 START CJM
+40 ;the station #, domain, or port may have changed
+41 SET OLD("RECEIVING FACILITY",1)=$PIECE(NODE,"^",3)
+42 SET OLD("RECEIVING FACILITY",2)=$PIECE(NODE,"^",4)
+43 SET OLD("RECEIVING FACILITY",3)="DNS"
+44 SET LINKIEN=$PIECE(NODE,"^",6)
+45 IF 'LINKIEN
MERGE RECIP=OLD
QUIT NEXT
+46 SET RECIP("RECEIVING FACILITY",1)=$$STATNUM^HLOTLNK(LINKIEN)
+47 SET RECIP("RECEIVING FACILITY",2)=$$DOMAIN^HLOTLNK(LINKIEN)_":"_$$PORT^HLOTLNK(LINKIEN)
+48 SET RECIP("RECEIVING FACILITY",3)="DNS"
+49 IF (RECIP("RECEIVING FACILITY",1)'=OLD("RECEIVING FACILITY",1))!(RECIP("RECEIVING FACILITY",2)'=OLD("RECEIVING FACILITY",2))
Begin DoDot:1
+50 NEW DA,DATA
+51 SET DATA(.03)=RECIP("RECEIVING FACILITY",1)
+52 SET DATA(.04)=RECIP("RECEIVING FACILITY",2)
+53 SET DATA(.05)="DNS"
+54 SET DA=NEXT
SET DA(1)=IEN
+55 IF $$UPD^HLOASUB1(779.41,.DA,.DATA)
End DoDot:1
+56 ;**P146 END CJM
+57 QUIT NEXT
+58 ;
END(IEN,WHO) ;will terminate a recipient from the list.The sub-record isn't
+1 ;deleted, but the DATE/TIME TERMINATED field is entered with the current
+2 ; date/time
+3 ;Input:
+4 ; IEN - the ien of the HL7 Subscription Registry entry (required)
+5 ; WHO - (required, pass by reference) If WHO("SUBIEN") is defined, then it should be the ien of the sub-record to be terminated. Otherwise, set the parameters as per $$ADD.
+6 ;Output:
+7 ; Function returns 1 on success, 0 on failure
+8 ; WHO - left undefined when the function returns
+9 ;
+10 NEW SUBIEN,DATA,DA,OK
+11 SET OK=0
+12 Begin DoDot:1
+13 SET SUBIEN=0
+14 if '$GET(IEN)
QUIT
+15 IF $GET(WHO("SUBIEN"))
Begin DoDot:2
+16 SET SUBIEN=WHO("SUBIEN")
End DoDot:2
+17 IF '$TEST
Begin DoDot:2
+18 NEW PARMS
+19 if $$CHECKWHO^HLOASUB1(.WHO,.PARMS)
SET SUBIEN=$$ONLIST^HLOASUB1(IEN,.WHO)
End DoDot:2
+20 IF 'SUBIEN
SET OK=1
QUIT
+21 SET DA(1)=IEN
SET DA=SUBIEN
+22 SET DATA(1.02)=$$NOW^XLFDT
+23 SET OK=$$UPD^HLOASUB1(779.41,.DA,.DATA)
End DoDot:1
+24 KILL WHO
+25 QUIT OK
+26 ;
DELETE(IEN) ;Deletes the entry in the HL7 Subscription Registry.
+1 QUIT $$DELETE^HLOASUB1(779.4,$GET(IEN))
+2 ;
+3 ;**P146 START CJM
ADDFAC(IEN,SUBIEN) ;
+1 ;Adds to the recipient sub-record components 1,2,3 of the Receiving
+2 ;Facility field of the message header.
+3 ;Input:
+4 ; IEN- the ien of the entry in the HL7 SUBSCRIPTION REGISTRY file.
+5 ; SUBIEN - ien in the multiple
+6 ;
+7 ;
+8 NEW PARMS,WHO,DATA,DA,NODE
+9 SET NODE=$GET(^HLD(779.4,+IEN,2,+SUBIEN,0))
+10 SET WHO("RECEIVING APPLICATION")=$PIECE(NODE,"^",1)
+11 SET WHO("IE LINK IEN")=$PIECE(NODE,"^",2)
+12 SET WHO("FACILITY LINK IEN")=$PIECE(NODE,"^",6)
+13 IF '$$CHECKWHO^HLOASUB1(.WHO,.PARMS,.ERROR)
WRITE !,ERROR,!
QUIT
+14 SET DA=SUBIEN
SET DA(1)=IEN
+15 IF '$PIECE($GET(^HLD(779.4,+IEN,2,+SUBIEN,1)),"^")
SET DATA(1.01)=$$NOW^XLFDT
+16 SET DATA(.03)=PARMS("RECEIVING FACILITY",1)
+17 SET DATA(.04)=PARMS("RECEIVING FACILITY",2)
+18 SET DATA(.05)=PARMS("RECEIVING FACILITY",3)
+19 IF '$$UPD^HLOASUB1(779.41,.DA,.DATA,.ERROR)
WRITE !,ERROR,!
+20 QUIT
+21 ;
TLINK(IEN,SUBIEN) ;
+1 ;returns the link overwhich to transmit for this subscriber
+2 ;
+3 NEW NODE,DLINK,MLINK
+4 SET NODE=$GET(^HLD(779.4,IEN,2,SUBIEN,0))
+5 SET DLINK=$PIECE(NODE,"^",6)
+6 SET MLINK=$PIECE(NODE,"^",2)
+7 IF MLINK
IF MLINK'=DLINK
QUIT +MLINK
+8 QUIT +DLINK
+9 ;**P146 END CJM
