IBCEOB2 ;ALB/TMP - EOB LIST FOR MANUAL MAINTENANCE ;18-FEB-99
;;2.0;INTEGRATED BILLING;**137,155**;21-MAR-94
Q
;
EN ; Enter/edit an EOB manually for a bill
; MRA's cannot be manually entered
N VALMCNT,VALMBG,VALMHDR
S VALMCNT=0,VALMBG=1
D EN^VALM("IBCE EOB LIST")
Q
;
HDR ; -- header code
N IBCOB,IBINS,IBINSNM
K VALMHDR
S IBINS=$$CURR^IBCEF2(IBIFN),IBINSNM=$P($G(^DIC(36,+IBINS,0)),U)
S IBCOB=$P("^PRIMARY^SECONDARY^TERTIARY",U,$$COBN^IBCEF(IBIFN)+1)
S VALMHDR(1)=IORVON_" BILL #:"_$$BN^PRCAFN(IBIFN)_IORVOFF
S VALMHDR(1)=$J("",80-$L(VALMHDR(1))\2)_VALMHDR(1)
S VALMHDR(2)=" CURRENT INSURANCE COMPANY ("_IBCOB_"): "_IBINSNM
I $D(^IBM(361.1,"B",IBIFN)) D
. S VALMHDR(3)=" "
. S VALMHDR(4)=" # SEQ PAYER"_$J("",15)_"EOB PAID DATE TYPE STATUS"
Q
;
INIT ; -- init variables and list array
; Select bill
K VALMQUIT
S IBIFN=$$BILL(.VALMQUIT)
INITQ Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("IBCEOB",$J),IBIFN,IBEOB
D CLEAR^VALM1
Q
;
BLD ; Build list template display - IBIFN must equal ien of bill in file 399
;
N IB0,X,Y,IBCOB,IBCOBN,IB,IBCNT,IBEOB,IBSEQ,IBPDDT
S VALMCNT=0
K ^TMP("IBCEOB",$J)
S IB0=$G(^DGCR(399,+$G(IBIFN),0)),VALMCNT=0
S IBCOB=$P($$EXTERNAL^DILFD(399,.21,,$P(IB0,U,21))," "),IBCOBN=$$COBN^IBCEF(IBIFN)
;
S IBCNT=0
I $D(^IBM(361.1,"B",IBIFN)) D ; Display existing EOB's for bill, if any
. K ^TMP("IB",$J)
. S IBEOB=0 F S IBEOB=$O(^IBM(361.1,"B",IBIFN,IBEOB)) Q:'IBEOB D
.. S IB0=$G(^IBM(361.1,IBEOB,0))
.. S ^TMP("IB",$J,+$P(IB0,U,6),IBEOB)=IB0 ; Sort by EOB paid date
. ;
. S IBPDDT="" F S IBPDDT=$O(^TMP("IB",$J,IBPDDT)) Q:IBPDDT="" S IBEOB=0 F S IBEOB=$O(^TMP("IB",$J,IBPDDT,IBEOB)) Q:'IBEOB S IB0=$G(^(IBEOB)) I IB0'="" D
.. ;
.. S IBCNT=IBCNT+1
.. S IBSEQ=+$P(IB0,U,15)
.. S IB=" "_$E(IBCNT_" ",1,3)_$S(IBSEQ:"("_$P("P^S^T",U,IBSEQ)_") ",1:$J("",4))_$E($$EXTERNAL^DILFD(361.1,.02,"",$P(IB0,U,2))_$J("",18),1,18)_" "
.. S IB=IB_$E($$FMTE^XLFDT($P(IB0,U,6),"2")_$J("",18),1,18)_" "_$E($P("EOB^MRA",U,$P(IB0,U,4)+1)_$J("",5),1,5)_$$EXTERNAL^DILFD(361.1,.13,"",$P(IB0,U,13))
.. ;
.. D SET(IB,IBCNT,IBEOB)
. ;
. K ^TMP("IB",$J)
I 'IBCNT S IBCNT=IBCNT D SET(" NO EOB's FOUND FOR BILL #"_$$BN^PRCAFN(IBIFN))
;
Q
;
SET(X,CNT,IBEOB) ;set list manager screen arrays
S VALMCNT=VALMCNT+1
S ^TMP("IBCEOB",$J,VALMCNT,0)=X
I $G(IBEOB) D
. S ^TMP("IBCEOB",$J,"IDX",VALMCNT,CNT)=""
. S ^TMP("IBCEOB",$J,CNT)=VALMCNT_U_IBEOB
Q
;
BILL(VALMQUIT,IBX) ; Select bill
; VALMQUIT = pass by reference to determine if protocol should quit
; IBX = pass by reference to return 1 if timeout or ^ entered
;
; Must be printed/txmt or closed status, have a current insurance and
; not having MEDICARE WNR as its primary insurance with the COB sequence
; of the bill being primary
;
N DIC,DA,X,Y,IBIFN
K VALMQUIT
S IBX=0
S DIC="^DGCR(399,",DIC(0)="AEMQ",DIC("S")="N IBY S IBY=Y I $P(^(0),U,13)'="""",""04""[$P(^(0),U,13),$D(^(""I1"")),$S($$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(+IBY)):+$$COBN^IBCEF(+IBY)'=1,1:1)" D ^DIC K DIC
S IBIFN=+Y,IBX=($G(DTOUT)!($G(DUOUT)))
I IBIFN'>0 S VALMQUIT=1 G BILLQ
I IBIFN>0 D BLD,HDR
BILLQ Q IBIFN
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEOB2 3243 printed Oct 16, 2024@18:12:03 Page 2
IBCEOB2 ;ALB/TMP - EOB LIST FOR MANUAL MAINTENANCE ;18-FEB-99
+1 ;;2.0;INTEGRATED BILLING;**137,155**;21-MAR-94
+2 QUIT
+3 ;
EN ; Enter/edit an EOB manually for a bill
+1 ; MRA's cannot be manually entered
+2 NEW VALMCNT,VALMBG,VALMHDR
+3 SET VALMCNT=0
SET VALMBG=1
+4 DO EN^VALM("IBCE EOB LIST")
+5 QUIT
+6 ;
HDR ; -- header code
+1 NEW IBCOB,IBINS,IBINSNM
+2 KILL VALMHDR
+3 SET IBINS=$$CURR^IBCEF2(IBIFN)
SET IBINSNM=$PIECE($GET(^DIC(36,+IBINS,0)),U)
+4 SET IBCOB=$PIECE("^PRIMARY^SECONDARY^TERTIARY",U,$$COBN^IBCEF(IBIFN)+1)
+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)=" CURRENT INSURANCE COMPANY ("_IBCOB_"): "_IBINSNM
+8 IF $DATA(^IBM(361.1,"B",IBIFN))
Begin DoDot:1
+9 SET VALMHDR(3)=" "
+10 SET VALMHDR(4)=" # SEQ PAYER"_$JUSTIFY("",15)_"EOB PAID DATE TYPE STATUS"
End DoDot:1
+11 QUIT
+12 ;
INIT ; -- init variables and list array
+1 ; Select bill
+2 KILL VALMQUIT
+3 SET IBIFN=$$BILL(.VALMQUIT)
INITQ QUIT
+1 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("IBCEOB",$JOB),IBIFN,IBEOB
+2 DO CLEAR^VALM1
+3 QUIT
+4 ;
BLD ; Build list template display - IBIFN must equal ien of bill in file 399
+1 ;
+2 NEW IB0,X,Y,IBCOB,IBCOBN,IB,IBCNT,IBEOB,IBSEQ,IBPDDT
+3 SET VALMCNT=0
+4 KILL ^TMP("IBCEOB",$JOB)
+5 SET IB0=$GET(^DGCR(399,+$GET(IBIFN),0))
SET VALMCNT=0
+6 SET IBCOB=$PIECE($$EXTERNAL^DILFD(399,.21,,$PIECE(IB0,U,21))," ")
SET IBCOBN=$$COBN^IBCEF(IBIFN)
+7 ;
+8 SET IBCNT=0
+9 ; Display existing EOB's for bill, if any
IF $DATA(^IBM(361.1,"B",IBIFN))
Begin DoDot:1
+10 KILL ^TMP("IB",$JOB)
+11 SET IBEOB=0
FOR
SET IBEOB=$ORDER(^IBM(361.1,"B",IBIFN,IBEOB))
if 'IBEOB
QUIT
Begin DoDot:2
+12 SET IB0=$GET(^IBM(361.1,IBEOB,0))
+13 ; Sort by EOB paid date
SET ^TMP("IB",$JOB,+$PIECE(IB0,U,6),IBEOB)=IB0
End DoDot:2
+14 ;
+15 SET IBPDDT=""
FOR
SET IBPDDT=$ORDER(^TMP("IB",$JOB,IBPDDT))
if IBPDDT=""
QUIT
SET IBEOB=0
FOR
SET IBEOB=$ORDER(^TMP("IB",$JOB,IBPDDT,IBEOB))
if 'IBEOB
QUIT
SET IB0=$GET(^(IBEOB))
IF IB0'=""
Begin DoDot:2
+16 ;
+17 SET IBCNT=IBCNT+1
+18 SET IBSEQ=+$PIECE(IB0,U,15)
+19 SET IB=" "_$EXTRACT(IBCNT_" ",1,3)_$SELECT(IBSEQ:"("_$PIECE("P^S^T",U,IBSEQ)_") ",1:$JUSTIFY("",4))_$EXTRACT($$EXTERNAL^DILFD(361.1,.02,"",$PIECE(IB0,U,2))_$JUSTIFY("",18),1,18)_" "
+20 SET IB=IB_$EXTRACT($$FMTE^XLFDT($PIECE(IB0,U,6),"2")_$JUSTIFY("",18),1,18)_" "_$EXTRACT($PIECE("EOB^MRA",U,$PIECE(IB0,U,4)+1)_$JUSTIFY("",5),1,5)_$$EXTERNAL^DILFD(361.1,.13,"",$PIECE(IB0,U,13))
+21 ;
+22 DO SET(IB,IBCNT,IBEOB)
End DoDot:2
+23 ;
+24 KILL ^TMP("IB",$JOB)
End DoDot:1
+25 IF 'IBCNT
SET IBCNT=IBCNT
DO SET(" NO EOB's FOUND FOR BILL #"_$$BN^PRCAFN(IBIFN))
+26 ;
+27 QUIT
+28 ;
SET(X,CNT,IBEOB) ;set list manager screen arrays
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("IBCEOB",$JOB,VALMCNT,0)=X
+3 IF $GET(IBEOB)
Begin DoDot:1
+4 SET ^TMP("IBCEOB",$JOB,"IDX",VALMCNT,CNT)=""
+5 SET ^TMP("IBCEOB",$JOB,CNT)=VALMCNT_U_IBEOB
End DoDot:1
+6 QUIT
+7 ;
BILL(VALMQUIT,IBX) ; Select bill
+1 ; VALMQUIT = pass by reference to determine if protocol should quit
+2 ; IBX = pass by reference to return 1 if timeout or ^ entered
+3 ;
+4 ; Must be printed/txmt or closed status, have a current insurance and
+5 ; not having MEDICARE WNR as its primary insurance with the COB sequence
+6 ; of the bill being primary
+7 ;
+8 NEW DIC,DA,X,Y,IBIFN
+9 KILL VALMQUIT
+10 SET IBX=0
+11 SET DIC="^DGCR(399,"
SET DIC(0)="AEMQ"
SET DIC("S")="N IBY S IBY=Y I $P(^(0),U,13)'="""",""04""[$P(^(0),U,13),$D(^(""I1"")),$S($$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(+IBY)):+$$COBN^IBCEF(+IBY)'=1,1:1)"
DO ^DIC
KILL DIC
+12 SET IBIFN=+Y
SET IBX=($GET(DTOUT)!($GET(DUOUT)))
+13 IF IBIFN'>0
SET VALMQUIT=1
GOTO BILLQ
+14 IF IBIFN>0
DO BLD
DO HDR
BILLQ QUIT IBIFN
+1 ;
