IBEC704P.m

IBEC704P ;ALB/CLT - POST PROCESSOR LOAD DNS ADDRESS INTO LOGICAL LINK ENTRIES ; 02 Jun 2022  1:08 PM

 ;;2.0;INTEGRATED BILLING;**704**;21-MAR-94;Build 49

 ;Per VA Directive 6402, this routine should not be modified.

 ;

 ; Reference to ^HLCS(870," in ICR #6409

 ;

 Q

 ;

EN ;ENTRY POINT

 N IBNODE,IBADDR,IEN,DIE,DR,DA

 F IBNODE="IBECEC-DFT","IBECEC-DSR","IBECEC-QRY" S IEN=$O(^HLCS(870,"B",IBNODE,"")) Q:IEN=""  D

 . S IBADDR=$S($$PROD^XUPROD()=1:"ehrm.das.domain.ext",1:"sqa.ehrm.das.domain.ext")

 . S DIE="^HLCS(870,",DR=".08///^S X=IBADDR",DA=IEN

 . D ^DIE

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBEC704P   576     printed  Apr 09, 2024@21:18:09                                                                                                                                                                                                     Page 2

IBEC704P  ;ALB/CLT - POST PROCESSOR LOAD DNS ADDRESS INTO LOGICAL LINK ENTRIES ; 02 Jun 2022  1:08 PM

 +1       ;;2.0;INTEGRATED BILLING;**704**;21-MAR-94;Build 49

 +2       ;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ; Reference to ^HLCS(870," in ICR #6409

 +5       ;

 +6        QUIT 

 +7       ;

EN        ;ENTRY POINT

 +1        NEW IBNODE,IBADDR,IEN,DIE,DR,DA

 +2        FOR IBNODE="IBECEC-DFT","IBECEC-DSR","IBECEC-QRY"

               SET IEN=$ORDER(^HLCS(870,"B",IBNODE,""))

               if IEN=""

                   QUIT 

               Begin DoDot:1

 +3                SET IBADDR=$SELECT($$PROD^XUPROD()=1:"ehrm.das.domain.ext",1:"sqa.ehrm.das.domain.ext")

 +4                SET DIE="^HLCS(870,"

                   SET DR=".08///^S X=IBADDR"

                   SET DA=IEN

 +5                DO ^DIE

               End DoDot:1

 +6        QUIT