Routine: ABME8REF

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

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)

10 ;segment

 S ABMR("REF",10)="REF"

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

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

40 ;REF03 - Description-not used

 S ABMR("REF",40)=""

50 ;REF04 - Reference Identifier-not used

 S ABMR("REF",50)=""

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

ABME8REF.m