Routine: ABMEEPRV

ABMEEPRV ;IHS/ASDST/DMJ - PROVIDER INFO

 ;;2.6;IHS 3P BILLING SYSTEM;**10,11**;NOV 12, 2009;Build 133

 ; IHS/SD/SDR - v2.5 p5 - 5/17/04 - Added code to get info for

 ;      referring provider if on page 3

 ; IHS/SD/SDR v2.5 p6 - 7/14/04 - IM14117 - Added code to get

 ;     tax code using CODE (DD was changed so code had to be updated)

 ; IHS/SD/SDR - v2.5 p9 - IM19291

 ;   Supervising provider UPIN

 ; IHS/SD/SDR - v2.5 p9 - IM18318

 ;    Correction for PTAX+16^ABMEEPRV

 ; IHS/SD/SDR - v2.5 p10 - IM20776

 ;    Fix for <SUBSCR>GETPRV+18^ABMEEPRV

 ; IHS/SD/SDR - v2.5 p10 - IM21451

 ;    Fix for Payer Assigned Provider Number for Medicare

 ;    Look for insurer match, not just looping through

 ; IHS/SD/SDR - v2.5 p11 - NPI

LNM(X) ;EP - last name

 S X=$P($G(^VA(200,X,0)),U)

 S X=$P(X,",",1)

Q X

FNM(X) ;EP - first name

 S X=$P($G(^VA(200,X,0)),U)

 S X=$P(X,",",2)

 S X=$P(X," ",1)

Q X

MI(X) ;EP - middle initial

 S X=$P($G(^VA(200,X,0)),U)

 S X=$P(X,",",2)

 S X=$P(X," ",2)

 S X=$E(X,1)

Q X

UPIN(X) ;EP - upin number

 S X=$P($G(^VA(200,X,9999999)),"^",8)

 S:X="" X="PHS000"

Q X

SLN(X,Y) ;EP - state license number

 ;X=provider ien

 ;Y=state ien

 S X=$G(X)

 I X="" Q X

 I '$G(Y) S Y=$P(^AUTTLOC(DUZ(2),0),"^",23)

 I 'Y S Y=$P(^AUTTLOC(DUZ(2),0),"^",14)

 I 'Y S Y=999

N I

 S I=$O(^VA(200,X,"PS1","B",Y,0))

 I 'I S I=$O(^VA(200,X,"PS1",0))

 I 'I S X="" Q X

 S Y=$P(^VA(200,X,"PS1",I,0),U)

 S X=$P(^VA(200,X,"PS1",I,0),"^",2)

 S X=$P(^DIC(5,Y,0),"^",2)_"-"_X

Q X

MCR(X) ;EP  - medicare provider number

 ;x=provider ien

 I '$D(^VA(200,+X)) S X="" Q X

N I

 S I=0 F  S I=$O(^VA(200,X,9999999.18,I)) Q:'I  D

 .;Q:$P($G(^AUTNINS(I,2)),U)'="R"  ;abm*2.6*10 HEAT73780

 .Q:($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,I,".211","I"),1,"I")'="R")  ;abm*2.6*10 HEAT73780

 .Q:I'=ABMP("INS")

 .S ABMCR=$P(^VA(200,X,9999999.18,I,0),"^",2)

 I $G(ABMCR)="" D

 .S ABMCR=$P($G(^VA(200,X,9999999)),"^",6)

 S X=ABMCR K ABMCR

Q X

MCD(X,Y) ;EP  - medicaid provider number

 ;x=provider ien

 ;Y=payer

 S X=+$G(X)

 S Y=$G(Y)

 I 'X S X="" Q X

 I '$D(^VA(200,X)) S X="" Q X

 S ABMCD=$P($G(^VA(200,X,9999999.18,+Y,0)),"^",2)

 I ABMCD="" D

 .S ABMCD=$P($G(^VA(200,X,9999999)),"^",7)

 S X=ABMCD K ABMCD

Q X

