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 ---[H[J[2J[HIBY794PO 2128 printed Sep 23, 2025@20:11:56 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
