| 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
|
---|