| [613] | 1 | IBCF21 ;ALB/ARH - HCFA 1500 19-90 DATA (gather insurance, cc) ;12-JUN-93
 | 
|---|
 | 2 |  ;;2.0;INTEGRATED BILLING;**8,80,51**;21-MAR-94
 | 
|---|
 | 3 |  ;;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
 | 4 |  ;
 | 
|---|
 | 5 |  ; requires IBIFN
 | 
|---|
 | 6 | INS S IBFLD("11AD")=""
 | 
|---|
 | 7 |  F IBI=1,2,3 S IB("I"_IBI)=$G(^DGCR(399,IBIFN,("I"_IBI)))
 | 
|---|
 | 8 |  F IBI="I1","I2","I3" I IB(IBI)'="" S IBX=+$P(IB(IBI),U,16),IBY="IBR"_IBI,@IBY=IBX I IBX'=1,IBX'=2 D  S @IBY=IBX ;pt's rel to insured
 | 
|---|
 | 9 |  . I $P(IB(IBI),U,6)="v" D:'$D(VAEL) ELIG^VADPT I +VAEL(4) S IBX=1 Q  ;vet is the patient
 | 
|---|
 | 10 |  . I $P(IB(IBI),U,6)="s" D:'$D(VAEL) ELIG^VADPT I +VAEL(4) S IBX=2 Q  ;vet is pt, so vets spouse is pt's spouse
 | 
|---|
 | 11 |  . I 'IBX S IBX=9 ; else relationship of insured to patient unknown
 | 
|---|
 | 12 |  K VAEL
 | 
|---|
 | 13 |  ;
 | 
|---|
 | 14 |  S IBCOB=$P($G(^DGCR(399,IBIFN,0)),U,21),IBPRIM="I1",IBRIP=$G(IBRI1),IBSECD="I2",IBRIS=$G(IBRI2)
 | 
|---|
 | 15 |  I IBCOB="S" S IBPRIM="I2",IBRIP=$G(IBRI2),IBSECD="I1",IBRIS=$G(IBRI1)
 | 
|---|
 | 16 |  I IBCOB="T" S IBPRIM="I3",IBRIP=$G(IBRI3),IBSECD="I1",IBRIS=$G(IBRI1)
 | 
|---|
 | 17 |  ;
 | 
