Routine: IBY621PO

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.")

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 ;

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 ;

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 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY621PO   3713     printed  Feb 19, 2025@00:01:18                                                                                                                                                                                                    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       ;

IBY621PO.m