IBCF21 ;ALB/ARH - HCFA 1500 19-90 DATA (gather insurance, cc) ; 12-JUN-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;
; requires IBIFN
INS F IBI=1,2 S IB("I"_IBI)=$G(^DGCR(399,IBIFN,("I"_IBI)))
F IBI="I1","I2" 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
. I $P(IB(IBI),U,6)="v" D:'$D(VAEL) ELIG^VADPT I +VAEL(4) S IBX=1 Q ;vet is the patient
. 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
. I 'IBX S IBX=9 ; else relationship of insured to patient unknown
K VAEL
INS1 G INS2:IB("I1")=""!('$D(^DIC(36,+IB("I1"),0)))
F IBI=$P(IB("I1"),U,2),$P(IB("I1"),U,3) I IBI'="" S IBFLD("1A")=IBI Q ;policy number
S IBFLD(4)=$S(IBRI1=1:"SAME",1:$P(IB("I1"),U,17)) ; insureds name
S IBFLD(6)=$S('$P(IB("I1"),U,16):IBRI1,1:+$P(IB("I1"),U,16)) ; patient relationship to insured
I IBRI1=1!(IBRI1=2) S IBFLD(7)="SAME" ; insured's address
;
I $P(IB("I1"),U,2)'="" S IBFLD(11)=$P(IB("I1"),U,3) ; group number
I +IBRI1=1,IBFLD("8E")="E" S VAOA("A")=5 D OAD^VADPT S IBFLD("11B")=VAOA(9) K VAOA ;employer
I +IBRI1=2 D
. I IBFLD("3X")'="" S X="MFM",IBFLD("11AX")=$E(X,$F(X,IBFLD("3X")))
. I IBSPE="E" S VAOA("A")=6 D OAD^VADPT S IBFLD("11B")=VAOA(9) K VAOA ;spouses employer
S IBFLD("11C")=$P(IB("I1"),U,15)
;
INS2 G COND:IB("I2")=""!('$D(^DIC(36,+IB("I2"),0))) ; secondary insurance
S IBFLD("11D")=1
S IBFLD(9)=$P(IB("I2"),U,17) I IBFLD(9)'="",IBFLD(9)=$P(IB("I1"),U,17) S IBFLD(9)="SAME" ;secondary insureds nam
F IBI=$P(IB("I2"),U,2),$P(IB("I2"),U,3) I IBI'="" S IBFLD("9A")=IBI Q ;policy number
I +IBRI2=1 D
. S IBFLD("9BD")=IBFLD("3D"),IBFLD("9BX")=IBFLD("3X")
. I IBFLD("8E")="E" S VAOA("A")=5 D OAD^VADPT S IBFLD("9C")=VAOA(9) K VAOA ;employer
I +IBRI2=2 D
. I IBFLD("3X")'="" S X="MFM",IBFLD("9BX")=$E(X,$F(X,IBFLD("3X")))
. I IBSPE="E" S VAOA("A")=6 D OAD^VADPT S IBFLD("9C")=VAOA(9) K VAOA ;spouses employer
I IBFLD("9A")=$P(IB("I2"),U,3) S IBFLD("9D")=$P(IB("I2"),U,15) ;group name
I IBFLD("9D")="" S IBFLD("9D")=$P($G(^DIC(36,+IB("I2"),0)),U) ;company name
;
COND ;condition related to employment, auto accident (place), other accident
S IBI=0 F S IBI=$O(^DGCR(399,IBIFN,"CC",IBI)) Q:'IBI I $G(^(IBI,0))="02" S IBFLD("10A")=1
S IBI=0 F S IBI=$O(^DGCR(399,IBIFN,"OC",IBI)) Q:'IBI S X=$G(^(IBI,0)) I +X D
. S Y=$G(^DGCR(399.1,+X,0)) Q:Y=""
. I $P(Y,U,9)=1 S IBFLD("10A")=1
. I $P(Y,U,9)=2 S IBFLD("10B")=1 S X=$$STATE^IBCF2($P(X,U,3)) I X'="" S IBFLD("10BS")=X
. I $P(Y,U,9)=3 S IBFLD("10C")=1
. I $P(Y,U,1)="ONSET OF SYMPTOMS/ILLNESS" S IBFLD(15)=$$DATE^IBCF22($P(X,U,2)) ; see DATES+1^IBCF22
;
K IBRI1,IBRI2
D ^IBCF22
Q
IBCF21 ;ALB/ARH - HCFA 1500 19-90 DATA (gather insurance, cc) ; 12-JUN-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;
+5 ; requires IBIFN
INS FOR IBI=1,2
SET IB("I"_IBI)=$GET(^DGCR(399,IBIFN,("I"_IBI)))
+1 ;pt's rel to insured
FOR IBI="I1","I2"
IF IB(IBI)'=""
SET IBX=+$PIECE(IB(IBI),U,16)
SET IBY="IBR"_IBI
SET @IBY=IBX
IF IBX'=1
IF IBX'=2
Begin DoDot:1
+2 ;vet is the patient
IF $PIECE(IB(IBI),U,6)="v"
IF '$DATA(VAEL)
DO ELIG^VADPT
IF +VAEL(4)
SET IBX=1
QUIT
+3 ;vet is pt, so vets spouse is pt's spouse
IF $PIECE(IB(IBI),U,6)="s"
IF '$DATA(VAEL)
DO ELIG^VADPT
IF +VAEL(4)
SET IBX=2
QUIT
+4 ; else relationship of insured to patient unknown
IF 'IBX
SET IBX=9
End DoDot:1
SET @IBY=IBX
+5 KILL VAEL
INS1 IF IB("I1")=""!('$DATA(^DIC(36,+IB("I1"),0)))
GOTO INS2
+1 ;policy number
FOR IBI=$PIECE(IB("I1"),U,2),$PIECE(IB("I1"),U,3)
IF IBI'=""
SET IBFLD("1A")=IBI
QUIT
+2 ; insureds name
SET IBFLD(4)=$SELECT(IBRI1=1:"SAME",1:$PIECE(IB("I1"),U,17))
+3 ; patient relationship to insured
SET IBFLD(6)=$SELECT('$PIECE(IB("I1"),U,16):IBRI1,1:+$PIECE(IB("I1"),U,16))
+4 ; insured's address
IF IBRI1=1!(IBRI1=2)
SET IBFLD(7)="SAME"
+5 ;
+6 ; group number
IF $PIECE(IB("I1"),U,2)'=""
SET IBFLD(11)=$PIECE(IB("I1"),U,3)
+7 ;employer
IF +IBRI1=1
IF IBFLD("8E")="E"
SET VAOA("A")=5
DO OAD^VADPT
SET IBFLD("11B")=VAOA(9)
KILL VAOA
+8 IF +IBRI1=2
Begin DoDot:1
+9 IF IBFLD("3X")'=""
SET X="MFM"
SET IBFLD("11AX")=$EXTRACT(X,$FIND(X,IBFLD("3X")))
+10 ;spouses employer
IF IBSPE="E"
SET VAOA("A")=6
DO OAD^VADPT
SET IBFLD("11B")=VAOA(9)
KILL VAOA
End DoDot:1
+11 SET IBFLD("11C")=$PIECE(IB("I1"),U,15)
+12 ;
INS2 ; secondary insurance
IF IB("I2")=""!('$DATA(^DIC(36,+IB("I2"),0)))
GOTO COND
+1 SET IBFLD("11D")=1
+2 ;secondary insureds nam
SET IBFLD(9)=$PIECE(IB("I2"),U,17)
IF IBFLD(9)'=""
IF IBFLD(9)=$PIECE(IB("I1"),U,17)
SET IBFLD(9)="SAME"
+3 ;policy number
FOR IBI=$PIECE(IB("I2"),U,2),$PIECE(IB("I2"),U,3)
IF IBI'=""
SET IBFLD("9A")=IBI
QUIT
+4 IF +IBRI2=1
Begin DoDot:1
+5 SET IBFLD("9BD")=IBFLD("3D")
SET IBFLD("9BX")=IBFLD("3X")
+6 ;employer
IF IBFLD("8E")="E"
SET VAOA("A")=5
DO OAD^VADPT
SET IBFLD("9C")=VAOA(9)
KILL VAOA
End DoDot:1
+7 IF +IBRI2=2
Begin DoDot:1
+8 IF IBFLD("3X")'=""
SET X="MFM"
SET IBFLD("9BX")=$EXTRACT(X,$FIND(X,IBFLD("3X")))
+9 ;spouses employer
IF IBSPE="E"
SET VAOA("A")=6
DO OAD^VADPT
SET IBFLD("9C")=VAOA(9)
KILL VAOA
End DoDot:1
+10 ;group name
IF IBFLD("9A")=$PIECE(IB("I2"),U,3)
SET IBFLD("9D")=$PIECE(IB("I2"),U,15)
+11 ;company name
IF IBFLD("9D")=""
SET IBFLD("9D")=$PIECE($GET(^DIC(36,+IB("I2"),0)),U)
+12 ;
COND ;condition related to employment, auto accident (place), other accident
+1 SET IBI=0
FOR
SET IBI=$ORDER(^DGCR(399,IBIFN,"CC",IBI))
IF 'IBI
QUIT
IF $GET(^(IBI,0))="02"
SET IBFLD("10A")=1
+2 SET IBI=0
FOR
SET IBI=$ORDER(^DGCR(399,IBIFN,"OC",IBI))
IF 'IBI
QUIT
SET X=$GET(^(IBI,0))
IF +X
Begin DoDot:1
+3 SET Y=$GET(^DGCR(399.1,+X,0))
IF Y=""
QUIT
+4 IF $PIECE(Y,U,9)=1
SET IBFLD("10A")=1
+5 IF $PIECE(Y,U,9)=2
SET IBFLD("10B")=1
SET X=$$STATE^IBCF2($PIECE(X,U,3))
IF X'=""
SET IBFLD("10BS")=X
+6 IF $PIECE(Y,U,9)=3
SET IBFLD("10C")=1
+7 ; see DATES+1^IBCF22
IF $PIECE(Y,U,1)="ONSET OF SYMPTOMS/ILLNESS"
SET IBFLD(15)=$$DATE^IBCF22($PIECE(X,U,2))
End DoDot:1
+8 ;
+9 KILL IBRI1,IBRI2
+10 DO ^IBCF22
+11 QUIT
