IBJTAD ;ALB/TJB - TP ERA/835 ADDITIONAL INFORMATION SCREEN ;01-MAY-2015
;;2.0;INTEGRATED BILLING;**530**;21-MAR-94;Build 71
;;Per VA Directive 6402, this routine should not be modified.
;; ;
EN ; -- main entry point for IBJT ADDITIONAL 835 DATA
D EN^VALM("IBJT ADDITIONAL 835 DATA")
Q
;
HDR ; -- header code
S VALMHDR(1)="******* ADDITIONAL INFORMATION FOUND IN THE 835 at the EOB level"
Q
;
INIT ; -- init variables and list array
I '$G(IBIFN) S VALMQUIT="" G INITQ
N ADERA,ADLN,ADRNM,ADRNPI,ADRTQ,IBRP,DIR,DIRUT,DIROUT,DTOUT,DUOUT,DZX,EPIEN,I,IBIFN,X,Y,IBARR,IBAR2,IBAR3,IBFN,IBMN,IBLN,IBPAYNM,IBPPAYTE,IBPPAYFX,IBPPAYEM
; EPBILL and ERALST come in from IBJTEP, that routine will clean up these variables.
IN1 ;
S IBRP(U)=", "
I $L(ERALST,U)=1 S ADERA=ERALST G IN2
S DIR("A")="Enter ERA for Receipt Review: ",DIR(0)="FA^1:10"
S DIR("A",1)="Enter an ERA# from the following list for additional information."
S DIR("A",2)="Available ERAs: "_$$REPLACE^XLFSTR(ERALST,.IBRP)
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") S VALMQUIT=1 G EXIT
S ADERA=Y I (U_ERALST_U)'[(U_Y_U) W !!,"ERA: "_Y_" not a valid selection. Please try again...",! S X="",ADERA="" G IN1
IN2 ;
; Get IEN pointing back to 361.1 & Rendering/Servicing Provider information
K IBARR,IBAR2,IBAR3
; EPBILL is created/Killed in IBJTEP
D FIND^DIC(344.41,","_ADERA_",",".02I;.19;.2;.21;.23","",EPBILL,,"AC",,,"IBAR2","ER")
D GETS^DIQ(344.4,ADERA_",",".06;3.01;3.02;3.03;3.04;3.05;3.06;3.07;5.01;","IE","IBAR3","ER") ; Get web address
; Check to see if we may have an EEOB if not report no ERA Information for this K-Bill
S EPIEN=$G(IBAR2("DILIST","ID",1,".02")) I EPIEN="" S VALMCNT=2 D SET^VALM10(1," "),SET^VALM10(2,"No ERA Information for Bill: "_EPBILL) G INITQ
S ADLN=0 S EPIEN=EPIEN_","
; Get additional ERA information from this entry in 361.1
D GETS^DIQ(361.1,EPIEN,".21;1.21;61.01;1.07;1.17;1.12;1.13;1.14;1.15;1.16;25.01;25.02;25.03;25.04;25.05;25.06;25.07;.08;.09","IE","IBARR")
; Set Rendering/Servicing provider information
S ADRNM=$G(IBAR2("DILIST","ID",1,.21)),ADRNPI=$G(IBAR2("DILIST","ID",1,.19)),ADRTQ=$G(IBAR2("DILIST","ID",1,.2))
; Set Corrected Patient Name and ID
S IBFN=$P(IBARR("361.1",EPIEN,61.01,"E"),U,4),IBMN=$P(IBARR("361.1",EPIEN,61.01,"E"),U,5),IBLN=$P(IBARR("361.1",EPIEN,61.01,"E"),U,3)
; Determine Payer's Phone, FAX and e-mail information
F I=25.03,25.05,25.07 D
. ; If "Extension" then add this to the previous (I-.03) field
. I $G(IBARR("361.1",EPIEN,I,"I"))="EX" S:I'=25.03 DZX(IBARR("361.1",EPIEN,I-.03,"I"))=DZX(IBARR("361.1",EPIEN,I-.03,"I"))_" x"_IBARR("361.1",EPIEN,I-.03,"E") Q
. I $G(IBARR("361.1",EPIEN,I,"I"))'="" S DZX(IBARR("361.1",EPIEN,I,"I"))=$G(IBARR("361.1",EPIEN,(I-.01),"E"))
; If the contact information is not present, set to ""
I $D(DZX)=0 S DZX("TE")="",DZX("EM")="",DZX("FX")=""
S IBPAYNM=$S(IBARR("361.1",EPIEN,25.01,"E")'="":IBARR("361.1",EPIEN,25.01,"E"),1:$G(IBAR3("344.4",ADERA_",",3.01,"E")))
;
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Claim Code/Status: "_IBARR("361.1",EPIEN,.21,"E")_"/"_$$CCS(IBARR("361.1",EPIEN,.21,"E")))
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Coverage Expiration Date: "_IBARR("361.1",EPIEN,1.13,"E")_" Claim Received Date: "_IBARR("361.1",EPIEN,1.12,"E"))
S ADLN=ADLN+1 D SET^VALM10(ADLN," ")
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Interest Amount: "_IBARR("361.1",EPIEN,1.07,"E"))
S ADLN=ADLN+1 D SET^VALM10(ADLN," ")
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Corrected Patient Name: "_IBFN_" "_$S(IBMN'="":IBMN_" ",1:"")_IBLN)
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Corrected Patient ID: "_$P(IBARR("361.1",EPIEN,61.01,"E"),U,6))
S ADLN=ADLN+1 D SET^VALM10(ADLN," ")
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Other Subscriber Name: "_IBARR("361.1",EPIEN,1.17,"E"))
S ADLN=ADLN+1 D SET^VALM10(ADLN," ")
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Rendering/Servicing Provider Name: "_ADRNM)
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Rendering/Servicing Provider NPI: "_ADRNPI)
I $G(IBAR2("DILIST","ID",1,.23))]"" S ADLN=ADLN+1 D SET^VALM10(ADLN," NPI Comment: "_IBAR2("DILIST","ID",1,.23))
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Type Qualifier: "_ADRTQ)
S ADLN=ADLN+1 D SET^VALM10(ADLN," ")
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Claim Contact Name: "_IBARR("361.1",EPIEN,25.01,"E"))
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Claim Contact Phone: "_$G(DZX("TE")))
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Claim Contact FAX: "_$G(DZX("FX")))
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Claim Contact e-mail: "_$G(DZX("EM")))
S ADLN=ADLN+1 D SET^VALM10(ADLN," ")
S ADLN=ADLN+1 D SET^VALM10(ADLN,"*** ADDITIONAL INFORMATION FOUND IN THE 835 at the ERA level: ")
S ADLN=ADLN+1 D SET^VALM10(ADLN," ")
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Payer Name/Payment From: "_IBAR3("344.4",ADERA_",",.06,"E"))
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Payer Contact Name: "_IBAR3("344.4",ADERA_",",3.01,"E"))
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Payer Contact Phone: "_IBAR3("344.4",ADERA_",",3.02,"E"))
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Payer Contact FAX: "_IBAR3("344.4",ADERA_",",3.04,"E"))
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Payer Contact e-mail: "_IBAR3("344.4",ADERA_",",3.06,"E"))
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Payer Website Address: "_IBAR3("344.4",ADERA_",",5.01,"E"))
S ADLN=ADLN+1 D SET^VALM10(ADLN," ")
S ADLN=ADLN+1 D SET^VALM10(ADLN,"*** Corrected Priority Payer Name (Last Name or Organization Name): ")
S ADLN=ADLN+1 D SET^VALM10(ADLN,IBARR("361.1",EPIEN,1.14,"E"))
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Type: "_IBARR("361.1",EPIEN,1.15,"I")_"/"_IBARR("361.1",EPIEN,1.15,"E"))
S ADLN=ADLN+1 D SET^VALM10(ADLN,"ID: "_IBARR("361.1",EPIEN,1.16,"E"))
S ADLN=ADLN+1 D SET^VALM10(ADLN," ")
S ADLN=ADLN+1 D SET^VALM10(ADLN,"*** Crossover Carrier Name (Last Name or Organization Name): ")
S ADLN=ADLN+1 D SET^VALM10(ADLN,IBARR("361.1",EPIEN,.08,"E"))
S ADLN=ADLN+1 D SET^VALM10(ADLN,"Crossover ID: "_IBARR("361.1",EPIEN,.09,"E"))
S VALMCNT=ADLN
;
INITQ Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
Q
;
EXPND ; -- expand code
Q
;
CCS(DATA) ; Build code array
N XCD
Q:$G(DATA)="" "" ; If DATA is null, then nothing to output return empty string
;
S XCD(1)="Processed as Primary"
S XCD(2)="Processed as Secondary"
S XCD(3)="Processed as Tertiary"
S XCD(4)="Denied"
S XCD(19)="Processed as Primary, Forwarded to Additional Payer(s)"
S XCD(20)="Processed as Secondary, Forwarded to Additional Payer(s)"
S XCD(21)="Processed as Tertiary, Forwarded to Additional Payer(s)"
S XCD(22)="Reversal of Previous Payment"
S XCD(23)="Not Our Claim, Forwarded to Additional Payer(s)"
S XCD(25)="Predetermination Pricing Only - No Payment"
Q:$G(XCD(DATA))'="" $G(XCD(DATA))
;
Q "No Status Code Description"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJTAD 6767 printed Apr 09, 2024@21:31:36 Page 2
IBJTAD ;ALB/TJB - TP ERA/835 ADDITIONAL INFORMATION SCREEN ;01-MAY-2015
+1 ;;2.0;INTEGRATED BILLING;**530**;21-MAR-94;Build 71
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;; ;
EN ; -- main entry point for IBJT ADDITIONAL 835 DATA
+1 DO EN^VALM("IBJT ADDITIONAL 835 DATA")
+2 QUIT
+3 ;
HDR ; -- header code
+1 SET VALMHDR(1)="******* ADDITIONAL INFORMATION FOUND IN THE 835 at the EOB level"
+2 QUIT
+3 ;
INIT ; -- init variables and list array
+1 IF '$GET(IBIFN)
SET VALMQUIT=""
GOTO INITQ
+2 NEW ADERA,ADLN,ADRNM,ADRNPI,ADRTQ,IBRP,DIR,DIRUT,DIROUT,DTOUT,DUOUT,DZX,EPIEN,I,IBIFN,X,Y,IBARR,IBAR2,IBAR3,IBFN,IBMN,IBLN,IBPAYNM,IBPPAYTE,IBPPAYFX,IBPPAYEM
+3 ; EPBILL and ERALST come in from IBJTEP, that routine will clean up these variables.
IN1 ;
+1 SET IBRP(U)=", "
+2 IF $LENGTH(ERALST,U)=1
SET ADERA=ERALST
GOTO IN2
+3 SET DIR("A")="Enter ERA for Receipt Review: "
SET DIR(0)="FA^1:10"
+4 SET DIR("A",1)="Enter an ERA# from the following list for additional information."
+5 SET DIR("A",2)="Available ERAs: "_$$REPLACE^XLFSTR(ERALST,.IBRP)
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
SET VALMQUIT=1
GOTO EXIT
+8 SET ADERA=Y
IF (U_ERALST_U)'[(U_Y_U)
WRITE !!,"ERA: "_Y_" not a valid selection. Please try again...",!
SET X=""
SET ADERA=""
GOTO IN1
IN2 ;
+1 ; Get IEN pointing back to 361.1 & Rendering/Servicing Provider information
+2 KILL IBARR,IBAR2,IBAR3
+3 ; EPBILL is created/Killed in IBJTEP
+4 DO FIND^DIC(344.41,","_ADERA_",",".02I;.19;.2;.21;.23","",EPBILL,,"AC",,,"IBAR2","ER")
+5 ; Get web address
DO GETS^DIQ(344.4,ADERA_",",".06;3.01;3.02;3.03;3.04;3.05;3.06;3.07;5.01;","IE","IBAR3","ER")
+6 ; Check to see if we may have an EEOB if not report no ERA Information for this K-Bill
+7 SET EPIEN=$GET(IBAR2("DILIST","ID",1,".02"))
IF EPIEN=""
SET VALMCNT=2
DO SET^VALM10(1," ")
DO SET^VALM10(2,"No ERA Information for Bill: "_EPBILL)
GOTO INITQ
+8 SET ADLN=0
SET EPIEN=EPIEN_","
+9 ; Get additional ERA information from this entry in 361.1
+10 DO GETS^DIQ(361.1,EPIEN,".21;1.21;61.01;1.07;1.17;1.12;1.13;1.14;1.15;1.16;25.01;25.02;25.03;25.04;25.05;25.06;25.07;.08;.09","IE","IBARR")
+11 ; Set Rendering/Servicing provider information
+12 SET ADRNM=$GET(IBAR2("DILIST","ID",1,.21))
SET ADRNPI=$GET(IBAR2("DILIST","ID",1,.19))
SET ADRTQ=$GET(IBAR2("DILIST","ID",1,.2))
+13 ; Set Corrected Patient Name and ID
+14 SET IBFN=$PIECE(IBARR("361.1",EPIEN,61.01,"E"),U,4)
SET IBMN=$PIECE(IBARR("361.1",EPIEN,61.01,"E"),U,5)
SET IBLN=$PIECE(IBARR("361.1",EPIEN,61.01,"E"),U,3)
+15 ; Determine Payer's Phone, FAX and e-mail information
+16 FOR I=25.03,25.05,25.07
Begin DoDot:1
+17 ; If "Extension" then add this to the previous (I-.03) field
+18 IF $GET(IBARR("361.1",EPIEN,I,"I"))="EX"
if I'=25.03
SET DZX(IBARR("361.1",EPIEN,I-.03,"I"))=DZX(IBARR("361.1",EPIEN,I-.03,"I"))_" x"_IBARR("361.1",EPIEN,I-.03,"E")
QUIT
+19 IF $GET(IBARR("361.1",EPIEN,I,"I"))'=""
SET DZX(IBARR("361.1",EPIEN,I,"I"))=$GET(IBARR("361.1",EPIEN,(I-.01),"E"))
End DoDot:1
+20 ; If the contact information is not present, set to ""
+21 IF $DATA(DZX)=0
SET DZX("TE")=""
SET DZX("EM")=""
SET DZX("FX")=""
+22 SET IBPAYNM=$SELECT(IBARR("361.1",EPIEN,25.01,"E")'="":IBARR("361.1",EPIEN,25.01,"E"),1:$GET(IBAR3("344.4",ADERA_",",3.01,"E")))
+23 ;
+24 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Claim Code/Status: "_IBARR("361.1",EPIEN,.21,"E")_"/"_$$CCS(IBARR("361.1",EPIEN,.21,"E")))
+25 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Coverage Expiration Date: "_IBARR("361.1",EPIEN,1.13,"E")_" Claim Received Date: "_IBARR("361.1",EPIEN,1.12,"E"))
+26 SET ADLN=ADLN+1
DO SET^VALM10(ADLN," ")
+27 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Interest Amount: "_IBARR("361.1",EPIEN,1.07,"E"))
+28 SET ADLN=ADLN+1
DO SET^VALM10(ADLN," ")
+29 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Corrected Patient Name: "_IBFN_" "_$SELECT(IBMN'="":IBMN_" ",1:"")_IBLN)
+30 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Corrected Patient ID: "_$PIECE(IBARR("361.1",EPIEN,61.01,"E"),U,6))
+31 SET ADLN=ADLN+1
DO SET^VALM10(ADLN," ")
+32 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Other Subscriber Name: "_IBARR("361.1",EPIEN,1.17,"E"))
+33 SET ADLN=ADLN+1
DO SET^VALM10(ADLN," ")
+34 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Rendering/Servicing Provider Name: "_ADRNM)
+35 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Rendering/Servicing Provider NPI: "_ADRNPI)
+36 IF $GET(IBAR2("DILIST","ID",1,.23))]""
SET ADLN=ADLN+1
DO SET^VALM10(ADLN," NPI Comment: "_IBAR2("DILIST","ID",1,.23))
+37 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Type Qualifier: "_ADRTQ)
+38 SET ADLN=ADLN+1
DO SET^VALM10(ADLN," ")
+39 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Claim Contact Name: "_IBARR("361.1",EPIEN,25.01,"E"))
+40 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Claim Contact Phone: "_$GET(DZX("TE")))
+41 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Claim Contact FAX: "_$GET(DZX("FX")))
+42 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Claim Contact e-mail: "_$GET(DZX("EM")))
+43 SET ADLN=ADLN+1
DO SET^VALM10(ADLN," ")
+44 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"*** ADDITIONAL INFORMATION FOUND IN THE 835 at the ERA level: ")
+45 SET ADLN=ADLN+1
DO SET^VALM10(ADLN," ")
+46 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Payer Name/Payment From: "_IBAR3("344.4",ADERA_",",.06,"E"))
+47 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Payer Contact Name: "_IBAR3("344.4",ADERA_",",3.01,"E"))
+48 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Payer Contact Phone: "_IBAR3("344.4",ADERA_",",3.02,"E"))
+49 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Payer Contact FAX: "_IBAR3("344.4",ADERA_",",3.04,"E"))
+50 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Payer Contact e-mail: "_IBAR3("344.4",ADERA_",",3.06,"E"))
+51 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Payer Website Address: "_IBAR3("344.4",ADERA_",",5.01,"E"))
+52 SET ADLN=ADLN+1
DO SET^VALM10(ADLN," ")
+53 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"*** Corrected Priority Payer Name (Last Name or Organization Name): ")
+54 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,IBARR("361.1",EPIEN,1.14,"E"))
+55 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Type: "_IBARR("361.1",EPIEN,1.15,"I")_"/"_IBARR("361.1",EPIEN,1.15,"E"))
+56 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"ID: "_IBARR("361.1",EPIEN,1.16,"E"))
+57 SET ADLN=ADLN+1
DO SET^VALM10(ADLN," ")
+58 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"*** Crossover Carrier Name (Last Name or Organization Name): ")
+59 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,IBARR("361.1",EPIEN,.08,"E"))
+60 SET ADLN=ADLN+1
DO SET^VALM10(ADLN,"Crossover ID: "_IBARR("361.1",EPIEN,.09,"E"))
+61 SET VALMCNT=ADLN
+62 ;
INITQ QUIT
+1 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
CCS(DATA) ; Build code array
+1 NEW XCD
+2 ; If DATA is null, then nothing to output return empty string
if $GET(DATA)=""
QUIT ""
+3 ;
+4 SET XCD(1)="Processed as Primary"
+5 SET XCD(2)="Processed as Secondary"
+6 SET XCD(3)="Processed as Tertiary"
+7 SET XCD(4)="Denied"
+8 SET XCD(19)="Processed as Primary, Forwarded to Additional Payer(s)"
+9 SET XCD(20)="Processed as Secondary, Forwarded to Additional Payer(s)"
+10 SET XCD(21)="Processed as Tertiary, Forwarded to Additional Payer(s)"
+11 SET XCD(22)="Reversal of Previous Payment"
+12 SET XCD(23)="Not Our Claim, Forwarded to Additional Payer(s)"
+13 SET XCD(25)="Predetermination Pricing Only - No Payment"
+14 if $GET(XCD(DATA))'=""
QUIT $GET(XCD(DATA))
+15 ;
+16 QUIT "No Status Code Description"
