- 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 Feb 18, 2025@23:53:40 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