PROVNUM(X) ; EP - Provider Number, sensitive to ABMP("INS") and ABMP("ITYPE")

 ;x=provider ien

 I 'X Q "PHS000"

 N RET S RET=""

 I ABMP("INS") D  Q:RET]"" RET

 .S RET=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),3,X,0)),"^",2)

 .Q:RET'=""

 .N D1 S D1=$O(^VA(200,X,9999999.18,"B",ABMP("INS"),0)) Q:'D1

 .S RET=$P(^VA(200,X,9999999.18,D1,0),U,2)

 I ABMP("ITYPE")="R" Q $$MCR(X)

 N ST S ST=$P($G(^AUTTLOC(+ABMP("LDFN"),0)),U,23)

 I ABMP("ITYPE")="D"!(ABMP("ITYPE")="K") Q $$MCD(X,ST)

 Q $$UPIN(X)

SSN(X) ; EP - Provider's SSN

 S X=$P($G(^VA(200,X,1)),"^",9)

Q X

EIN(X) ; EP - Provider's EIN

 Q ""

SPEC(X) ;EP - provider specialty

 ;x=provider ien

 S ABMPS=$P($G(^VA(200,+X,"PS")),"^",5) ;

 S X=$G(^DIC(7,+ABMPS,0))

 S:$G(^DIC(7,+ABMPS,9999999))'="" X=X_"^"_^(9999999)

 K ABMPS

Q X

NPI(X,Y,Z)         ;EP - national provider identifier

 ;x=ien file 200, y=location, z=insurer

 S X=$P($G(^ABMNINS(+Y,+Z,3,+X,0)),"^",2)

Q X

ENVSPEC(X) ; EP - Envoy Provider Specialty Code

 ; Given X = pointer to ^VA(200,

 ; ABMP("INS") = pointer to ^AUTNINS / ^ABMNINS

 ; ABMP("XMIT") = pointer to ^ABMDTXST

 N D0

 S D0=$P($G(^VA(200,+X,"PS")),U,5) Q:'D0     ; the IHS code in ^DIC(7,X,

 Q:'$D(^ABMENVPS(D0,0))

 N CODE S CODE=$P(^ABMENVPS(D0,0),"^",2)     ; CODE we will return

 D ENVSPEC1                                  ; deal with restrictions

 Q CODE

ENVSPEC1 ; some codes are restricted to certain bill formats and

 ; whether or not we are deality with a Participating Payer

 ; Change "CODE" value if there is such a restriction

 N CODETYPE S CODETYPE=$$ENVSPECT

 N D1,STOP S D1=0

 F  S D1=$O(^ABMENVPS(D0,1,"B",CODETYPE,D1)) Q:'D1  D  Q:$G(STOP)

 .N X S X=^ABMENVPS(D0,1,D1,0)

 .; future: might have more restrictions to check,

 .; that's why we put in the loop

 .S CODE=$P(X,U,2),STOP=1

ENVSPECT() ; Envoy Specialty Code Type

 Q "NB"  ; always go with the more restrictive list for now.

 N RCID S RCID=$$RCID^ABMERUTL(ABMP("INS")) ; receiver ID

 ; PP = whether this is an Envoy participating payer

 ; If RCID is all spaces or all 0s or all 9s, we say "no"

 N PP S PP='((RCID?." ")!(RCID?."0")!(RCID?."9"))

 I $$ENVOY15^ABMEF19 Q $S(PP:"NP",1:"NB")

 Q "NP"  ; just go with 1500 participating payer codes?

PTAX(X) ;EP - provider taxonomy

 ;X=provider ien

 I $G(ABMR("PRV",20))="RF",+$O(ABMP("PRV","F",""))=0 D  Q X

 .S X=$P($G(ABMP("PRV","F",ABMIEN)),U,2)

 I '+$G(X) S X="" Q X

N Y

 ;start old code abm*2.6*11 HEAT92505

 ;S Y=$O(^VA(200,X,"USC1",0))

 ;S ABMPCLAS=$P($G(^VA(200,X,"USC1",+Y,0)),U)

 ;S ABMPTAX=$G(^ABMPTAX("AUSC",+ABMPCLAS))

 ;I ABMPTAX'="" Q ABMPTAX

 ;end old code start new code HEAT92505

 S Y=0

 S ABMPTAX=""

 F  S Y=$O(^VA(200,X,"USC1",Y)) Q:'Y  D  Q:($G(ABMPTAX)'="")

 .Q:$P($G(^VA(200,X,"USC1",+Y,0)),U,3)'=""  ;expiration date

 .S ABMPCLAS=$P($G(^VA(200,X,"USC1",+Y,0)),U)

 .S ABMPTAX=$G(^ABMPTAX("AUSC",+ABMPCLAS))

 I ABMPTAX'="" Q ABMPTAX

 ;end new code HEAT92505

 S Y=$P($G(^VA(200,X,"PS")),"^",5)

 S:Y Y=$P($G(^DIC(7,Y,9999999)),U)

 S ABMPTAX=$S($G(Y)'="":$G(^ABMPTAX("A7",Y)),1:0)

 Q ABMPTAX

GETPRV ;EP - build provider array

 ;only first provider found for each type

N J

 S J=0

 F  S J=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,J)) Q:'J  D

 .S ABM0=^ABMDBILL(DUZ(2),ABMP("BDFN"),41,J,0)

 .S ABMPTYP=$P(ABM0,"^",2)

 .Q:$D(ABMP("PRV",ABMPTYP))

 .S ABMP("PRV",ABMPTYP,+ABM0)=""

 K ABM0,ABMPTYP

 I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",8)'="" D

 .I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,13)'="" D  ;Person Class

 ..S ABMPTAX=$G(^ABMPTAX("AUSC",$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,13)))

 .I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,14)'="" D  ;Provider Class

 ..S ABMPTAX=$P($G(^DIC(7,$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,14),9999999)),U)

 ..S:ABMPTAX'="" ABMPTAX=$G(^ABMPTAX("A7",ABMPTAX))

 .I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,15)'="" D  ;Provider Taxonomy

 ..S ABMPTAX=$P($G(^ABMPTAX($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,15),0)),U)

 .S ABMP("PRV","F",$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,8))=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",11)_"^"_$G(ABMPTAX)

 .S:$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,17)'="" $P(ABMP("PRV","F",$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,8)),U,3)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,17)

 I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,12)'="" D  ;supervising provider

 .S ABMP("PRV","S",$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),9),U,12))=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,24)

 .;S:$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,25)'="" $P(ABMP("PRV","S",$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),9),U,12)),U,2)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,25)  ;abm*2.6*10 HEAT80154

 .S:$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,25)'="" $P(ABMP("PRV","S",$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),9),U,12)),U,3)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,25)  ;abm*2.6*10 HEAT80154

