IBTOBI1 ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ;27-OCT-93
;;2.0;INTEGRATED BILLING;**276,377,516**;21-MAR-94;Build 123
;;Per VA Directive 6402, this routine should not be modified.
;
% ;
F IBTAG="INS","BI","SC","CLIN^IBTOBI4","IR^IBTOBI2","HR^IBTOBI3" D @IBTAG Q:IBQUIT
Q
;
INS ; -- print ins. stuff
N TAB,TAB2,IBALLIN,IBDT,IBINS,IBCNT,I,X,IBI,PHON,PHON2,PHON3,P,IBI
S TAB=5,TAB2=45,IBALLIN=1
S IBDT=$P(IBTRND,"^",6)
I '$G(IBDT) S IBDT=DT
W !," Insurance Information "
;
D ALL^IBCNS1(DFN,"IBINS",1,IBDT)
I $G(IBINS(0))<1 W !,?TAB,"No Insurance Information",!!! G INSQ
S IBI=0,IBCNT=0 F S IBI=$O(IBINS(IBI)) Q:'IBI!(IBQUIT) S IBINS=IBINS(IBI,0) D Q:IBQUIT
.S IBCNT=IBCNT+1
.I ($Y+10)>IOSL D HDR^IBTOBI Q:IBQUIT
.I IBCNT>1 W !
.W !?TAB," Ins. Co "_IBCNT_": ",$E($P($G(^DIC(36,+IBINS,0)),"^"),1,59)
.S X=$G(^DIC(36,+IBINS,.13))
.S PHON=$S($P(X,"^",3)'="":$P(X,"^",3),1:$P(X,"^"))
.S PHON2=$S($P(X,"^",2)'="":$P(X,"^",2),1:$P(X,"^"))
.S P=$S($P(IBETYP,"^",3)=1:5,$P(IBETYP,"^",3)=2:6,$P(IBETYP,"^",3)=3:11,1:1)
.S PHON3=$S($P(X,"^",P)'="":$P(X,"^",P),1:$P(X,"^"))
.; MRD;IB*2.0*516 - Rearranged some fields to allow more characters
.; to be displayed for some fields.
.W !?TAB," Type: ",$E($P($G(^IBE(355.1,+$P($G(^IBA(355.3,+$P(IBINS,"^",18),0)),"^",9),0)),"^"),1,18)
.W ?TAB2,"Pre-Cert Phone: ",PHON
.W !?TAB," Subsc.: ",$E($P(IBINS,"^",17),1,59)
.W !?TAB," Subsc. ID: ",$E($P(IBINS,"^",2),1,59)
.W !?TAB," Group: ",$E($$GRP^IBCNS($P(IBINS,"^",18)),1,59)
.W !?TAB," Coord Ben: ",$E($$EXPAND^IBTRE(2.312,.2,$P(IBINS,"^",20)),1,18)
.W ?TAB2," Billing Phone: ",PHON2
.W !,?TAB,"Filing Time Fr: ",$$EXPAND^IBTRE(36,.12,$P($G(^DIC(36,+IBINS,0)),"^",12))
.W ?TAB2," Claims Phone: ",PHON3
.S X=$P($G(IBINS(IBI,1)),"^",8) I X'="" W !," Policy Comment: " W:($L(X)+23)>IOM ! W " ",X
.D COMM(+$P(IBINS,"^",18))
.Q:IBQUIT
.W !?30,"-----------------------------------"
W:'IBQUIT !?4,$TR($J(" ",IOM-8)," ","-"),!
INSQ Q
;
BI ; -- print billing information
Q:$D(IBCTHDR)
I ($Y+8)>IOSL D HDR^IBTOBI Q:IBQUIT
BI1 W !," Billing Information "
N IBDGCR,IBDGCRU1,IBDGCRU,IBAMNT,IBD,I,IBIFN,IBLN,IBECME
S IBIFN=+$P(IBTRND,"^",11)
S IBDGCR=$G(^DGCR(399,IBIFN,0)),IBDGCRU1=$G(^("U1")),IBDGCRU=$G(^("U"))
S IBECME=$P($P($G(^DGCR(399,IBIFN,"M1")),U,8),";")
S IBAMNT=$$BILLD^IBTRED1(IBTRN)
S IBLN=0
S IBLN=IBLN+1,IBD(IBLN,1)=" Initial Bill: "_$P(IBDGCR,U,1)
I IBECME D
. S IBD(IBLN,1)=IBD(IBLN,1)_"e"
. S IBLN=IBLN+1,IBD(IBLN,1)=" ECME Number: "_IBECME
S IBLN=IBLN+1,IBD(IBLN,1)=" Bill Status: "_$E($$EXPAND^IBTRE(399,.13,$P(IBDGCR,U,13)),1,14)
S IBLN=IBLN+1,IBD(IBLN,1)=" Total Charges: $ "_$J($P(IBAMNT,"^"),8)
S IBLN=IBLN+1,IBD(IBLN,1)=" Amount Paid: $ "_$J($P(IBAMNT,"^",2),8)
;
I $P(IBTRND,U,19) D
. S IBLN=IBLN+1,IBD(IBLN,1)="Reason Not Billable: "_$$EXPAND^IBTRE(356,.19,$P(IBTRND,U,19))
. S IBLN=IBLN+1,IBD(IBLN,1)="Additional Comment: "_$P(IBTRND1,U,8)
. Q
;
I '$P(IBTRND,U,19),$L($P(IBTRND1,U,8))>0 S IBLN=IBLN+1,IBD(IBLN,1)="Additional Comment: "_$P(IBTRND1,U,8)
;
S IBD(1,2)="Estimated Recv (Pri): $ "_$J($P(IBTRND,"^",21),8)
S IBD(2,2)="Estimated Recv (Sec): $ "_$J($P(IBTRND,"^",22),8)
S IBD(3,2)="Estimated Recv (ter): $ "_$J($P(IBTRND,"^",23),8)
S IBD(4,2)=" Means Test Charges: $ "_$J($P(IBTRND,"^",28),8)
;
S I=0 F S I=$O(IBD(I)) Q:'I W !,$G(IBD(I,1)),?39,$E($G(IBD(I,2)),1,36)
W:'IBQUIT !,?4,$TR($J(" ",IOM-8)," ","-")
Q
;
SC ; -- print SC information
I ($Y+7)>IOSL D HDR^IBTOBI Q:IBQUIT
N VAEL,TAB,IBTRCSC
D ELIG^VADPT
W !!," Eligibility Information"
W !," Primary Eligibility: "_$P(VAEL(1),"^",2)
W !," Means Test Status: "_$P(VAEL(9),"^",2)
W !," Service Connected Percent: "_$S(+VAEL(3):+$P(VAEL(3),"^",2)_"%",1:"")
I 'VAEL(3) W "Patient Not Service Connected",!! G SCQ
S TAB=5,IBTRCSC=1 D SC^IBTOAT2
SCQ W:'IBQUIT !?4,$TR($J(" ",IOM-8)," ","-"),!
Q
;
COMM(DA) ; -- print comments from GROUP plans.
Q:IBQUIT
W !,"Group Plan Comments: "
Q:'$D(^IBA(355.3,DA,11))
K ^UTILITY($J,"W")
S DIWL=10,DIWR=IOM-12,DIWF="W"
S IBJ=0 F S IBJ=$O(^IBA(355.3,DA,11,IBJ)) Q:'IBJ S X=^(IBJ,0) D ^DIWP I IOSL<($Y+3) Q:IBQUIT D HDR^IBTOBI
Q:IBQUIT
D ^DIWW
K ^UTILITY($J,"W")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTOBI1 4334 printed Dec 13, 2024@02:27:11 Page 2
IBTOBI1 ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ;27-OCT-93
+1 ;;2.0;INTEGRATED BILLING;**276,377,516**;21-MAR-94;Build 123
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
% ;
+1 FOR IBTAG="INS","BI","SC","CLIN^IBTOBI4","IR^IBTOBI2","HR^IBTOBI3"
DO @IBTAG
if IBQUIT
QUIT
+2 QUIT
+3 ;
INS ; -- print ins. stuff
+1 NEW TAB,TAB2,IBALLIN,IBDT,IBINS,IBCNT,I,X,IBI,PHON,PHON2,PHON3,P,IBI
+2 SET TAB=5
SET TAB2=45
SET IBALLIN=1
+3 SET IBDT=$PIECE(IBTRND,"^",6)
+4 IF '$GET(IBDT)
SET IBDT=DT
+5 WRITE !," Insurance Information "
+6 ;
+7 DO ALL^IBCNS1(DFN,"IBINS",1,IBDT)
+8 IF $GET(IBINS(0))<1
WRITE !,?TAB,"No Insurance Information",!!!
GOTO INSQ
+9 SET IBI=0
SET IBCNT=0
FOR
SET IBI=$ORDER(IBINS(IBI))
if 'IBI!(IBQUIT)
QUIT
SET IBINS=IBINS(IBI,0)
Begin DoDot:1
+10 SET IBCNT=IBCNT+1
+11 IF ($Y+10)>IOSL
DO HDR^IBTOBI
if IBQUIT
QUIT
+12 IF IBCNT>1
WRITE !
+13 WRITE !?TAB," Ins. Co "_IBCNT_": ",$EXTRACT($PIECE($GET(^DIC(36,+IBINS,0)),"^"),1,59)
+14 SET X=$GET(^DIC(36,+IBINS,.13))
+15 SET PHON=$SELECT($PIECE(X,"^",3)'="":$PIECE(X,"^",3),1:$PIECE(X,"^"))
+16 SET PHON2=$SELECT($PIECE(X,"^",2)'="":$PIECE(X,"^",2),1:$PIECE(X,"^"))
+17 SET P=$SELECT($PIECE(IBETYP,"^",3)=1:5,$PIECE(IBETYP,"^",3)=2:6,$PIECE(IBETYP,"^",3)=3:11,1:1)
+18 SET PHON3=$SELECT($PIECE(X,"^",P)'="":$PIECE(X,"^",P),1:$PIECE(X,"^"))
+19 ; MRD;IB*2.0*516 - Rearranged some fields to allow more characters
+20 ; to be displayed for some fields.
+21 WRITE !?TAB," Type: ",$EXTRACT($PIECE($GET(^IBE(355.1,+$PIECE($GET(^IBA(355.3,+$PIECE(IBINS,"^",18),0)),"^",9),0)),"^"),1,18)
+22 WRITE ?TAB2,"Pre-Cert Phone: ",PHON
+23 WRITE !?TAB," Subsc.: ",$EXTRACT($PIECE(IBINS,"^",17),1,59)
+24 WRITE !?TAB," Subsc. ID: ",$EXTRACT($PIECE(IBINS,"^",2),1,59)
+25 WRITE !?TAB," Group: ",$EXTRACT($$GRP^IBCNS($PIECE(IBINS,"^",18)),1,59)
+26 WRITE !?TAB," Coord Ben: ",$EXTRACT($$EXPAND^IBTRE(2.312,.2,$PIECE(IBINS,"^",20)),1,18)
+27 WRITE ?TAB2," Billing Phone: ",PHON2
+28 WRITE !,?TAB,"Filing Time Fr: ",$$EXPAND^IBTRE(36,.12,$PIECE($GET(^DIC(36,+IBINS,0)),"^",12))
+29 WRITE ?TAB2," Claims Phone: ",PHON3
+30 SET X=$PIECE($GET(IBINS(IBI,1)),"^",8)
IF X'=""
WRITE !," Policy Comment: "
if ($LENGTH(X)+23)>IOM
WRITE !
WRITE " ",X
+31 DO COMM(+$PIECE(IBINS,"^",18))
+32 if IBQUIT
QUIT
+33 WRITE !?30,"-----------------------------------"
End DoDot:1
if IBQUIT
QUIT
+34 if 'IBQUIT
WRITE !?4,$TRANSLATE($JUSTIFY(" ",IOM-8)," ","-"),!
INSQ QUIT
+1 ;
BI ; -- print billing information
+1 if $DATA(IBCTHDR)
QUIT
+2 IF ($Y+8)>IOSL
DO HDR^IBTOBI
if IBQUIT
QUIT
BI1 WRITE !," Billing Information "
+1 NEW IBDGCR,IBDGCRU1,IBDGCRU,IBAMNT,IBD,I,IBIFN,IBLN,IBECME
+2 SET IBIFN=+$PIECE(IBTRND,"^",11)
+3 SET IBDGCR=$GET(^DGCR(399,IBIFN,0))
SET IBDGCRU1=$GET(^("U1"))
SET IBDGCRU=$GET(^("U"))
+4 SET IBECME=$PIECE($PIECE($GET(^DGCR(399,IBIFN,"M1")),U,8),";")
+5 SET IBAMNT=$$BILLD^IBTRED1(IBTRN)
+6 SET IBLN=0
+7 SET IBLN=IBLN+1
SET IBD(IBLN,1)=" Initial Bill: "_$PIECE(IBDGCR,U,1)
+8 IF IBECME
Begin DoDot:1
+9 SET IBD(IBLN,1)=IBD(IBLN,1)_"e"
+10 SET IBLN=IBLN+1
SET IBD(IBLN,1)=" ECME Number: "_IBECME
End DoDot:1
+11 SET IBLN=IBLN+1
SET IBD(IBLN,1)=" Bill Status: "_$EXTRACT($$EXPAND^IBTRE(399,.13,$PIECE(IBDGCR,U,13)),1,14)
+12 SET IBLN=IBLN+1
SET IBD(IBLN,1)=" Total Charges: $ "_$JUSTIFY($PIECE(IBAMNT,"^"),8)
+13 SET IBLN=IBLN+1
SET IBD(IBLN,1)=" Amount Paid: $ "_$JUSTIFY($PIECE(IBAMNT,"^",2),8)
+14 ;
+15 IF $PIECE(IBTRND,U,19)
Begin DoDot:1
+16 SET IBLN=IBLN+1
SET IBD(IBLN,1)="Reason Not Billable: "_$$EXPAND^IBTRE(356,.19,$PIECE(IBTRND,U,19))
+17 SET IBLN=IBLN+1
SET IBD(IBLN,1)="Additional Comment: "_$PIECE(IBTRND1,U,8)
+18 QUIT
End DoDot:1
+19 ;
+20 IF '$PIECE(IBTRND,U,19)
IF $LENGTH($PIECE(IBTRND1,U,8))>0
SET IBLN=IBLN+1
SET IBD(IBLN,1)="Additional Comment: "_$PIECE(IBTRND1,U,8)
+21 ;
+22 SET IBD(1,2)="Estimated Recv (Pri): $ "_$JUSTIFY($PIECE(IBTRND,"^",21),8)
+23 SET IBD(2,2)="Estimated Recv (Sec): $ "_$JUSTIFY($PIECE(IBTRND,"^",22),8)
+24 SET IBD(3,2)="Estimated Recv (ter): $ "_$JUSTIFY($PIECE(IBTRND,"^",23),8)
+25 SET IBD(4,2)=" Means Test Charges: $ "_$JUSTIFY($PIECE(IBTRND,"^",28),8)
+26 ;
+27 SET I=0
FOR
SET I=$ORDER(IBD(I))
if 'I
QUIT
WRITE !,$GET(IBD(I,1)),?39,$EXTRACT($GET(IBD(I,2)),1,36)
+28 if 'IBQUIT
WRITE !,?4,$TRANSLATE($JUSTIFY(" ",IOM-8)," ","-")
+29 QUIT
+30 ;
SC ; -- print SC information
+1 IF ($Y+7)>IOSL
DO HDR^IBTOBI
if IBQUIT
QUIT
+2 NEW VAEL,TAB,IBTRCSC
+3 DO ELIG^VADPT
+4 WRITE !!," Eligibility Information"
+5 WRITE !," Primary Eligibility: "_$PIECE(VAEL(1),"^",2)
+6 WRITE !," Means Test Status: "_$PIECE(VAEL(9),"^",2)
+7 WRITE !," Service Connected Percent: "_$SELECT(+VAEL(3):+$PIECE(VAEL(3),"^",2)_"%",1:"")
+8 IF 'VAEL(3)
WRITE "Patient Not Service Connected",!!
GOTO SCQ
+9 SET TAB=5
SET IBTRCSC=1
DO SC^IBTOAT2
SCQ if 'IBQUIT
WRITE !?4,$TRANSLATE($JUSTIFY(" ",IOM-8)," ","-"),!
+1 QUIT
+2 ;
COMM(DA) ; -- print comments from GROUP plans.
+1 if IBQUIT
QUIT
+2 WRITE !,"Group Plan Comments: "
+3 if '$DATA(^IBA(355.3,DA,11))
QUIT
+4 KILL ^UTILITY($JOB,"W")
+5 SET DIWL=10
SET DIWR=IOM-12
SET DIWF="W"
+6 SET IBJ=0
FOR
SET IBJ=$ORDER(^IBA(355.3,DA,11,IBJ))
if 'IBJ
QUIT
SET X=^(IBJ,0)
DO ^DIWP
IF IOSL<($Y+3)
if IBQUIT
QUIT
DO HDR^IBTOBI
+7 if IBQUIT
QUIT
+8 DO ^DIWW
+9 KILL ^UTILITY($JOB,"W")
+10 QUIT
