IBY794PO.m

IBY794PO ;AITC/CKB - Post-Installation for IB patch 794; JUN 12, 2024

 ;;2.0;INTEGRATED BILLING;**794**;21-MAR-94;Build 9

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

 ;

 ; Reference to ^XPDUTL in ICR #10141

 Q

 ;

POST ; POST-INSTALL

 N IBXPD,SITE,XPDIDTOT

 ; total number of work items

 S XPDIDTOT=1

 ;

 D MES^XPDUTL("")

 ;

 ; Correct the ENTRY ACTION field (#20) for several entries in the PROTOCOL FILE (#101)

 D FIXEA(1)

 ;

 D MES^XPDUTL("")      ; Displays the 'Done' message and finishes the progress bar

 D BMES^XPDUTL("POST-Install for IB*2.0*794 Completed.")

 Q

 ;============================

 ;

FIXEA(IBXPD) ; Fix the ENTRY ACTION field (#20), in file #101

 ;

 S IBXPD=$G(IBXPD),XPDIDTOT=$G(XPDIDTOT)

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

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

 N DA,DR,IBERR,IBIEN,IBACT,IBPRO

 S IBACT="K IBFASTXT S VALMBCK=""R"""

 ;

 S IBPRO="IBJT CLAIM SCREEN MENU"

 S IBIEN=$$FIND1^DIC(101,,"MX",IBPRO,"","","IBERR")

 I 'IBIEN D

 . D BMES^XPDUTL("The protocol "_IBPRO_" in file #101 was not found. No change made.")

 I IBIEN'="" D UPDEA

 ;

 S IBPRO="IBJT NS VIEW EXP POL MENU"

 K IBEIN,IBERR

 S IBIEN=$$FIND1^DIC(101,,"MX",IBPRO,"","","IBERR")

 I 'IBIEN D

 . D BMES^XPDUTL("The protocol "_IBPRO_" in file #101 was not found. No change made.")

 I IBIEN D UPDEA

 ;

 S IBPRO="IBJT NS VIEW INS CO MENU"

 K IBEIN,IBERR

 S IBIEN=$$FIND1^DIC(101,,"MX",IBPRO,"","","IBERR")

 I 'IBIEN D

 . D BMES^XPDUTL("The protocol "_IBPRO_" in file #101 was not found. No change made.")

 I IBIEN D UPDEA

 ;

 S IBPRO="IBJT EDI STATUS MENU"

 K IBIEN,IBERR

 S IBIEN=$$FIND1^DIC(101,,"MX",IBPRO,"","","IBERR")

 I 'IBIEN D

 . D BMES^XPDUTL("The protocol "_IBPRO_" in file #101 was not found. No change made.")

 I IBIEN D UPDEA

 ;

FIXEAX ; FIXEA exit

 D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT_" Complete")

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

 Q

 ;

UPDEA ; update the ENTRY ACTION field (#101,20)

 N DR,DA,DIE

 S DR="20///"_IBACT

 S DA=IBIEN,DIE="^ORD(101," D ^DIE

 D BMES^XPDUTL("The protocol "_IBPRO_" in file #101 has been modified")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBY794PO   2128     printed  Mar 13, 2025@21:40:44                                                                                                                                                                                                    Page 2

IBY794PO  ;AITC/CKB - Post-Installation for IB patch 794; JUN 12, 2024

 +1       ;;2.0;INTEGRATED BILLING;**794**;21-MAR-94;Build 9

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

 +3       ;

 +4       ; Reference to ^XPDUTL in ICR #10141

 +5        QUIT 

 +6       ;

POST      ; POST-INSTALL

 +1        NEW IBXPD,SITE,XPDIDTOT

 +2       ; total number of work items

 +3        SET XPDIDTOT=1

 +4       ;

 +5        DO MES^XPDUTL("")

 +6       ;

 +7       ; Correct the ENTRY ACTION field (#20) for several entries in the PROTOCOL FILE (#101)

 +8        DO FIXEA(1)

 +9       ;

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

           DO MES^XPDUTL("")

 +11       DO BMES^XPDUTL("POST-Install for IB*2.0*794 Completed.")

 +12       QUIT 

 +13      ;============================

 +14      ;

FIXEA(IBXPD) ; Fix the ENTRY ACTION field (#20), in file #101

 +1       ;

 +2        SET IBXPD=$GET(IBXPD)

           SET XPDIDTOT=$GET(XPDIDTOT)

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

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

 +5        NEW DA,DR,IBERR,IBIEN,IBACT,IBPRO

 +6        SET IBACT="K IBFASTXT S VALMBCK=""R"""

 +7       ;

 +8        SET IBPRO="IBJT CLAIM SCREEN MENU"

 +9        SET IBIEN=$$FIND1^DIC(101,,"MX",IBPRO,"","","IBERR")

 +10       IF 'IBIEN

               Begin DoDot:1

 +11               DO BMES^XPDUTL("The protocol "_IBPRO_" in file #101 was not found. No change made.")

               End DoDot:1

 +12       IF IBIEN'=""

               DO UPDEA

 +13      ;

 +14       SET IBPRO="IBJT NS VIEW EXP POL MENU"

 +15       KILL IBEIN,IBERR

 +16       SET IBIEN=$$FIND1^DIC(101,,"MX",IBPRO,"","","IBERR")

 +17       IF 'IBIEN

               Begin DoDot:1

 +18               DO BMES^XPDUTL("The protocol "_IBPRO_" in file #101 was not found. No change made.")

               End DoDot:1

 +19       IF IBIEN

               DO UPDEA

 +20      ;

 +21       SET IBPRO="IBJT NS VIEW INS CO MENU"

 +22       KILL IBEIN,IBERR

 +23       SET IBIEN=$$FIND1^DIC(101,,"MX",IBPRO,"","","IBERR")

 +24       IF 'IBIEN

               Begin DoDot:1

 +25               DO BMES^XPDUTL("The protocol "_IBPRO_" in file #101 was not found. No change made.")

               End DoDot:1

 +26       IF IBIEN

               DO UPDEA

 +27      ;

 +28       SET IBPRO="IBJT EDI STATUS MENU"

 +29       KILL IBIEN,IBERR

 +30       SET IBIEN=$$FIND1^DIC(101,,"MX",IBPRO,"","","IBERR")

 +31       IF 'IBIEN

               Begin DoDot:1

 +32               DO BMES^XPDUTL("The protocol "_IBPRO_" in file #101 was not found. No change made.")

               End DoDot:1

 +33       IF IBIEN

               DO UPDEA

 +34      ;

FIXEAX    ; FIXEA exit

 +1        DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT_" Complete")

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

 +3        QUIT 

 +4       ;

UPDEA     ; update the ENTRY ACTION field (#101,20)

 +1        NEW DR,DA,DIE

 +2        SET DR="20///"_IBACT

 +3        SET DA=IBIEN

           SET DIE="^ORD(101,"

           DO ^DIE

 +4        DO BMES^XPDUTL("The protocol "_IBPRO_" in file #101 has been modified")

 +5        QUIT