Changeset 636 for FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCBB.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/IBCBB.m (modified) (5 diffs)

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

@@ -1 +1 @@
 IBCBB ;ALB/AAS - EDIT CHECK ROUTINE TO BE INVOKED BEFORE ALL BILL APPROVAL ACTIONS ;2-NOV-89
- ;;2.0;INTEGRATED BILLING;**80,51,137,288,327,361,371,377**;21-MAR-94;Build 23
+ ;;2.0;INTEGRATED BILLING;**80,51,137,288,327,361**;21-MAR-94;Build 9
  ;;Per VHA Directive 2004-038, this routine should not be modified.
  ;
@@ -23 +23 @@
  ;
 EN ;Entry to check for errors
- N IBQ,IBXERR,IBXDATA,IBXSAVE,IBZPRC92,IBQUIT,IBISEQ,IDDATA,IBFOR,IBC
+ N IBQ,IBXERR,IBXDATA,IBXSAVE,IBZPRC92,IBQUIT,IBISEQ,IDDATA,IBERRNO
  I $D(IBFL) N IBFL
  K ^TMP($J)
  W !
  S IBER="" D GVAR I '$D(IBND0) S IBER=-1 Q
+ ;
+ ;I $$ISPROS^IBCEF1(IBIFN) D
+ ;. D WARN^IBCBB11("Bill has prosthetics item(s) and will only print locally")
+ ;. I $$NEEDMRA^IBEFUNC(IBIFN) S IBQUIT=$$IBER^IBCBB3(.IBER,"098")
  ;
  ;patient in patient file
@@ -41 +45 @@
  I IBAT]"",'$D(^DGCR(399.3,IBAT,0)) S IBER=IBER_"IB059;"
  I IBAT]"",$D(^DGCR(399.3,IBAT,0)),'$P(^(0),"^",6) S IBER=IBER_"IB059;",IBAT=""
+ ;I IBAT]"",$D(^DGCR(399.3,IBAT,0)) S IBARTP=$P(^PRCA(430.2,$P(^DGCR(399.3,IBAT,0),"^",6),0),"^",6)
  I IBAT]"",$P($G(^DGCR(399.3,IBAT,0)),"^",6) S IBARTP=$P($$CATN^PRCAFN($P(^DGCR(399.3,IBAT,0),"^",6)),"^",3)
  ;Check that AR category expects same debtor as defined in who's responsible.
@@ -77 +82 @@
  . S IDDATA=$$INSDEM^IBCEF(IBIFN,IBISEQ)
  . K ^UTILITY("VADM",$J),^UTILITY("VAPA",$J)
