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

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

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1IBCBB7 ;ALB/BGA - CONT. OF MEDICARE EDIT CHECKS ;09/10/98
2 ;;2.0;INTEGRATED BILLING;**51,137,240**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; Revenue Codes
6 ;
7 ; rev codes must be between 100 AND 999
8 I $O(IBREV1(100),-1)>0!($O(IBREV1(999))>0) S IBQUIT=$$IBER^IBCBB3(.IBER,184) Q:IBQUIT
9 N IBRATYP
10 ;
11 ; ibrev1(rev cd,seq #)=Rev code^ptr cpt^unit chg^units^total^tot unc^^^mod ptrs
12 ; 3 subsection edits
13 ;
14 D F^IBCEF("N-BILL RATE TYPE","IBZ",,IBIFN)
15 ; Don't apply some edits unless specific rate types
16 S IBZ=$P($G(^DGCR(399.3,+IBZ,0)),U)
17 S IBRATYP=$S(IBZ="":1,IBZ["TRICARE"!(IBZ["CHAMPVA")!(IBZ["SHARING")!(IBZ["REIMBURS"):1,1:0)
18 S IBREVC=0 F S IBREVC=$O(IBREV1(IBREVC)) Q:IBREVC="" D Q:IBQUIT
19 . S IBI=0
20 . F S IBI=$O(IBREV1(IBREVC,IBI)) Q:'IBI D Q:IBQUIT
21 . . ;
22 . . S IBREVD=IBREV1(IBREVC,IBI),IBREVC12=$E(IBREVC,1,2),IBBCPT=$P(IBREVD,U,2)
23 . . ;
24 . . ; No charge associated with rev code
25 . . I '$P(IBREVD,U,3),IBREVC12'=18 S IBQUIT=$$IBER^IBCBB3(.IBER,185) Q:IBQUIT
26 . . ;
27 . . ; Charges cannot be negative dollar amounts
28 . . I $P(IBREVD,U,5)<0 S IBQUIT=$$IBER^IBCBB3(.IBER,213) Q:IBQUIT
29 . . ;
30 . . ; Non Covered charges cannot be a negative amount
31 . . ; and must not be > total charge
32 . . I $P(IBREVD,U,6)>$P(IBREVD,U,5)!($P(IBREVD,U,6)<0) S IBQUIT=$$IBER^IBCBB3(.IBER,214) Q:IBQUIT
33 . . ;
34 . . ; =====
35 . . ; Accommodation revenue code edits
36 . . I IBREV1(IBREVC)="AC" D Q
37 . . . N IBBSEC
38 . . . ; dup Rev accom cds must have diff rates and bedsections
39 . . . S IBBSEC=$P($G(^DGCR(399,IBIFN,"RC",+$P(IBREVD,U,8),0)),U,5)
40 . . . I $O(IBREV1(IBREVC,1)) D Q:IBQUIT
41 . . . . I IBI=1 K IBREVDUP S IBREVDUP(+$P(IBREVD,U,3)_" "_IBBSEC)=""
42 . . . . I IBI>1,$D(IBREVDUP(+$P(IBREVD,U,3)_" "_IBBSEC)) S IBQUIT=$$IBER^IBCBB3(.IBER,186)
43 . . . ; Total Line charges for accom rev codes can not be < 0
44 . . . I IBREVC>99,IBREVC<220,IBREVTOT("AC")<0 S IBQUIT=$$IBER^IBCBB3(.IBER,211)
45 . . . ; For accom rev codes, detail charge for revc=18x must be 0
46 . . . I IBREVC12=18,$P(IBREV1(IBREVC,IBI),U,3) S IBQUIT=$$IBER^IBCBB3(.IBER,212)
47 . . ;
48 . . ; =====
49 . . ; Inpatient Ancillary only Rev Codes edit 60-4
50 . . I IBREV1(IBREVC)="AI" D Q
51 . . . ; Cannot have dup anc REV codes except 24X
52 . . . N IBMOD
53 . . . S IBMOD=$P(IBREVD,U,9)
54 . . . ;I IBRATYP,IBI>1,IBREVC12'=24 S IBQUIT=$$IBER^IBCBB3(.IBER,188)
55 . . . ;
56 . . . ;HCPCS code is required for rev code 636 and TOB 13X, 14X, 83X
57 . . . I IBREVC=636,IBBCPT="",(IBTOB12=13!(IBTOB12=14)!(IBTOB12=83)) S IBQUIT=$$IBER^IBCBB3(.IBER,191)
58 . . . ;
59 . . ; =====
60 . . ; OUTPATIENT ANCILLARY only Rev Codes edit rec 61-04
61 . . I IBREV1(IBREVC)="AO" D Q
62 . . . ;
63 . . . ; Rev codes with different HCPCS codes can be duplicated
64 . . . I $$FT^IBCEF(IBIFN)=3,$O(IBREV1(IBREVC,1)) D Q:IBQUIT
65 . . . . N IBMOD
66 . . . . S IBMOD=$P(IBREVD,U,9)
67 . . . . I IBI=1 K IBREVDUP S IBREVDUP(IBBCPT_" "_IBMOD)=""
68 . . . . I '$$ISRX^IBCEF1(IBIFN),IBI>1,$D(IBREVDUP(IBBCPT_" "_IBMOD)),IBER'["IB192;" S IBQUIT=$$IBER^IBCBB3(.IBER,192)
69 . . . ;
70 . . . ; Rev Code 49x can not be entered with 36x and 37x
71 . . . I IBREVC12=49,$O(IBREV1(380),-1)'<360 S IBQUIT=$$IBER^IBCBB3(.IBER,195) Q:IBQUIT
72 . . . ;
73 . . . ; If Rev=42x & billtype=83x!13x req occ cds 11&35 and val code 50
74 . . . ;I IBREVC12=42,(IBTOB12=83!(IBTOB12=13)) D Q:IBQUIT
75 . . . ;. I '$D(IBVALCD(50))!'$D(IBOCCD(11))!'$D(IBOCCD(35)) S IBQUIT=$$IBER^IBCBB3(.IBER,196)
76 . . . ;
77 . . . ; If Rev=43x & billtype=83x!13x req occ cds 11&44 and val code 51
78 . . . ;I IBREVC12=43,(IBTOB12=83!(IBTOB12=13)) D
79 . . . ;. I '$D(IBVALCD(51))!'$D(IBOCCD(11))!'$D(IBOCCD(44)) S IBQUIT=$$IBER^IBCBB3(.IBER,197)
80 . . . ;
81 . . . ; If Rev=44x & billtype=83x!13x req occ cds 11&45 and val code 52
82 . . . ;I IBREVC12=44,(IBTOB12=83!(IBTOB12=13)) D
83 . . . ;. I '$D(IBVALCD(52))!'$D(IBOCCD(11))!'$D(IBOCCD(45)) S IBQUIT=$$IBER^IBCBB3(.IBER,198)
84 . . . ;
85 . . . ; If Rev=943 & billtype=83x!13x req occ cds 11&46 and val code 53
86 . . . ;I IBREVC=943,(IBTOB12=83!IBTOB12=13) D
87 . . . ;. I '$D(IBVALCD(53))!('$D(IBOCCD(11)))!('$D(IBOCCD(46))) S IBQUIT=$$IBER^IBCBB3(.IBER,199)
88 . . . ;
89 . . . ; If Rev=403 & bill type=14x!23x and service date >= 01-01-91
90 . . . ; require only HCPCS codes 76092 and no other rev codes
91 . . . I IBREVC=403,IBFDT'<2910101,(IBTOB12=14!(IBTOB12=23)) D
92 . . . . I $O(IBREV1(403))!$O(IBREV1(403),-1)!(IBBCPT'=76092) S IBQUIT=$$IBER^IBCBB3(.IBER,194) Q
93 . . . ;
94 . . . ; If Rev=401 & bill type=13x!14x!23x!71x allow only HCPSCS codes
95 . . . ; 76090 or 78091
96 . . . ;I IBREVC=401,(IBTOB12=13!(IBTOB12=14)!(IBTOB12=23)!(IBTOB12=71)),IBBCPT'="",IBBCPT'=76090,IBBCPT'=78091 S IBQUIT=$$IBER^IBCBB3(.IBER,201)
97 . . . ;
98 . . . ; Rev code cannot equal 227 or 29x
99 . . . ;I IBREVC=227!(IBREVC12=29) S IBQUIT=$$IBER^IBCBB3(.IBER,202)
100 . . . D REVC^IBCBB7A(IBREVD,IBREVC,IBBCPT,IBREVC12,.IBER)
101 Q:IBQUIT
102 ;
103 D ^IBCBB8
104 Q
Note: See TracBrowser for help on using the repository browser.