HLOASUB1 ;IRMFO-ALB/CJM - Subscription Registry (continued) ;03/24/2004 14:43
;;1.6;HEALTH LEVEL SEVEN;**126**;Oct 13, 1995;
;
INDEX(IEN,PARMARY) ;
;Description: This allows an application to build an index of its
;subscriptions. This is optional, but using this function allows the
;application to easily find subscriptions without storing the ien.
;
;Input:
; IEN - ien of the entry in the Subscription Registry
; PARMARY - **pass by reference** an array of parameters with which to build the index. The format is: PARMARY(1)=<first parameter>, PARMARY(2)=<second parameter> If PARMARY(i)=null, the parameter will be translated to a single space.
;Output:
; function returns 1 on success, 0 otherwise
; PARMARY - left undefined
;
N OK S OK=0
D
.Q:'$G(IEN)
.N OWNER,INDEX,I
.S OWNER=$P($G(^HLD(779.4,IEN,0)),"^",2)
.Q:'$L(OWNER)
.Q:'$D(PARMARY)
.S INDEX="^HLD(779.4,""AH"",OWNER,"
.S I=0
.F S I=$O(PARMARY(I)) Q:'I S INDEX=INDEX_""""_$S($L(PARMARY(I)):PARMARY(I),1:" ")_""","
.S INDEX=$E(INDEX,1,$L(INDEX)-1)_")"
.S @INDEX=IEN
.S ^HLD(779.4,"AH KILL",IEN,""""_OWNER_""","_$P(INDEX,"^HLD(779.4,""AH"",OWNER,",2))=""
.S OK=1
K PARMARY
Q OK
;
KILLAH(IEN) ;kills the AH x~ref on file 779.4 for a particular subscription registry entry=ien
Q:'$G(IEN)
N NEXT,LOCATION
S NEXT=""
F S NEXT=$O(^HLD(779.4,"AH KILL",IEN,NEXT)) Q:'$L(NEXT) D
.S LOCATION="^HLD(779.4,""AH"","_NEXT
.K @LOCATION
K ^HLD(779.4,"AH KILL",IEN)
Q
;
FIND(OWNER,PARMARY) ;
;Description: This allows an application to find a subscription
;list. The application must maintain a private index in order to
;utilize this function, via $$INDEX^HLOASUB()
;
;Input:
; OWNER - owning application name
; PARMARY **pass by reference** an array of parameters with which the index was built. The format is: PARMARY(1)=<first parameter>, PARMARY(2)=<second parameter> If PARMARY(i)=null, the parameter will be translated to a single space.
;Output:
; function returns the ien of the subscription list if found, 0 otherwise
; PARMARY - left undefined
;
N OK S OK=0
;
D
.Q:'$D(PARMARY)
.Q:'$L($G(OWNER))
.N INDEX,I
.S INDEX="^HLD(779.4,""AH"",OWNER,"
.S I=0
.F S I=$O(PARMARY(I)) Q:'I S INDEX=INDEX_""""_$S($L(PARMARY(I)):PARMARY(I),1:" ")_""","
.S INDEX=$E(INDEX,1,$L(INDEX)-1)_")"
.S OK=+$G(@INDEX)
K PARMARY
Q OK
;
UPD(FILE,DA,DATA,ERROR) ;File data into an existing record.
; Input:
; FILE - File or sub-file number
; DA - Traditional DA array, with same meaning.
; Pass by reference.
; DATA - Data array to file (pass by reference)
; Format: DATA(<field #>)=<value>
;
; Output:
; Function Value - 0=error and 1=no error
; ERROR - optional error message - if needed, pass by reference
;
; Example: To update a record in subfile 2.0361 in record with ien=353,
; subrecord ien=68, with the field .01 value = 21:
; S DATA(.01)=21,DA=68,DA(1)=353 I $$UPDS(2.0361,.DA,.DATA,.ERROR) W !,"DONE"
;
N FDA,FIELD,IENS,ERRORS
;
;IENS - Internal Entry Number String defined by FM
;FDA - the FDA array as defined by FM
;
I '$G(DA) S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED" Q 0
S IENS=$$IENS^DILF(.DA)
S FIELD=0
F S FIELD=$O(DATA(FIELD)) Q:'FIELD D
.S FDA(FILE,IENS,FIELD)=$G(DATA(FIELD))
D FILE^DIE("","FDA","ERRORS(1)")
I +$G(DIERR) D
.S ERROR=$G(ERRORS(1,"DIERR",1,"TEXT",1))
E D
.S ERROR=""
;
D CLEAN^DILF
Q $S(+$G(DIERR):0,1:1)
;
ADD(FILE,DA,DATA,ERROR,IEN) ;
;Description: Creates a new record and files the data.
; Input:
; FILE - File or sub-file number
; DA - Traditional FileMan DA array with same
; meaning. Pass by reference. Only needed if adding to a
; subfile.
; DATA - Data array to file, pass by reference
; Format: DATA(<field #>)=<value>
; IEN - internal entry number to use (optional)
;
; Output:
; Function Value - If no error then it returns the ien of the created record, else returns NULL.
; DA - returns the ien of the new record, NULL if none created. If needed, pass by reference.
; ERROR - optional error message - if needed, pass by reference
;
; Example: To add a record in subfile 2.0361 in the record with ien=353
; with the field .01 value = 21:
; S DATA(.01)=21,DA(1)=353 I $$ADD(2.0361,.DA,.DATA) W !,"DONE"
;
; Example: If creating a record not in a subfile, would look like this:
; S DATA(.01)=21 I $$ADD(867,,.DATA) W !,"DONE"
;
N FDA,FIELD,IENA,IENS,ERRORS
;
;IENS - Internal Entry Number String defined by FM
;IENA - the Internal Entry Number Array defined by FM
;FDA - the FDA array defined by FM
;IEN - the ien of the new record
;
S DA="+1"
S IENS=$$IENS^DILF(.DA)
S FIELD=0
F S FIELD=$O(DATA(FIELD)) Q:'FIELD D
.S FDA(FILE,IENS,FIELD)=$G(DATA(FIELD))
I $G(IEN) S IENA(1)=IEN
D UPDATE^DIE("","FDA","IENA","ERRORS(1)")
I +$G(DIERR) D
.S ERROR=$G(ERRORS(1,"DIERR",1,"TEXT",1))
.S IEN=""
E D
.S IEN=IENA(1)
.S ERROR=""
D CLEAN^DILF
S DA=IEN
Q IEN
;
DELETE(FILE,DA,ERROR) ;Delete an existing record.
N DATA
S DATA(.01)="@"
Q $$UPD^HLEMU(FILE,.DA,.DATA,.ERROR)
Q
;
STATNUM(IEN) ;
;Description: Given an ien to the Institution file, returns as the function value the station number. If IEN is NOT passed in, it assumes the local site. Returns "" on failure.
;
N STATION,RETURN
S RETURN=""
I $G(IEN) D
.Q:'$D(^DIC(4,IEN,0))
.S STATION=$P($$NNT^XUAF4(IEN),"^",2)
.S RETURN=$S(+STATION:STATION,1:"")
E D
.S RETURN=$P($$SITE^VASITE(),"^",3)
Q RETURN
;
CHECKWHO(WHO,PARMS,ERROR) ;
;Checks the parameters provided in WHO() (see $$ADD). They must resolve
;the link, receiving app and receiving facility.
;INPUT:
; WHO - (required, pass by reference) - see $$ADD.
;
; WHO("PORT") - if this is valued, it will be used as the remote port
; to connect with rather than the port associated with the link
;Output:
; Function returns 1 if the input is resolved successfully, 0 otherwise
; PARMS - (pass by reference) These subscripts are returned:
; "LINK IEN" - ien of the link
; "LINK NAME" - name of the link
; "RECEIVING APPLICATION" - name of the receiving app
; "RECEIVING FACILITY",1) - component 1
; "RECEIVING FACILITY",2) - component 2
; "RECEIVING FACILITY",3) - component 3
; ERROR - (pass by reference) - if unsuccessful, an error message is returned.
;
N OK
K ERROR
S OK=1
S PARMS("LINK IEN")="",PARMS("LINK NAME")=""
;must identify the receiving app
;
D
.N LEN
.S LEN=$L($G(WHO("RECEIVING APPLICATION")))
.I 'LEN S OK=0
.E I LEN>60 S OK=0
.S:'OK ERROR="RECEIVING APPLICATION NOT VALID"
.S PARMS("RECEIVING APPLICATION")=$G(WHO("RECEIVING APPLICATION"))
;
;find the station # if Institution ien known
S:$G(WHO("INSTITUTION IEN")) WHO("STATION NUMBER")=$$STATNUM^HLOASUB1(WHO("INSTITUTION IEN"))
;
;if destination link specified by name, get its ien
I '$G(WHO("FACILITY LINK IEN")),$L($G(WHO("FACILITY LINK NAME"))) S WHO("FACILITY LINK IEN")=$O(^HLCS(870,"B",WHO("FACILITY LINK NAME"),0))
;
;if destination link not specified, find it based on station #
I +$G(WHO("STATION NUMBER")),'$G(WHO("FACILITY LINK IEN")) S WHO("FACILITY LINK IEN")=$$FINDLINK^HLOTLNK(WHO("STATION NUMBER"))
;
;if station # not known, find it based on destination link
I '$G(WHO("STATION NUMBER")),$G(WHO("FACILITY LINK IEN")) S WHO("STATION NUMBER")=$$STATNUM^HLOTLNK(WHO("FACILITY LINK IEN"))
;
S PARMS("RECEIVING FACILITY",1)=$G(WHO("STATION NUMBER"))
;
;if the destination link is known, get the domain
S PARMS("RECEIVING FACILITY",2)=$S($G(WHO("FACILITY LINK IEN")):$$DOMAIN^HLOTLNK(WHO("FACILITY LINK IEN")),1:"")
;
S PARMS("RECEIVING FACILITY",3)="DNS"
;
;find the link to send over - need name & ien
I $G(WHO("IE LINK IEN")) D
.S PARMS("LINK IEN")=WHO("IE LINK IEN")
.S PARMS("LINK NAME")=$P($G(^HLCS(870,PARMS("LINK IEN"),0)),"^")
.I OK,'$L(PARMS("LINK NAME")) S OK=0,ERROR="INTERFACE ENGINE LOGICAL LINK PROVIDED BUT NOT FOUND"
E I $L($G(WHO("IE LINK NAME"))) D
.S PARMS("LINK NAME")=WHO("IE LINK NAME")
.S PARMS("LINK IEN")=$O(^HLCS(870,"B",WHO("IE LINK NAME"),0))
.I OK,'PARMS("LINK IEN") S OK=0,ERROR="INTERFACE ENGINE LOGICAL LINK PROVIDED BUT NOT FOUND"
E I $G(WHO("FACILITY LINK IEN")) D
.S PARMS("LINK IEN")=WHO("FACILITY LINK IEN")
.S PARMS("LINK NAME")=$P($G(^HLCS(870,PARMS("LINK IEN"),0)),"^")
.I OK,'$L(PARMS("LINK NAME")) S OK=0,ERROR="RECEIVING FACILITY LOGICAL LINK NOT FOUND"
E I $L($G(WHO("FACILITY LINK NAME"))) D
.S PARMS("LINK NAME")=WHO("FACILITY LINK NAME")
.S PARMS("LINK IEN")=$O(^HLCS(870,"B",WHO("FACILITY LINK NAME"),0))
.I OK,'PARMS("LINK IEN") S OK=0,ERROR="RECEIVING FACILITY LOGICAL LINK NOT FOUND"
I OK,(('PARMS("LINK IEN"))!(PARMS("LINK NAME")="")) S OK=0,ERROR="LOGICAL LINK TO TRANSMIT OVER NOT SPECIFIED"
;
;need the station # or domain for msg header
I OK,'$L(PARMS("RECEIVING FACILITY",2)),'PARMS("RECEIVING FACILITY",1) S OK=0,ERROR="RECEIVING FACILITY STATION # AND DOMAIN NOT SPECIFIED"
;
;append the port#
I '$G(WHO("PORT")) S PARMS("RECEIVING FACILITY",2)=PARMS("RECEIVING FACILITY",2)_":"_$$PORT^HLOTLNK($G(WHO("FACILITY LINK IEN")))
E S PARMS("RECEIVING FACILITY",2)=PARMS("RECEIVING FACILITY",2)_":"_WHO("PORT")
;
Q OK
HLOASUB1 ;IRMFO-ALB/CJM - Subscription Registry (continued) ;03/24/2004 14:43
+1 ;;1.6;HEALTH LEVEL SEVEN;**126**;Oct 13, 1995;
+2 ;
INDEX(IEN,PARMARY) ;
+1 ;Description: This allows an application to build an index of its
+2 ;subscriptions. This is optional, but using this function allows the
+3 ;application to easily find subscriptions without storing the ien.
+4 ;
+5 ;Input:
+6 ; IEN - ien of the entry in the Subscription Registry
+7 ; PARMARY - **pass by reference** an array of parameters with which to build the index. The format is: PARMARY(1)=<first parameter>, PARMARY(2)=<second parameter> If PARMARY(i)=null, the parameter will be translated to a single space.
+8 ;Output:
+9 ; function returns 1 on success, 0 otherwise
+10 ; PARMARY - left undefined
+11 ;
+12 NEW OK
SET OK=0
+13 Begin DoDot:1
+14 IF '$GET(IEN)
QUIT
+15 NEW OWNER,INDEX,I
+16 SET OWNER=$PIECE($GET(^HLD(779.4,IEN,0)),"^",2)
+17 IF '$LENGTH(OWNER)
QUIT
+18 IF '$DATA(PARMARY)
QUIT
+19 SET INDEX="^HLD(779.4,""AH"",OWNER,"
+20 SET I=0
+21 FOR
SET I=$ORDER(PARMARY(I))
IF 'I
QUIT
SET INDEX=INDEX_""""_$SELECT($LENGTH(PARMARY(I)):PARMARY(I),1:" ")_""","
+22 SET INDEX=$EXTRACT(INDEX,1,$LENGTH(INDEX)-1)_")"
+23 SET @INDEX=IEN
+24 SET ^HLD(779.4,"AH KILL",IEN,""""_OWNER_""","_$PIECE(INDEX,"^HLD(779.4,""AH"",OWNER,",2))=""
+25 SET OK=1
End DoDot:1
+26 KILL PARMARY
+27 QUIT OK
+28 ;
KILLAH(IEN) ;kills the AH x~ref on file 779.4 for a particular subscription registry entry=ien
+1 IF '$GET(IEN)
QUIT
+2 NEW NEXT,LOCATION
+3 SET NEXT=""
+4 FOR
SET NEXT=$ORDER(^HLD(779.4,"AH KILL",IEN,NEXT))
IF '$LENGTH(NEXT)
QUIT
Begin DoDot:1
+5 SET LOCATION="^HLD(779.4,""AH"","_NEXT
+6 KILL @LOCATION
End DoDot:1
+7 KILL ^HLD(779.4,"AH KILL",IEN)
+8 QUIT
+9 ;
FIND(OWNER,PARMARY) ;
+1 ;Description: This allows an application to find a subscription
+2 ;list. The application must maintain a private index in order to
+3 ;utilize this function, via $$INDEX^HLOASUB()
+4 ;
+5 ;Input:
+6 ; OWNER - owning application name
+7 ; PARMARY **pass by reference** an array of parameters with which the index was built. The format is: PARMARY(1)=<first parameter>, PARMARY(2)=<second parameter> If PARMARY(i)=null, the parameter will be translated to a single space.
+8 ;Output:
+9 ; function returns the ien of the subscription list if found, 0 otherwise
+10 ; PARMARY - left undefined
+11 ;
+12 NEW OK
SET OK=0
+13 ;
+14 Begin DoDot:1
+15 IF '$DATA(PARMARY)
QUIT
+16 IF '$LENGTH($GET(OWNER))
QUIT
+17 NEW INDEX,I
+18 SET INDEX="^HLD(779.4,""AH"",OWNER,"
+19 SET I=0
+20 FOR
SET I=$ORDER(PARMARY(I))
IF 'I
QUIT
SET INDEX=INDEX_""""_$SELECT($LENGTH(PARMARY(I)):PARMARY(I),1:" ")_""","
+21 SET INDEX=$EXTRACT(INDEX,1,$LENGTH(INDEX)-1)_")"
+22 SET OK=+$GET(@INDEX)
End DoDot:1
+23 KILL PARMARY
+24 QUIT OK
+25 ;
UPD(FILE,DA,DATA,ERROR) ;File data into an existing record.
+1 ; Input:
+2 ; FILE - File or sub-file number
+3 ; DA - Traditional DA array, with same meaning.
+4 ; Pass by reference.
+5 ; DATA - Data array to file (pass by reference)
+6 ; Format: DATA(<field #>)=<value>
+7 ;
+8 ; Output:
+9 ; Function Value - 0=error and 1=no error
+10 ; ERROR - optional error message - if needed, pass by reference
+11 ;
+12 ; Example: To update a record in subfile 2.0361 in record with ien=353,
+13 ; subrecord ien=68, with the field .01 value = 21:
+14 ; S DATA(.01)=21,DA=68,DA(1)=353 I $$UPDS(2.0361,.DA,.DATA,.ERROR) W !,"DONE"
+15 ;
+16 NEW FDA,FIELD,IENS,ERRORS
+17 ;
+18 ;IENS - Internal Entry Number String defined by FM
+19 ;FDA - the FDA array as defined by FM
+20 ;
+21 IF '$GET(DA)
SET ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED"
QUIT 0
+22 SET IENS=$$IENS^DILF(.DA)
+23 SET FIELD=0
+24 FOR
SET FIELD=$ORDER(DATA(FIELD))
IF 'FIELD
QUIT
Begin DoDot:1
+25 SET FDA(FILE,IENS,FIELD)=$GET(DATA(FIELD))
End DoDot:1
+26 DO FILE^DIE("","FDA","ERRORS(1)")
+27 IF +$GET(DIERR)
Begin DoDot:1
+28 SET ERROR=$GET(ERRORS(1,"DIERR",1,"TEXT",1))
End DoDot:1
+29 IF '$TEST
Begin DoDot:1
+30 SET ERROR=""
End DoDot:1
+31 ;
+32 DO CLEAN^DILF
+33 QUIT $SELECT(+$GET(DIERR):0,1:1)
+34 ;
ADD(FILE,DA,DATA,ERROR,IEN) ;
+1 ;Description: Creates a new record and files the data.
+2 ; Input:
+3 ; FILE - File or sub-file number
+4 ; DA - Traditional FileMan DA array with same
+5 ; meaning. Pass by reference. Only needed if adding to a
+6 ; subfile.
+7 ; DATA - Data array to file, pass by reference
+8 ; Format: DATA(<field #>)=<value>
+9 ; IEN - internal entry number to use (optional)
+10 ;
+11 ; Output:
+12 ; Function Value - If no error then it returns the ien of the created record, else returns NULL.
+13 ; DA - returns the ien of the new record, NULL if none created. If needed, pass by reference.
+14 ; ERROR - optional error message - if needed, pass by reference
+15 ;
+16 ; Example: To add a record in subfile 2.0361 in the record with ien=353
+17 ; with the field .01 value = 21:
+18 ; S DATA(.01)=21,DA(1)=353 I $$ADD(2.0361,.DA,.DATA) W !,"DONE"
+19 ;
+20 ; Example: If creating a record not in a subfile, would look like this:
+21 ; S DATA(.01)=21 I $$ADD(867,,.DATA) W !,"DONE"
+22 ;
+23 NEW FDA,FIELD,IENA,IENS,ERRORS
+24 ;
+25 ;IENS - Internal Entry Number String defined by FM
+26 ;IENA - the Internal Entry Number Array defined by FM
+27 ;FDA - the FDA array defined by FM
+28 ;IEN - the ien of the new record
+29 ;
+30 SET DA="+1"
+31 SET IENS=$$IENS^DILF(.DA)
+32 SET FIELD=0
+33 FOR
SET FIELD=$ORDER(DATA(FIELD))
IF 'FIELD
QUIT
Begin DoDot:1
+34 SET FDA(FILE,IENS,FIELD)=$GET(DATA(FIELD))
End DoDot:1
+35 IF $GET(IEN)
SET IENA(1)=IEN
+36 DO UPDATE^DIE("","FDA","IENA","ERRORS(1)")
+37 IF +$GET(DIERR)
Begin DoDot:1
+38 SET ERROR=$GET(ERRORS(1,"DIERR",1,"TEXT",1))
+39 SET IEN=""
End DoDot:1
+40 IF '$TEST
Begin DoDot:1
+41 SET IEN=IENA(1)
+42 SET ERROR=""
End DoDot:1
+43 DO CLEAN^DILF
+44 SET DA=IEN
+45 QUIT IEN
+46 ;
DELETE(FILE,DA,ERROR) ;Delete an existing record.
+1 NEW DATA
+2 SET DATA(.01)="@"
+3 QUIT $$UPD^HLEMU(FILE,.DA,.DATA,.ERROR)
+4 QUIT
+5 ;
STATNUM(IEN) ;
+1 ;Description: Given an ien to the Institution file, returns as the function value the station number. If IEN is NOT passed in, it assumes the local site. Returns "" on failure.
+2 ;
+3 NEW STATION,RETURN
+4 SET RETURN=""
+5 IF $GET(IEN)
Begin DoDot:1
+6 IF '$DATA(^DIC(4,IEN,0))
QUIT
+7 SET STATION=$PIECE($$NNT^XUAF4(IEN),"^",2)
+8 SET RETURN=$SELECT(+STATION:STATION,1:"")
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 SET RETURN=$PIECE($$SITE^VASITE(),"^",3)
End DoDot:1
+11 QUIT RETURN
+12 ;
CHECKWHO(WHO,PARMS,ERROR) ;
+1 ;Checks the parameters provided in WHO() (see $$ADD). They must resolve
+2 ;the link, receiving app and receiving facility.
+3 ;INPUT:
+4 ; WHO - (required, pass by reference) - see $$ADD.
+5 ;
+6 ; WHO("PORT") - if this is valued, it will be used as the remote port
+7 ; to connect with rather than the port associated with the link
+8 ;Output:
+9 ; Function returns 1 if the input is resolved successfully, 0 otherwise
+10 ; PARMS - (pass by reference) These subscripts are returned:
+11 ; "LINK IEN" - ien of the link
+12 ; "LINK NAME" - name of the link
+13 ; "RECEIVING APPLICATION" - name of the receiving app
+14 ; "RECEIVING FACILITY",1) - component 1
+15 ; "RECEIVING FACILITY",2) - component 2
+16 ; "RECEIVING FACILITY",3) - component 3
+17 ; ERROR - (pass by reference) - if unsuccessful, an error message is returned.
+18 ;
+19 NEW OK
+20 KILL ERROR
+21 SET OK=1
+22 SET PARMS("LINK IEN")=""
SET PARMS("LINK NAME")=""
+23 ;must identify the receiving app
+24 ;
+25 Begin DoDot:1
+26 NEW LEN
+27 SET LEN=$LENGTH($GET(WHO("RECEIVING APPLICATION")))
+28 IF 'LEN
SET OK=0
+29 IF '$TEST
IF LEN>60
SET OK=0
+30 IF 'OK
SET ERROR="RECEIVING APPLICATION NOT VALID"
+31 SET PARMS("RECEIVING APPLICATION")=$GET(WHO("RECEIVING APPLICATION"))
End DoDot:1
+32 ;
+33 ;find the station # if Institution ien known
+34 IF $GET(WHO("INSTITUTION IEN"))
SET WHO("STATION NUMBER")=$$STATNUM^HLOASUB1(WHO("INSTITUTION IEN"))
+35 ;
+36 ;if destination link specified by name, get its ien
+37 IF '$GET(WHO("FACILITY LINK IEN"))
IF $LENGTH($GET(WHO("FACILITY LINK NAME")))
SET WHO("FACILITY LINK IEN")=$ORDER(^HLCS(870,"B",WHO("FACILITY LINK NAME"),0))
+38 ;
+39 ;if destination link not specified, find it based on station #
+40 IF +$GET(WHO("STATION NUMBER"))
IF '$GET(WHO("FACILITY LINK IEN"))
SET WHO("FACILITY LINK IEN")=$$FINDLINK^HLOTLNK(WHO("STATION NUMBER"))
+41 ;
+42 ;if station # not known, find it based on destination link
+43 IF '$GET(WHO("STATION NUMBER"))
IF $GET(WHO("FACILITY LINK IEN"))
SET WHO("STATION NUMBER")=$$STATNUM^HLOTLNK(WHO("FACILITY LINK IEN"))
+44 ;
+45 SET PARMS("RECEIVING FACILITY",1)=$GET(WHO("STATION NUMBER"))
+46 ;
+47 ;if the destination link is known, get the domain
+48 SET PARMS("RECEIVING FACILITY",2)=$SELECT($GET(WHO("FACILITY LINK IEN")):$$DOMAIN^HLOTLNK(WHO("FACILITY LINK IEN")),1:"")
+49 ;
+50 SET PARMS("RECEIVING FACILITY",3)="DNS"
+51 ;
+52 ;find the link to send over - need name & ien
+53 IF $GET(WHO("IE LINK IEN"))
Begin DoDot:1
+54 SET PARMS("LINK IEN")=WHO("IE LINK IEN")
+55 SET PARMS("LINK NAME")=$PIECE($GET(^HLCS(870,PARMS("LINK IEN"),0)),"^")
+56 IF OK
IF '$LENGTH(PARMS("LINK NAME"))
SET OK=0
SET ERROR="INTERFACE ENGINE LOGICAL LINK PROVIDED BUT NOT FOUND"
End DoDot:1
+57 IF '$TEST
IF $LENGTH($GET(WHO("IE LINK NAME")))
Begin DoDot:1
+58 SET PARMS("LINK NAME")=WHO("IE LINK NAME")
+59 SET PARMS("LINK IEN")=$ORDER(^HLCS(870,"B",WHO("IE LINK NAME"),0))
+60 IF OK
IF 'PARMS("LINK IEN")
SET OK=0
SET ERROR="INTERFACE ENGINE LOGICAL LINK PROVIDED BUT NOT FOUND"
End DoDot:1
+61 IF '$TEST
IF $GET(WHO("FACILITY LINK IEN"))
Begin DoDot:1
+62 SET PARMS("LINK IEN")=WHO("FACILITY LINK IEN")
+63 SET PARMS("LINK NAME")=$PIECE($GET(^HLCS(870,PARMS("LINK IEN"),0)),"^")
+64 IF OK
IF '$LENGTH(PARMS("LINK NAME"))
SET OK=0
SET ERROR="RECEIVING FACILITY LOGICAL LINK NOT FOUND"
End DoDot:1
+65 IF '$TEST
IF $LENGTH($GET(WHO("FACILITY LINK NAME")))
Begin DoDot:1
+66 SET PARMS("LINK NAME")=WHO("FACILITY LINK NAME")
+67 SET PARMS("LINK IEN")=$ORDER(^HLCS(870,"B",WHO("FACILITY LINK NAME"),0))
+68 IF OK
IF 'PARMS("LINK IEN")
SET OK=0
SET ERROR="RECEIVING FACILITY LOGICAL LINK NOT FOUND"
End DoDot:1
+69 IF OK
IF (('PARMS("LINK IEN"))!(PARMS("LINK NAME")=""))
SET OK=0
SET ERROR="LOGICAL LINK TO TRANSMIT OVER NOT SPECIFIED"
+70 ;
+71 ;need the station # or domain for msg header
+72 IF OK
IF '$LENGTH(PARMS("RECEIVING FACILITY",2))
IF 'PARMS("RECEIVING FACILITY",1)
SET OK=0
SET ERROR="RECEIVING FACILITY STATION # AND DOMAIN NOT SPECIFIED"
+73 ;
+74 ;append the port#
+75 IF '$GET(WHO("PORT"))
SET PARMS("RECEIVING FACILITY",2)=PARMS("RECEIVING FACILITY",2)_":"_$$PORT^HLOTLNK($GET(WHO("FACILITY LINK IEN")))
+76 IF '$TEST
SET PARMS("RECEIVING FACILITY",2)=PARMS("RECEIVING FACILITY",2)_":"_WHO("PORT")
+77 ;
+78 QUIT OK