|---|
 | 18 | INS1 G INS2:IB(IBPRIM)=""!('$D(^DIC(36,+IB(IBPRIM),0)))
 | 
|---|
 | 19 |  F IBI=$P(IB(IBPRIM),U,2),$P(IB(IBPRIM),U,3) I IBI'="" S IBFLD("1A")=IBI Q  ;policy number
 | 
|---|
 | 20 |  S IBFLD(4)=$S(IBRIP=1:"SAME",1:$P(IB(IBPRIM),U,17)) ; insureds name
 | 
|---|
 | 21 |  S IBFLD(6)=$S('$P(IB(IBPRIM),U,16):IBRIP,1:+$P(IB(IBPRIM),U,16)) ; patient relationship to insured
 | 
|---|
 | 22 |  I IBRIP=1!(IBRIP=2) S IBFLD(7)="SAME" ; insured's address
 | 
|---|
 | 23 |  ;
 | 
|---|
 | 24 |  I $P(IB(IBPRIM),U,2)'="" S IBFLD(11)=$P(IB(IBPRIM),U,3) ; group number
 | 
|---|
 | 25 |  I IBRIP=1 S IBFLD("11AD")=IBFLD("3D"),IBFLD("11AX")=IBFLD("3X")
 | 
|---|
 | 26 |  I +IBRIP=1,IBFLD("8E")="E" S VAOA("A")=5 D OAD^VADPT S IBFLD("11B")=VAOA(9) K VAOA ;employer
 | 
|---|
 | 27 |  I +IBRIP=2 D
 | 
|---|
 | 28 |  . I IBFLD("3X")'="" S X="MFM",IBFLD("11AX")=$E(X,$F(X,IBFLD("3X")))
 | 
|---|
 | 29 |  . I IBSPE="E" S VAOA("A")=6 D OAD^VADPT S IBFLD("11B")=VAOA(9) K VAOA ;spouses employer
 | 
|---|
 | 30 |  S IBFLD("11C")=$P(IB(IBPRIM),U,15)
 | 
|---|
 | 31 |  ;
 | 
|---|
 | 32 | INS2 G COND:IB(IBSECD)=""!('$D(^DIC(36,+IB(IBSECD),0))) ; secondary insurance
 | 
|---|
 | 33 |  S IBFLD("11D")=1
 | 
|---|
 | 34 |  S IBFLD(9)=$P(IB(IBSECD),U,17) I IBFLD(9)'="",IBFLD(9)=$P(IB(IBPRIM),U,17) S IBFLD(9)="SAME" ;secondary insureds nam
 | 
|---|
 | 35 |  F IBI=$P(IB(IBSECD),U,2),$P(IB(IBSECD),U,3) I IBI'="" S IBFLD("9A")=IBI Q  ;policy number
 | 
|---|
 | 36 |  I +IBRIS=1 D
 | 
|---|
 | 37 |  . S IBFLD("9BD")=IBFLD("3D"),IBFLD("9BX")=IBFLD("3X")
 | 
|---|
 | 38 |  . I IBFLD("8E")="E" S VAOA("A")=5 D OAD^VADPT S IBFLD("9C")=VAOA(9) K VAOA ;employer
 | 
|---|
 | 39 |  I +IBRIS=2 D
 | 
|---|
 | 40 |  . I IBFLD("3X")'="" S X="MFM",IBFLD("9BX")=$E(X,$F(X,IBFLD("3X")))
 | 
|---|
 | 41 |  . I IBSPE="E" S VAOA("A")=6 D OAD^VADPT S IBFLD("9C")=VAOA(9) K VAOA ;spouses employer
 | 
|---|
 | 42 |  I IBFLD("9A")=$P(IB(IBSECD),U,3) S IBFLD("9D")=$P(IB(IBSECD),U,15) ;group name
 | 
|---|
 | 43 |  I IBFLD("9D")="" S IBFLD("9D")=$P($G(^DIC(36,+IB(IBSECD),0)),U) ;company name
 | 
|---|
 | 44 |  ;
 | 
|---|
 | 45 | COND ;condition related to employment, auto accident (place), other accident
 | 
|---|
 | 46 |  S IBI=0 F  S IBI=$O(^DGCR(399,IBIFN,"CC",IBI)) Q:'IBI  S X=$G(^(IBI,0)) I +X D
 | 
|---|
 | 47 |  . S Y=$G(^DGCR(399.1,+X,0)) Q:Y=""  I $P(Y,U,2)="02" S IBFLD("10A")=1
 | 
|---|
 | 48 |  S IBI=0 F  S IBI=$O(^DGCR(399,IBIFN,"OC",IBI)) Q:'IBI  S X=$G(^(IBI,0)) I +X D
 | 
|---|
 | 49 |  . S Y=$G(^DGCR(399.1,+X,0)) Q:Y=""
 | 
|---|
 | 50 |  . I $P(Y,U,9)=1 S IBFLD("10A")=1
 | 
|---|
 | 51 |  . I $P(Y,U,9)=2 S IBFLD("10B")=1 S X=$$STATE^IBCF2($P(X,U,3)) I X'="" S IBFLD("10BS")=X
 | 
|---|
 | 52 |  . I $P(Y,U,9)=3 S IBFLD("10C")=1
 | 
|---|
 | 53 |  . I $P(Y,U,1)="ONSET OF SYMPTOMS/ILLNESS" S IBFLD(15)=$$DATE^IBCF2($P(X,U,2),1) ; see DATES+1^IBCF22
 | 
|---|
 | 54 |  ;
 | 
|---|
 | 55 |  K IBRI1,IBRI2,IBRI3,IBCOB,IBPRIM,IBSECD,IBRIP,IBRIS
 | 
|---|
 | 56 |  D ^IBCF22
 | 
|---|
 | 57 |  Q
 | 
|---|