- . ;
- . I '$P(IDDATA,U,1) D ERR(221)   ; birth date missing
- . ;
- . I "^M^F^"'[(U_$P(IDDATA,U,2)_U) D ERR(261)  ; sex missing
- . ;
- . ; IB*2*371 - esg - check for other missing insurance pieces
- . ; check insured's name, primary ID#, pt. relationship to insured,
- . ; and subscriber address data  
- . N INNAME,SUBID,PTREL,SFA,CAS,LN,FN
- . ;
- . ;          IB273 - Primary Insurance name of insured missing
- . ;          IB274 - Secondary Insurance name of insured missing
- . ;          IB275 - Tertiary Insurance name of insured missing
- . S INNAME=$$POLICY^IBCEF(IBIFN,17,IBISEQ)
- . S LN=$P(INNAME,",",1),FN=$P(INNAME,",",2)   ; last name,first name
- . S LN=$$NOPUNCT^IBCEF(LN,1)
- . S FN=$$NOPUNCT^IBCEF(FN,1)
- . I LN=""!(FN="") D ERR(273)   ; name of insured missing or invalid
- . S LN=$$NAME^IBCEFG1(INNAME)  ; additional name checks
- . S FN=$P(LN,U,2)
- . S LN=$P(LN,U,1)
- . I LN=""!(FN="") D ERR(273)   ; name of insured missing or invalid
- . ;
- . ;          IB276 - Primary Insurance subscriber ID missing
- . ;          IB277 - Secondary Insurance subscriber ID missing
- . ;          IB278 - Tertiary Insurance subscriber ID missing
- . S SUBID=$$NOPUNCT^IBCEF($$POLICY^IBCEF(IBIFN,2,IBISEQ),1)
- . I SUBID="" D ERR(276)     ; subscriber ID# missing
- . ;
- . ;          IB279 - Primary Insurance missing pt relationship
- . ;          IB280 - Secondary Insurance missing pt relationship
- . ;          IB281 - Tertiary Insurance missing pt relationship
- . S PTREL=$$POLICY^IBCEF(IBIFN,16,IBISEQ)
- . I PTREL="" D ERR(279)      ; missing patient relationship to insured
- . ;
- . ; subscriber address section
- . S SFA=$$INSADDR^IBCEF(IBIFN,IBISEQ)     ; full address all pieces
- . S CAS=$$NOPUNCT^IBCEF($P(SFA,U,2,5),1)  ; string city,st,zip,addr1
- . ;
- . ;          IB282 - Primary Insurance address line 1 missing
- . ;          IB283 - Secondary Insurance address line 1 missing
- . ;          IB284 - Tertiary Insurance address line 1 missing
- . I $$NOPUNCT^IBCEF($P(SFA,U,5),1)="" D   ; address line 1 is blank
- .. ; pat=subscriber and current insurance - address is required
- .. I +PTREL=1,IBISEQ=$$COBN^IBCEF(IBIFN) D ERR(282) Q
- .. ; if any part of the address is there, then all fields are required
- .. I CAS'="" D ERR(282) Q
- .. Q
- . ;
- . ;          IB285 - Primary Insurance city missing
- . ;          IB286 - Secondary Insurance city missing
- . ;          IB287 - Tertiary Insurance city missing
- . I $$NOPUNCT^IBCEF($P(SFA,U,2),1)="" D   ; city is blank
- .. ; pat=subscriber and current insurance - address is required
- .. I +PTREL=1,IBISEQ=$$COBN^IBCEF(IBIFN) D ERR(285) Q
- .. ; if any part of the address is there, then all fields are required
- .. I CAS'="" D ERR(285) Q
- .. Q
- . ;
- . ;          IB288 - Primary Insurance state missing
- . ;          IB289 - Secondary Insurance state missing
- . ;          IB290 - Tertiary Insurance state missing
- . I $$NOPUNCT^IBCEF($P(SFA,U,3),1)="" D   ; state is blank
- .. ; pat=subscriber and current insurance - address is required
- .. I +PTREL=1,IBISEQ=$$COBN^IBCEF(IBIFN) D ERR(288) Q
- .. ; if any part of the address is there, then all fields are required
- .. I CAS'="" D ERR(288) Q
- .. Q
- . ;
- . ;          IB291 - Primary Insurance zipcode missing
- . ;          IB292 - Secondary Insurance zipcode missing
- . ;          IB293 - Tertiary Insurance zipcode missing
- . I $$NOPUNCT^IBCEF($P(SFA,U,4),1)="" D   ; zipcode is blank
- .. ; pat=subscriber and current insurance - address is required
- .. I +PTREL=1,IBISEQ=$$COBN^IBCEF(IBIFN) D ERR(291) Q
- .. ; if any part of the address is there, then all fields are required
- .. I CAS'="" D ERR(291) Q
- .. Q
- . ;
- . Q
- ;
- ; esg - IB*2*371 - check patient address fields
- K ^UTILITY("VAPA",$J)
- ;
- S IBFOR=0                              ; foreign address flag
- S IBC=+$$PTADDR^IBCEF(IBIFN,25)        ; country code ien
- I IBC D
- . N CODE
- . S CODE=$$GET1^DIQ(779.004,IBC,.01)   ; .01 code field file 779.004
- . I CODE'="",CODE'="USA" S IBFOR=1     ; foreign country exists
- . Q
- ;
- I $$NOPUNCT^IBCEF($$PTADDR^IBCEF(IBIFN,1),1)="" S IBER=IBER_"IB269;"
- I $$NOPUNCT^IBCEF($$PTADDR^IBCEF(IBIFN,4),1)="" S IBER=IBER_"IB270;"
- I $$NOPUNCT^IBCEF($$PTADDR^IBCEF(IBIFN,5),1)="",'IBFOR S IBER=IBER_"IB271;"
- I $$NOPUNCT^IBCEF($$PTADDR^IBCEF(IBIFN,11),1)="",'IBFOR S IBER=IBER_"IB272;"
- K ^UTILITY("VAPA",$J)
- ;
- D PAYERADD^IBCBB0(IBIFN)     ; check the payer addresses
- ;
- ; esg - 9/20/07 - IB patch 371 - prevent EDI transmission for 3 payer
- ;       claims for all but the first payer.  To be removed when Emdeon
- ;       and FSC are able to deal with these.
- ;
- I +$G(^DGCR(399,IBIFN,"I2")),+$G(^DGCR(399,IBIFN,"I3")),$$TXMT^IBCEF4(IBIFN) D
- . ; for MRA request claims, make sure the MRA secondary claim is forced to print
- . I $$REQMRA^IBEFUNC(IBIFN) D  Q
- .. I '$P($G(^DGCR(399,IBIFN,"TX")),U,9) S IBER=IBER_"IB146;"
- .. Q
- . ;
- . I $$COBN^IBCEF(IBIFN)=1 Q   ; primary payer sequence claims are OK
- . ;
- . ; But claims with a payer sequence of 2 or 3 need to print locally
- . S IBER=IBER_"IB147;"
+ . I '$P(IDDATA,U,1) D  ; birth date missing
+ .. S IBERRNO=220+IBISEQ
+ .. S IBER=IBER_"IB"_IBERRNO_";"
+ . I "^M^F^"'[(U_$P(IDDATA,U,2)_U) D  ; sex missing
+ .. S IBERRNO=260+IBISEQ
+ .. S IBER=IBER_"IB"_IBERRNO_";"
  . Q
  ;
@@ -207 +104 @@
  Q ($P(IBND0,U,24)_$P($G(^DGCR(399.1,+$P(IBND0,U,25),0)),U,2)_$P(IBND0,U,26))
  ;
-ERR(Z) ; update IBER variable from the above insurance checks
- ; Z is the IB error code# for the primary insurance error
- N IBERRNO
- S IBERRNO="IB"_(Z+IBISEQ-1)
- I IBER[IBERRNO Q
- S IBER=IBER_IBERRNO_";"
- Q
- ;