ABME8REF ; IHS/ASDST/DMJ - 837 REF Segment
;;2.6;IHS Third Party Billing;**1,8**;NOV 12, 2009
;other payer provider info
;
; IHS/SD/SDR - v2.5 p5 - 5/17/04 - Added code to pull referring provider
; from page 3 (primarily used from diagnostic claims)
; IHS/SD/SDR - v2.5 p8 - IM12246/IM17548
; Added code from CLIA REF segment
; IHS/SD/SDR - v2.5 p9 - IM19291
; Supervising provider UPIN
; IHS/SD/SDR - v2.5 p9 - IM16962
; Added code for Provider if PI
; IHS/SD/SDR - v2.5 p9 - IM18032
; Put Medicaid Resubmission Number as REF*F8
; IHS/SD/SDR - v2.5 p10 - IM20395
; Split out lines bundled by rev code
; IHS/SD/SDR - v2.5 p10 - IM19940
; Fix for supervising provider UPIN
; IHS/SD/SDR - v2.5 p11 - NPI
; IHS/SD/SDR - v2.5 p11 - IM21946
; CLIA number changes
; IHS/SD/SDR - v2.5 p12 - IM24898
; Change for supervising provider qualifier
; IHS/SD/SDR - v2.5 p12 - IM24975
; Changes for Value Options
; IHS/SD/SDR - v2.5 p12 - IM23560
; Made changes for CLIA (qualifier not showing up
; for referring lab charges)
; IHS/SD/SDR - abm*2.6*1 - HEAT4158 - mammography cert#
;
EP(X,Y,Z) ;EP
;x=entity identifier code from nm1
;y=file number
;z=internal entry number
K ABMREC("REF"),ABMR("REF")
S ABMEIC=X
S ABMFILE=+$G(Y)
S ABMIEN=+$G(Z)
;S ABMSIEN=$G(Z) ;abm*2.6*8
S ABME("RTYPE")="REF"
D LOOP
K ABME,ABM
Q
LOOP ;LOOP HERE
F I=10:10:50 D
.D @I
.I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),ABME("RTYPE"),I)) D @(^(I))
.I $G(ABMREC("REF"))'="" S ABMREC("REF")=ABMREC("REF")_"*"
.S ABMREC("REF")=$G(ABMREC("REF"))_ABMR("REF",I)
Q
10 ;segment
S ABMR("REF",10)="REF"
Q
20 ;REF01 - Reference Identification Qualifier
S ABMR("REF",20)=ABMEIC
I $G(ABMCLIA)="SV" D
.I $G(ABMI)=37,(ABMEIC="X4"),($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)'=""),($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)=($P($G(ABMB9),U,2))) S ABMR("REF",20)=""
.I $G(ABMI)=37,($G(ABMEIC)="F4"),($P($G(ABMRV(ABMI,ABMJ,ABMK)),U,3)'=90),($P($G(ABMRV(ABMI,ABMJ,ABMK)),U,4)'=90)&($P($G(ABMRV(ABMI,ABMJ,ABMK)),U,12)'=90) S ABMR("REF",20)=""
I $G(ABMR("REF",20))="",ABMIEN=0,($G(ABMFILE)=200),$D(ABMP("PRV","F")) S ABMR("REF",20)="1G"
I +$G(Z)'=0,$D(ABMP("PRV","S",Z)) S ABMR("REF",20)="1D" ;supervising
Q
30 ;REF02 - Reference Identification
I ABMEIC=87 D
.S:ABMP("EXP")=21 ABMR("REF",30)="004010X096A1"
.S:ABMP("EXP")=22 ABMR("REF",30)="004010X098A1"
.S:ABMP("EXP")=23 ABMR("REF",30)="004010X097A1"
I ABMEIC="G4" D
.S ABMR("REF",30)=$P(ABMB5,"^",8)
I ABMEIC="9F" D
.S ABMR("REF",30)=$P(ABMB5,"^",11)
I ABMEIC="G1" D
.S ABMR("REF",30)=$P(ABMB5,"^",12)
;start new code abm*2.6*1 HEAT4158
;mammography cert#
I ABMEIC="EW" D
.S ABMR("REF",30)=$P($G(^ABMDPARM(ABMP("LDFN"),1,5)),U,4)
;end new code HEAT4158
I ABMEIC="F4" D
.S ABMR("REF",30)=""
.I ABMCLIA="SV" D ;service lines
..; if outside lab (determined by use of 90 modifier)
..; ABMOUTLB will be used later to determine whether other segments should be written
..I $P(ABMRV(ABMI,ABMJ,ABMK),U,3)=90!($P(ABMRV(ABMI,ABMJ,ABMK),U,4)=90)!($P(ABMRV(ABMI,ABMJ,ABMK),U,12)=90) D
...I $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0),"^",14)'="" S ABMR("REF",30)=$P(^ABMRLABS($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0),"^",14),0),"^",2) Q
...I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",23)'="" S ABMR("REF",30)=$P(^ABMRLABS($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",23),0),"^",2)
..; if in-house lab (lack of 90 modifier)
I ABMEIC="X4" D
.S ABMR("REF",30)=""
.I ABMCLIA="CLM" S ABMR("REF",30)=$P(ABMB9,U,22) Q ;in-house CLIA from claim header
.I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)'="",($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)'=($P($G(ABMB9),U,22))) S ABMR("REF",30)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)
.E S ABMR("REF",30)=$P($G(ABMB9),U,22)
I ABMEIC="EA" D
.S ABMR("REF",30)=$$HRN^ABMUTL8(ABMP("PDFN"))
I ABMEIC="1C" D
.I ABMFILE=9999999.06 D
..S ABMR("REF",30)=$$MCR^ABMUTLF(ABMIEN)
.I ABMFILE=200 D
..S ABMR("REF",30)=$$MCR^ABMEEPRV(ABMIEN)
..Q:$$RCID^ABMUTLP(ABMP("INS"))'="C00900"
..Q:$$RCID^ABMUTLP(ABMP("INS"))'="04402"
..S ABMR("REF",30)=$$NPI^ABMEEPRV(ABMIEN,ABMP("LDFN"),ABMP("INS"))
I ABMEIC="1D" D
.I ABMFILE=9999999.06 D
..S ABMR("REF",30)=$$MCD^ABMUTLF(ABMIEN)
.I ABMFILE=200 D
..S ABMR("REF",30)=$$MCD^ABMEEPRV(ABMIEN,+$G(ABMPAYER))
I ABMEIC="0B" D
.S ABMR("REF",30)=$$SLN^ABMEEPRV(ABMIEN)
I ABMEIC="1G" D
.S ABMR("REF",30)=$$MCD^ABMUTLF(ABMIEN)
.S:ABMR("REF",30)="" ABMR("REF",30)=$$UPIN^ABMEEPRV(ABMIEN)
I "^BQ^G2^1A^1B^B3^1H^1J^EI^FH^G5^LU^SY^U3^X5^"[("^"_ABMEIC_"^") D
.I ABMFILE=9999999.06 D
..I ABMRCID="FHC&AFFILIATES"&(ABMEIC="LU") D
...S ABMR("REF",30)=$P($G(^AUTNINS(ABMP("INS"),15,ABMIEN,0)),U,2)
..E S ABMR("REF",30)=$$PI^ABMUTLF(ABMIEN)
.I ABMFILE=200 D
..I ABMRCID="FHC&AFFILIATES"&(ABMEIC="LU") D
...S ABMR("REF",30)=$P($G(^AUTNINS(ABMP("INS"),15,ABMIEN,0)),U,2)
..E S ABMR("REF",30)=$$PI^ABMUTLF(ABMP("LDFN"))
I ABMEIC="F8" D
.S ABMR("REF",30)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,9)
I +ABMIEN=0,$D(ABMP("PRV","F")),($G(Z)'="") S ABMR("REF",30)=$P($G(ABMP("PRV","F",Z)),"^")
;I +$G(Z)=0,($G(ABMSIEN)'=""),(ABMR("REF",30)="") S ABMR("REF",30)=$P($G(ABMP("PRV","S",Z)),U) ;abm*2.6*8
I +$G(Z)=0,($G(ABMIEN)'=""),(ABMR("REF",30)="") S ABMR("REF",30)=$P($G(ABMP("PRV","S",Z)),U) ;abm*2.6*8
Q
40 ;REF03 - Description-not used
S ABMR("REF",40)=""
Q
50 ;REF04 - Reference Identifier-not used
S ABMR("REF",50)=""
Q
ABME8REF ; IHS/ASDST/DMJ - 837 REF Segment
+1 ;;2.6;IHS Third Party Billing;**1,8**;NOV 12, 2009
+2 ;other payer provider info
+3 ;
+4 ; IHS/SD/SDR - v2.5 p5 - 5/17/04 - Added code to pull referring provider
+5 ; from page 3 (primarily used from diagnostic claims)
+6 ; IHS/SD/SDR - v2.5 p8 - IM12246/IM17548
+7 ; Added code from CLIA REF segment
+8 ; IHS/SD/SDR - v2.5 p9 - IM19291
+9 ; Supervising provider UPIN
+10 ; IHS/SD/SDR - v2.5 p9 - IM16962
+11 ; Added code for Provider if PI
+12 ; IHS/SD/SDR - v2.5 p9 - IM18032
+13 ; Put Medicaid Resubmission Number as REF*F8
+14 ; IHS/SD/SDR - v2.5 p10 - IM20395
+15 ; Split out lines bundled by rev code
+16 ; IHS/SD/SDR - v2.5 p10 - IM19940
+17 ; Fix for supervising provider UPIN
+18 ; IHS/SD/SDR - v2.5 p11 - NPI
+19 ; IHS/SD/SDR - v2.5 p11 - IM21946
+20 ; CLIA number changes
+21 ; IHS/SD/SDR - v2.5 p12 - IM24898
+22 ; Change for supervising provider qualifier
+23 ; IHS/SD/SDR - v2.5 p12 - IM24975
+24 ; Changes for Value Options
+25 ; IHS/SD/SDR - v2.5 p12 - IM23560
+26 ; Made changes for CLIA (qualifier not showing up
+27 ; for referring lab charges)
+28 ; IHS/SD/SDR - abm*2.6*1 - HEAT4158 - mammography cert#
+29 ;
EP(X,Y,Z) ;EP
+1 ;x=entity identifier code from nm1
+2 ;y=file number
+3 ;z=internal entry number
+4 KILL ABMREC("REF"),ABMR("REF")
+5 SET ABMEIC=X
+6 SET ABMFILE=+$GET(Y)
+7 SET ABMIEN=+$GET(Z)
+8 ;S ABMSIEN=$G(Z) ;abm*2.6*8
+9 SET ABME("RTYPE")="REF"
+10 DO LOOP
+11 KILL ABME,ABM
+12 QUIT
LOOP ;LOOP HERE
+1 FOR I=10:10:50
Begin DoDot:1
+2 DO @I
+3 IF $DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),ABME("RTYPE"),I))
DO @(^(I))
+4 IF $GET(ABMREC("REF"))'=""
SET ABMREC("REF")=ABMREC("REF")_"*"
+5 SET ABMREC("REF")=$GET(ABMREC("REF"))_ABMR("REF",I)
End DoDot:1
+6 QUIT
10 ;segment
+1 SET ABMR("REF",10)="REF"
+2 QUIT
20 ;REF01 - Reference Identification Qualifier
+1 SET ABMR("REF",20)=ABMEIC
+2 IF $GET(ABMCLIA)="SV"
Begin DoDot:1
+3 IF $GET(ABMI)=37
IF (ABMEIC="X4")
IF ($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)'="")
IF ($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)=($PIECE($GET(ABMB9),U,2)))
SET ABMR("REF",20)=""
+4 IF $GET(ABMI)=37
IF ($GET(ABMEIC)="F4")
IF ($PIECE($GET(ABMRV(ABMI,ABMJ,ABMK)),U,3)'=90)
IF ($PIECE($GET(ABMRV(ABMI,ABMJ,ABMK)),U,4)'=90)&($PIECE($GET(ABMRV(ABMI,ABMJ,ABMK)),U,12)'=90)
SET ABMR("REF",20)=""
End DoDot:1
+5 IF $GET(ABMR("REF",20))=""
IF ABMIEN=0
IF ($GET(ABMFILE)=200)
IF $DATA(ABMP("PRV","F"))
SET ABMR("REF",20)="1G"
+6 ;supervising
IF +$GET(Z)'=0
IF $DATA(ABMP("PRV","S",Z))
SET ABMR("REF",20)="1D"
+7 QUIT
30 ;REF02 - Reference Identification
+1 IF ABMEIC=87
Begin DoDot:1
+2 IF ABMP("EXP")=21
SET ABMR("REF",30)="004010X096A1"
+3 IF ABMP("EXP")=22
SET ABMR("REF",30)="004010X098A1"
+4 IF ABMP("EXP")=23
SET ABMR("REF",30)="004010X097A1"
End DoDot:1
+5 IF ABMEIC="G4"
Begin DoDot:1
+6 SET ABMR("REF",30)=$PIECE(ABMB5,"^",8)
End DoDot:1
+7 IF ABMEIC="9F"
Begin DoDot:1
+8 SET ABMR("REF",30)=$PIECE(ABMB5,"^",11)
End DoDot:1
+9 IF ABMEIC="G1"
Begin DoDot:1
+10 SET ABMR("REF",30)=$PIECE(ABMB5,"^",12)
End DoDot:1
+11 ;start new code abm*2.6*1 HEAT4158
+12 ;mammography cert#
+13 IF ABMEIC="EW"
Begin DoDot:1
+14 SET ABMR("REF",30)=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,5)),U,4)
End DoDot:1
+15 ;end new code HEAT4158
+16 IF ABMEIC="F4"
Begin DoDot:1
+17 SET ABMR("REF",30)=""
+18 ;service lines
IF ABMCLIA="SV"
Begin DoDot:2
+19 ; if outside lab (determined by use of 90 modifier)
+20 ; ABMOUTLB will be used later to determine whether other segments should be written
+21 IF $PIECE(ABMRV(ABMI,ABMJ,ABMK),U,3)=90!($PIECE(ABMRV(ABMI,ABMJ,ABMK),U,4)=90)!($PIECE(ABMRV(ABMI,ABMJ,ABMK),U,12)=90)
Begin DoDot:3
+22 IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0),"^",14)'=""
SET ABMR("REF",30)=$PIECE(^ABMRLABS($PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0),"^",14),0),"^",2)
QUIT
+23 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",23)'=""
SET ABMR("REF",30)=$PIECE(^ABMRLABS($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",23),0),"^",2)
End DoDot:3
+24 ; if in-house lab (lack of 90 modifier)
End DoDot:2
End DoDot:1
+25 IF ABMEIC="X4"
Begin DoDot:1
+26 SET ABMR("REF",30)=""
+27 ;in-house CLIA from claim header
IF ABMCLIA="CLM"
SET ABMR("REF",30)=$PIECE(ABMB9,U,22)
QUIT
+28 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)'=""
IF ($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)'=($PIECE($GET(ABMB9),U,22)))
SET ABMR("REF",30)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)
+29 IF '$TEST
SET ABMR("REF",30)=$PIECE($GET(ABMB9),U,22)
End DoDot:1
+30 IF ABMEIC="EA"
Begin DoDot:1
+31 SET ABMR("REF",30)=$$HRN^ABMUTL8(ABMP("PDFN"))
End DoDot:1
+32 IF ABMEIC="1C"
Begin DoDot:1
+33 IF ABMFILE=9999999.06
Begin DoDot:2
+34 SET ABMR("REF",30)=$$MCR^ABMUTLF(ABMIEN)
End DoDot:2
+35 IF ABMFILE=200
Begin DoDot:2
+36 SET ABMR("REF",30)=$$MCR^ABMEEPRV(ABMIEN)
+37 IF $$RCID^ABMUTLP(ABMP("INS"))'="C00900"
QUIT
+38 IF $$RCID^ABMUTLP(ABMP("INS"))'="04402"
QUIT
+39 SET ABMR("REF",30)=$$NPI^ABMEEPRV(ABMIEN,ABMP("LDFN"),ABMP("INS"))
End DoDot:2
End DoDot:1
+40 IF ABMEIC="1D"
Begin DoDot:1
+41 IF ABMFILE=9999999.06
Begin DoDot:2
+42 SET ABMR("REF",30)=$$MCD^ABMUTLF(ABMIEN)
End DoDot:2
+43 IF ABMFILE=200
Begin DoDot:2
+44 SET ABMR("REF",30)=$$MCD^ABMEEPRV(ABMIEN,+$GET(ABMPAYER))
End DoDot:2
End DoDot:1
+45 IF ABMEIC="0B"
Begin DoDot:1
+46 SET ABMR("REF",30)=$$SLN^ABMEEPRV(ABMIEN)
End DoDot:1
+47 IF ABMEIC="1G"
Begin DoDot:1
+48 SET ABMR("REF",30)=$$MCD^ABMUTLF(ABMIEN)
+49 IF ABMR("REF",30)=""
SET ABMR("REF",30)=$$UPIN^ABMEEPRV(ABMIEN)
End DoDot:1
+50 IF "^BQ^G2^1A^1B^B3^1H^1J^EI^FH^G5^LU^SY^U3^X5^"[("^"_ABMEIC_"^")
Begin DoDot:1
+51 IF ABMFILE=9999999.06
Begin DoDot:2
+52 IF ABMRCID="FHC&AFFILIATES"&(ABMEIC="LU")
Begin DoDot:3
+53 SET ABMR("REF",30)=$PIECE($GET(^AUTNINS(ABMP("INS"),15,ABMIEN,0)),U,2)
End DoDot:3
+54 IF '$TEST
SET ABMR("REF",30)=$$PI^ABMUTLF(ABMIEN)
End DoDot:2
+55 IF ABMFILE=200
Begin DoDot:2
+56 IF ABMRCID="FHC&AFFILIATES"&(ABMEIC="LU")
Begin DoDot:3
+57 SET ABMR("REF",30)=$PIECE($GET(^AUTNINS(ABMP("INS"),15,ABMIEN,0)),U,2)
End DoDot:3
+58 IF '$TEST
SET ABMR("REF",30)=$$PI^ABMUTLF(ABMP("LDFN"))
End DoDot:2
End DoDot:1
+59 IF ABMEIC="F8"
Begin DoDot:1
+60 SET ABMR("REF",30)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,9)
End DoDot:1
+61 IF +ABMIEN=0
IF $DATA(ABMP("PRV","F"))
IF ($GET(Z)'="")
SET ABMR("REF",30)=$PIECE($GET(ABMP("PRV","F",Z)),"^")
+62 ;I +$G(Z)=0,($G(ABMSIEN)'=""),(ABMR("REF",30)="") S ABMR("REF",30)=$P($G(ABMP("PRV","S",Z)),U) ;abm*2.6*8
+63 ;abm*2.6*8
IF +$GET(Z)=0
IF ($GET(ABMIEN)'="")
IF (ABMR("REF",30)="")
SET ABMR("REF",30)=$PIECE($GET(ABMP("PRV","S",Z)),U)
+64 QUIT
40 ;REF03 - Description-not used
+1 SET ABMR("REF",40)=""
+2 QUIT
50 ;REF04 - Reference Identifier-not used
+1 SET ABMR("REF",50)=""
+2 QUIT
