IBRFN4 ;ALB/TMK - Supported functions for AR/IB DATA EXTRACT ;15-FEB-2005
;;2.0;INTEGRATED BILLING;**301,305,389,516**;21-MAR-94;Build 123
;;Per VA Directive 6402, this routine should not be modified.
;
IBAREXT(IBIFN,IBD) ; Returns data for claim IBIFN for IB/AR Extract
; Data returned (pieces):
; 1-MEDICARE Status (0=not MRA secondary, 1=MRA secondary)
; 2-Last MRA requested date "S";7 (7 - INTERNAL)
; 3-Last Electronic extract date "TX";2 (21 - INTERNAL)
; 4-Printed via EDI "TX";7 (26 - EXTERNAL)
; 5-Force Claim to Print "TX";8 (27 - EXTERNAL)
; 6-Claim MRA Status "TX";5 (24 - EXTERNAL)
; 7-MRA recorded date "TX";3 (22 - INTERNAL)
; 8-Bill cancelled date "S";17 (17 - INTERNAL)
; 9-form type 0;19 (.19 - EXTERNAL)
; 10-Current Payer $$CURR^IBCEF2(IBIFN) returns IEN;NAME (file 36)
; 11-DRG 0;8==> file 45 (9 - EXTERNAL)
; 12-ECME # "M1";8 (460 - EXTERNAL)
; 13-NON-VA Facility
; 14-#Days Site Not Responsible for MRA ($$DAYS(IBIFN))
; 15-National VA id number for Ins Verification (365.12;.02 - INTERNAL)
; 16-Payer name (file 365.12;.01)
; 17-Offset Amount (202-INTERNAL)
;
; IBD("PRD",seq #)=prosthetic item name^date^bill ien
; IBD("IN")= TYPE OF PLAN NAME ^ GROUP NUMBER ^ RELATIONSHIP TO INSURED
; ^ SOURCE OF INFO ^ EDI ID NUMBER - INST ^ EDI ID NUMBER - PROF
; ^ INSURANCE REIMBURSE
; IBD("IN","MMA")= MAILING STREET ADDRESS [LINE 1] ^
; ^ MAILING STREET ADDRESS [LINE 2] ^ CITY ^ STATE NAME ^ ZIP
;
N IB,IBI,IBJ,IBK,IBX,IBNODE,IBTMP,IBIN,Z
F IBNODE=0,"S","TX","M","U1" S IB(IBNODE)=$G(^DGCR(399,IBIFN,IBNODE))
S IBD=$S($$MRASEC^IBCEF4(IBIFN):1,1:0)
S $P(IBD,U,2)=$P(IB("S"),U,7),$P(IBD,U,3)=$P(IB("TX"),U,2)
S $P(IBD,U,4)=$$GET1^DIQ(399,IBIFN_",",26,"E"),$P(IBD,U,5)=$$GET1^DIQ(399,IBIFN_",",27,"E")
S $P(IBD,U,6)=$$GET1^DIQ(399,IBIFN_",",24,"E"),$P(IBD,U,7)=$P(IB("TX"),U,3)
S $P(IBD,U,8)=$P(IB("S"),U,17),$P(IBD,U,9)=$$GET1^DIQ(399,IBIFN_",",.19,"E")
S Z=$$CURR^IBCEF2(IBIFN),$P(IBD,U,10)=Z_$S(Z:";"_$P($G(^DIC(36,Z,0)),U),1:"")
S Z=$P($G(^DIC(36,+Z,3)),U,10),$P(IBD,U,15)=$P($G(^IBE(365.12,+Z,0)),U,2),$P(IBD,U,16)=$P($G(^(0)),U)
S Z=$P(IB(0),U,8),$P(IBD,U,11)=$S(Z:$$GET1^DIQ(45,Z_",",9,"E"),1:"")
S $P(IBD,U,12)=$$GET1^DIQ(399,IBIFN_",",460,"E")
S Z=$P($G(^DGCR(399,IBIFN,"U2")),U,10),$P(IBD,U,13)=$S(Z:$P($G(^IBA(355.93,Z,0)),U,1),1:"")
;
S $P(IBD,U,14)=$$DAYS(IBIFN)
S $P(IBD,U,17)=$P(IB("U1"),U,2)
;
K IBTMP D SET^IBCSC5B(IBIFN,.IBTMP)
S (IBI,IBJ)=0 F S IBI=$O(IBTMP(IBI)) Q:'IBI D
. S IBK=0 F S IBK=$O(IBTMP(IBI,IBK)) Q:'IBK D
.. S IBX=IBTMP(IBI,IBK)
.. S IBJ=IBJ+1
.. S IBD("PRD",IBJ)=$$PINB^IBCSC5B(+IBX)_U_IBI_U_+IBTMP
;
S Z=" ",IBD("IN")="",DFN=+$P(IB(0),U,2)
F S Z=$O(^DPT(DFN,.312,Z),-1) Q:Z="" D Q:Z=""
. ;IB*2.0*516/TAZ - Use HIPAA compliant fields
. ;S IBIN=$G(^DPT(DFN,.312,Z,0)) ; 516 - baa
. S IBIN=$$ZND^IBCNS1(DFN,Z) ; 516 - baa
. I +IB("M")=+IBIN D
.. N IBQ,IBP
.. S IBP=+$P(IBIN,U,18),IBQ=$G(^IBA(355.3,+IBP,0))
.. ;S IBD("IN")=$S($P(IBQ,U,9):$$GET1^DIQ(355.3,IBP_",",.09,"E"),1:"")_U_$P(IBQ,U,4)_U_$P(IBIN,U,6)_U_$P($G(^DPT(DFN,.312,Z,1)),U,9)
.. S IBD("IN")=$$GET1^DIQ(355.3,IBP_",",.09,"E")_U_$P(IBIN,U,3)_U_$P(IBIN,U,6)_U_$P($G(^DPT(DFN,.312,Z,1)),U,9)
.. S Z=""
;
S Z=$G(^DIC(36,+IB("M"),3))
S $P(IBD("IN"),U,5)=$P(Z,U,4),$P(IBD("IN"),U,6)=$P(Z,U,2)
S $P(IBD("IN"),U,7)=$$GET1^DIQ(36,+IB("M")_",",1,"I")
S Z=$G(^DIC(36,+IB("M"),.11))
S IBD("IN","MMA")=$P(Z,U,1)_U_$P(Z,U,2)_U_$P(Z,U,4)_U_$S($P(Z,U,5):$P($G(^DIC(5,$P(Z,U,5),0)),U,1),1:"")_U_$P(Z,U,6)
;
Q IBD
;
IBACT(IBIFN,IBARRY) ; Returns IB actions for bill ien IBIFN
;IBARRY should be passed by reference and returns:
;
; IBARRY(seq)=AR bill #^reference #^external STATUS^IB ACTION TYPE NAME
; ^UNITS^TOTAL CHARGE^DT BILLD FROM^DT BILLD TO^AR BILL IEN
; ^DT ENTRY ADDED^PATIENT SSN^EVENT DATE^RESULTING FROM
; ^INSTITUTION IEN
;
N IBNA,IB,IB0,DFN,IBCT,Z
S IBNA=$$BN1^PRCAFN(IBIFN),IB="",IBCT=0
F S IB=$O(^IB("ABIL",IBNA,IB)) Q:IB="" D
. S IBCT=IBCT+1
. S IB0=$G(^IB(IB,0))
. I $G(DFN)="" S DFN=$P(IB0,U,2)
. ;
. S IBARRY=IBNA_U_$P(IB0,U,1)_U_$$GET1^DIQ(350,IB_",",.05,"E")
. S Z=$P(IB0,U,3)
. S IBARRY=IBARRY_U_$S(Z'="":$P($G(^IBE(350.1,Z,0)),U,1),1:"")
. S IBARRY=IBARRY_U_$P(IB0,U,6) ; UNITS
. S IBARRY=IBARRY_U_$P(IB0,U,7) ; TOTAL CHARGE
. S IBARRY=IBARRY_U_$P(IB0,U,14) ; DT BILLD FROM
. S IBARRY=IBARRY_U_$P(IB0,U,15) ; DT BILLD TO
. S IBARRY=IBARRY_U_$P(IB0,U,11) ; AR BILL #
. S IBARRY=IBARRY_U_$P($P($G(^IB(IB,1)),U,2),".",1) ; DT ENTRY ADDED
. S IBARRY=IBARRY_U_$P(^DPT(DFN,0),U,9) ; SSN
. S IBARRY=IBARRY_U_$P(IB0,U,17) ; EVENT DT
. S IBARRY=IBARRY_U_$P(IB0,U,4) ;RESULTING FROM
. S IBARRY=IBARRY_U_$P(IB0,U,13) ; Institution
. S IBARRY(IBCT)=IBARRY,IBARRY=""
Q
;
PREREG(IBBDT,IBEDT) ;Returns Pre-registration data
N IBDATA
S IBDATA=$$IBAR^IBJDIPR(IBBDT,IBEDT)
Q IBDATA
;
BUFFER(IBBDT,IBEDT) ;Returns Buffer data
N IBDATA
S IBDATA=$$IBAR^IBCNBOA(IBBDT,IBEDT)
Q IBDATA
;
DAYS(IBIFN) ; Returns # days site not responsible for MRA
N X,X1,X2,D0
S X="" ;No. of days
G:'$P(IBD,U,2) DAYSQ
S X2=$P(IBD,U,2) ;MRA Request Date
S X1=$P(IBD,U,7) ;MRA Recorded Date
G:'$$MRASEC^IBCEF4(IBIFN) DAYSQ ; Not MEDICARE secondary
I 'X1!(X1<X2) S X1=DT
D ^%DTC
DAYSQ Q X
;
REJ(IBIFN) ; Returns 1 if any rejects found for MRA secondary claim or for
; any preceding claims it was cancelled/cloned from
N X,Y,I,X1,X2,X3,D0,CURSEQ
S Y=0 ;Y=REJECT FLAG
G:'$$MRASEC^IBCEF4(IBIFN) REJQ ; Not MEDICARE secondary
S CURSEQ=$$COBN^IBCEF(IBIFN),X1=+$P($G(^DGCR(399,IBIFN,0)),U,15)
S D0=IBIFN
F D Q:'D0!Y
. ; claim copied from not cancelled and not MRA secondary claim
. I X1,$P($G(^DGCR(399,X1,0)),U,13)'=7,X1'=IBIFN S D0="" Q
. I X1,$P($G(^DGCR(399,X1,0)),U,19)'=$P($G(^DGCR(399,D0,0)),U,19) S D0="" Q
. S I=0 F S I=$O(^IBM(361,"B",D0,I)) Q:'I D Q:Y
.. S X2=$G(^IBM(361,I,0))
.. Q:$P(X2,U,3)'="R"!'$P(X2,U,11) ;No reject or no transmit bill
.. S X3=$TR($P($G(^IBA(364,+$P(X2,U,11),0)),U,8),"PST","123") ;status msg seq
.. Q:X3'=(CURSEQ-1)
.. S Y=1
. I 'Y S D0=X1,X1=+$P($G(^DGCR(399,X1,0)),U,15) S:X1=D0 D0="" Q
REJQ Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBRFN4 6259 printed Oct 16, 2024@18:27:34 Page 2
IBRFN4 ;ALB/TMK - Supported functions for AR/IB DATA EXTRACT ;15-FEB-2005
+1 ;;2.0;INTEGRATED BILLING;**301,305,389,516**;21-MAR-94;Build 123
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
IBAREXT(IBIFN,IBD) ; Returns data for claim IBIFN for IB/AR Extract
+1 ; Data returned (pieces):
+2 ; 1-MEDICARE Status (0=not MRA secondary, 1=MRA secondary)
+3 ; 2-Last MRA requested date "S";7 (7 - INTERNAL)
+4 ; 3-Last Electronic extract date "TX";2 (21 - INTERNAL)
+5 ; 4-Printed via EDI "TX";7 (26 - EXTERNAL)
+6 ; 5-Force Claim to Print "TX";8 (27 - EXTERNAL)
+7 ; 6-Claim MRA Status "TX";5 (24 - EXTERNAL)
+8 ; 7-MRA recorded date "TX";3 (22 - INTERNAL)
+9 ; 8-Bill cancelled date "S";17 (17 - INTERNAL)
+10 ; 9-form type 0;19 (.19 - EXTERNAL)
+11 ; 10-Current Payer $$CURR^IBCEF2(IBIFN) returns IEN;NAME (file 36)
+12 ; 11-DRG 0;8==> file 45 (9 - EXTERNAL)
+13 ; 12-ECME # "M1";8 (460 - EXTERNAL)
+14 ; 13-NON-VA Facility
+15 ; 14-#Days Site Not Responsible for MRA ($$DAYS(IBIFN))
+16 ; 15-National VA id number for Ins Verification (365.12;.02 - INTERNAL)
+17 ; 16-Payer name (file 365.12;.01)
+18 ; 17-Offset Amount (202-INTERNAL)
+19 ;
+20 ; IBD("PRD",seq #)=prosthetic item name^date^bill ien
+21 ; IBD("IN")= TYPE OF PLAN NAME ^ GROUP NUMBER ^ RELATIONSHIP TO INSURED
+22 ; ^ SOURCE OF INFO ^ EDI ID NUMBER - INST ^ EDI ID NUMBER - PROF
+23 ; ^ INSURANCE REIMBURSE
+24 ; IBD("IN","MMA")= MAILING STREET ADDRESS [LINE 1] ^
+25 ; ^ MAILING STREET ADDRESS [LINE 2] ^ CITY ^ STATE NAME ^ ZIP
+26 ;
+27 NEW IB,IBI,IBJ,IBK,IBX,IBNODE,IBTMP,IBIN,Z
+28 FOR IBNODE=0,"S","TX","M","U1"
SET IB(IBNODE)=$GET(^DGCR(399,IBIFN,IBNODE))
+29 SET IBD=$SELECT($$MRASEC^IBCEF4(IBIFN):1,1:0)
+30 SET $PIECE(IBD,U,2)=$PIECE(IB("S"),U,7)
SET $PIECE(IBD,U,3)=$PIECE(IB("TX"),U,2)
+31 SET $PIECE(IBD,U,4)=$$GET1^DIQ(399,IBIFN_",",26,"E")
SET $PIECE(IBD,U,5)=$$GET1^DIQ(399,IBIFN_",",27,"E")
+32 SET $PIECE(IBD,U,6)=$$GET1^DIQ(399,IBIFN_",",24,"E")
SET $PIECE(IBD,U,7)=$PIECE(IB("TX"),U,3)
+33 SET $PIECE(IBD,U,8)=$PIECE(IB("S"),U,17)
SET $PIECE(IBD,U,9)=$$GET1^DIQ(399,IBIFN_",",.19,"E")
+34 SET Z=$$CURR^IBCEF2(IBIFN)
SET $PIECE(IBD,U,10)=Z_$SELECT(Z:";"_$PIECE($GET(^DIC(36,Z,0)),U),1:"")
+35 SET Z=$PIECE($GET(^DIC(36,+Z,3)),U,10)
SET $PIECE(IBD,U,15)=$PIECE($GET(^IBE(365.12,+Z,0)),U,2)
SET $PIECE(IBD,U,16)=$PIECE($GET(^(0)),U)
+36 SET Z=$PIECE(IB(0),U,8)
SET $PIECE(IBD,U,11)=$SELECT(Z:$$GET1^DIQ(45,Z_",",9,"E"),1:"")
+37 SET $PIECE(IBD,U,12)=$$GET1^DIQ(399,IBIFN_",",460,"E")
+38 SET Z=$PIECE($GET(^DGCR(399,IBIFN,"U2")),U,10)
SET $PIECE(IBD,U,13)=$SELECT(Z:$PIECE($GET(^IBA(355.93,Z,0)),U,1),1:"")
+39 ;
+40 SET $PIECE(IBD,U,14)=$$DAYS(IBIFN)
+41 SET $PIECE(IBD,U,17)=$PIECE(IB("U1"),U,2)
+42 ;
+43 KILL IBTMP
DO SET^IBCSC5B(IBIFN,.IBTMP)
+44 SET (IBI,IBJ)=0
FOR
SET IBI=$ORDER(IBTMP(IBI))
if 'IBI
QUIT
Begin DoDot:1
+45 SET IBK=0
FOR
SET IBK=$ORDER(IBTMP(IBI,IBK))
if 'IBK
QUIT
Begin DoDot:2
+46 SET IBX=IBTMP(IBI,IBK)
+47 SET IBJ=IBJ+1
+48 SET IBD("PRD",IBJ)=$$PINB^IBCSC5B(+IBX)_U_IBI_U_+IBTMP
End DoDot:2
End DoDot:1
+49 ;
+50 SET Z=" "
SET IBD("IN")=""
SET DFN=+$PIECE(IB(0),U,2)
+51 FOR
SET Z=$ORDER(^DPT(DFN,.312,Z),-1)
if Z=""
QUIT
Begin DoDot:1
+52 ;IB*2.0*516/TAZ - Use HIPAA compliant fields
+53 ;S IBIN=$G(^DPT(DFN,.312,Z,0)) ; 516 - baa
+54 ; 516 - baa
SET IBIN=$$ZND^IBCNS1(DFN,Z)
+55 IF +IB("M")=+IBIN
Begin DoDot:2
+56 NEW IBQ,IBP
+57 SET IBP=+$PIECE(IBIN,U,18)
SET IBQ=$GET(^IBA(355.3,+IBP,0))
+58 ;S IBD("IN")=$S($P(IBQ,U,9):$$GET1^DIQ(355.3,IBP_",",.09,"E"),1:"")_U_$P(IBQ,U,4)_U_$P(IBIN,U,6)_U_$P($G(^DPT(DFN,.312,Z,1)),U,9)
+59 SET IBD("IN")=$$GET1^DIQ(355.3,IBP_",",.09,"E")_U_$PIECE(IBIN,U,3)_U_$PIECE(IBIN,U,6)_U_$PIECE($GET(^DPT(DFN,.312,Z,1)),U,9)
+60 SET Z=""
End DoDot:2
End DoDot:1
if Z=""
QUIT
+61 ;
+62 SET Z=$GET(^DIC(36,+IB("M"),3))
+63 SET $PIECE(IBD("IN"),U,5)=$PIECE(Z,U,4)
SET $PIECE(IBD("IN"),U,6)=$PIECE(Z,U,2)
+64 SET $PIECE(IBD("IN"),U,7)=$$GET1^DIQ(36,+IB("M")_",",1,"I")
+65 SET Z=$GET(^DIC(36,+IB("M"),.11))
+66 SET IBD("IN","MMA")=$PIECE(Z,U,1)_U_$PIECE(Z,U,2)_U_$PIECE(Z,U,4)_U_$SELECT($PIECE(Z,U,5):$PIECE($GET(^DIC(5,$PIECE(Z,U,5),0)),U,1),1:"")_U_$PIECE(Z,U,6)
+67 ;
+68 QUIT IBD
+69 ;
IBACT(IBIFN,IBARRY) ; Returns IB actions for bill ien IBIFN
+1 ;IBARRY should be passed by reference and returns:
+2 ;
+3 ; IBARRY(seq)=AR bill #^reference #^external STATUS^IB ACTION TYPE NAME
+4 ; ^UNITS^TOTAL CHARGE^DT BILLD FROM^DT BILLD TO^AR BILL IEN
+5 ; ^DT ENTRY ADDED^PATIENT SSN^EVENT DATE^RESULTING FROM
+6 ; ^INSTITUTION IEN
+7 ;
+8 NEW IBNA,IB,IB0,DFN,IBCT,Z
+9 SET IBNA=$$BN1^PRCAFN(IBIFN)
SET IB=""
SET IBCT=0
+10 FOR
SET IB=$ORDER(^IB("ABIL",IBNA,IB))
if IB=""
QUIT
Begin DoDot:1
+11 SET IBCT=IBCT+1
+12 SET IB0=$GET(^IB(IB,0))
+13 IF $GET(DFN)=""
SET DFN=$PIECE(IB0,U,2)
+14 ;
+15 SET IBARRY=IBNA_U_$PIECE(IB0,U,1)_U_$$GET1^DIQ(350,IB_",",.05,"E")
+16 SET Z=$PIECE(IB0,U,3)
+17 SET IBARRY=IBARRY_U_$SELECT(Z'="":$PIECE($GET(^IBE(350.1,Z,0)),U,1),1:"")
+18 ; UNITS
SET IBARRY=IBARRY_U_$PIECE(IB0,U,6)
+19 ; TOTAL CHARGE
SET IBARRY=IBARRY_U_$PIECE(IB0,U,7)
+20 ; DT BILLD FROM
SET IBARRY=IBARRY_U_$PIECE(IB0,U,14)
+21 ; DT BILLD TO
SET IBARRY=IBARRY_U_$PIECE(IB0,U,15)
+22 ; AR BILL #
SET IBARRY=IBARRY_U_$PIECE(IB0,U,11)
+23 ; DT ENTRY ADDED
SET IBARRY=IBARRY_U_$PIECE($PIECE($GET(^IB(IB,1)),U,2),".",1)
+24 ; SSN
SET IBARRY=IBARRY_U_$PIECE(^DPT(DFN,0),U,9)
+25 ; EVENT DT
SET IBARRY=IBARRY_U_$PIECE(IB0,U,17)
+26 ;RESULTING FROM
SET IBARRY=IBARRY_U_$PIECE(IB0,U,4)
+27 ; Institution
SET IBARRY=IBARRY_U_$PIECE(IB0,U,13)
+28 SET IBARRY(IBCT)=IBARRY
SET IBARRY=""
End DoDot:1
+29 QUIT
+30 ;
PREREG(IBBDT,IBEDT) ;Returns Pre-registration data
+1 NEW IBDATA
+2 SET IBDATA=$$IBAR^IBJDIPR(IBBDT,IBEDT)
+3 QUIT IBDATA
+4 ;
BUFFER(IBBDT,IBEDT) ;Returns Buffer data
+1 NEW IBDATA
+2 SET IBDATA=$$IBAR^IBCNBOA(IBBDT,IBEDT)
+3 QUIT IBDATA
+4 ;
DAYS(IBIFN) ; Returns # days site not responsible for MRA
+1 NEW X,X1,X2,D0
+2 ;No. of days
SET X=""
+3 if '$PIECE(IBD,U,2)
GOTO DAYSQ
+4 ;MRA Request Date
SET X2=$PIECE(IBD,U,2)
+5 ;MRA Recorded Date
SET X1=$PIECE(IBD,U,7)
+6 ; Not MEDICARE secondary
if '$$MRASEC^IBCEF4(IBIFN)
GOTO DAYSQ
+7 IF 'X1!(X1<X2)
SET X1=DT
+8 DO ^%DTC
DAYSQ QUIT X
+1 ;
REJ(IBIFN) ; Returns 1 if any rejects found for MRA secondary claim or for
+1 ; any preceding claims it was cancelled/cloned from
+2 NEW X,Y,I,X1,X2,X3,D0,CURSEQ
+3 ;Y=REJECT FLAG
SET Y=0
+4 ; Not MEDICARE secondary
if '$$MRASEC^IBCEF4(IBIFN)
GOTO REJQ
+5 SET CURSEQ=$$COBN^IBCEF(IBIFN)
SET X1=+$PIECE($GET(^DGCR(399,IBIFN,0)),U,15)
+6 SET D0=IBIFN
+7 FOR
Begin DoDot:1
+8 ; claim copied from not cancelled and not MRA secondary claim
+9 IF X1
IF $PIECE($GET(^DGCR(399,X1,0)),U,13)'=7
IF X1'=IBIFN
SET D0=""
QUIT
+10 IF X1
IF $PIECE($GET(^DGCR(399,X1,0)),U,19)'=$PIECE($GET(^DGCR(399,D0,0)),U,19)
SET D0=""
QUIT
+11 SET I=0
FOR
SET I=$ORDER(^IBM(361,"B",D0,I))
if 'I
QUIT
Begin DoDot:2
+12 SET X2=$GET(^IBM(361,I,0))
+13 ;No reject or no transmit bill
if $PIECE(X2,U,3)'="R"!'$PIECE(X2,U,11)
QUIT
+14 ;status msg seq
SET X3=$TRANSLATE($PIECE($GET(^IBA(364,+$PIECE(X2,U,11),0)),U,8),"PST","123")
+15 if X3'=(CURSEQ-1)
QUIT
+16 SET Y=1
End DoDot:2
if Y
QUIT
+17 IF 'Y
SET D0=X1
SET X1=+$PIECE($GET(^DGCR(399,X1,0)),U,15)
if X1=D0
SET D0=""
QUIT
End DoDot:1
if 'D0!Y
QUIT
REJQ QUIT Y
