IBY713PO ;AITC/DTG - Post-Installation for IB patch 713; DEC 27, 2021
;;2.0;INTEGRATED BILLING;**713**;MAR 21,1994;Build 12
;;Per VA Directive 6402, this routine should not be modified.
;
; Reference to $$INSTALDT^XPDUTL in ICR #10141
Q
;
POST ; POST-INSTALL
N IBINSTLD,IBXPD,SITE,SITENAME,SITENUM,XPDIDTOT
; total number of work items
S XPDIDTOT=1
;
S SITE=$$SITE^VASITE,SITENAME=$P(SITE,U,2),SITENUM=$P(SITE,U,3)
;
S IBINSTLD=$$INSTALDT^XPDUTL("IB*2.0*713","") ;ICR 10141
D MES^XPDUTL("")
;
D NEWSTAT(1) ; add a new code to (#365.15) for COMMUNICATION FAILURE
;
D MES^XPDUTL("") ; Displays the 'Done' message and finishes the progress bar
D MES^XPDUTL("POST-Install for IB*2.0*713 Completed.")
Q
;============================
;
;
NEWSTAT(IBXPD) ; add a new code to the IIV STATUS TABLE (#365.15) for COMMUNICATION FAILURE
S IBXPD=$G(IBXPD),XPDIDTOT=$G(XPDIDTOT)
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
;
D MES^XPDUTL("Add a new COMMUNICATION FAILURE code to the IIV STATUS TABLE")
N IBACTN,IBDATA,IBDESC,IBERR,IBIEN,IBLOOK,IBCHK,IBFND,IBTMP,IBTCT
; check for B17
S (IBFND,IBCHK)="" K IBLOOK
D FIND^DIC(365.15,"","@;.01;IX","X","B17","","","","","IBLOOK")
I +$G(IBLOOK("DILIST",0)) D I IBFND G NEWSTATX
. ; verify that the code is B17
. S IBTCT=$P($G(IBLOOK("DILIST",0)),U,1) I 'IBTCT Q
. S IBTMP=$G(IBLOOK("DILIST",2,IBTCT)) I 'IBTMP Q
. S IBCHK=$$GET1^DIQ(365.15,IBTMP_",",.01,"I")
. I IBCHK="B17" D S IBFND=1
.. D BMES^XPDUTL("*** NEW 'B17' CODE NOT ADDED TO IIV STATUS TABLE (#365.15) ... ALREADY EXISTS ***")
;
;Set up WP Arrays
S IBDESC("WP",1)="eIV was unable to electronically verify this insurance information as "
S IBDESC("WP",2)="invalid characters were identified in a required field(s)."
;
S IBACTN("WP",1)="Action to take: Contact the insurance company to manually verify"
S IBACTN("WP",2)="this insurance information."
;
;Set up File Nodes
S IBDATA(.01)="B17"
S IBDATA(.02)=33
S IBDATA(.03)=0
S IBDATA(1)=$NA(IBDESC("WP"))
S IBDATA(2)=$NA(IBACTN("WP"))
S IBIEN=$$ADD^IBDFDBS(365.15,,.IBDATA,.IBERR)
I IBERR D G NEWSTATX
. D BMES^XPDUTL("*** ERROR ADDING 'B17' CODE TO THE IIV STATUS TABLE (#365.15) ***")
D BMES^XPDUTL(" NEW 'B17' CODE SUCCESSFULLY ADDED TO IIV STATUS TABLE")
;
NEWSTATX ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY713PO 2379 printed Apr 09, 2024@21:38:08 Page 2
IBY713PO ;AITC/DTG - Post-Installation for IB patch 713; DEC 27, 2021
+1 ;;2.0;INTEGRATED BILLING;**713**;MAR 21,1994;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference to $$INSTALDT^XPDUTL in ICR #10141
+5 QUIT
+6 ;
POST ; POST-INSTALL
+1 NEW IBINSTLD,IBXPD,SITE,SITENAME,SITENUM,XPDIDTOT
+2 ; total number of work items
+3 SET XPDIDTOT=1
+4 ;
+5 SET SITE=$$SITE^VASITE
SET SITENAME=$PIECE(SITE,U,2)
SET SITENUM=$PIECE(SITE,U,3)
+6 ;
+7 ;ICR 10141
SET IBINSTLD=$$INSTALDT^XPDUTL("IB*2.0*713","")
+8 DO MES^XPDUTL("")
+9 ;
+10 ; add a new code to (#365.15) for COMMUNICATION FAILURE
DO NEWSTAT(1)
+11 ;
+12 ; Displays the 'Done' message and finishes the progress bar
DO MES^XPDUTL("")
+13 DO MES^XPDUTL("POST-Install for IB*2.0*713 Completed.")
+14 QUIT
+15 ;============================
+16 ;
+17 ;
NEWSTAT(IBXPD) ; add a new code to the IIV STATUS TABLE (#365.15) for COMMUNICATION FAILURE
+1 SET IBXPD=$GET(IBXPD)
SET XPDIDTOT=$GET(XPDIDTOT)
+2 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 ;
+5 DO MES^XPDUTL("Add a new COMMUNICATION FAILURE code to the IIV STATUS TABLE")
+6 NEW IBACTN,IBDATA,IBDESC,IBERR,IBIEN,IBLOOK,IBCHK,IBFND,IBTMP,IBTCT
+7 ; check for B17
+8 SET (IBFND,IBCHK)=""
KILL IBLOOK
+9 DO FIND^DIC(365.15,"","@;.01;IX","X","B17","","","","","IBLOOK")
+10 IF +$GET(IBLOOK("DILIST",0))
Begin DoDot:1
+11 ; verify that the code is B17
+12 SET IBTCT=$PIECE($GET(IBLOOK("DILIST",0)),U,1)
IF 'IBTCT
QUIT
+13 SET IBTMP=$GET(IBLOOK("DILIST",2,IBTCT))
IF 'IBTMP
QUIT
+14 SET IBCHK=$$GET1^DIQ(365.15,IBTMP_",",.01,"I")
+15 IF IBCHK="B17"
Begin DoDot:2
+16 DO BMES^XPDUTL("*** NEW 'B17' CODE NOT ADDED TO IIV STATUS TABLE (#365.15) ... ALREADY EXISTS ***")
End DoDot:2
SET IBFND=1
End DoDot:1
IF IBFND
GOTO NEWSTATX
+17 ;
+18 ;Set up WP Arrays
+19 SET IBDESC("WP",1)="eIV was unable to electronically verify this insurance information as "
+20 SET IBDESC("WP",2)="invalid characters were identified in a required field(s)."
+21 ;
+22 SET IBACTN("WP",1)="Action to take: Contact the insurance company to manually verify"
+23 SET IBACTN("WP",2)="this insurance information."
+24 ;
+25 ;Set up File Nodes
+26 SET IBDATA(.01)="B17"
+27 SET IBDATA(.02)=33
+28 SET IBDATA(.03)=0
+29 SET IBDATA(1)=$NAME(IBDESC("WP"))
+30 SET IBDATA(2)=$NAME(IBACTN("WP"))
+31 SET IBIEN=$$ADD^IBDFDBS(365.15,,.IBDATA,.IBERR)
+32 IF IBERR
Begin DoDot:1
+33 DO BMES^XPDUTL("*** ERROR ADDING 'B17' CODE TO THE IIV STATUS TABLE (#365.15) ***")
End DoDot:1
GOTO NEWSTATX
+34 DO BMES^XPDUTL(" NEW 'B17' CODE SUCCESSFULLY ADDED TO IIV STATUS TABLE")
+35 ;
NEWSTATX ;
+1 QUIT
