- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTOBI1.m
r613 r623 1 IBTOBI1 ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ;27-OCT-93 2 ;;2.0;INTEGRATED BILLING;**276,377**;21-MAR-94;Build 23 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 % ; 6 F IBTAG="INS","BI","SC","CLIN^IBTOBI4","IR^IBTOBI2","HR^IBTOBI3" D @IBTAG Q:IBQUIT 7 Q 8 ; 9 INS ; -- print ins. stuff 10 N TAB,TAB2,IBALLIN,IBDT,IBINS,IBCNT,I,X,IBI,PHON,PHON2,PHON3,P,IBI 11 S TAB=5,TAB2=45,IBALLIN=1 12 S IBDT=$P(IBTRND,"^",6) 13 I '$G(IBDT) S IBDT=DT 14 W !," Insurance Information " 15 ; 16 D ALL^IBCNS1(DFN,"IBINS",1,IBDT) 17 I $G(IBINS(0))<1 W !,?TAB,"No Insurance Information",!!! G INSQ 18 S IBI=0,IBCNT=0 F S IBI=$O(IBINS(IBI)) Q:'IBI!(IBQUIT) S IBINS=IBINS(IBI,0) D Q:IBQUIT 19 .S IBCNT=IBCNT+1 20 .I ($Y+8)>IOSL D HDR^IBTOBI Q:IBQUIT 21 .I IBCNT>1 W ! 22 .W !?TAB," Ins. Co "_IBCNT_": ",$E($P($G(^DIC(36,+IBINS,0)),"^"),1,23) 23 .S X=$G(^DIC(36,+IBINS,.13)) 24 .S PHON=$S($P(X,"^",3)'="":$P(X,"^",3),1:$P(X,"^")) 25 .S PHON2=$S($P(X,"^",2)'="":$P(X,"^",2),1:$P(X,"^")) 26 .S P=$S($P(IBETYP,"^",3)=1:5,$P(IBETYP,"^",3)=2:6,$P(IBETYP,"^",3)=3:11,1:1) 27 .S PHON3=$S($P(X,"^",P)'="":$P(X,"^",P),1:$P(X,"^")) 28 .W ?TAB2,"Pre-Cert Phone: ",PHON 29 .W !?TAB," Subsc.: ",$P(IBINS,"^",17) 30 .W ?TAB2," Type: ",$E($P($G(^IBE(355.1,+$P($G(^IBA(355.3,+$P(IBINS,"^",18),0)),"^",9),0)),"^"),1,18) 31 .W !?TAB," Subsc. ID: ",$P(IBINS,"^",2) 32 .W ?TAB2," Group: ",$$GRP^IBCNS($P(IBINS,"^",18)) 33 .W !?TAB," Coord Ben: ",$E($$EXPAND^IBTRE(2.312,.2,$P(IBINS,"^",20)),1,18) 34 .W ?TAB2," Billing Phone: ",PHON2 35 .W !,?TAB,"Filing Time Fr: ",$$EXPAND^IBTRE(36,.12,$P($G(^DIC(36,+IBINS,0)),"^",12)) 36 .W ?TAB2," Claims Phone: ",PHON3 37 .S X=$P($G(IBINS(IBI,1)),"^",8) I X'="" W !," Policy Comment: " W:($L(X)+23)>IOM ! W " ",X 38 .D COMM(+$P(IBINS,"^",18)) 39 .Q:IBQUIT 40 .W !?30,"-----------------------------------" 41 W:'IBQUIT !?4,$TR($J(" ",IOM-8)," ","-"),! 42 INSQ Q 43 ; 44 BI ; -- print billing information 45 Q:$D(IBCTHDR) 46 I ($Y+8)>IOSL D HDR^IBTOBI Q:IBQUIT 47 BI1 W !," Billing Information " 48 N IBDGCR,IBDGCRU1,IBDGCRU,IBAMNT,IBD,I,IBIFN,IBLN,IBECME 49 S IBIFN=+$P(IBTRND,"^",11) 50 S IBDGCR=$G(^DGCR(399,IBIFN,0)),IBDGCRU1=$G(^("U1")),IBDGCRU=$G(^("U")) 51 S IBECME=$P($P($G(^DGCR(399,IBIFN,"M1")),U,8),";") 52 S IBAMNT=$$BILLD^IBTRED1(IBTRN) 53 S IBLN=0 54 S IBLN=IBLN+1,IBD(IBLN,1)=" Initial Bill: "_$P(IBDGCR,U,1) 55 I IBECME D 56 . S IBD(IBLN,1)=IBD(IBLN,1)_"e" 57 . S IBLN=IBLN+1,IBD(IBLN,1)=" ECME Number: "_IBECME 58 S IBLN=IBLN+1,IBD(IBLN,1)=" Bill Status: "_$E($$EXPAND^IBTRE(399,.13,$P(IBDGCR,U,13)),1,14) 59 S IBLN=IBLN+1,IBD(IBLN,1)=" Total Charges: $ "_$J($P(IBAMNT,"^"),8) 60 S IBLN=IBLN+1,IBD(IBLN,1)=" Amount Paid: $ "_$J($P(IBAMNT,"^",2),8) 61 ; 62 I $P(IBTRND,U,19) D 63 . S IBLN=IBLN+1,IBD(IBLN,1)="Reason Not Billable: "_$$EXPAND^IBTRE(356,.19,$P(IBTRND,U,19)) 64 . S IBLN=IBLN+1,IBD(IBLN,1)="Additional Comment: "_$P(IBTRND1,U,8) 65 . Q 66 ; 67 I '$P(IBTRND,U,19),$L($P(IBTRND1,U,8))>0 S IBLN=IBLN+1,IBD(IBLN,1)="Additional Comment: "_$P(IBTRND1,U,8) 68 ; 69 S IBD(1,2)="Estimated Recv (Pri): $ "_$J($P(IBTRND,"^",21),8) 70 S IBD(2,2)="Estimated Recv (Sec): $ "_$J($P(IBTRND,"^",22),8) 71 S IBD(3,2)="Estimated Recv (ter): $ "_$J($P(IBTRND,"^",23),8) 72 S IBD(4,2)=" Means Test Charges: $ "_$J($P(IBTRND,"^",28),8) 73 ; 74 S I=0 F S I=$O(IBD(I)) Q:'I W !,$G(IBD(I,1)),?39,$E($G(IBD(I,2)),1,36) 75 W:'IBQUIT !,?4,$TR($J(" ",IOM-8)," ","-") 76 Q 77 ; 78 SC ; -- print SC information 79 I ($Y+7)>IOSL D HDR^IBTOBI Q:IBQUIT 80 N VAEL,TAB,IBTRCSC 81 D ELIG^VADPT 82 W !!," Eligibility Information" 83 W !," Primary Eligibility: "_$P(VAEL(1),"^",2) 84 W !," Means Test Status: "_$P(VAEL(9),"^",2) 85 W !," Service Connected Percent: "_$S(+VAEL(3):+$P(VAEL(3),"^",2)_"%",1:"") 86 I 'VAEL(3) W "Patient Not Service Connected",!! G SCQ 87 S TAB=5,IBTRCSC=1 D SC^IBTOAT2 88 SCQ W:'IBQUIT !?4,$TR($J(" ",IOM-8)," ","-"),! 89 Q 90 ; 91 COMM(DA) ; -- print comments from GROUP plans. 92 Q:IBQUIT 93 W !,"Group Plan Comments: " 94 Q:'$D(^IBA(355.3,DA,11)) 95 K ^UTILITY($J,"W") 96 S DIWL=10,DIWR=IOM-12,DIWF="W" 97 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 98 Q:IBQUIT 99 D ^DIWW 100 K ^UTILITY($J,"W") 101 Q 1 IBTOBI1 ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ;27-OCT-93 2 ;;2.0;INTEGRATED BILLING;**276**;21-MAR-94 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 ; 5 % ; 6 F IBTAG="INS","BI","SC","CLIN^IBTOBI4","IR^IBTOBI2","HR^IBTOBI3" D @IBTAG Q:IBQUIT 7 Q 8 ; 9 INS ; -- print ins. stuff 10 N TAB,TAB2,IBALLIN,IBDT,IBINS,IBCNT,I,X,IBI,PHON,PHON2,PHON3,P,IBI 11 S TAB=5,TAB2=45,IBALLIN=1 12 S IBDT=$P(IBTRND,"^",6) 13 I '$G(IBDT) S IBDT=DT 14 W !," Insurance Information " 15 ; 16 D ALL^IBCNS1(DFN,"IBINS",1,IBDT) 17 I $G(IBINS(0))<1 W !,?TAB,"No Insurance Information",!!! G INSQ 18 S IBI=0,IBCNT=0 F S IBI=$O(IBINS(IBI)) Q:'IBI!(IBQUIT) S IBINS=IBINS(IBI,0) D Q:IBQUIT 19 .S IBCNT=IBCNT+1 20 .I ($Y+8)>IOSL D HDR^IBTOBI Q:IBQUIT 21 .I IBCNT>1 W ! 22 .W !?TAB," Ins. Co "_IBCNT_": ",$E($P($G(^DIC(36,+IBINS,0)),"^"),1,23) 23 .S X=$G(^DIC(36,+IBINS,.13)) 24 .S PHON=$S($P(X,"^",3)'="":$P(X,"^",3),1:$P(X,"^")) 25 .S PHON2=$S($P(X,"^",2)'="":$P(X,"^",2),1:$P(X,"^")) 26 .S P=$S($P(IBETYP,"^",3)=1:5,$P(IBETYP,"^",3)=2:6,$P(IBETYP,"^",3)=3:11,1:1) 27 .S PHON3=$S($P(X,"^",P)'="":$P(X,"^",P),1:$P(X,"^")) 28 .W ?TAB2,"Pre-Cert Phone: ",PHON 29 .W !?TAB," Subsc.: ",$P(IBINS,"^",17) 30 .W ?TAB2," Type: ",$E($P($G(^IBE(355.1,+$P($G(^IBA(355.3,+$P(IBINS,"^",18),0)),"^",9),0)),"^"),1,18) 31 .W !?TAB," Subsc. ID: ",$P(IBINS,"^",2) 32 .W ?TAB2," Group: ",$$GRP^IBCNS($P(IBINS,"^",18)) 33 .W !?TAB," Coord Ben: ",$E($$EXPAND^IBTRE(2.312,.2,$P(IBINS,"^",20)),1,18) 34 .W ?TAB2," Billing Phone: ",PHON2 35 .W !,?TAB,"Filing Time Fr: ",$$EXPAND^IBTRE(36,.12,$P($G(^DIC(36,+IBINS,0)),"^",12)) 36 .W ?TAB2," Claims Phone: ",PHON3 37 .S X=$P($G(IBINS(IBI,1)),"^",8) I X'="" W !," Policy Comment: " W:($L(X)+23)>IOM ! W " ",X 38 .D COMM(+$P(IBINS,"^",18)) 39 .Q:IBQUIT 40 .W !?30,"-----------------------------------" 41 W:'IBQUIT !?4,$TR($J(" ",IOM-8)," ","-"),! 42 INSQ Q 43 ; 44 BI ; -- print billing information 45 Q:$D(IBCTHDR) 46 I ($Y+8)>IOSL D HDR^IBTOBI Q:IBQUIT 47 BI1 W !," Billing Information " 48 N IBDGCR,IBDGCRU1,IBDGCRU,IBAMNT,IBD,I,IBIFN,IBADD,IBECME 49 S IBIFN=+$P(IBTRND,"^",11) 50 S IBDGCR=$G(^DGCR(399,IBIFN,0)),IBDGCRU1=$G(^("U1")),IBDGCRU=$G(^("U")) 51 S IBECME=$P($P($G(^DGCR(399,IBIFN,"M1")),U,8),";") 52 S IBAMNT=$$BILLD^IBTRED1(IBTRN) 53 S IBADD=0 54 S IBD(1,1)=" Initial Bill: "_$P(IBDGCR,"^") 55 I IBECME D 56 . S IBADD=1 57 . S IBD(1,1)=IBD(1,1)_"e" 58 . S IBD(2,1)=" ECME Number: "_IBECME 59 S IBD(2+IBADD,1)=" Bill Status: "_$E($$EXPAND^IBTRE(399,.13,$P(IBDGCR,"^",13)),1,14) 60 S IBD(3+IBADD,1)=" Total Charges: $ "_$J($P(IBAMNT,"^"),8) 61 S IBD(4+IBADD,1)=" Amount Paid: $ "_$J($P(IBAMNT,"^",2),8) 62 ; 63 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) 64 ; 65 S IBD(1,2)="Estimated Recv (Pri): $ "_$J($P(IBTRND,"^",21),8) 66 S IBD(2,2)="Estimated Recv (Sec): $ "_$J($P(IBTRND,"^",22),8) 67 S IBD(3,2)="Estimated Recv (ter): $ "_$J($P(IBTRND,"^",23),8) 68 S IBD(4,2)=" Means Test Charges: $ "_$J($P(IBTRND,"^",28),8) 69 I $L($P($G(^IBT(356,IBTRN,1)),U,8))>0 S IBD(5,1)="Additional Comment: "_$P($G(^IBT(356,IBTRN,1)),U,8) 70 S I=0 F S I=$O(IBD(I)) Q:'I W !,$G(IBD(I,1)),?39,$E($G(IBD(I,2)),1,36) 71 W:'IBQUIT !,?4,$TR($J(" ",IOM-8)," ","-") 72 Q 73 ; 74 SC ; -- print SC information 75 I ($Y+7)>IOSL D HDR^IBTOBI Q:IBQUIT 76 N VAEL,TAB,IBTRCSC 77 D ELIG^VADPT 78 W !!," Eligibility Information" 79 W !," Primary Eligibility: "_$P(VAEL(1),"^",2) 80 W !," Means Test Status: "_$P(VAEL(9),"^",2) 81 W !," Service Connected Percent: "_$S(+VAEL(3):+$P(VAEL(3),"^",2)_"%",1:"") 82 I 'VAEL(3) W "Patient Not Service Connected",!! G SCQ 83 S TAB=5,IBTRCSC=1 D SC^IBTOAT2 84 SCQ W:'IBQUIT !?4,$TR($J(" ",IOM-8)," ","-"),! 85 Q 86 ; 87 COMM(DA) ; -- print comments from GROUP plans. 88 Q:IBQUIT 89 W !,"Group Plan Comments: " 90 Q:'$D(^IBA(355.3,DA,11)) 91 K ^UTILITY($J,"W") 92 S DIWL=10,DIWR=IOM-12,DIWF="W" 93 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 94 Q:IBQUIT 95 D ^DIWW 96 K ^UTILITY($J,"W") 97 Q
Note:
See TracChangeset
for help on using the changeset viewer.
