Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCBB7

IBCBB7.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; Revenue Codes
  1.  ;
  1.  ; MRD;IB*2.0*516 - Remove check; allow any revenue code.
  1.  ;; rev codes must be between 100 AND 999
  1.  ;I $O(IBREV1(100),-1)>0!($O(IBREV1(999))>0) S IBQUIT=$$IBER^IBCBB3(.IBER,184) Q:IBQUIT
  1.  ;
  1.  N IBRATYP
  1.  ;
  1.  ; ibrev1(rev cd,seq #)=Rev code^ptr cpt^unit chg^units^total^tot unc^^^mod ptrs
  1.  ; 3 subsection edits
  1.  ;
  1.  D F^IBCEF("N-BILL RATE TYPE","IBZ",,IBIFN)
  1.  ; Don't apply some edits unless specific rate types
  1.  S IBZ=$P($G(^DGCR(399.3,+IBZ,0)),U)
  1.  S IBRATYP=$S(IBZ="":1,IBZ["TRICARE"!(IBZ["CHAMPVA")!(IBZ["SHARING")!(IBZ["REIMBURS"):1,1:0)
  1.  S IBREVC=0 F  S IBREVC=$O(IBREV1(IBREVC)) Q:IBREVC=""  D  Q:IBQUIT
  1.  . S IBI=0
  1.  . F  S IBI=$O(IBREV1(IBREVC,IBI)) Q:'IBI  D  Q:IBQUIT
  1.  . . ;
  1.  . . S IBREVD=IBREV1(IBREVC,IBI),IBREVC12=$E(IBREVC,1,2),IBBCPT=$P(IBREVD,U,2)
  1.  . . ;
  1.  . . ; IB*2.0*447/TAZ Removed this error so that zero dollar revenue codes can process on the 837
  1.  . . ; No charge associated with rev code
  1.  . . ;I '$P(IBREVD,U,3),IBREVC12'=18 S IBQUIT=$$IBER^IBCBB3(.IBER,185) Q:IBQUIT
  1.  . . ;
  1.  . . ; Charges cannot be negative dollar amounts
  1.  . . I $P(IBREVD,U,5)<0 S IBQUIT=$$IBER^IBCBB3(.IBER,213) Q:IBQUIT
  1.  . . ;
  1.  . . ; Non Covered charges cannot be a negative amount
  1.  . . ;     and must not be > total charge
  1.  . . I $P(IBREVD,U,6)>$P(IBREVD,U,5)!($P(IBREVD,U,6)<0) S IBQUIT=$$IBER^IBCBB3(.IBER,214) Q:IBQUIT
  1.  . . ;
  1.  . . ; =====
  1.  . . ; Accommodation revenue code edits
  1.  . . I IBREV1(IBREVC)="AC" D  Q
  1.  . . . N IBBSEC
  1.  . . . ; dup Rev accom cds must have diff rates and bedsections
  1.  . . . S IBBSEC=$P($G(^DGCR(399,IBIFN,"RC",+$P(IBREVD,U,8),0)),U,5)
  1.  . . . I $O(IBREV1(IBREVC,1)) D  Q:IBQUIT
  1.  . . . . I IBI=1 K IBREVDUP S IBREVDUP(+$P(IBREVD,U,3)_" "_IBBSEC)=""
  1.  . . . . I IBI>1,$D(IBREVDUP(+$P(IBREVD,U,3)_" "_IBBSEC)) S IBQUIT=$$IBER^IBCBB3(.IBER,186)
  1.  . . . ; Total Line charges for accom rev codes can not be < 0
  1.  . . . I IBREVC>99,IBREVC<220,IBREVTOT("AC")<0 S IBQUIT=$$IBER^IBCBB3(.IBER,211)
  1.  . . . ; For accom rev codes, detail charge for revc=18x must be 0
  1.  . . . I IBREVC12=18,$P(IBREV1(IBREVC,IBI),U,3) S IBQUIT=$$IBER^IBCBB3(.IBER,212)
  1.  . . ;
  1.  . . ; =====
  1.  . . ; Inpatient Ancillary only Rev Codes edit 60-4
  1.  . . I IBREV1(IBREVC)="AI" D  Q
  1.  . . . ; Cannot have dup anc REV codes except 24X
  1.  . . . N IBMOD
  1.  . . . S IBMOD=$P(IBREVD,U,9)
  1.  . . . ;I IBRATYP,IBI>1,IBREVC12'=24 S IBQUIT=$$IBER^IBCBB3(.IBER,188)
  1.  . . . ;
  1.  . . . ;HCPCS code is required for rev code 636 and TOB 13X, 14X, 83X
  1.  . . . I IBREVC=636,IBBCPT="",(IBTOB12=13!(IBTOB12=14)!(IBTOB12=83)) S IBQUIT=$$IBER^IBCBB3(.IBER,191)
  1.  . . . ;
  1.  . . ; =====
  1.  . . ; OUTPATIENT ANCILLARY only Rev Codes edit rec 61-04
  1.  . . I IBREV1(IBREVC)="AO" D  Q
  1.  . . . ;
  1.  . . . ; Rev codes with different HCPCS codes can be duplicated => baa ; 488 ; removed to allow splitting.
  1.  . . . ;I $$FT^IBCEF(IBIFN)=3,$O(IBREV1(IBREVC,1))  D  Q:IBQUIT
  1.  . . . ;. N IBMOD
  1.  . . . ;. S IBMOD=$P(IBREVD,U,9)
  1.  . . . ;. I IBI=1 K IBREVDUP S IBREVDUP(IBBCPT_" "_IBMOD)=""
  1.  . . . ;. I '$$ISRX^IBCEF1(IBIFN),IBI>1,$D(IBREVDUP(IBBCPT_" "_IBMOD)),IBER'["IB192;" S IBQUIT=$$IBER^IBCBB3(.IBER,192)
  1.  . . . ;
  1.  . . . ; Rev Code 49x can not be entered with 36x and 37x
  1.  . . . I IBREVC12=49,$O(IBREV1(380),-1)'<360 S IBQUIT=$$IBER^IBCBB3(.IBER,195) Q:IBQUIT
  1.  . . . ;
  1.  . . . ; If Rev=42x & billtype=83x!13x req occ cds 11&35 and val code 50
  1.  . . . ;I IBREVC12=42,(IBTOB12=83!(IBTOB12=13)) D  Q:IBQUIT
  1.  . . . ;. I '$D(IBVALCD(50))!'$D(IBOCCD(11))!'$D(IBOCCD(35)) S IBQUIT=$$IBER^IBCBB3(.IBER,196)
  1.  . . . ;
  1.  . . . ; If Rev=43x & billtype=83x!13x req occ cds 11&44 and val code 51
  1.  . . . ;I IBREVC12=43,(IBTOB12=83!(IBTOB12=13)) D
  1.  . . . ;. I '$D(IBVALCD(51))!'$D(IBOCCD(11))!'$D(IBOCCD(44)) S IBQUIT=$$IBER^IBCBB3(.IBER,197)
  1.  . . . ;
  1.  . . . ; If Rev=44x & billtype=83x!13x req occ cds 11&45 and val code 52
  1.  . . . ;I IBREVC12=44,(IBTOB12=83!(IBTOB12=13)) D
  1.  . . . ;. I '$D(IBVALCD(52))!'$D(IBOCCD(11))!'$D(IBOCCD(45)) S IBQUIT=$$IBER^IBCBB3(.IBER,198)
  1.  . . . ;
  1.  . . . ; If Rev=943 & billtype=83x!13x req occ cds 11&46 and val code 53
  1.  . . . ;I IBREVC=943,(IBTOB12=83!IBTOB12=13) D
  1.  . . . ;. I '$D(IBVALCD(53))!('$D(IBOCCD(11)))!('$D(IBOCCD(46))) S IBQUIT=$$IBER^IBCBB3(.IBER,199)
  1.  . . . ;
  1.  . . . ; If Rev=403 & bill type=14x!23x and service date >= 01-01-91
  1.  . . . ;   require only HCPCS codes 76092 and no other rev codes
  1.  . . . I IBREVC=403,IBFDT'<2910101,(IBTOB12=14!(IBTOB12=23)) D
  1.  . . . . I $O(IBREV1(403))!$O(IBREV1(403),-1)!(IBBCPT'=76092) S IBQUIT=$$IBER^IBCBB3(.IBER,194) Q
  1.  . . . ;
  1.  . . . ; If Rev=401 & bill type=13x!14x!23x!71x allow only HCPSCS codes
  1.  . . . ;   76090 or 78091
  1.  . . . ;I IBREVC=401,(IBTOB12=13!(IBTOB12=14)!(IBTOB12=23)!(IBTOB12=71)),IBBCPT'="",IBBCPT'=76090,IBBCPT'=78091 S IBQUIT=$$IBER^IBCBB3(.IBER,201)
  1.  . . . ;
  1.  . . . ; Rev code cannot equal 227 or 29x
  1.  . . . ;I IBREVC=227!(IBREVC12=29) S IBQUIT=$$IBER^IBCBB3(.IBER,202)
  1.  . . . D REVC^IBCBB7A(IBREVD,IBREVC,IBBCPT,IBREVC12,.IBER)
  1.  Q:IBQUIT
  1.  ;
  1.  D ^IBCBB8
  1.  Q