IBCECOB5 ;ALB/TMP - IB COB MANAGEMENT SCREEN ;31-JAN-01
;;2.0;INTEGRATED BILLING;**137,155,349,417,488**;21-MAR-94;Build 184
;;Per VHA Directive 2004-038, this routine should not be modified.
;
INIT ;
S IBDA=+$O(IBDA(0))
Q:'IBDA
D BLD(IBDA)
S VALMBG=1
Q
;
BLD(IBDA) ; Build list entrypoint
N IB,IBIFN,IBVCNT,X,Z,IBCNT,CNT,IBREC,IBIFN1,IBPTRESP
K ^TMP("IBCECOB-X",$J)
S VALMCNT=0
S IB=$G(^TMP("IBCECOB1",$J,IBDA)),IBCNT=$P(IB,"^",10)
S IBVCNT=$G(^TMP("IBCECOB",$J,IBDA)),IBIFN=$P(IBVCNT,U,2),IBVCNT=+IBVCNT
Q:'IBVCNT
S Z=IBVCNT-1
F S Z=$O(^TMP("IBCECOB",$J,"IDX",Z)) Q:'Z!('$D(^TMP("IBCECOB",$J,"IDX",+Z,IBDA))) D SET($G(^TMP("IBCECOB",$J,Z,0)))
D SET("")
S X=$E(" Original Billed Amt: $"_$$A10^IBCECSA5(+$P(IB,U,2))_$J("",40),1,40)
S X=X_$S($G(IBSRC):" Total A/R Payments: $"_$$A10^IBCECSA5($P(IB,U,3)),1:"Unreimburse Medicare Exp: $"_$$A10^IBCECSA5(+$G(^IBM(361.1,IBCNT,1))))
D SET(X)
;
S IBIFN1=$P($G(^IBM(361.1,IBCNT,0)),U,1) ; bill#
; filing error
S IBPTRESP=$P($G(^IBM(361.1,IBCNT,1)),U,2) ; Pt Resp Amt 1.02 field
S:$D(^IBM(361.1,IBCNT,"ERR")) IBPTRESP=0 ; filing error
; Override Pt Resp Amt for bills with Form Type UB-04
I $$FT^IBCEF(IBIFN1)=3 S IBPTRESP=$$PTRESPI^IBCECOB1(IBCNT)
;
S X=$E($S($G(IBSRC):" Bill Balance: $"_$$A10^IBCECSA5(+$P(IB,U,4)),1:" Pt Resp Amt: $"_$$A10^IBCECSA5(IBPTRESP))_$J("",40),1,40)
I '$G(IBSRC) N IBCALC,IBIFN S IBIFN=+$G(^IBM(361.1,IBCNT,0)) D MRACALC^IBCEMU2(IBCNT,IBIFN,0,.IBCALC)
S X=X_$S($G(IBSRC):" Total Amt This EOB: $"_$$A10^IBCECSA5($P(IB,U,17)),1:" Medicare Contract Adj: $"_$$A10^IBCECSA5($G(IBCALC("MEDCA"))))
D SET(X)
D SET("")
I $G(IBSRC) D
. S X=" Days Since Last Transmit: "_+$P(IB,U,12)
. D SET(X)
. S X=" Authorizing Biller: "_$P(IB,U,8)
. D SET(X)
. S X=" COB History: "
. I $P(IB,U,11)'="" D
.. F Z=1:1:$L($P(IB,U,11),";") S X=X_$P($P(IB,U,11),";",Z) D SET(X) S X=$J("",27)
. E D
.. S X=X_"NONE FOUND" D SET(X)
I '$G(IBSRC) S CNT=20,IBREC=$G(^IBM(361.1,IBCNT,0)) K ^TMP("IBCECSD",$J) D MRALLA^IBCECSA5 M ^TMP("IBCECOB-X",$J)=^TMP("IBCECSD",$J) K ^TMP("IBCECSD",$J)
;
;/Beginning IB*2.0*488 (vd)
I '$D(^IBM(361.1,IBCNT,"ERR")) Q
D EOBERR
Q
;
EOBERR ; Display information about any 361.1 message storage or filing errors
N ERRTXT,DASHES,X,Z
S DASHES="---------------------------------------------------------------------"
I '$O(^IBM(361.1,IBCNT,"ERR",0)) Q
S X="VistA could not match all of the Line Level data received in the EEOB" D SET(X)
S X="(835 Record 40) to the claim in VistA." D SET(X)
S X=" " D SET(X)
S Z=0 F S Z=$O(^IBM(361.1,IBCNT,"ERR",Z)) Q:'Z D
.S ERRTXT=$G(^IBM(361.1,IBCNT,"ERR",Z,0))
.I ERRTXT["##RAW DATA" S ERRTXT=DASHES
.S X=$$SETLN^IBJTBA(ERRTXT,"",1,79) D SET(X)
;/End of IB*2.0*488 (vd)
;
Q
;
EXIT ; -- exit code --
K ^TMP("IBCECOB-X",$J),IBDA
D CLEAN^VALM10
Q
;
HDR1 ; -- header code
; Assume IBIFN and IBZIEN are defined
N IBCOB,IBINS
K VALMHDR
S IBINS=$$FINDINS^IBCEF1(IBIFN)
S VALMHDR(1)=IORVON_" BILL #:"_$$BN^PRCAFN(IBIFN)_IORVOFF
S VALMHDR(1)=$J("",80-$L(VALMHDR(1))\2)_VALMHDR(1)
S VALMHDR(2)=" INSURANCE COMPANY: "_$P($G(^DIC(36,+IBINS,0)),U)
S VALMHDR(3)=" "_IOUON_"Svc Date Patient Name/Last 4 Care Type/Form COB/SEQ"_IOUOFF
S Z=$G(^TMP("IBCECOB",$J,IBZIEN,0))
S VALMHDR(4)=" "_$E(Z,17,$L(Z))
Q
;
EXIT1 ; -- exit code --
K ^TMP("IBCECSD",$J)
D CLEAN^VALM10
Q
;
VEOB ;View an EOB from EOB Management
N IBDA,IBCNT,IBIFN,Z,VALMCNT,IBZIEN,IBONE
;
D FULL^VALM1
D SEL^IBCECOB2(.IBDA,1)
S IBDA=+$O(IBDA(0))
I IBDA D EN^VALM("IBCEM EOB VIEW EOB")
S VALMBCK="R"
Q
;
INIT1 ;
S IBCNT=+$P($G(IBDA(IBDA)),U,3)
S IBIFN=+$G(IBDA(IBDA)),IBZIEN=+$G(^TMP("IBCECOB",$J,IBDA)),IBONE=1
Q:'IBCNT!'IBIFN!'IBZIEN
D HDR1
D BLD^IBCECSA6
Q
;
SET(X) ;set up list manager screen array
S VALMCNT=VALMCNT+1
S ^TMP("IBCECOB-X",$J,VALMCNT,0)=X
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCECOB5 4007 printed Dec 13, 2024@02:09:42 Page 2
IBCECOB5 ;ALB/TMP - IB COB MANAGEMENT SCREEN ;31-JAN-01
+1 ;;2.0;INTEGRATED BILLING;**137,155,349,417,488**;21-MAR-94;Build 184
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
INIT ;
+1 SET IBDA=+$ORDER(IBDA(0))
+2 if 'IBDA
QUIT
+3 DO BLD(IBDA)
+4 SET VALMBG=1
+5 QUIT
+6 ;
BLD(IBDA) ; Build list entrypoint
+1 NEW IB,IBIFN,IBVCNT,X,Z,IBCNT,CNT,IBREC,IBIFN1,IBPTRESP
+2 KILL ^TMP("IBCECOB-X",$JOB)
+3 SET VALMCNT=0
+4 SET IB=$GET(^TMP("IBCECOB1",$JOB,IBDA))
SET IBCNT=$PIECE(IB,"^",10)
+5 SET IBVCNT=$GET(^TMP("IBCECOB",$JOB,IBDA))
SET IBIFN=$PIECE(IBVCNT,U,2)
SET IBVCNT=+IBVCNT
+6 if 'IBVCNT
QUIT
+7 SET Z=IBVCNT-1
+8 FOR
SET Z=$ORDER(^TMP("IBCECOB",$JOB,"IDX",Z))
if 'Z!('$DATA(^TMP("IBCECOB",$JOB,"IDX",+Z,IBDA)))
QUIT
DO SET($GET(^TMP("IBCECOB",$JOB,Z,0)))
+9 DO SET("")
+10 SET X=$EXTRACT(" Original Billed Amt: $"_$$A10^IBCECSA5(+$PIECE(IB,U,2))_$JUSTIFY("",40),1,40)
+11 SET X=X_$SELECT($GET(IBSRC):" Total A/R Payments: $"_$$A10^IBCECSA5($PIECE(IB,U,3)),1:"Unreimburse Medicare Exp: $"_$$A10^IBCECSA5(+$GET(^IBM(361.1,IBCNT,1))))
+12 DO SET(X)
+13 ;
+14 ; bill#
SET IBIFN1=$PIECE($GET(^IBM(361.1,IBCNT,0)),U,1)
+15 ; filing error
+16 ; Pt Resp Amt 1.02 field
SET IBPTRESP=$PIECE($GET(^IBM(361.1,IBCNT,1)),U,2)
+17 ; filing error
if $DATA(^IBM(361.1,IBCNT,"ERR"))
SET IBPTRESP=0
+18 ; Override Pt Resp Amt for bills with Form Type UB-04
+19 IF $$FT^IBCEF(IBIFN1)=3
SET IBPTRESP=$$PTRESPI^IBCECOB1(IBCNT)
+20 ;
+21 SET X=$EXTRACT($SELECT($GET(IBSRC):" Bill Balance: $"_$$A10^IBCECSA5(+$PIECE(IB,U,4)),1:" Pt Resp Amt: $"_$$A10^IBCECSA5(IBPTRESP))_$JUSTIFY("",40),1,40)
+22 IF '$GET(IBSRC)
NEW IBCALC,IBIFN
SET IBIFN=+$GET(^IBM(361.1,IBCNT,0))
DO MRACALC^IBCEMU2(IBCNT,IBIFN,0,.IBCALC)
+23 SET X=X_$SELECT($GET(IBSRC):" Total Amt This EOB: $"_$$A10^IBCECSA5($PIECE(IB,U,17)),1:" Medicare Contract Adj: $"_$$A10^IBCECSA5($GET(IBCALC("MEDCA"))))
+24 DO SET(X)
+25 DO SET("")
+26 IF $GET(IBSRC)
Begin DoDot:1
+27 SET X=" Days Since Last Transmit: "_+$PIECE(IB,U,12)
+28 DO SET(X)
+29 SET X=" Authorizing Biller: "_$PIECE(IB,U,8)
+30 DO SET(X)
+31 SET X=" COB History: "
+32 IF $PIECE(IB,U,11)'=""
Begin DoDot:2
+33 FOR Z=1:1:$LENGTH($PIECE(IB,U,11),";")
SET X=X_$PIECE($PIECE(IB,U,11),";",Z)
DO SET(X)
SET X=$JUSTIFY("",27)
End DoDot:2
+34 IF '$TEST
Begin DoDot:2
+35 SET X=X_"NONE FOUND"
DO SET(X)
End DoDot:2
End DoDot:1
+36 IF '$GET(IBSRC)
SET CNT=20
SET IBREC=$GET(^IBM(361.1,IBCNT,0))
KILL ^TMP("IBCECSD",$JOB)
DO MRALLA^IBCECSA5
MERGE ^TMP("IBCECOB-X",$JOB)=^TMP("IBCECSD",$JOB)
KILL ^TMP("IBCECSD",$JOB)
+37 ;
+38 ;/Beginning IB*2.0*488 (vd)
+39 IF '$DATA(^IBM(361.1,IBCNT,"ERR"))
QUIT
+40 DO EOBERR
+41 QUIT
+42 ;
EOBERR ; Display information about any 361.1 message storage or filing errors
+1 NEW ERRTXT,DASHES,X,Z
+2 SET DASHES="---------------------------------------------------------------------"
+3 IF '$ORDER(^IBM(361.1,IBCNT,"ERR",0))
QUIT
+4 SET X="VistA could not match all of the Line Level data received in the EEOB"
DO SET(X)
+5 SET X="(835 Record 40) to the claim in VistA."
DO SET(X)
+6 SET X=" "
DO SET(X)
+7 SET Z=0
FOR
SET Z=$ORDER(^IBM(361.1,IBCNT,"ERR",Z))
if 'Z
QUIT
Begin DoDot:1
+8 SET ERRTXT=$GET(^IBM(361.1,IBCNT,"ERR",Z,0))
+9 IF ERRTXT["##RAW DATA"
SET ERRTXT=DASHES
+10 SET X=$$SETLN^IBJTBA(ERRTXT,"",1,79)
DO SET(X)
End DoDot:1
+11 ;/End of IB*2.0*488 (vd)
+12 ;
+13 QUIT
+14 ;
EXIT ; -- exit code --
+1 KILL ^TMP("IBCECOB-X",$JOB),IBDA
+2 DO CLEAN^VALM10
+3 QUIT
+4 ;
HDR1 ; -- header code
+1 ; Assume IBIFN and IBZIEN are defined
+2 NEW IBCOB,IBINS
+3 KILL VALMHDR
+4 SET IBINS=$$FINDINS^IBCEF1(IBIFN)
+5 SET VALMHDR(1)=IORVON_" BILL #:"_$$BN^PRCAFN(IBIFN)_IORVOFF
+6 SET VALMHDR(1)=$JUSTIFY("",80-$LENGTH(VALMHDR(1))\2)_VALMHDR(1)
+7 SET VALMHDR(2)=" INSURANCE COMPANY: "_$PIECE($GET(^DIC(36,+IBINS,0)),U)
+8 SET VALMHDR(3)=" "_IOUON_"Svc Date Patient Name/Last 4 Care Type/Form COB/SEQ"_IOUOFF
+9 SET Z=$GET(^TMP("IBCECOB",$JOB,IBZIEN,0))
+10 SET VALMHDR(4)=" "_$EXTRACT(Z,17,$LENGTH(Z))
+11 QUIT
+12 ;
EXIT1 ; -- exit code --
+1 KILL ^TMP("IBCECSD",$JOB)
+2 DO CLEAN^VALM10
+3 QUIT
+4 ;
VEOB ;View an EOB from EOB Management
+1 NEW IBDA,IBCNT,IBIFN,Z,VALMCNT,IBZIEN,IBONE
+2 ;
+3 DO FULL^VALM1
+4 DO SEL^IBCECOB2(.IBDA,1)
+5 SET IBDA=+$ORDER(IBDA(0))
+6 IF IBDA
DO EN^VALM("IBCEM EOB VIEW EOB")
+7 SET VALMBCK="R"
+8 QUIT
+9 ;
INIT1 ;
+1 SET IBCNT=+$PIECE($GET(IBDA(IBDA)),U,3)
+2 SET IBIFN=+$GET(IBDA(IBDA))
SET IBZIEN=+$GET(^TMP("IBCECOB",$JOB,IBDA))
SET IBONE=1
+3 if 'IBCNT!'IBIFN!'IBZIEN
QUIT
+4 DO HDR1
+5 DO BLD^IBCECSA6
+6 QUIT
+7 ;
SET(X) ;set up list manager screen array
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("IBCECOB-X",$JOB,VALMCNT,0)=X
+3 QUIT
+4 ;
