Changeset 636 for FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCBB1.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCBB1.m (modified) (7 diffs)

FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCBB1.m

@@ -1 +1 @@
 IBCBB1 ;ALB/AAS - CONTINUATION OF EDIT CHECK ROUTINE ;2-NOV-89
- ;;2.0;INTEGRATED BILLING;**27,52,80,93,106,51,151,148,153,137,232,280,155,320,343,349,363,371,395**;21-MAR-94;Build 3
+ ;;2.0;INTEGRATED BILLING;**27,52,80,93,106,51,151,148,153,137,232,280,155,320,343,349,363**;21-MAR-94;Build 35
  ;;Per VHA Directive 2004-038, this routine should not be modified.
  ;
@@ -23 +23 @@
  S IBTFY=$$FY^IBOUTL(IBTDT)
  ;
+ ;Statement crosses fiscal years
+ ;I IBTFY'=IBFFY S IBER=IBER_"IB047;"
+ ;
+ ;Statement crosses calendar years
+ ;I $E(IBTDT,1,3)'=$E(IBFDT,1,3) S IBER=IBER_"IB046;"
+ ;
  ;Total Charges
  I +IBTC'>0!(+IBTC'=IBTC) S IBER=IBER_"IB064;"
@@ -37 +43 @@
  I IBAU]"",'$D(^VA(200,IBAU,0)) S IBER=IBER_"IB041;"
  ;
+ ;Bill exists and not already new bill
+ ;I $S('$D(^PRCA(430,IBIFN,0)):1,$P($P(^PRCA(430,IBIFN,0),"^"),"-",2)'=IBBNO:1,1:0) S IBER=IBER_"IB056;"
+ ;I $P($$BN^PRCAFN(IBIFN),"-",2)'=IBBNO S IBER=IBER_"IB056;"
+ ;I IBER="",$P(^PRCA(430,IBIFN,0),"^",8)=$O(^PRCA(430.3,"AC",104,"")) S IBER=IBER_"IB040;"
  I IBER="",+$$STA^PRCAFN(IBIFN)=104 S IBER=IBER_"IB040;"
  ; If ins bill, must have valid COB sequence
@@ -46 +56 @@
  ; Check NPIs
  D NPICHK^IBCBB11
- ;
- ; Check multiple rx NPIs
- D RXNPI^IBCBB11(IBIFN)
  ;
  ; Check taxonomies
@@ -68 +75 @@
  ... S Q0=0 F  S Q0=$O(IBID(1,FUNCTION,Q0)) Q:'Q0  I $P(IBID(1,FUNCTION,Q0),U,9)=+Z S IBOK=1 Q
  ... I 'IBOK S IBER=IBER_$S(IBINS=1:"IB236;",IBINS=2:"IB237;",IBINS=3:"IB238;",1:"")
- ;
- D PRIIDCHK^IBCBB11
+ . I $$TXMT^IBCEF4(IBIFN) D
+ .. D F^IBCEF("N-ALL ATT/REND PROV SSN/EI","IBZ",,IBIFN)
+ .. I $P(IBZ,U,3)=""&($P(IBZ,U,4)="") S IBER=IBER_"IB321;" ; SSN/IEN required for rend/att
  ;
  N IBM,IBM1
@@ -133 +141 @@
  F Z=0:1:2 S Z0=$O(Z(Z)) Q:'Z0  I Z0'=(Z+1) S IBER=IBER_"IB322;" Q
  K Z
- ; HD64676  IB*2*371 - OK for payer sequence to be blank when the Rate
- ;    Type is either Interagency or Sharing Agreement
- I $P($G(^DGCR(399,IBIFN,0)),U,21)="",$P($G(^DGCR(399,IBIFN,0)),U,7)'=4,$P($G(^DGCR(399,IBIFN,0)),U,7)'=9 S IBER=IBER_"IB323;"
+ I $P($G(^DGCR(399,IBIFN,0)),U,21)="" S IBER=IBER_"IB323;"
  K IBXDATA D F^IBCEF("N-PROCEDURE CODING METHD",,,IBIFN)
  ; Coding method should agree with types of procedure codes
@@ -153 +159 @@
  ;
  D VALNDC^IBCBB11(IBIFN,DFN)  ;validate NDC#
- ;
  ;Build AR array if no errors and MRA not needed or already rec'd
  I IBER="",$S($$NEEDMRA^IBEFUNC(IBIFN)!($$REQMRA^IBEFUNC(IBIFN)):0,1:1) D ARRAY