IBOHLD2 ;ALB/CJM - REPORT OF CHARGES ON HOLD W/INS ;MAR 6,1991
;;2.0;INTEGRATED BILLING;**70,95,133,153,347,452,618,651**;21-MAR-94;Build 9
;;Per VA Directive 6402, this routine should not be modified.
;
; Reference to $$CLAIM^BPSBUTL supported by DBIA# 4719
REPORT ;
N IBQUIT,IBPAGE,IBNOW,IBLINE,IBLINE2,IBCRT,IBBOT,DFN,IBNAME,IBN
S IBCRT=0,IBBOT=7,IBQUIT=0 I $E(IOST,1,2)="C-" S IBCRT=1,IBBOT=7
S IBLINE="",$P(IBLINE,"=",86)="||",IBLINE=IBLINE_$E(IBLINE,1,45)
S IBLINE2="",$P(IBLINE2,"-",75)="--"
D NOW^%DTC S Y=X X ^DD("DD") S IBNOW=Y
I IBCRT W @IOF
LOOP ;
S IBPAGE=1 D HEADER Q:IBQUIT
S IBNAME="" F S IBNAME=$O(^TMP($J,"HOLD",IBNAME)) Q:IBNAME=""!(IBQUIT) S DFN=0 F S DFN=$O(^TMP($J,"HOLD",IBNAME,DFN)) Q:'DFN!(IBQUIT) D
.D PRNTPAT,PRNTINS W:IBII ?35,IBLINE2,! Q:IBQUIT S IBN=0 F S IBN=$O(^TMP($J,"HOLD",IBNAME,DFN,IBN)) Q:'IBN!(IBQUIT) D
..D PRNTCHG,PRNTBILL:'IBQUIT
Q
PRNTBILL ; prints bills for a charge
N IB,IB0,IBSTAT,IBCHG,IBPD,C,Y,I,IBT
D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
S IB="" F I=1:1 S IB=$O(^TMP($J,"HOLD",IBNAME,DFN,IBN,IB)) W:'IB&(I<2) ?85,"||",! Q:'IB!(IBQUIT) D
.W ?85,"||"
.S IB0=$G(^DGCR(399,IB,0)) Q:IB0=""
.W ?88,$P(IB0,"^",1) ; bill #
.S IBSTAT=$$STA^PRCAFN(IB)
.W:+IBSTAT>0 ?97,$E($P(IBSTAT,"^",2),1,14)
.S IBT=$J((+^DGCR(399,IB,"U1")-$P(^("U1"),"^",2)),9,2)
.W ?112,IBT ; total charges
.S IBPD=$$TPR^PRCAFN(IB) S:IBPD<0 IBPD="" S IBPD=$J(IBPD,9,2) W ?123,IBPD,! D:$Y+IBBOT>IOSL HEADER
Q
PRNTPAT ; prints patient data
N VAERR,VADM,IBSSN D DEM^VADPT S:'VAERR IBSSN=VA("BID") ; pt id,brief
D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
W IBLINE,!
W $E(IBNAME,1,20),?22,IBSSN
W:IBII ?35,"Insurance Co.",?53,"Subscriber ID",?71,"Group",?88,"Eff Dt",?102,"Exp Dt",!
Q
PRNTINS ; prints insurance information
Q:'$D(DFN)!(IBII=0)
N X,IBINS,IBX
D ALL^IBCNS1(DFN,"IBINS")
D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
W IBLINE,!
I '$D(IBINS) W ?35,"No Insurance Information"
S X=0 F S X=$O(IBINS(X)) Q:'X S IBINS=IBINS(X,0) D
.D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
.N COV,COVD,COVFN,IBCNT,LEDT,LIM,PLN,SP,X,X1,X2,Z0 Q:'$D(IBINS)
.W ?36,$S($D(^DIC(36,+IBINS,0)):$E($P(^(0),"^",1),1,16),1:"UNKNOWN")
.W ?54,$E($P(IBINS,"^",2),1,16)
.W ?72,$E($$GRP($P(IBINS,"^",18)),1,10) S PLN=$P(IBINS,"^",18)
.W ?88,$$DAT1^IBOUTL($P(IBINS,"^",8)),?102,$$DAT1^IBOUTL($P(IBINS,"^",4))
.I PLN="" W !,?38,"* No Group Plan Information for this Patient - Verify Insurance Info!",! Q
.W !,?40,"Plan Coverage Effective Date Covered? Limit Comments",!
.W ?40,"------------- -------------- -------- --------------",!
.S LIM=0 F S LIM=$O(^IBE(355.31,LIM)) Q:'LIM S COV=$P($G(^(LIM,0)),U),IBCNT=0,LEDT="" F S LEDT=$O(^IBA(355.32,"APCD",PLN,LIM,LEDT)) Q:$S(LEDT="":IBCNT,1:0) D Q:LEDT=""
..D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
..S COVFN=+$O(^IBA(355.32,"APCD",PLN,LIM,+LEDT,"")),COVD=$G(^IBA(355.32,+COVFN,0))
..I COVD="" W ?40,COV,?86,"BY DEFAULT",! Q
..S IBCNT=IBCNT+1
..S X1=" "_$S(IBCNT=1:COV,1:"") ;Don't duplicate category
..S X2=$$PR(X1,18)_$$PR($$DAT1^IBOUTL($P(LEDT,"-",2)),16)_$$PR($S($P(COVD,U,4):$S($P(COVD,U,4)<2:"YES",$P(COVD,U,4)=2:"CONDITIONAL",1:"UNKNOWN"),1:"NO"),14)
..I '$O(^IBA(355.32,COVFN,2,0)) W ?40,X2,! Q
..S Z0=0 F S Z0=$O(^IBA(355.32,COVFN,2,Z0)) Q:'Z0 S SP="" W ?40,$S(Z0=1:X2_$G(^IBA(355.32,COVFN,2,Z0,0)),1:$$PR(SP,48)_$G(^IBA(355.32,COVFN,2,Z0,0))),!
Q
GRP(IBCPOL) ; get group name/group policy
N X,Y S X=""
S X=$G(^IBA(355.3,+$G(IBCPOL),0))
S Y=$S($P(X,"^",4)'="":$P(X,"^",4),1:$P(X,"^",3))
I $P(X,"^",10) S Y="Ind Plan "_Y
GRPQ Q Y
PR(STR,LEN) ; pad right
N B S STR=$E(STR,1,LEN),$P(B," ",LEN-$L(STR))=" "
Q STR_$G(B)
PRNTCHG ; prints a charge
N IBACT,IBTYPE,IBBILL,IBFR,IBTO,IBCHG,IBND,IBND1
N IBRX,IBRXN,IBRF,IBRDT,IBX,IENS,IBECME
S IBND=$G(^IB(IBN,0))
S IBND1=$G(^IB(IBN,1))
S (IBRX,IBRXN,IBRF,IBRDT,IBX,IBECME)=0
; action id
S IBACT=+IBND
; type
; begin of Patch IB*2.0*618 - added community care - action types to HELD CHARGES report
S IBTYPE=$P(IBND,"^",3),IBTYPE=$P($G(^IBE(350.1,IBTYPE,0)),"^",1)
S IBTYPE=$$IBACTYPE(IBTYPE)
; end of Patch IB*2.0*618
; bill #
S IBBILL=$P($P(IBND,"^",11),"-",2)
; rx info
I $P(IBND,"^",4)["52:" D
. S IBRXN=+$P($P(IBND,"^",4),":",2) ; Rx ien
. S IBRX=$P($P(IBND,"^",8),"-") ; external Rx#
. S IBRF=+$P($P(IBND,"^",4),":",3) ; fill# or 0 for original fill
. S IBECME=$P($$CLAIM^BPSBUTL(IBRXN,IBRF),U,6) ; ecme# DBIA# 4719
. I IBRF S IENS=+IBRF,IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,+IENS,52,.01) ; refill date
. I 'IBRF S IENS=+IBRXN,IBRDT=$$FILE^IBRXUTL(+IENS,22) ; orig fill date
. Q
;
S IBX=$$APPT^IBCU3(IBRDT,DFN)
; from/rx fill date
S IBFR=$$DAT1^IBOUTL($S(IBRXN>0:IBRDT,1:$P(IBND,"^",15)))
; to date
S IBTO=$$DAT1^IBOUTL($S($P(IBND,"^",15)'="":($P(IBND,"^",15)),1:$P(IBND1,"^",2)))
; charge$
S IBCHG=$J(+$P(IBND,"^",7),9,2)
W ?29,IBACT,?39,IBTYPE,?46,IBBILL
I IBRX>0 W ?55,"Rx #: "_IBRX_$S(IBRF>0:"("_IBRF_")",1:""),?85,"||",! I IBECME W ?55,"ECME #: ",IBECME,?85,"||",!
W:IBX=1 ?54,"*"
W ?55,IBFR,?66,IBTO,?75,IBCHG
Q
Q:IBQUIT
I IBCRT,$Y>1 D Q:IBQUIT ;F Q:$Y>(IOSL-1) W !
.W ! N T R " Press RETURN to continue",T:DTIME I '$T!(T["^") S IBQUIT=1 Q
I IBPAGE>1 W !,@IOF
W ?53,"MEANS TEST CHARGES ON HOLD",?110,IBNOW," PAGE ",IBPAGE,!,"HELD CHARGES",?87,"CORRESPONDING THIRD PARTY BILLS",!,IBLINE
W !,"Name",?22,"Pt.ID",?29,"Act.ID",?39,"Type",?46,"Bill#",?55,"Fr/Fl Dt",?66,"To/Rls Dt",?78,"Charge",?85,"||",?88,"Bill#",?97,"AR-Status",?115,"Charge",?128,"Paid"
W !,IBLINE,!
W ?20,"'*' = outpt visit on same day as Rx fill date",?85,"||",!,IBLINE,!
S IBPAGE=IBPAGE+1
Q
IBACTYPE(IBTYPE) ; Patch IB*2.0*618 - added community care - action types to HELD CHARGES report
I IBTYPE["URGENT " Q "NVCUC"
I IBTYPE["CC " Q "NVC"
I IBTYPE["CCN " Q "NVC"
I IBTYPE["CHOICE" Q "NVC"
I IBTYPE["PSO NSC" Q "RXNSC"
I IBTYPE["PSO SC" Q "RX SC"
Q $E(IBTYPE,4,7)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOHLD2 6031 printed Apr 09, 2024@21:23:21 Page 2
IBOHLD2 ;ALB/CJM - REPORT OF CHARGES ON HOLD W/INS ;MAR 6,1991
+1 ;;2.0;INTEGRATED BILLING;**70,95,133,153,347,452,618,651**;21-MAR-94;Build 9
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference to $$CLAIM^BPSBUTL supported by DBIA# 4719
REPORT ;
+1 NEW IBQUIT,IBPAGE,IBNOW,IBLINE,IBLINE2,IBCRT,IBBOT,DFN,IBNAME,IBN
+2 SET IBCRT=0
SET IBBOT=7
SET IBQUIT=0
IF $EXTRACT(IOST,1,2)="C-"
SET IBCRT=1
SET IBBOT=7
+3 SET IBLINE=""
SET $PIECE(IBLINE,"=",86)="||"
SET IBLINE=IBLINE_$EXTRACT(IBLINE,1,45)
+4 SET IBLINE2=""
SET $PIECE(IBLINE2,"-",75)="--"
+5 DO NOW^%DTC
SET Y=X
XECUTE ^DD("DD")
SET IBNOW=Y
+6 IF IBCRT
WRITE @IOF
LOOP ;
+1 SET IBPAGE=1
DO HEADER
if IBQUIT
QUIT
+2 SET IBNAME=""
FOR
SET IBNAME=$ORDER(^TMP($JOB,"HOLD",IBNAME))
if IBNAME=""!(IBQUIT)
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"HOLD",IBNAME,DFN))
if 'DFN!(IBQUIT)
QUIT
Begin DoDot:1
+3 DO PRNTPAT
DO PRNTINS
if IBII
WRITE ?35,IBLINE2,!
if IBQUIT
QUIT
SET IBN=0
FOR
SET IBN=$ORDER(^TMP($JOB,"HOLD",IBNAME,DFN,IBN))
if 'IBN!(IBQUIT)
QUIT
Begin DoDot:2
+4 DO PRNTCHG
if 'IBQUIT
DO PRNTBILL
End DoDot:2
End DoDot:1
+5 QUIT
PRNTBILL ; prints bills for a charge
+1 NEW IB,IB0,IBSTAT,IBCHG,IBPD,C,Y,I,IBT
+2 if $Y+IBBOT>IOSL
DO HEADER
if IBQUIT
QUIT
+3 SET IB=""
FOR I=1:1
SET IB=$ORDER(^TMP($JOB,"HOLD",IBNAME,DFN,IBN,IB))
if 'IB&(I<2)
WRITE ?85,"||",!
if 'IB!(IBQUIT)
QUIT
Begin DoDot:1
+4 WRITE ?85,"||"
+5 SET IB0=$GET(^DGCR(399,IB,0))
if IB0=""
QUIT
+6 ; bill #
WRITE ?88,$PIECE(IB0,"^",1)
+7 SET IBSTAT=$$STA^PRCAFN(IB)
+8 if +IBSTAT>0
WRITE ?97,$EXTRACT($PIECE(IBSTAT,"^",2),1,14)
+9 SET IBT=$JUSTIFY((+^DGCR(399,IB,"U1")-$PIECE(^("U1"),"^",2)),9,2)
+10 ; total charges
WRITE ?112,IBT
+11 SET IBPD=$$TPR^PRCAFN(IB)
if IBPD<0
SET IBPD=""
SET IBPD=$JUSTIFY(IBPD,9,2)
WRITE ?123,IBPD,!
if $Y+IBBOT>IOSL
DO HEADER
End DoDot:1
+12 QUIT
PRNTPAT ; prints patient data
+1 ; pt id,brief
NEW VAERR,VADM,IBSSN
DO DEM^VADPT
if 'VAERR
SET IBSSN=VA("BID")
+2 if $Y+IBBOT>IOSL
DO HEADER
if IBQUIT
QUIT
+3 WRITE IBLINE,!
+4 WRITE $EXTRACT(IBNAME,1,20),?22,IBSSN
+5 if IBII
WRITE ?35,"Insurance Co.",?53,"Subscriber ID",?71,"Group",?88,"Eff Dt",?102,"Exp Dt",!
+6 QUIT
PRNTINS ; prints insurance information
+1 if '$DATA(DFN)!(IBII=0)
QUIT
+2 NEW X,IBINS,IBX
+3 DO ALL^IBCNS1(DFN,"IBINS")
+4 if $Y+IBBOT>IOSL
DO HEADER
if IBQUIT
QUIT
+5 WRITE IBLINE,!
+6 IF '$DATA(IBINS)
WRITE ?35,"No Insurance Information"
+7 SET X=0
FOR
SET X=$ORDER(IBINS(X))
if 'X
QUIT
SET IBINS=IBINS(X,0)
Begin DoDot:1
+8 if $Y+IBBOT>IOSL
DO HEADER
if IBQUIT
QUIT
+9 NEW COV,COVD,COVFN,IBCNT,LEDT,LIM,PLN,SP,X,X1,X2,Z0
if '$DATA(IBINS)
QUIT
+10 WRITE ?36,$SELECT($DATA(^DIC(36,+IBINS,0)):$EXTRACT($PIECE(^(0),"^",1),1,16),1:"UNKNOWN")
+11 WRITE ?54,$EXTRACT($PIECE(IBINS,"^",2),1,16)
+12 WRITE ?72,$EXTRACT($$GRP($PIECE(IBINS,"^",18)),1,10)
SET PLN=$PIECE(IBINS,"^",18)
+13 WRITE ?88,$$DAT1^IBOUTL($PIECE(IBINS,"^",8)),?102,$$DAT1^IBOUTL($PIECE(IBINS,"^",4))
+14 IF PLN=""
WRITE !,?38,"* No Group Plan Information for this Patient - Verify Insurance Info!",!
QUIT
+15 WRITE !,?40,"Plan Coverage Effective Date Covered? Limit Comments",!
+16 WRITE ?40,"------------- -------------- -------- --------------",!
+17 SET LIM=0
FOR
SET LIM=$ORDER(^IBE(355.31,LIM))
if 'LIM
QUIT
SET COV=$PIECE($GET(^(LIM,0)),U)
SET IBCNT=0
SET LEDT=""
FOR
SET LEDT=$ORDER(^IBA(355.32,"APCD",PLN,LIM,LEDT))
if $SELECT(LEDT=""
QUIT
Begin DoDot:2
+18 if $Y+IBBOT>IOSL
DO HEADER
if IBQUIT
QUIT
+19 SET COVFN=+$ORDER(^IBA(355.32,"APCD",PLN,LIM,+LEDT,""))
SET COVD=$GET(^IBA(355.32,+COVFN,0))
+20 IF COVD=""
WRITE ?40,COV,?86,"BY DEFAULT",!
QUIT
+21 SET IBCNT=IBCNT+1
+22 ;Don't duplicate category
SET X1=" "_$SELECT(IBCNT=1:COV,1:"")
+23 SET X2=$$PR(X1,18)_$$PR($$DAT1^IBOUTL($PIECE(LEDT,"-",2)),16)_$$PR($SELECT($PIECE(COVD,U,4):$SELECT($PIECE(COVD,U,4)<2:"YES",$PIECE(COVD,U,4)=2:"CONDITIONAL",1:"UNKNOWN"),1:"NO"),14)
+24 IF '$ORDER(^IBA(355.32,COVFN,2,0))
WRITE ?40,X2,!
QUIT
+25 SET Z0=0
FOR
SET Z0=$ORDER(^IBA(355.32,COVFN,2,Z0))
if 'Z0
QUIT
SET SP=""
WRITE ?40,$SELECT(Z0=1:X2_$GET(^IBA(355.32,COVFN,2,Z0,0)),1:$$PR(SP,48)_$GET(^IBA(355.32,COVFN,2,Z0,0))),!
End DoDot:2
if LEDT=""
QUIT
End DoDot:1
+26 QUIT
GRP(IBCPOL) ; get group name/group policy
+1 NEW X,Y
SET X=""
+2 SET X=$GET(^IBA(355.3,+$GET(IBCPOL),0))
+3 SET Y=$SELECT($PIECE(X,"^",4)'="":$PIECE(X,"^",4),1:$PIECE(X,"^",3))
+4 IF $PIECE(X,"^",10)
SET Y="Ind Plan "_Y
GRPQ QUIT Y
PR(STR,LEN) ; pad right
+1 NEW B
SET STR=$EXTRACT(STR,1,LEN)
SET $PIECE(B," ",LEN-$LENGTH(STR))=" "
+2 QUIT STR_$GET(B)
PRNTCHG ; prints a charge
+1 NEW IBACT,IBTYPE,IBBILL,IBFR,IBTO,IBCHG,IBND,IBND1
+2 NEW IBRX,IBRXN,IBRF,IBRDT,IBX,IENS,IBECME
+3 SET IBND=$GET(^IB(IBN,0))
+4 SET IBND1=$GET(^IB(IBN,1))
+5 SET (IBRX,IBRXN,IBRF,IBRDT,IBX,IBECME)=0
+6 ; action id
+7 SET IBACT=+IBND
+8 ; type
+9 ; begin of Patch IB*2.0*618 - added community care - action types to HELD CHARGES report
+10 SET IBTYPE=$PIECE(IBND,"^",3)
SET IBTYPE=$PIECE($GET(^IBE(350.1,IBTYPE,0)),"^",1)
+11 SET IBTYPE=$$IBACTYPE(IBTYPE)
+12 ; end of Patch IB*2.0*618
+13 ; bill #
+14 SET IBBILL=$PIECE($PIECE(IBND,"^",11),"-",2)
+15 ; rx info
+16 IF $PIECE(IBND,"^",4)["52:"
Begin DoDot:1
+17 ; Rx ien
SET IBRXN=+$PIECE($PIECE(IBND,"^",4),":",2)
+18 ; external Rx#
SET IBRX=$PIECE($PIECE(IBND,"^",8),"-")
+19 ; fill# or 0 for original fill
SET IBRF=+$PIECE($PIECE(IBND,"^",4),":",3)
+20 ; ecme# DBIA# 4719
SET IBECME=$PIECE($$CLAIM^BPSBUTL(IBRXN,IBRF),U,6)
+21 ; refill date
IF IBRF
SET IENS=+IBRF
SET IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,+IENS,52,.01)
+22 ; orig fill date
IF 'IBRF
SET IENS=+IBRXN
SET IBRDT=$$FILE^IBRXUTL(+IENS,22)
+23 QUIT
End DoDot:1
+24 ;
+25 SET IBX=$$APPT^IBCU3(IBRDT,DFN)
+26 ; from/rx fill date
+27 SET IBFR=$$DAT1^IBOUTL($SELECT(IBRXN>0:IBRDT,1:$PIECE(IBND,"^",15)))
+28 ; to date
+29 SET IBTO=$$DAT1^IBOUTL($SELECT($PIECE(IBND,"^",15)'="":($PIECE(IBND,"^",15)),1:$PIECE(IBND1,"^",2)))
+30 ; charge$
+31 SET IBCHG=$JUSTIFY(+$PIECE(IBND,"^",7),9,2)
+32 WRITE ?29,IBACT,?39,IBTYPE,?46,IBBILL
+33 IF IBRX>0
WRITE ?55,"Rx #: "_IBRX_$SELECT(IBRF>0:"("_IBRF_")",1:""),?85,"||",!
IF IBECME
WRITE ?55,"ECME #: ",IBECME,?85,"||",!
+34 if IBX=1
WRITE ?54,"*"
+35 WRITE ?55,IBFR,?66,IBTO,?75,IBCHG
+36 QUIT
+1 if IBQUIT
QUIT
+2 ;F Q:$Y>(IOSL-1) W !
IF IBCRT
IF $Y>1
Begin DoDot:1
+3 WRITE !
NEW T
READ " Press RETURN to continue",T:DTIME
IF '$TEST!(T["^")
SET IBQUIT=1
QUIT
End DoDot:1
if IBQUIT
QUIT
+4 IF IBPAGE>1
WRITE !,@IOF
+5 WRITE ?53,"MEANS TEST CHARGES ON HOLD",?110,IBNOW," PAGE ",IBPAGE,!,"HELD CHARGES",?87,"CORRESPONDING THIRD PARTY BILLS",!,IBLINE
+6 WRITE !,"Name",?22,"Pt.ID",?29,"Act.ID",?39,"Type",?46,"Bill#",?55,"Fr/Fl Dt",?66,"To/Rls Dt",?78,"Charge",?85,"||",?88,"Bill#",?97,"AR-Status",?115,"Charge",?128,"Paid"
+7 WRITE !,IBLINE,!
+8 WRITE ?20,"'*' = outpt visit on same day as Rx fill date",?85,"||",!,IBLINE,!
+9 SET IBPAGE=IBPAGE+1
+10 QUIT
IBACTYPE(IBTYPE) ; Patch IB*2.0*618 - added community care - action types to HELD CHARGES report
+1 IF IBTYPE["URGENT "
QUIT "NVCUC"
+2 IF IBTYPE["CC "
QUIT "NVC"
+3 IF IBTYPE["CCN "
QUIT "NVC"
+4 IF IBTYPE["CHOICE"
QUIT "NVC"
+5 IF IBTYPE["PSO NSC"
QUIT "RXNSC"
+6 IF IBTYPE["PSO SC"
QUIT "RX SC"
+7 QUIT $EXTRACT(IBTYPE,4,7)
+8 ;
