IBY601PO.m

IBY601PO ;EDE/DM - Post-Installation for IB patch 601 ; 01-NOV-2017

 ;;2.0;INTEGRATED BILLING;**601**;21-MAR-94;Build 14

 ;;Per VA Directive 6402, this routine should not be modified.

 ;

POST ; POST ROUTINE(S)

 N IBXPD,XPDIDTOT

 S XPDIDTOT=2

 ;

 ; Send site registration message to FSC

 D REGMSG(1)

 ;

 ; Check/remove any link from an insurance to the National MBI Payer

 D CHKLNK(2)

 ;

 ; 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 MBI Payer

 ;It's possible that a client linked an insurance to the MBI payer

 ;This is not allowed. Any such link will be removed

 N IBMBIPYR,IBIEN

 D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)

 D MES^XPDUTL("-------------")

 D MES^XPDUTL("Verifying Insurance links to payers...")

 S IBMBIPYR=0

 S IBMBIPYR=$O(^IBE(365.12,"B","CMS MBI ONLY",IBMBIPYR))

 I 'IBMBIPYR D BMES^XPDUTL("MBI Payer has not been established") G CHKLNKQ

 S IBIEN=0

 F  S IBIEN=$O(^DIC(36,"AC",IBMBIPYR,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

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBY601PO   1683     printed  Apr 09, 2024@21:04:05                                                                                                                                                                                                    Page 2

IBY601PO  ;EDE/DM - Post-Installation for IB patch 601 ; 01-NOV-2017

 +1       ;;2.0;INTEGRATED BILLING;**601**;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=2

 +3       ;

 +4       ; Send site registration message to FSC

 +5        DO REGMSG(1)

 +6       ;

 +7       ; Check/remove any link from an insurance to the National MBI Payer

 +8        DO CHKLNK(2)

 +9       ;

 +10      ; Displays the 'Done' message and finishes the progress bar

 +11       DO MES^XPDUTL("")

 +12       DO MES^XPDUTL("POST-Install Completed.")

 +13       QUIT 

 +14      ;

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        IF '$$PROD^XUPROD(1)

               DO MES^XPDUTL(" N/A - Not a production account - No site registration message sent")

               GOTO REGMSGQ

 +5        DO MES^XPDUTL("Sending site registration message to FSC ... ")

 +6        DO ^IBCNEHLM

 +7       ;

REGMSGQ   ;

 +1        QUIT 

 +2       ; 

CHKLNK(IBXPD) ; Due to a timing issue with the National MBI Payer

 +1       ;It's possible that a client linked an insurance to the MBI payer

 +2       ;This is not allowed. Any such link will be removed

 +3        NEW IBMBIPYR,IBIEN

 +4        DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)

 +5        DO MES^XPDUTL("-------------")

 +6        DO MES^XPDUTL("Verifying Insurance links to payers...")

 +7        SET IBMBIPYR=0

 +8        SET IBMBIPYR=$ORDER(^IBE(365.12,"B","CMS MBI ONLY",IBMBIPYR))

 +9        IF 'IBMBIPYR

               DO BMES^XPDUTL("MBI Payer has not been established")

               GOTO CHKLNKQ

 +10       SET IBIEN=0

 +11       FOR 

               SET IBIEN=$ORDER(^DIC(36,"AC",IBMBIPYR,IBIEN))

               if 'IBIEN

                   QUIT 

               Begin DoDot:1

 +12      ; remove the link

                   SET DIE="^DIC(36,"

                   SET DA=IBIEN

                   SET DR="3.1///@"

                   DO ^DIE

 +13               WRITE !,"Insurance:"_IBIEN_" "_$$GET1^DIQ(36,IBIEN_",","NAME")

 +14               KILL DIE,DA,DR

               End DoDot:1

 +15      ;

CHKLNKQ   ;

 +1        QUIT 

 +2       ;