IB20P509 ;ALB/RRA - Patch Install Routine ; 10/10/12 5:45pm
;;2.0;INTEGRATED BILLING;**509**;21-MAR-94;Build 3
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
POST ; Update the TCP/IP address for HL7 Logical Link
N IBIEN1,IBIEN2,IBPAD,IBTAD,IBNAD,IB870,IBERR,IBQUIT
D MES^XPDUTL("Update TCP/IP address of HL7 Logical Link 'EPHARM OUT' & 'BPS NCPDP'")
; DBIA #1496
S IBQUIT=0
S IBPAD="127.0.0.1",IBTAD="127.0.0.1"
S IBIEN1=$O(^HLCS(870,"B","EPHARM OUT",0))
I 'IBIEN1 D
. D MES^XPDUTL("IEN of HL7 Logical Link 'EPHARM OUT' not found - install aborted")
. S IBQUIT=1
S IBIEN2=$O(^HLCS(870,"B","BPS NCPDP",0))
I 'IBIEN2 D
. D MES^XPDUTL("IEN of HL7 Logical Link 'BPS NCPDP' not found - install aborted")
. S IBQUIT=1
;
I IBQUIT D POSTQ Q
; check the account (test or production) and then update the IP address
S IBNAD=$S($$PROD^XUPROD:IBPAD,1:IBTAD)
S IB870(870,IBIEN1_",",400.01)=IBNAD,IB870(870,IBIEN2_",",400.01)=IBNAD
D FILE^DIE("","IB870","IBERR")
I $D(IBERR) D
. D MES^XPDUTL("Update failed")
I '$D(IBERR) D
. D MES^XPDUTL("The TCP/IP address updates were successful")
D POSTQ Q
;
POSTQ D MES^XPDUTL(" Done.")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P509 1207 printed Nov 22, 2024@17:13:28 Page 2
IB20P509 ;ALB/RRA - Patch Install Routine ; 10/10/12 5:45pm
+1 ;;2.0;INTEGRATED BILLING;**509**;21-MAR-94;Build 3
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
POST ; Update the TCP/IP address for HL7 Logical Link
+1 NEW IBIEN1,IBIEN2,IBPAD,IBTAD,IBNAD,IB870,IBERR,IBQUIT
+2 DO MES^XPDUTL("Update TCP/IP address of HL7 Logical Link 'EPHARM OUT' & 'BPS NCPDP'")
+3 ; DBIA #1496
+4 SET IBQUIT=0
+5 SET IBPAD="127.0.0.1"
SET IBTAD="127.0.0.1"
+6 SET IBIEN1=$ORDER(^HLCS(870,"B","EPHARM OUT",0))
+7 IF 'IBIEN1
Begin DoDot:1
+8 DO MES^XPDUTL("IEN of HL7 Logical Link 'EPHARM OUT' not found - install aborted")
+9 SET IBQUIT=1
End DoDot:1
+10 SET IBIEN2=$ORDER(^HLCS(870,"B","BPS NCPDP",0))
+11 IF 'IBIEN2
Begin DoDot:1
+12 DO MES^XPDUTL("IEN of HL7 Logical Link 'BPS NCPDP' not found - install aborted")
+13 SET IBQUIT=1
End DoDot:1
+14 ;
+15 IF IBQUIT
DO POSTQ
QUIT
+16 ; check the account (test or production) and then update the IP address
+17 SET IBNAD=$SELECT($$PROD^XUPROD:IBPAD,1:IBTAD)
+18 SET IB870(870,IBIEN1_",",400.01)=IBNAD
SET IB870(870,IBIEN2_",",400.01)=IBNAD
+19 DO FILE^DIE("","IB870","IBERR")
+20 IF $DATA(IBERR)
Begin DoDot:1
+21 DO MES^XPDUTL("Update failed")
End DoDot:1
+22 IF '$DATA(IBERR)
Begin DoDot:1
+23 DO MES^XPDUTL("The TCP/IP address updates were successful")
End DoDot:1
+24 DO POSTQ
QUIT
+25 ;
POSTQ DO MES^XPDUTL(" Done.")
+1 QUIT
+2 ;
