source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTOBI1.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1IBTOBI1 ;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 ;
9INS ; -- 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)," ","-"),!
42INSQ Q
43 ;
44BI ; -- print billing information
45 Q:$D(IBCTHDR)
46 I ($Y+8)>IOSL D HDR^IBTOBI Q:IBQUIT
47BI1 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 ;
78SC ; -- 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
88SCQ W:'IBQUIT !?4,$TR($J(" ",IOM-8)," ","-"),!
89 Q
90 ;
91COMM(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
Note: See TracBrowser for help on using the repository browser.