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

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

initial load of FOIAVistA 6/30/08 version

File size: 5.8 KB
Line 
1IBRFN4 ;ALB/TMK - Supported functions for AR/IB DATA EXTRACT ;15-FEB-2005
2 ;;2.0;INTEGRATED BILLING;**301,305,389**;21-MAR-94;Build 6
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5IBAREXT(IBIFN,IBD) ; Returns data for claim IBIFN for IB/AR Extract
6 ; Data returned (pieces):
7 ; 1-MEDICARE Status (0=not MRA secondary, 1=MRA secondary)
8 ; 2-Last MRA requested date "S";7 (7 - INTERNAL)
9 ; 3-Last Electronic extract date "TX";2 (21 - INTERNAL)
10 ; 4-Printed via EDI "TX";7 (26 - EXTERNAL)
11 ; 5-Force Claim to Print "TX";8 (27 - EXTERNAL)
12 ; 6-Claim MRA Status "TX";5 (24 - EXTERNAL)
13 ; 7-MRA recorded date "TX";3 (22 - INTERNAL)
14 ; 8-Bill cancelled date "S";17 (17 - INTERNAL)
15 ; 9-form type 0;19 (.19 - EXTERNAL)
16 ; 10-Current Payer $$CURR^IBCEF2(IBIFN) returns IEN;NAME (file 36)
17 ; 11-DRG 0;8==> file 45 (9 - EXTERNAL)
18 ; 12-ECME # "M1";8 (460 - EXTERNAL)
19 ; 13-NON-VA Facility
20 ; 14-#Days Site Not Responsible for MRA ($$DAYS(IBIFN))
21 ; 15-National VA id number for Ins Verification (365.12;.02 - INTERNAL)
22 ; 16-Payer name (file 365.12;.01)
23 ; 17-Offset Amount (202-INTERNAL)
24 ;
25 ; IBD("PRD",seq #)=prosthetic item name^date^bill ien
26 ; IBD("IN")= TYPE OF PLAN NAME ^ GROUP NUMBER ^ RELATIONSHIP TO INSURED
27 ; ^ SOURCE OF INFO ^ EDI ID NUMBER - INST ^ EDI ID NUMBER - PROF
28 ; ^ INSURANCE REIMBURSE
29 ; IBD("IN","MMA")= MAILING STREET ADDRESS [LINE 1] ^
30 ; ^ MAILING STREET ADDRESS [LINE 2] ^ CITY ^ STATE NAME ^ ZIP
31 ;
32 N IB,IBI,IBJ,IBK,IBX,IBNODE,IBTMP,IBIN,Z
33 F IBNODE=0,"S","TX","M","U1" S IB(IBNODE)=$G(^DGCR(399,IBIFN,IBNODE))
34 S IBD=$S($$MRASEC^IBCEF4(IBIFN):1,1:0)
35 S $P(IBD,U,2)=$P(IB("S"),U,7),$P(IBD,U,3)=$P(IB("TX"),U,2)
36 S $P(IBD,U,4)=$$GET1^DIQ(399,IBIFN_",",26,"E"),$P(IBD,U,5)=$$GET1^DIQ(399,IBIFN_",",27,"E")
37 S $P(IBD,U,6)=$$GET1^DIQ(399,IBIFN_",",24,"E"),$P(IBD,U,7)=$P(IB("TX"),U,3)
38 S $P(IBD,U,8)=$P(IB("S"),U,17),$P(IBD,U,9)=$$GET1^DIQ(399,IBIFN_",",.19,"E")
39 S Z=$$CURR^IBCEF2(IBIFN),$P(IBD,U,10)=Z_$S(Z:";"_$P($G(^DIC(36,Z,0)),U),1:"")
40 S Z=$P($G(^DIC(36,+Z,3)),U,10),$P(IBD,U,15)=$P($G(^IBE(365.12,+Z,0)),U,2),$P(IBD,U,16)=$P($G(^(0)),U)
41 S Z=$P(IB(0),U,8),$P(IBD,U,11)=$S(Z:$$GET1^DIQ(45,Z_",",9,"E"),1:"")
42 S $P(IBD,U,12)=$$GET1^DIQ(399,IBIFN_",",460,"E")
43 S Z=$P($G(^DGCR(399,IBIFN,"U2")),U,10),$P(IBD,U,13)=$S(Z:$P($G(^IBA(355.93,Z,0)),U,1),1:"")
44 ;
45 S $P(IBD,U,14)=$$DAYS(IBIFN)
46 S $P(IBD,U,17)=$P(IB("U1"),U,2)
47 ;
48 K IBTMP D SET^IBCSC5B(IBIFN,.IBTMP)
49 S (IBI,IBJ)=0 F S IBI=$O(IBTMP(IBI)) Q:'IBI D
50 . S IBK=0 F S IBK=$O(IBTMP(IBI,IBK)) Q:'IBK D
51 .. S IBX=IBTMP(IBI,IBK)
52 .. S IBJ=IBJ+1
53 .. S IBD("PRD",IBJ)=$$PINB^IBCSC5B(+IBX)_U_IBI_U_+IBTMP
54 ;
55 S Z=" ",IBD("IN")="",DFN=+$P(IB(0),U,2)
56 F S Z=$O(^DPT(DFN,.312,Z),-1) Q:Z="" D Q:Z=""
57 . S IBIN=$G(^DPT(DFN,.312,Z,0))
58 . I +IB("M")=+IBIN D
59 .. N IBQ,IBP
60 .. S IBP=+$P(IBIN,U,18),IBQ=$G(^IBA(355.3,+IBP,0))
61 .. S IBD("IN")=$S($P(IBQ,U,9):$$GET1^DIQ(355.3,IBP_",",.09,"E"),1:"")_U_$P(IBQ,U,4)_U_$P(IBIN,U,6)_U_$P($G(^DPT(DFN,.312,Z,1)),U,9)
62 .. S Z=""
63 ;
64 S Z=$G(^DIC(36,+IB("M"),3))
65 S $P(IBD("IN"),U,5)=$P(Z,U,4),$P(IBD("IN"),U,6)=$P(Z,U,2)
66 S $P(IBD("IN"),U,7)=$$GET1^DIQ(36,+IB("M")_",",1,"I")
67 S Z=$G(^DIC(36,+IB("M"),.11))
68 S IBD("IN","MMA")=$P(Z,U,1)_U_$P(Z,U,2)_U_$P(Z,U,4)_U_$S($P(Z,U,5):$P($G(^DIC(5,$P(Z,U,5),0)),U,1),1:"")_U_$P(Z,U,6)
69 ;
70 Q IBD
71 ;
72IBACT(IBIFN,IBARRY) ; Returns IB actions for bill ien IBIFN
73 ;IBARRY should be passed by reference and returns:
74 ;
75 ; IBARRY(seq)=AR bill #^reference #^external STATUS^IB ACTION TYPE NAME
76 ; ^UNITS^TOTAL CHARGE^DT BILLD FROM^DT BILLD TO^AR BILL IEN
77 ; ^DT ENTRY ADDED^PATIENT SSN^EVENT DATE^RESULTING FROM
78 ; ^INSTITUTION IEN
79 ;
80 N IBNA,IB,IB0,DFN,IBCT,Z
81 S IBNA=$$BN1^PRCAFN(IBIFN),IB="",IBCT=0
82 F S IB=$O(^IB("ABIL",IBNA,IB)) Q:IB="" D
83 . S IBCT=IBCT+1
84 . S IB0=$G(^IB(IB,0))
85 . I $G(DFN)="" S DFN=$P(IB0,U,2)
86 . ;
87 . S IBARRY=IBNA_U_$P(IB0,U,1)_U_$$GET1^DIQ(350,IB_",",.05,"E")
88 . S Z=$P(IB0,U,3)
89 . S IBARRY=IBARRY_U_$S(Z'="":$P($G(^IBE(350.1,Z,0)),U,1),1:"")
90 . S IBARRY=IBARRY_U_$P(IB0,U,6) ; UNITS
91 . S IBARRY=IBARRY_U_$P(IB0,U,7) ; TOTAL CHARGE
92 . S IBARRY=IBARRY_U_$P(IB0,U,14) ; DT BILLD FROM
93 . S IBARRY=IBARRY_U_$P(IB0,U,15) ; DT BILLD TO
94 . S IBARRY=IBARRY_U_$P(IB0,U,11) ; AR BILL #
95 . S IBARRY=IBARRY_U_$P($P($G(^IB(IB,1)),U,2),".",1) ; DT ENTRY ADDED
96 . S IBARRY=IBARRY_U_$P(^DPT(DFN,0),U,9) ; SSN
97 . S IBARRY=IBARRY_U_$P(IB0,U,17) ; EVENT DT
98 . S IBARRY=IBARRY_U_$P(IB0,U,4) ;RESULTING FROM
99 . S IBARRY=IBARRY_U_$P(IB0,U,13) ; Institution
100 . S IBARRY(IBCT)=IBARRY,IBARRY=""
101 Q
102 ;
103PREREG(IBBDT,IBEDT) ;Returns Pre-registration data
104 N IBDATA
105 S IBDATA=$$IBAR^IBJDIPR(IBBDT,IBEDT)
106 Q IBDATA
107 ;
108BUFFER(IBBDT,IBEDT) ;Returns Buffer data
109 N IBDATA
110 S IBDATA=$$IBAR^IBCNBOA(IBBDT,IBEDT)
111 Q IBDATA
112 ;
113DAYS(IBIFN) ; Returns # days site not responsible for MRA
114 N X,X1,X2,D0
115 S X="" ;No. of days
116 G:'$P(IBD,U,2) DAYSQ
117 S X2=$P(IBD,U,2) ;MRA Request Date
118 S X1=$P(IBD,U,7) ;MRA Recorded Date
119 G:'$$MRASEC^IBCEF4(IBIFN) DAYSQ ; Not MEDICARE secondary
120 I 'X1!(X1<X2) S X1=DT
121 D ^%DTC
122DAYSQ Q X
123 ;
124REJ(IBIFN) ; Returns 1 if any rejects found for MRA secondary claim or for
125 ; any preceding claims it was cancelled/cloned from
126 N X,Y,I,X1,X2,X3,D0,CURSEQ
127 S Y=0 ;Y=REJECT FLAG
128 G:'$$MRASEC^IBCEF4(IBIFN) REJQ ; Not MEDICARE secondary
129 S CURSEQ=$$COBN^IBCEF(IBIFN),X1=+$P($G(^DGCR(399,IBIFN,0)),U,15)
130 S D0=IBIFN
131 F D Q:'D0!Y
132 . ; claim copied from not cancelled and not MRA secondary claim
133 . I X1,$P($G(^DGCR(399,X1,0)),U,13)'=7,X1'=IBIFN S D0="" Q
134 . I X1,$P($G(^DGCR(399,X1,0)),U,19)'=$P($G(^DGCR(399,D0,0)),U,19) S D0="" Q
135 . S I=0 F S I=$O(^IBM(361,"B",D0,I)) Q:'I D Q:Y
136 .. S X2=$G(^IBM(361,I,0))
137 .. Q:$P(X2,U,3)'="R"!'$P(X2,U,11) ;No reject or no transmit bill
138 .. S X3=$TR($P($G(^IBA(364,+$P(X2,U,11),0)),U,8),"PST","123") ;status msg seq
139 .. Q:X3'=(CURSEQ-1)
140 .. S Y=1
141 . I 'Y S D0=X1,X1=+$P($G(^DGCR(399,X1,0)),U,15) S:X1=D0 D0="" Q
142REJQ Q Y
Note: See TracBrowser for help on using the repository browser.