IBY822PO ;AITC/CKB - Post-Installation for IB patch 822; 02-APR-2025
;;2.0;INTEGRATED BILLING;**822**;21-MAR-94;Build 21
;;Per VA Directive 6402, this routine should not be modified.
;
; Reference to ^XPDUTL in ICR #10141
; Reference to ^XUSAP in ICR #4677
Q
;
POST ; POST-INSTALL
N IBXPD,XPDIDTOT
; total number of work items
S XPDIDTOT=4
;
D MES^XPDUTL("")
;
D UPDENTRY(1) ; Update DESCRIPTION field (#355.12,.02) for 'E-PHARMACY' entry to 'EPHARMACY' entry
;
D IIVSTAT(2) ; Add two new entries to the IIV STATUS TABLE file #365.15
;
D ADDPROXY(3) ; Create "IB,AUTOINS FILEUPDATE" in file New Person (#200)
;
D SETDEF(4) ; Set default for field E1 TRANSACTIONS ENABLED (#350.9,54.05) to '1' for 'YES'
;
D MES^XPDUTL("") ; Displays the 'Done' message and finishes the progress bar
D MES^XPDUTL("POST-Install for IB*2.0*822 Completed.")
Q
;================================
;
UPDENTRY(IBXPD) ;Update field #.02 DESCRIPTION in file #355.12 SOURCE OF INFORMATION
; from 'E-PHARMACY' to 'EPHARMACY'
;
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Update DESCRIPTION (#355.12,.02) for 'E-PHARMACY' entry... ")
;
N IBENT,DATA,MSG
I $D(^IBE(355.12,"C","EPHARMACY")) D G UPDENTQ
. S MSG="DESCRIPTION has already been updated to 'EPHARMACY'."
. D MES^XPDUTL(MSG)
S IBENT=$O(^IBE(355.12,"C","E-PHARMACY",0))
I IBENT="" S MSG="Unable to update E-PHARMACY entry, not found." G UPDENTQ
S DATA(.02)="EPHARMACY"
D UPD^IBDFDBS(355.12,.IBENT,.DATA)
S MSG="DESCRIPTION for 'E-PHARMACY' has been updated to 'EPHARMACY'."
UPDENTQ ;
S MSG="Finshed STEP "_IBXPD_" of "_XPDIDTOT
D MES^XPDUTL(MSG)
;
Q
;================================
;
IIVSTAT(IBXPD) ;Add two new entries to the IIV STATUS TABLE file #365.15
;
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Adding entries to the IIV STATUS TABLE File (#365.15)")
;
N IBASC,IBCODE,IBDATA,IBERR,IBEX,IBFIEN,IBFILE,IBIENS,IBRIEN,MSG
S IBFILE=365.15,(IBCODE,IBASC,IBEX,IBERR,IBRIEN,IBFIEN)=""
; check if 'a1' or 'r1' defined
I $D(^IBE(365.15,"B","a1")) D G IIVST2
. D MES^XPDUTL("Code 'a1' has already been added.")
; first create 'a1'
S IBCODE="a1",IBASC=97,IBEX=0
K IBDATA
S IBDATA(.01)=IBCODE,IBDATA(.02)=IBASC,IBDATA(.03)=IBEX
S IBFIEN=$$ADD^IBDFDBS(IBFILE,,.IBDATA,.IBERR,.IBRIEN)
I 'IBFIEN!'(IBRIEN) D G IIVST2
. S MSG="NOT able to add entry 'a1' for reason: "_IBERR
. D MES^XPDUTL(MSG)
; add description
K IBDATA S IBERR="" S IBIENS=IBFIEN S:IBIENS="" IBIENS=IBRIEN S IBIENS=IBIENS_","
I '+IBIENS D MES^XPDUTL("'a1' not added to the IIV STATUS TABLE File (#365.15)") G IIVST2
S MSG="Entry 'a1' ("_+IBIENS_") ADDED to the IIV STATUS TABLE File (#365.15)" D MES^XPDUTL(MSG)
S IBDATA(1,0)="Information received via electronic inquiry indicates an Accepted Response."
; save it
D WP^DIE(IBFILE,IBIENS,1,"","IBDATA","IBERR")
I IBERR'="" D
. S MSG="NOT able to add DESCRIPTION to code : 'a1' ("_+IBIENS_") for error: "_IBERR
E S MSG="ADDED DESCRIPTION to code : 'a1' ("_+IBIENS_")"
D MES^XPDUTL(MSG)
;
; add corrective action
K IBDATA S IBERR=""
S IBDATA(1,0)="Action to take: Review the details in the ePharmacy Eligibility Response Data"
S IBDATA(2,0)="before processing this buffer entry."
; save it
D WP^DIE(IBFILE,IBIENS,2,"","IBDATA","IBERR")
I IBERR'="" D
. S MSG="NOT able to add CORRECTIVE ACTION to code : 'a1' ("_+IBIENS_") for error: "_IBERR
E S MSG="ADDED CORRECTIVE ACTION to code : 'a1' ("_+IBIENS_")"
D MES^XPDUTL(MSG)
;
IIVST2 ; add 'r1'
;
I $D(^IBE(365.15,"B","r1")) D G IIVSTATQ
. D MES^XPDUTL("Code 'r1' has already been added.")
; first create 'r1'
K IBDATA
S IBCODE="r1",IBASC=114,IBEX=0,IBERR="",IBIENS="",IBRIEN="",IBFIEN=""
S IBDATA(.01)=IBCODE,IBDATA(.02)=IBASC,IBDATA(.03)=IBEX
S IBFIEN=$$ADD^IBDFDBS(IBFILE,,.IBDATA,.IBERR,.IBRIEN)
I 'IBFIEN!'(IBRIEN) D G IIVSTATQ
. S MSG="NOT able to add entry 'r1' for reason: "_IBERR
. D MES^XPDUTL(MSG)
;
; add description
K IBDATA S IBERR="" S IBIENS=IBFIEN S:IBIENS="" IBIENS=IBRIEN S IBIENS=IBIENS_","
I '+IBIENS S MSG="'r1' was not added to the IIV STATUS TABLE File (#365.15)" D MES^XPDUTL(MSG) G IIVSTATQ
S MSG="Entry 'r1' ("_+IBIENS_") ADDED to the IIV STATUS TABLE File (#365.15)" D MES^XPDUTL(MSG)
S IBDATA(1,0)="Information received via electronic inquiry indicates a Rejected Response."
; save it
D WP^DIE(IBFILE,IBIENS,1,"","IBDATA","IBERR")
I IBERR'="" D
. S MSG="NOT able to add DESCRIPTION to code : 'r1' ("_+IBIENS_") for error: "_IBERR
E S MSG="ADDED DESCRIPTION to code : 'r1' ("_+IBIENS_")"
D MES^XPDUTL(MSG)
;
; add corrective action
K IBDATA S IBERR=""
S IBDATA(1,0)="Action to take: Review the details listed in the ePharmacy Eligibility"
S IBDATA(2,0)="Response and contact the insurance company to manually verify this"
S IBDATA(3,0)="insurance information."
; save it
D WP^DIE(IBFILE,IBIENS,2,"","IBDATA","IBERR")
I IBERR'="" D
. S MSG="NOT able to add CORRECTIVE ACTION to code : 'a1' ("_+IBIENS_") for error: "_IBERR
E S MSG="ADDED CORRECTIVE ACTION to code : 'r1' ("_+IBIENS_")"
D MES^XPDUTL(MSG)
;
IIVSTATQ ;
S MSG="Finished STEP "_IBXPD_" of "_XPDIDTOT
D MES^XPDUTL(MSG)
Q
;================================
;
ADDPROXY(IBXPD) ;Add APPLICATION PROXY user to file 200. Supported by IA#4677.
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Adding entry 'IB,AUTOINS FILEUPDATE' to the New Person file (#200)")
N IEN200,IBPROX
S IEN200=$$CREATE^XUSAP("IB,AUTOINS FILEUPDATE","")
I +IEN200=0 D MES^XPDUTL("New Person 'IB,AUTOINS FILEUPDATE' already exists.") Q
I IEN200<0 D MES^XPDUTL("...ERROR: New Person 'IB,AUTOINS FILEUPDATE' NOT added.") Q
I +IEN200>0 D Q
. D MES^XPDUTL("New Person 'IB,AUTOINS FILEUPDATE' added.")
Q
;================================
;
SETDEF(IBXPD) ;Set default for field #350.9,54.05 to '1' for 'YES'.
;
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Set default for field E1 TRANSACTIONS ENABLED (#350.9,54.05) ... ")
;
N IBDFDA,DATA,ENABLED,MSG
S ENABLED=$$GET1^DIQ(350.9,"1,",54.05)
I ENABLED'="" S MSG="E1 TRANSACTIONS ENABLED is already set." G SETDEFQ
S IBDFDA=1
S DATA(54.05)=1
D UPD^IBDFDBS(350.9,.IBDFDA,.DATA)
S MSG="E1 TRANSACTIONS ENABLED default set to 1 for 'YES'."
SETDEFQ ;
D MES^XPDUTL(MSG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY822PO 6577 printed Mar 25, 2026@16:00:40 Page 2
IBY822PO ;AITC/CKB - Post-Installation for IB patch 822; 02-APR-2025
+1 ;;2.0;INTEGRATED BILLING;**822**;21-MAR-94;Build 21
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference to ^XPDUTL in ICR #10141
+5 ; Reference to ^XUSAP in ICR #4677
+6 QUIT
+7 ;
POST ; POST-INSTALL
+1 NEW IBXPD,XPDIDTOT
+2 ; total number of work items
+3 SET XPDIDTOT=4
+4 ;
+5 DO MES^XPDUTL("")
+6 ;
+7 ; Update DESCRIPTION field (#355.12,.02) for 'E-PHARMACY' entry to 'EPHARMACY' entry
DO UPDENTRY(1)
+8 ;
+9 ; Add two new entries to the IIV STATUS TABLE file #365.15
DO IIVSTAT(2)
+10 ;
+11 ; Create "IB,AUTOINS FILEUPDATE" in file New Person (#200)
DO ADDPROXY(3)
+12 ;
+13 ; Set default for field E1 TRANSACTIONS ENABLED (#350.9,54.05) to '1' for 'YES'
DO SETDEF(4)
+14 ;
+15 ; Displays the 'Done' message and finishes the progress bar
DO MES^XPDUTL("")
+16 DO MES^XPDUTL("POST-Install for IB*2.0*822 Completed.")
+17 QUIT
+18 ;================================
+19 ;
UPDENTRY(IBXPD) ;Update field #.02 DESCRIPTION in file #355.12 SOURCE OF INFORMATION
+1 ; from 'E-PHARMACY' to 'EPHARMACY'
+2 ;
+3 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
+4 DO MES^XPDUTL("-------------")
+5 DO MES^XPDUTL("Update DESCRIPTION (#355.12,.02) for 'E-PHARMACY' entry... ")
+6 ;
+7 NEW IBENT,DATA,MSG
+8 IF $DATA(^IBE(355.12,"C","EPHARMACY"))
Begin DoDot:1
+9 SET MSG="DESCRIPTION has already been updated to 'EPHARMACY'."
+10 DO MES^XPDUTL(MSG)
End DoDot:1
GOTO UPDENTQ
+11 SET IBENT=$ORDER(^IBE(355.12,"C","E-PHARMACY",0))
+12 IF IBENT=""
SET MSG="Unable to update E-PHARMACY entry, not found."
GOTO UPDENTQ
+13 SET DATA(.02)="EPHARMACY"
+14 DO UPD^IBDFDBS(355.12,.IBENT,.DATA)
+15 SET MSG="DESCRIPTION for 'E-PHARMACY' has been updated to 'EPHARMACY'."
UPDENTQ ;
+1 SET MSG="Finshed STEP "_IBXPD_" of "_XPDIDTOT
+2 DO MES^XPDUTL(MSG)
+3 ;
+4 QUIT
+5 ;================================
+6 ;
IIVSTAT(IBXPD) ;Add two new entries to the IIV STATUS TABLE file #365.15
+1 ;
+2 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Adding entries to the IIV STATUS TABLE File (#365.15)")
+5 ;
+6 NEW IBASC,IBCODE,IBDATA,IBERR,IBEX,IBFIEN,IBFILE,IBIENS,IBRIEN,MSG
+7 SET IBFILE=365.15
SET (IBCODE,IBASC,IBEX,IBERR,IBRIEN,IBFIEN)=""
+8 ; check if 'a1' or 'r1' defined
+9 IF $DATA(^IBE(365.15,"B","a1"))
Begin DoDot:1
+10 DO MES^XPDUTL("Code 'a1' has already been added.")
End DoDot:1
GOTO IIVST2
+11 ; first create 'a1'
+12 SET IBCODE="a1"
SET IBASC=97
SET IBEX=0
+13 KILL IBDATA
+14 SET IBDATA(.01)=IBCODE
SET IBDATA(.02)=IBASC
SET IBDATA(.03)=IBEX
+15 SET IBFIEN=$$ADD^IBDFDBS(IBFILE,,.IBDATA,.IBERR,.IBRIEN)
+16 IF 'IBFIEN!'(IBRIEN)
Begin DoDot:1
+17 SET MSG="NOT able to add entry 'a1' for reason: "_IBERR
+18 DO MES^XPDUTL(MSG)
End DoDot:1
GOTO IIVST2
+19 ; add description
+20 KILL IBDATA
SET IBERR=""
SET IBIENS=IBFIEN
if IBIENS=""
SET IBIENS=IBRIEN
SET IBIENS=IBIENS_","
+21 IF '+IBIENS
DO MES^XPDUTL("'a1' not added to the IIV STATUS TABLE File (#365.15)")
GOTO IIVST2
+22 SET MSG="Entry 'a1' ("_+IBIENS_") ADDED to the IIV STATUS TABLE File (#365.15)"
DO MES^XPDUTL(MSG)
+23 SET IBDATA(1,0)="Information received via electronic inquiry indicates an Accepted Response."
+24 ; save it
+25 DO WP^DIE(IBFILE,IBIENS,1,"","IBDATA","IBERR")
+26 IF IBERR'=""
Begin DoDot:1
+27 SET MSG="NOT able to add DESCRIPTION to code : 'a1' ("_+IBIENS_") for error: "_IBERR
End DoDot:1
+28 IF '$TEST
SET MSG="ADDED DESCRIPTION to code : 'a1' ("_+IBIENS_")"
+29 DO MES^XPDUTL(MSG)
+30 ;
+31 ; add corrective action
+32 KILL IBDATA
SET IBERR=""
+33 SET IBDATA(1,0)="Action to take: Review the details in the ePharmacy Eligibility Response Data"
+34 SET IBDATA(2,0)="before processing this buffer entry."
+35 ; save it
+36 DO WP^DIE(IBFILE,IBIENS,2,"","IBDATA","IBERR")
+37 IF IBERR'=""
Begin DoDot:1
+38 SET MSG="NOT able to add CORRECTIVE ACTION to code : 'a1' ("_+IBIENS_") for error: "_IBERR
End DoDot:1
+39 IF '$TEST
SET MSG="ADDED CORRECTIVE ACTION to code : 'a1' ("_+IBIENS_")"
+40 DO MES^XPDUTL(MSG)
+41 ;
IIVST2 ; add 'r1'
+1 ;
+2 IF $DATA(^IBE(365.15,"B","r1"))
Begin DoDot:1
+3 DO MES^XPDUTL("Code 'r1' has already been added.")
End DoDot:1
GOTO IIVSTATQ
+4 ; first create 'r1'
+5 KILL IBDATA
+6 SET IBCODE="r1"
SET IBASC=114
SET IBEX=0
SET IBERR=""
SET IBIENS=""
SET IBRIEN=""
SET IBFIEN=""
+7 SET IBDATA(.01)=IBCODE
SET IBDATA(.02)=IBASC
SET IBDATA(.03)=IBEX
+8 SET IBFIEN=$$ADD^IBDFDBS(IBFILE,,.IBDATA,.IBERR,.IBRIEN)
+9 IF 'IBFIEN!'(IBRIEN)
Begin DoDot:1
+10 SET MSG="NOT able to add entry 'r1' for reason: "_IBERR
+11 DO MES^XPDUTL(MSG)
End DoDot:1
GOTO IIVSTATQ
+12 ;
+13 ; add description
+14 KILL IBDATA
SET IBERR=""
SET IBIENS=IBFIEN
if IBIENS=""
SET IBIENS=IBRIEN
SET IBIENS=IBIENS_","
+15 IF '+IBIENS
SET MSG="'r1' was not added to the IIV STATUS TABLE File (#365.15)"
DO MES^XPDUTL(MSG)
GOTO IIVSTATQ
+16 SET MSG="Entry 'r1' ("_+IBIENS_") ADDED to the IIV STATUS TABLE File (#365.15)"
DO MES^XPDUTL(MSG)
+17 SET IBDATA(1,0)="Information received via electronic inquiry indicates a Rejected Response."
+18 ; save it
+19 DO WP^DIE(IBFILE,IBIENS,1,"","IBDATA","IBERR")
+20 IF IBERR'=""
Begin DoDot:1
+21 SET MSG="NOT able to add DESCRIPTION to code : 'r1' ("_+IBIENS_") for error: "_IBERR
End DoDot:1
+22 IF '$TEST
SET MSG="ADDED DESCRIPTION to code : 'r1' ("_+IBIENS_")"
+23 DO MES^XPDUTL(MSG)
+24 ;
+25 ; add corrective action
+26 KILL IBDATA
SET IBERR=""
+27 SET IBDATA(1,0)="Action to take: Review the details listed in the ePharmacy Eligibility"
+28 SET IBDATA(2,0)="Response and contact the insurance company to manually verify this"
+29 SET IBDATA(3,0)="insurance information."
+30 ; save it
+31 DO WP^DIE(IBFILE,IBIENS,2,"","IBDATA","IBERR")
+32 IF IBERR'=""
Begin DoDot:1
+33 SET MSG="NOT able to add CORRECTIVE ACTION to code : 'a1' ("_+IBIENS_") for error: "_IBERR
End DoDot:1
+34 IF '$TEST
SET MSG="ADDED CORRECTIVE ACTION to code : 'r1' ("_+IBIENS_")"
+35 DO MES^XPDUTL(MSG)
+36 ;
IIVSTATQ ;
+1 SET MSG="Finished STEP "_IBXPD_" of "_XPDIDTOT
+2 DO MES^XPDUTL(MSG)
+3 QUIT
+4 ;================================
+5 ;
ADDPROXY(IBXPD) ;Add APPLICATION PROXY user to file 200. Supported by IA#4677.
+1 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
+2 DO MES^XPDUTL("-------------")
+3 DO MES^XPDUTL("Adding entry 'IB,AUTOINS FILEUPDATE' to the New Person file (#200)")
+4 NEW IEN200,IBPROX
+5 SET IEN200=$$CREATE^XUSAP("IB,AUTOINS FILEUPDATE","")
+6 IF +IEN200=0
DO MES^XPDUTL("New Person 'IB,AUTOINS FILEUPDATE' already exists.")
QUIT
+7 IF IEN200<0
DO MES^XPDUTL("...ERROR: New Person 'IB,AUTOINS FILEUPDATE' NOT added.")
QUIT
+8 IF +IEN200>0
Begin DoDot:1
+9 DO MES^XPDUTL("New Person 'IB,AUTOINS FILEUPDATE' added.")
End DoDot:1
QUIT
+10 QUIT
+11 ;================================
+12 ;
SETDEF(IBXPD) ;Set default for field #350.9,54.05 to '1' for 'YES'.
+1 ;
+2 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Set default for field E1 TRANSACTIONS ENABLED (#350.9,54.05) ... ")
+5 ;
+6 NEW IBDFDA,DATA,ENABLED,MSG
+7 SET ENABLED=$$GET1^DIQ(350.9,"1,",54.05)
+8 IF ENABLED'=""
SET MSG="E1 TRANSACTIONS ENABLED is already set."
GOTO SETDEFQ
+9 SET IBDFDA=1
+10 SET DATA(54.05)=1
+11 DO UPD^IBDFDBS(350.9,.IBDFDA,.DATA)
+12 SET MSG="E1 TRANSACTIONS ENABLED default set to 1 for 'YES'."
SETDEFQ ;
+1 DO MES^XPDUTL(MSG)
+2 QUIT
