IBTOBI1 ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 27-OCT-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
% ;
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+8)>IOSL D HDR^IBTOBI Q:IBQUIT
.I IBCNT>1 W !
.W !?TAB," Ins. Co "_IBCNT_": ",$E($P($G(^DIC(36,+IBINS,0)),"^"),1,23)
.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,"^"))
.W ?TAB2,"Pre-Cert Phone: ",PHON
.W !?TAB," Subsc.: ",$P(IBINS,"^",17)
.W ?TAB2," Type: ",$E($P($G(^IBE(355.1,+$P($G(^IBA(355.3,+$P(IBINS,"^",18),0)),"^",9),0)),"^"),1,18)
.W !?TAB," Subsc. ID: ",$P(IBINS,"^",2)
.W ?TAB2," Group: ",$$GRP^IBCNS($P(IBINS,"^",18))
.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
S IBDGCR=$G(^DGCR(399,+$P(IBTRND,"^",11),0)),IBDGCRU1=$G(^("U1")),IBDGCRU=$G(^("U"))
S IBAMNT=$$BILLD^IBTRED1(IBTRN)
S IBD(1,1)=" Initial Bill: "_$P(IBDGCR,"^")
S IBD(2,1)=" Bill Status: "_$E($$EXPAND^IBTRE(399,.13,$P(IBDGCR,"^",13)),1,14)
S IBD(3,1)=" Total Charges: $ "_$J($P(IBAMNT,"^"),8)
S IBD(4,1)=" Amount Paid: $ "_$J($P(IBAMNT,"^",2),8)
;
I $P(IBTRND,"^",19) S IBD(5,1)="Reason Not Billable: "_$$EXPAND^IBTRE(356,.19,$P(IBTRND,"^",19)),IBD(6,1)="Additional Comment: "_$P(IBTRND1,"^",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
IBTOBI1 ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 27-OCT-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
% ;
+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+8)>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,23)
+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 WRITE ?TAB2,"Pre-Cert Phone: ",PHON
+20 WRITE !?TAB," Subsc.: ",$PIECE(IBINS,"^",17)
+21 WRITE ?TAB2," Type: ",$EXTRACT($PIECE($GET(^IBE(355.1,+$PIECE($GET(^IBA(355.3,+$PIECE(IBINS,"^",18),0)),"^",9),0)),"^"),1,18)
+22 WRITE !?TAB," Subsc. ID: ",$PIECE(IBINS,"^",2)
+23 WRITE ?TAB2," Group: ",$$GRP^IBCNS($PIECE(IBINS,"^",18))
+24 WRITE !?TAB," Coord Ben: ",$EXTRACT($$EXPAND^IBTRE(2.312,.2,$PIECE(IBINS,"^",20)),1,18)
+25 WRITE ?TAB2," Billing Phone: ",PHON2
+26 WRITE !,?TAB,"Filing Time Fr: ",$$EXPAND^IBTRE(36,.12,$PIECE($GET(^DIC(36,+IBINS,0)),"^",12))
+27 WRITE ?TAB2," Claims Phone: ",PHON3
+28 SET X=$PIECE($GET(IBINS(IBI,1)),"^",8)
IF X'=""
WRITE !," Policy Comment: "
IF ($LENGTH(X)+23)>IOM
WRITE !
WRITE " ",X
+29 DO COMM(+$PIECE(IBINS,"^",18))
+30 IF IBQUIT
QUIT
+31 WRITE !?30,"-----------------------------------"
End DoDot:1
IF IBQUIT
QUIT
+32 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
+2 SET IBDGCR=$GET(^DGCR(399,+$PIECE(IBTRND,"^",11),0))
SET IBDGCRU1=$GET(^("U1"))
SET IBDGCRU=$GET(^("U"))
+3 SET IBAMNT=$$BILLD^IBTRED1(IBTRN)
+4 SET IBD(1,1)=" Initial Bill: "_$PIECE(IBDGCR,"^")
+5 SET IBD(2,1)=" Bill Status: "_$EXTRACT($$EXPAND^IBTRE(399,.13,$PIECE(IBDGCR,"^",13)),1,14)
+6 SET IBD(3,1)=" Total Charges: $ "_$JUSTIFY($PIECE(IBAMNT,"^"),8)
+7 SET IBD(4,1)=" Amount Paid: $ "_$JUSTIFY($PIECE(IBAMNT,"^",2),8)
+8 ;
+9 IF $PIECE(IBTRND,"^",19)
SET IBD(5,1)="Reason Not Billable: "_$$EXPAND^IBTRE(356,.19,$PIECE(IBTRND,"^",19))
SET IBD(6,1)="Additional Comment: "_$PIECE(IBTRND1,"^",8)
+10 ;
+11 SET IBD(1,2)="Estimated Recv (Pri): $ "_$JUSTIFY($PIECE(IBTRND,"^",21),8)
+12 SET IBD(2,2)="Estimated Recv (Sec): $ "_$JUSTIFY($PIECE(IBTRND,"^",22),8)
+13 SET IBD(3,2)="Estimated Recv (ter): $ "_$JUSTIFY($PIECE(IBTRND,"^",23),8)
+14 SET IBD(4,2)=" Means Test Charges: $ "_$JUSTIFY($PIECE(IBTRND,"^",28),8)
+15 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)
+16 IF 'IBQUIT
WRITE !?4,$TRANSLATE($JUSTIFY(" ",IOM-8)," ","-"),!
+17 QUIT
+18 ;
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
