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