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
Q
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
Q
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
