- 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 Apr 23, 2025@18:17:49 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 ;