ABMEEPRV  ;IHS/ASDST/DMJ - PROVIDER INFO

 +1       ;;2.6;IHS 3P BILLING SYSTEM;**10,11**;NOV 12, 2009;Build 133

 +2       ;

 +3       ; IHS/SD/SDR - v2.5 p5 - 5/17/04 - Added code to get info for

 +4       ;      referring provider if on page 3

 +5       ; IHS/SD/SDR v2.5 p6 - 7/14/04 - IM14117 - Added code to get

 +6       ;     tax code using CODE (DD was changed so code had to be updated)

 +7       ; IHS/SD/SDR - v2.5 p9 - IM19291

 +8       ;   Supervising provider UPIN

 +9       ; IHS/SD/SDR - v2.5 p9 - IM18318

 +10      ;    Correction for PTAX+16^ABMEEPRV

 +11      ; IHS/SD/SDR - v2.5 p10 - IM20776

 +12      ;    Fix for <SUBSCR>GETPRV+18^ABMEEPRV

 +13      ; IHS/SD/SDR - v2.5 p10 - IM21451

 +14      ;    Fix for Payer Assigned Provider Number for Medicare

 +15      ;    Look for insurer match, not just looping through

 +16      ; IHS/SD/SDR - v2.5 p11 - NPI

 +17      ;

LNM(X)    ;EP - last name

 +1        SET X=$PIECE($GET(^VA(200,X,0)),U)

 +2        SET X=$PIECE(X,",",1)

 +3        QUIT X

FNM(X)    ;EP - first name

 +1        SET X=$PIECE($GET(^VA(200,X,0)),U)

 +2        SET X=$PIECE(X,",",2)

 +3        SET X=$PIECE(X," ",1)

 +4        QUIT X

