IBY621PO ;AITC/DM - Post-Installation for IB patch 621; 22-MAY-2018
;;2.0;INTEGRATED BILLING;**621**;21-MAR-94;Build 14
;;Per VA Directive 6402, this routine should not be modified.
;
POST ; POST ROUTINE(S)
N IBXPD,XPDIDTOT
S XPDIDTOT=3
;
; Create/update the EICD extract
D CHKEICD(1)
;
; Send site registration message to FSC
D REGMSG(2)
;
; Check/remove any link from an insurance to the National EICD Payer
D CHKLNK(3)
;
; Displays the 'Done' message and finishes the progress bar
D MES^XPDUTL("")
D MES^XPDUTL("POST-Install Completed.")
Q
;
REGMSG(IBXPD) ; send site registration message to FSC
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Sending site registration message to FSC ... ")
;
I '$$PROD^XUPROD(1) D MES^XPDUTL(" N/A - Not a production account - No site registration message sent") G REGMSGQ
D MES^XPDUTL("Sending site registration message to FSC ... ")
D ^IBCNEHLM
;
REGMSGQ ;
Q
;
CHKLNK(IBXPD) ; Due to a timing issue with the National EICD Payer
;It's possible that a client linked an insurance to the EICD payer
;This is not allowed. Any such link will be removed
N IBEICDPY,IBIEN
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Verifying Insurance links to payers...")
;
S IBEICDPY=0
S IBEICDPY=$O(^IBE(365.12,"B","ELECTRONIC COVERAGE DISCOVERY",IBEICDPY))
I 'IBEICDPY D BMES^XPDUTL("The Electronic Insurance Coverage Discovery Payer has not been established") G CHKLNKQ
S IBIEN=0
F S IBIEN=$O(^DIC(36,"AC",IBEICDPY,IBIEN)) Q:'IBIEN D
. S DIE="^DIC(36,",DA=IBIEN,DR="3.1///@" D ^DIE ; remove the link
. W !,"Insurance:"_IBIEN_" "_$$GET1^DIQ(36,IBIEN_",","NAME")
. K DIE,DA,DR
;
CHKLNKQ ;
Q
;
CHKEICD(IBXPD) ; Create or update the EICD Extract
N IBFDA,IBSETIEN,IBERR,IBEXT4,IBEXTIEN
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Create/update the EICD Extract parameters... ")
;
S IBEXT4=+$$FIND1^DIC(350.9002,",1,","BQX","4","B")
I 'IBEXT4 D G CHKEICDQ
. W !," Creating a new EICD batch extract record..."
. S IBEXTIEN="+1,1,"
. S IBSETIEN(1)=4 ;for safety, force new IEN to 4
. S IBFDA(350.9002,IBEXTIEN,.01)="4" ; BATCH EXTRACTS
. S IBFDA(350.9002,IBEXTIEN,.02)="1" ; Active?
. S IBFDA(350.9002,IBEXTIEN,.03)="" ; SELECTION CRITERIA #1
. S IBFDA(350.9002,IBEXTIEN,.04)="" ; SELECTION CRITERIA #2
. S IBFDA(350.9002,IBEXTIEN,.05)=99999 ; MAXIMUM EXTRACT NUMBER
. S IBFDA(350.9002,IBEXTIEN,.06)="1" ; SUPPRESS BUFFER CREATION
. S IBFDA(350.9002,IBEXTIEN,.07)=31 ; START DAYS
. S IBFDA(350.9002,IBEXTIEN,.08)=9 ; DAYS AFTER START
. S IBFDA(350.9002,IBEXTIEN,.09)=365 ; FREQUENCY
. ;
. D UPDATE^DIE(,"IBFDA","IBSETIEN","IBERR")
. I $G(IBERR("DIERR",1,"TEXT",1))'="" W !,"ISSUE CREATING EXTRACT: "_$G(IBERR("DIERR",1,"TEXT",1))
;
I IBEXT4 D G CHKEICDQ
. W !," Updating existing EICD batch extract record..."
. S IBEXTIEN=IBEXT4_",1,"
. S IBFDA(350.9002,IBEXTIEN,.02)="1" ; Active?
. S IBFDA(350.9002,IBEXTIEN,.03)="" ; SELECTION CRITERIA #1
. S IBFDA(350.9002,IBEXTIEN,.04)="" ; SELECTION CRITERIA #2
. S IBFDA(350.9002,IBEXTIEN,.05)=99999 ; MAXIMUM EXTRACT NUMBER
. S IBFDA(350.9002,IBEXTIEN,.06)="1" ; SUPPRESS BUFFER CREATION
. S IBFDA(350.9002,IBEXTIEN,.07)=31 ; START DAYS
. S IBFDA(350.9002,IBEXTIEN,.08)=9 ; DAYS AFTER START
. S IBFDA(350.9002,IBEXTIEN,.09)=365 ; FREQUENCY
. ;
. D FILE^DIE(,"IBFDA","IBERR")
. I $G(IBERR("DIERR",1,"TEXT",1))'="" W !,"ISSUE UPDATING EXTRACT: "_$G(IBERR("DIERR",1,"TEXT",1))
;
CHKEICDQ ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY621PO 3713 printed Sep 23, 2025@20:11:12 Page 2
IBY621PO ;AITC/DM - Post-Installation for IB patch 621; 22-MAY-2018
+1 ;;2.0;INTEGRATED BILLING;**621**;21-MAR-94;Build 14
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
POST ; POST ROUTINE(S)
+1 NEW IBXPD,XPDIDTOT
+2 SET XPDIDTOT=3
+3 ;
+4 ; Create/update the EICD extract
+5 DO CHKEICD(1)
+6 ;
+7 ; Send site registration message to FSC
+8 DO REGMSG(2)
+9 ;
+10 ; Check/remove any link from an insurance to the National EICD Payer
+11 DO CHKLNK(3)
+12 ;
+13 ; Displays the 'Done' message and finishes the progress bar
+14 DO MES^XPDUTL("")
+15 DO MES^XPDUTL("POST-Install Completed.")
+16 QUIT
+17 ;
REGMSG(IBXPD) ; send site registration message to FSC
+1 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
+2 DO MES^XPDUTL("-------------")
+3 DO MES^XPDUTL("Sending site registration message to FSC ... ")
+4 ;
+5 IF '$$PROD^XUPROD(1)
DO MES^XPDUTL(" N/A - Not a production account - No site registration message sent")
GOTO REGMSGQ
+6 DO MES^XPDUTL("Sending site registration message to FSC ... ")
+7 DO ^IBCNEHLM
+8 ;
REGMSGQ ;
+1 QUIT
+2 ;
CHKLNK(IBXPD) ; Due to a timing issue with the National EICD Payer
+1 ;It's possible that a client linked an insurance to the EICD payer
+2 ;This is not allowed. Any such link will be removed
+3 NEW IBEICDPY,IBIEN
+4 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
+5 DO MES^XPDUTL("-------------")
+6 DO MES^XPDUTL("Verifying Insurance links to payers...")
+7 ;
+8 SET IBEICDPY=0
+9 SET IBEICDPY=$ORDER(^IBE(365.12,"B","ELECTRONIC COVERAGE DISCOVERY",IBEICDPY))
+10 IF 'IBEICDPY
DO BMES^XPDUTL("The Electronic Insurance Coverage Discovery Payer has not been established")
GOTO CHKLNKQ
+11 SET IBIEN=0
+12 FOR
SET IBIEN=$ORDER(^DIC(36,"AC",IBEICDPY,IBIEN))
if 'IBIEN
QUIT
Begin DoDot:1
+13 ; remove the link
SET DIE="^DIC(36,"
SET DA=IBIEN
SET DR="3.1///@"
DO ^DIE
+14 WRITE !,"Insurance:"_IBIEN_" "_$$GET1^DIQ(36,IBIEN_",","NAME")
+15 KILL DIE,DA,DR
End DoDot:1
+16 ;
CHKLNKQ ;
+1 QUIT
+2 ;
CHKEICD(IBXPD) ; Create or update the EICD Extract
+1 NEW IBFDA,IBSETIEN,IBERR,IBEXT4,IBEXTIEN
+2 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Create/update the EICD Extract parameters... ")
+5 ;
+6 SET IBEXT4=+$$FIND1^DIC(350.9002,",1,","BQX","4","B")
+7 IF 'IBEXT4
Begin DoDot:1
+8 WRITE !," Creating a new EICD batch extract record..."
+9 SET IBEXTIEN="+1,1,"
+10 ;for safety, force new IEN to 4
SET IBSETIEN(1)=4
+11 ; BATCH EXTRACTS
SET IBFDA(350.9002,IBEXTIEN,.01)="4"
+12 ; Active?
SET IBFDA(350.9002,IBEXTIEN,.02)="1"
+13 ; SELECTION CRITERIA #1
SET IBFDA(350.9002,IBEXTIEN,.03)=""
+14 ; SELECTION CRITERIA #2
SET IBFDA(350.9002,IBEXTIEN,.04)=""
+15 ; MAXIMUM EXTRACT NUMBER
SET IBFDA(350.9002,IBEXTIEN,.05)=99999
+16 ; SUPPRESS BUFFER CREATION
SET IBFDA(350.9002,IBEXTIEN,.06)="1"
+17 ; START DAYS
SET IBFDA(350.9002,IBEXTIEN,.07)=31
+18 ; DAYS AFTER START
SET IBFDA(350.9002,IBEXTIEN,.08)=9
+19 ; FREQUENCY
SET IBFDA(350.9002,IBEXTIEN,.09)=365
+20 ;
+21 DO UPDATE^DIE(,"IBFDA","IBSETIEN","IBERR")
+22 IF $GET(IBERR("DIERR",1,"TEXT",1))'=""
WRITE !,"ISSUE CREATING EXTRACT: "_$GET(IBERR("DIERR",1,"TEXT",1))
End DoDot:1
GOTO CHKEICDQ
+23 ;
+24 IF IBEXT4
Begin DoDot:1
+25 WRITE !," Updating existing EICD batch extract record..."
+26 SET IBEXTIEN=IBEXT4_",1,"
+27 ; Active?
SET IBFDA(350.9002,IBEXTIEN,.02)="1"
+28 ; SELECTION CRITERIA #1
SET IBFDA(350.9002,IBEXTIEN,.03)=""
+29 ; SELECTION CRITERIA #2
SET IBFDA(350.9002,IBEXTIEN,.04)=""
+30 ; MAXIMUM EXTRACT NUMBER
SET IBFDA(350.9002,IBEXTIEN,.05)=99999
+31 ; SUPPRESS BUFFER CREATION
SET IBFDA(350.9002,IBEXTIEN,.06)="1"
+32 ; START DAYS
SET IBFDA(350.9002,IBEXTIEN,.07)=31
+33 ; DAYS AFTER START
SET IBFDA(350.9002,IBEXTIEN,.08)=9
+34 ; FREQUENCY
SET IBFDA(350.9002,IBEXTIEN,.09)=365
+35 ;
+36 DO FILE^DIE(,"IBFDA","IBERR")
+37 IF $GET(IBERR("DIERR",1,"TEXT",1))'=""
WRITE !,"ISSUE UPDATING EXTRACT: "_$GET(IBERR("DIERR",1,"TEXT",1))
End DoDot:1
GOTO CHKEICDQ
+38 ;
CHKEICDQ ;
+1 QUIT
+2 ;
