IBEC769P ;ALB/RRA - POST PROCESSOR LOAD DNS ADDRESS INTO LOGICAL LINK ENTRIES ; 02 Jun 2022 1:08 PM
;;2.0;INTEGRATED BILLING;**769**;21-MAR-94;Build 42
;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,IBMES,IBIENS,IBIPADD,IBPORT,IBIENS1
F IBNODE="IBECEC-ACK","IBECEC-DFT","IBECEC-DSR","IBECEC-QRY" S IEN=$O(^HLCS(870,"B",IBNODE,"")) Q:IEN="" D
. S IBIENS=$O(^HLCS(870,"B","IBARXCVDF",""))_",",IBADDR=$$GET1^DIQ(870,IBIENS,.08),IBPORT=$$GET1^DIQ(870,IBIENS,400.08)
. I $$PROD^XUPROD()=1 D
.. S DIE="^HLCS(870,",DR="400.01///@",DA=IEN D ^DIE ;Clear old IP Address
.. S DIE="^HLCS(870,",DR="400.08///^S X=IBPORT;.08///^S X=IBADDR",DA=IEN D ^DIE ;set new dns and port
.. S IBIENS1=IEN_","
.. S IBIPADD=$$ADDRESS^XLFNSLK(IBADDR) I $G(IBIPADD)'="" S DIE="^HLCS(870,",DR="400.01///^S X=IBIPADD",DA=IEN D ^DIE ;Set new address
.. I $$GET1^DIQ(870,IBIENS1,400.01)'="" S IBMES=IBNODE_" LOGICAL LINK SUCCESSFULLY UPDATED." D BMES^XPDUTL(IBMES)
.. I $$GET1^DIQ(870,IBIENS1,400.01)="" S IBMES=IBNODE_" LOGICAL LINK FAILED TO UPDATED. PLEASE CHECK THE LOGICAL LINK AND OPEN A SERVICE TICKET IF NEEDED" D BMES^XPDUTL(IBMES)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBEC769P 1265 printed Sep 23, 2025@19:57:25 Page 2
IBEC769P ;ALB/RRA - POST PROCESSOR LOAD DNS ADDRESS INTO LOGICAL LINK ENTRIES ; 02 Jun 2022 1:08 PM
+1 ;;2.0;INTEGRATED BILLING;**769**;21-MAR-94;Build 42
+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,IBMES,IBIENS,IBIPADD,IBPORT,IBIENS1
+2 FOR IBNODE="IBECEC-ACK","IBECEC-DFT","IBECEC-DSR","IBECEC-QRY"
SET IEN=$ORDER(^HLCS(870,"B",IBNODE,""))
if IEN=""
QUIT
Begin DoDot:1
+3 SET IBIENS=$ORDER(^HLCS(870,"B","IBARXCVDF",""))_","
SET IBADDR=$$GET1^DIQ(870,IBIENS,.08)
SET IBPORT=$$GET1^DIQ(870,IBIENS,400.08)
+4 IF $$PROD^XUPROD()=1
Begin DoDot:2
+5 ;Clear old IP Address
SET DIE="^HLCS(870,"
SET DR="400.01///@"
SET DA=IEN
DO ^DIE
+6 ;set new dns and port
SET DIE="^HLCS(870,"
SET DR="400.08///^S X=IBPORT;.08///^S X=IBADDR"
SET DA=IEN
DO ^DIE
+7 SET IBIENS1=IEN_","
+8 ;Set new address
SET IBIPADD=$$ADDRESS^XLFNSLK(IBADDR)
IF $GET(IBIPADD)'=""
SET DIE="^HLCS(870,"
SET DR="400.01///^S X=IBIPADD"
SET DA=IEN
DO ^DIE
+9 IF $$GET1^DIQ(870,IBIENS1,400.01)'=""
SET IBMES=IBNODE_" LOGICAL LINK SUCCESSFULLY UPDATED."
DO BMES^XPDUTL(IBMES)
+10 IF $$GET1^DIQ(870,IBIENS1,400.01)=""
SET IBMES=IBNODE_" LOGICAL LINK FAILED TO UPDATED. PLEASE CHECK THE LOGICAL LINK AND OPEN A SERVICE TICKET IF NEEDED"
DO BMES^XPDUTL(IBMES)
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