MI(X)     ;EP - middle initial

 +1        SET X=$PIECE($GET(^VA(200,X,0)),U)

 +2        SET X=$PIECE(X,",",2)

 +3        SET X=$PIECE(X," ",2)

 +4        SET X=$EXTRACT(X,1)

 +5        QUIT X

UPIN(X)   ;EP - upin number

 +1        SET X=$PIECE($GET(^VA(200,X,9999999)),"^",8)

 +2        IF X=""

               SET X="PHS000"

 +3        QUIT X

SLN(X,Y)  ;EP - state license number

 +1       ;X=provider ien

 +2       ;Y=state ien

 +3        SET X=$GET(X)

 +4        IF X=""

               QUIT X

 +5        IF '$GET(Y)

               SET Y=$PIECE(^AUTTLOC(DUZ(2),0),"^",23)

 +6        IF 'Y

               SET Y=$PIECE(^AUTTLOC(DUZ(2),0),"^",14)

 +7        IF 'Y

               SET Y=999

 +8        NEW I

 +9        SET I=$ORDER(^VA(200,X,"PS1","B",Y,0))

 +10       IF 'I

               SET I=$ORDER(^VA(200,X,"PS1",0))

 +11       IF 'I

               SET X=""

               QUIT X

 +12       SET Y=$PIECE(^VA(200,X,"PS1",I,0),U)

 +13       SET X=$PIECE(^VA(200,X,"PS1",I,0),"^",2)

 +14       SET X=$PIECE(^DIC(5,Y,0),"^",2)_"-"_X

 +15       QUIT X

MCR(X)    ;EP  - medicare provider number

 +1       ;x=provider ien

 +2        IF '$DATA(^VA(200,+X))

               SET X=""

               QUIT X

 +3        NEW I

 +4        SET I=0

FOR

               SET I=$ORDER(^VA(200,X,9999999.18,I))

               IF 'I

                   QUIT

               Begin DoDot:1

 +5       ;Q:$P($G(^AUTNINS(I,2)),U)'="R"  ;abm*2.6*10 HEAT73780

 +6       ;abm*2.6*10 HEAT73780

                   IF ($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,I,".211","I"),1,"I")'="R")

                       QUIT

 +7                IF I'=ABMP("INS")

                       QUIT

 +8                SET ABMCR=$PIECE(^VA(200,X,9999999.18,I,0),"^",2)

               End DoDot:1

 +9        IF $GET(ABMCR)=""

               Begin DoDot:1

 +10               SET ABMCR=$PIECE($GET(^VA(200,X,9999999)),"^",6)

               End DoDot:1

 +11       SET X=ABMCR

           KILL ABMCR

 +12       QUIT X

MCD(X,Y)  ;EP  - medicaid provider number

 +1       ;x=provider ien

 +2       ;Y=payer

 +3        SET X=+$GET(X)

 +4        SET Y=$GET(Y)

 +5        IF 'X

               SET X=""

               QUIT X

 +6        IF '$DATA(^VA(200,X))

               SET X=""

               QUIT X

 +7        SET ABMCD=$PIECE($GET(^VA(200,X,9999999.18,+Y,0)),"^",2)

 +8        IF ABMCD=""

               Begin DoDot:1

 +9                SET ABMCD=$PIECE($GET(^VA(200,X,9999999)),"^",7)

               End DoDot:1

 +10       SET X=ABMCD

           KILL ABMCD

 +11       QUIT X

PROVNUM(X) ; EP - Provider Number, sensitive to ABMP("INS") and ABMP("ITYPE")

 +1       ;x=provider ien

 +2        IF 'X

               QUIT "PHS000"

 +3        NEW RET

           SET RET=""

 +4        IF ABMP("INS")

               Begin DoDot:1

 +5                SET RET=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),3,X,0)),"^",2)

 +6                IF RET'=""

                       QUIT

 +7                NEW D1

                   SET D1=$ORDER(^VA(200,X,9999999.18,"B",ABMP("INS"),0))

                   IF 'D1

                       QUIT

 +8                SET RET=$PIECE(^VA(200,X,9999999.18,D1,0),U,2)

               End DoDot:1

               IF RET]""

                   QUIT RET

 +9        IF ABMP("ITYPE")="R"

               QUIT $$MCR(X)

 +10       NEW ST

           SET ST=$PIECE($GET(^AUTTLOC(+ABMP("LDFN"),0)),U,23)

 +11       IF ABMP("ITYPE")="D"!(ABMP("ITYPE")="K")

               QUIT $$MCD(X,ST)

 +12       QUIT $$UPIN(X)

