- 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