SSN(X)    ; EP - Provider's SSN

 +1        SET X=$PIECE($GET(^VA(200,X,1)),"^",9)

 +2        QUIT X

EIN(X)    ; EP - Provider's EIN

 +1        QUIT ""

SPEC(X)   ;EP - provider specialty

 +1       ;x=provider ien

 +2       ;

           SET ABMPS=$PIECE($GET(^VA(200,+X,"PS")),"^",5)

 +3        SET X=$GET(^DIC(7,+ABMPS,0))

 +4        IF $GET(^DIC(7,+ABMPS,9999999))'=""

               SET X=X_"^"_^(9999999)

 +5        KILL ABMPS

 +6        QUIT X

NPI(X,Y,Z) ;EP - national provider identifier

 +1       ;x=ien file 200, y=location, z=insurer

 +2        SET X=$PIECE($GET(^ABMNINS(+Y,+Z,3,+X,0)),"^",2)

 +3        QUIT X

ENVSPEC(X) ; EP - Envoy Provider Specialty Code

 +1       ; Given X = pointer to ^VA(200,

 +2       ; ABMP("INS") = pointer to ^AUTNINS / ^ABMNINS

 +3       ; ABMP("XMIT") = pointer to ^ABMDTXST

 +4       ;

 +5        NEW D0

 +6       ; the IHS code in ^DIC(7,X,

           SET D0=$PIECE($GET(^VA(200,+X,"PS")),U,5)

           IF 'D0

               QUIT

 +7        IF '$DATA(^ABMENVPS(D0,0))

               QUIT

 +8       ; CODE we will return

           NEW CODE

           SET CODE=$PIECE(^ABMENVPS(D0,0),"^",2)

 +9       ; deal with restrictions

           DO ENVSPEC1

 +10       QUIT CODE

ENVSPEC1  ; some codes are restricted to certain bill formats and

 +1       ; whether or not we are deality with a Participating Payer

 +2       ; Change "CODE" value if there is such a restriction

 +3        NEW CODETYPE

           SET CODETYPE=$$ENVSPECT

 +4        NEW D1,STOP

           SET D1=0

 +5        FOR

               SET D1=$ORDER(^ABMENVPS(D0,1,"B",CODETYPE,D1))

               IF 'D1

                   QUIT

               Begin DoDot:1

 +6                NEW X

                   SET X=^ABMENVPS(D0,1,D1,0)

 +7       ; future: might have more restrictions to check,

 +8       ; that's why we put in the loop

 +9                SET CODE=$PIECE(X,U,2)

                   SET STOP=1

               End DoDot:1

               IF $GET(STOP)

                   QUIT

 +10       QUIT

ENVSPECT() ; Envoy Specialty Code Type

 +1       ; always go with the more restrictive list for now.

           QUIT "NB"

 +2       ; receiver ID

           NEW RCID

           SET RCID=$$RCID^ABMERUTL(ABMP("INS"))

 +3       ; PP = whether this is an Envoy participating payer

 +4       ; If RCID is all spaces or all 0s or all 9s, we say "no"

 +5        NEW PP

           SET PP='((RCID?." ")!(RCID?."0")!(RCID?."9"))

 +6        IF $$ENVOY15^ABMEF19

               QUIT $SELECT(PP:"NP",1:"NB")

 +7       ; just go with 1500 participating payer codes?

           QUIT "NP"

PTAX(X)   ;EP - provider taxonomy

 +1       ;X=provider ien

 +2        IF $GET(ABMR("PRV",20))="RF"

               IF +$ORDER(ABMP("PRV","F",""))=0

                   Begin DoDot:1

 +3                    SET X=$PIECE($GET(ABMP("PRV","F",ABMIEN)),U,2)

                   End DoDot:1

                   QUIT X

 +4        IF '+$GET(X)

               SET X=""

               QUIT X

 +5        NEW Y

 +6       ;start old code abm*2.6*11 HEAT92505

 +7       ;S Y=$O(^VA(200,X,"USC1",0))

 +8       ;S ABMPCLAS=$P($G(^VA(200,X,"USC1",+Y,0)),U)

 +9       ;S ABMPTAX=$G(^ABMPTAX("AUSC",+ABMPCLAS))

 +10      ;I ABMPTAX'="" Q ABMPTAX

 +11      ;end old code start new code HEAT92505

 +12       SET Y=0

 +13       SET ABMPTAX=""

 +14       FOR

               SET Y=$ORDER(^VA(200,X,"USC1",Y))

               IF 'Y

                   QUIT

               Begin DoDot:1

 +15      ;expiration date

                   IF $PIECE($GET(^VA(200,X,"USC1",+Y,0)),U,3)'=""

                       QUIT

 +16               SET ABMPCLAS=$PIECE($GET(^VA(200,X,"USC1",+Y,0)),U)

 +17               SET ABMPTAX=$GET(^ABMPTAX("AUSC",+ABMPCLAS))

               End DoDot:1

               IF ($GET(ABMPTAX)'="")

                   QUIT

 +18       IF ABMPTAX'=""

               QUIT ABMPTAX

 +19      ;end new code HEAT92505

 +20       SET Y=$PIECE($GET(^VA(200,X,"PS")),"^",5)

 +21       IF Y

               SET Y=$PIECE($GET(^DIC(7,Y,9999999)),U)

 +22       SET ABMPTAX=$SELECT($GET(Y)'="":$GET(^ABMPTAX("A7",Y)),1:0)

 +23       QUIT ABMPTAX

GETPRV    ;EP - build provider array

 +1       ;only first provider found for each type

 +2        NEW J

 +3        SET J=0

 +4        FOR

               SET J=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,J))

               IF 'J

                   QUIT

               Begin DoDot:1

 +5                SET ABM0=^ABMDBILL(DUZ(2),ABMP("BDFN"),41,J,0)

 +6                SET ABMPTYP=$PIECE(ABM0,"^",2)

 +7                IF $DATA(ABMP("PRV",ABMPTYP))

                       QUIT

 +8                SET ABMP("PRV",ABMPTYP,+ABM0)=""

               End DoDot:1

 +9        KILL ABM0,ABMPTYP

 +10       IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",8)'=""

               Begin DoDot:1

 +11      ;Person Class

                   IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,13)'=""

                       Begin DoDot:2

 +12                       SET ABMPTAX=$GET(^ABMPTAX("AUSC",$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,13)))

                       End DoDot:2

 +13      ;Provider Class

                   IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,14)'=""

                       Begin DoDot:2

 +14                       SET ABMPTAX=$PIECE($GET(^DIC(7,$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,14),9999999)),U)

 +15                       IF ABMPTAX'=""

                               SET ABMPTAX=$GET(^ABMPTAX("A7",ABMPTAX))

                       End DoDot:2

 +16      ;Provider Taxonomy

                   IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,15)'=""

                       Begin DoDot:2

 +17                       SET ABMPTAX=$PIECE($GET(^ABMPTAX($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,15),0)),U)

                       End DoDot:2

 +18               SET ABMP("PRV","F",$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,8))=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",11)_"^"_$GET(ABMPTAX)

 +19               IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,17)'=""

                       SET $PIECE(ABMP("PRV","F",$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,8)),U,3)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,17)

               End DoDot:1

 +20      ;supervising provider

           IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,12)'=""

               Begin DoDot:1

 +21               SET ABMP("PRV","S",$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),9),U,12))=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,24)

 +22      ;S:$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,25)'="" $P(ABMP("PRV","S",$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),9),U,12)),U,2)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,25)  ;abm*2.6*10 HEAT80154

 +23      ;abm*2.6*10 HEAT80154

                   IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,25)'=""

                       SET $PIECE(ABMP("PRV","S",$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),9),U,12)),U,3)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,25)

               End DoDot:1

 +24       QUIT

ABMEEPRV.m