ABMDE4X ; IHS/SD/SDR - Edit Page 4 - Providers DATA CK ; 11 Sep 2012 9:33 AM
;;2.6;IHS Third Party Billing;**1,3,8,9,10,11**;NOV 12, 2009;Build 133
;
; IHS/DSD/LSL - 05/20/98 - NOIS HQW-0598-100109
; Modified to check file 200, payer assigned provider
; number, first on dental form
; IHS/ASDS/LSL - 10/21/01 - V2.4 Patch 9
; Display Medicare part B pin number on page 4 if professional
; component, medicare insurer type and mode of export contain
; HCFA-1500. If the above are true and no pin number, set errror
; 189.
;
; IHS/SD/SDR - v2.5 p5 - 5/17/2004 - IM12881 - Made change to display
; provider number correctly
; IHS/SD/SDR - v2.5 p8 - IM14693/IM16105
; Added code to check error 190 for export mode 25
; IHS/SD/SDR - v2.5 p9 - IM19302
; Correction to error 170
; IHS/SD/SDR - v2.5 p9 - IM16942
; For OK Medicaid - if VT 999 - print payer assigned provider#
; if not VT 999-PIN# from Insurer file
; IHS/SD/SDR - v2.5 p10 - IM20310
; Update 170 error check to check Payer Assigned Provider Number
; for Medicare
; IHS/SD/SDR - v2.5 p10 - IM20776
; Made change to 190 error to check for Rendering provider
; IHS/SD/SDR - v2.5 p11 - NPI
; IHS/SD/SDR - abm*2.6*1 - NO HEAT - remove error 189 if NPI ONLY
; IHS/SD/SDR - abm*2.6*3 - HEAT12442 - made error 92 display for all 837s
;
; *********************************************************************
;
PROV ; Provider Info
ERR S ABME("TITL")="PAGE 4 - PROVIDER INFORMATION"
K ABM("A"),ABM("O")
I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"B",0))=0 S ABME(244)="" ;abm*2.6*11 HEAT81017
S ABM=""
F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C",ABM)) Q:ABM="" D
.S ABM("X")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C",ABM,0))
.S ABM("NUM")=ABM("I")
.D SEL
I '$D(ABM("A")) D
.;Q:ABMP("EXP")=22 ;abm*2.6*3 HEAT12442 ;abm*2.6*9 HEAT57734
.Q:ABMP("EXP")=22!(ABMP("EXP")=32) ;abm*2.6*3 HEAT12442 ;abm*2.6*9 HEAT57734
.S ABME(92)=""
OP I '$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C","O")),$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,0)),ABMP("PAGE")'[8 S ABME(2)=""
I ABMP("EXP")=2!(ABMP("EXP")=3)!(ABMP("EXP")=14),$P(^ABMDPARM(DUZ(2),1,0),U,17)=2 K ABME
K ABM
Q
;
SEL ;EP - Entry Point for select provider, Claim File Error Check
S ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),41,ABM("X"),0) G GET
SELBILL ;EP - Entry Point for Bill file provider error check
;
; input var: ABM(X) = the IEN of the Provider for the Bill
;
; output var: ABM("A") - attending name ^ Prv IEN ^ Claim IEN
; ABM("O") - operating name ^ Prv IEN ^ Claim IEN
; ABM("PNUM") - provider number
; ABM("DISC") - provider discipline
;
S ABM("X0")=^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABM("X"),0),ABMP("C0")=ABMP("B0")
;
GET S (ABM("DISC"),ABM("PNUM"))=""
Q:$P(ABM("X0"),U,2)=""
I '$D(^VA(200,$P(ABM("X0"),U),0)) S ABME(119)="DFN:"_$P(ABM("X0"),U) Q
S ABM($P(ABM("X0"),U,2))=$P(^VA(200,$P(ABM("X0"),U),0),U)_U_$P(ABM("X0"),U)_U_ABM("X")
S ABM("DISC")=$P($G(^VA(200,$P(ABM("X0"),U),"PS")),U,5)
I ABM("DISC")]"",$D(^DIC(7,ABM("DISC"),0)) S ABM("DISC")=$E($P(^(0),U),1,30)
E S ABME(118)=""
DR ;PHYSICIAN'S PROVIDER NUMBER
S ABMNPIUS=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
I ABMNPIUS="N",($P($$NPI^XUSNPI("Individual_ID",+ABM("X0")),U)<0)&($P($$NPI^XUSNPI("Organization_ID",+ABMP("LDFN")),U)<0) S ABME(220)=""
I ABMNPIUS="B",($P($$NPI^XUSNPI("Individual_ID",+ABM("X0")),U)<0)&($P($$NPI^XUSNPI("Organization_ID",+ABMP("LDFN")),U)<0) S ABME(221)=""
I (ABMNPIUS="N"!(ABMNPIUS="B")),($P($$NPI^XUSNPI("Individual_ID",+ABM("X0")),U)<0)&($P($$NPI^XUSNPI("Organization_ID",ABMP("LDFN")),U)>0) S ABME(232)=""
I '$D(ABMP("CDFN")),$D(ABMP("BDFN")) S ABMP("CDFN")=+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U)
I +ABMP("CDFN") D Q:$D(ABME(189))
.S:ABMP("VTYP")="" ABMP("VTYP")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,7)
.S:ABMP("INS")="" ABMP("INS")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,8)
.;S:ABMP("INS")'="" ABMP("ITYP")=$P($G(^AUTNINS(ABMP("INS"),2)),U) ;abm*2.6*10 HEAT73780
.S:ABMP("INS")'="" ABMP("ITYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I") ;abm*2.6*10 HEAT73780
.S:ABMP("EXP")="" ABMP("EXP")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,14)
.S:ABMP("LDFN")="" ABMP("LDFN")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,3)
.;start old code abm*2.6*9 NOHEAT
.;I ABMP("VTYP")=999 D
.;.I $G(ABMP("ITYP"))="R" D ;abm*2.6*1 NOHEAT
.;.;I $G(ABMP("ITYP"))="R",(ABMNPIUS'="N") D ;abm*2.6*1 NOHEAT
.;..I +ABMP("EXP"),(($P($G(^ABMDEXP(+ABMP("EXP"),0)),U)["HCFA")!($P($G(^ABMDEXP(+ABMP("EXP"),0)),U)["CMS")) D
.;...S ABM("PNUM")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),3,+ABM("X0"),0)),U,2)
.;...S:ABM("PNUM")="" ABME(189)=""
.;.I $P(^AUTNINS(ABMP("INS"),0),U)["OKLAHOMA MEDICAID" D
.;..S ABM("PNUM")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),3,+ABM("X0"),0)),U,2)
.;end old start new abm*2.6*9
.I $G(ABMP("ITYP"))="R",ABMP("VTYP")=999 D
..I +ABMP("EXP"),(($P($G(^ABMDEXP(+ABMP("EXP"),0)),U)["HCFA")!($P($G(^ABMDEXP(+ABMP("EXP"),0)),U)["CMS")) D
...S ABM("PNUM")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),3,+ABM("X0"),0)),U,2)
...S:ABM("PNUM")="" ABME(189)=""
.I $P(^AUTNINS(ABMP("INS"),0),U)["OKLAHOMA MEDICAID" D
..S ABM("PNUM")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),3,+ABM("X0"),0)),U,2)
;end new ABM*2.6*9
I $G(ABM("PNUM"))="" D
.S ABM("PNUM")=$P($G(^VA(200,+ABM("X0"),9999999.18,+ABMP("INS"),0)),"^",2)
I ABM("PNUM")="" D
.;I $P($G(^AUTNINS(+ABMP("INS"),2)),U)="R" D ;abm*2.6*10 HEAT73780
.I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="R" D ;abm*2.6*10 HEAT73780
..S ABM("PNUM")=$P($G(^VA(200,+ABM("X0"),9999999)),U,6)
..S:ABM("PNUM")="" ABM("PNUM")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),3,+ABM("X0"),0)),U,2)
..I ABM("PNUM")="" S ABME(170)=""
..S:ABM("PNUM")="" ABM("PNUM")=$P($G(^VA(200,+ABM("X0"),9999999)),"^",8)
..S:ABM("PNUM")="" ABM("PNUM")="PHS000"
.;I $P($G(^AUTNINS(+ABMP("INS"),2)),U)="D" D ;IHS/SD/SDR 9/25/09
.;I $P($G(^AUTNINS(+ABMP("INS"),2)),U)="D",(ABMNPIUS'="N") D ;IHS/SD/SDR 9/25/09 ;abm*2.6*10 HEAT73780
.I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMP("INS"),".211","I"),1,"I")="D",(ABMNPIUS'="N") D ;IHS/SD/SDR 9/25/09 ;abm*2.6*10 HEAT73780
..S ABM("PNUM")=$P($G(^VA(200,+ABM("X0"),9999999)),U,7)
..S:ABM("PNUM")="" ABME(170)=""
I ABM("PNUM")="",(ABMNPIUS'="N") D
.S ABM("ST")=$P(ABMP("C0"),U,3)
.S ABM("ST")=$P($G(^AUTTLOC(+ABM("ST"),0)),U,23)
.S:ABM("ST")="" ABM("ST")=$P($G(^AUTTLOC(+ABM("ST"),0)),U,14)
.I ABM("ST")="" S ABME(120)=""
.S ABM("PNUM")=$$SLN^ABMERUTL(+ABM("X0"),ABM("ST"))
S:ABM("PNUM")="" ABM("PNUM")=$P($G(^VA(200,+ABM("X0"),9999999)),U,8)
I ABM("PNUM")="",(ABMNPIUS'="N") S ABME(115)=""
;
COV ;
I $P(^ABMDEXP(ABMP("EXP"),0),U)[837!($G(ABMP("EXP"))=25) D
.Q:'("OAR"[$P(ABM("X0"),U,2))
.Q:$$PTAX^ABMEEPRV(+ABM("X0"))'=""
.S ABME(190)=""
Q:$G(ABMP("COV"))=""
Q:$G(ABM("DISC"))=""
F ABMX("C")=1:1 S ABM("COVD")=$P(ABMP("COV"),";",ABMX("C")) Q:'ABM("COVD") D
.S ABM("COVD")=$P($G(^VA(200,$P(ABM("X0"),U),"PS")),U,5)
.Q:$P($G(^AUTTPIC(ABMP("COV"),15,ABM("COVD"),0)),"^",2)'="U"
.S ABME(160)=""
Q
;
CONTR ;EP - Entry Point to determine if Contract Provider
S:'$D(ABMP("CDFN")) ABMP("CDFN")=ABMP("BDFN")
S ABM("CONTRACT")=0
S ABMX("D")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C","A","")) I ABMX("D")]"",$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,ABMX("D"),0)),$P($G(^VA(200,$P(^(0),U),9999999)),U)=2 S ABM("CONTRACT")=1 Q
S ABMX("D")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C","O","")) I ABMX("D")]"",$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,ABMX("D"),0)),$P($G(^VA(200,$P(^(0),U),9999999)),U)=2 S ABM("CONTRACT")=1
Q
;
AFFL ;EP - Entry Point to determine Provider's Affiliation
Q:ABM("MD") Q:$P($G(^VA(200,+ABM("X0"),"PS")),U,5)="" Q:$P($G(^DIC(7,$P(^("PS"),U,5),9999999)),U)="" S ABM("MD")=$P(^(9999999),U)
S ABM("MD")=$S(ABM("MD")="00"!(ABM("MD")>69&(ABM("MD")<87))!(ABM("MD")=49)!(ABM("MD")=18)!(ABM("MD")=25)!(ABM("MD")=33)!(ABM("MD")=41)!(ABM("MD")=44)!(ABM("MD")=45):1,1:0)
Q
ABMDE4X ; IHS/SD/SDR - Edit Page 4 - Providers DATA CK ; 11 Sep 2012 9:33 AM
+1 ;;2.6;IHS Third Party Billing;**1,3,8,9,10,11**;NOV 12, 2009;Build 133
+2 ;
+3 ; IHS/DSD/LSL - 05/20/98 - NOIS HQW-0598-100109
+4 ; Modified to check file 200, payer assigned provider
+5 ; number, first on dental form
+6 ; IHS/ASDS/LSL - 10/21/01 - V2.4 Patch 9
+7 ; Display Medicare part B pin number on page 4 if professional
+8 ; component, medicare insurer type and mode of export contain
+9 ; HCFA-1500. If the above are true and no pin number, set errror
+10 ; 189.
+11 ;
+12 ; IHS/SD/SDR - v2.5 p5 - 5/17/2004 - IM12881 - Made change to display
+13 ; provider number correctly
+14 ; IHS/SD/SDR - v2.5 p8 - IM14693/IM16105
+15 ; Added code to check error 190 for export mode 25
+16 ; IHS/SD/SDR - v2.5 p9 - IM19302
+17 ; Correction to error 170
+18 ; IHS/SD/SDR - v2.5 p9 - IM16942
+19 ; For OK Medicaid - if VT 999 - print payer assigned provider#
+20 ; if not VT 999-PIN# from Insurer file
+21 ; IHS/SD/SDR - v2.5 p10 - IM20310
+22 ; Update 170 error check to check Payer Assigned Provider Number
+23 ; for Medicare
+24 ; IHS/SD/SDR - v2.5 p10 - IM20776
+25 ; Made change to 190 error to check for Rendering provider
+26 ; IHS/SD/SDR - v2.5 p11 - NPI
+27 ; IHS/SD/SDR - abm*2.6*1 - NO HEAT - remove error 189 if NPI ONLY
+28 ; IHS/SD/SDR - abm*2.6*3 - HEAT12442 - made error 92 display for all 837s
+29 ;
+30 ; *********************************************************************
+31 ;
PROV ; Provider Info
ERR SET ABME("TITL")="PAGE 4 - PROVIDER INFORMATION"
+1 KILL ABM("A"),ABM("O")
+2 ;abm*2.6*11 HEAT81017
IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"B",0))=0
SET ABME(244)=""
+3 SET ABM=""
+4 FOR ABM("I")=1:1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C",ABM))
IF ABM=""
QUIT
Begin DoDot:1
+5 SET ABM("X")=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C",ABM,0))
+6 SET ABM("NUM")=ABM("I")
+7 DO SEL
End DoDot:1
+8 IF '$DATA(ABM("A"))
Begin DoDot:1
+9 ;Q:ABMP("EXP")=22 ;abm*2.6*3 HEAT12442 ;abm*2.6*9 HEAT57734
+10 ;abm*2.6*3 HEAT12442 ;abm*2.6*9 HEAT57734
IF ABMP("EXP")=22!(ABMP("EXP")=32)
QUIT
+11 SET ABME(92)=""
End DoDot:1
OP IF '$DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C","O"))
IF $ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,0))
IF ABMP("PAGE")'[8
SET ABME(2)=""
+1 IF ABMP("EXP")=2!(ABMP("EXP")=3)!(ABMP("EXP")=14)
IF $PIECE(^ABMDPARM(DUZ(2),1,0),U,17)=2
KILL ABME
+2 KILL ABM
+3 QUIT
+4 ;
SEL ;EP - Entry Point for select provider, Claim File Error Check
+1 SET ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),41,ABM("X"),0)
GOTO GET
SELBILL ;EP - Entry Point for Bill file provider error check
+1 ;
+2 ; input var: ABM(X) = the IEN of the Provider for the Bill
+3 ;
+4 ; output var: ABM("A") - attending name ^ Prv IEN ^ Claim IEN
+5 ; ABM("O") - operating name ^ Prv IEN ^ Claim IEN
+6 ; ABM("PNUM") - provider number
+7 ; ABM("DISC") - provider discipline
+8 ;
+9 SET ABM("X0")=^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABM("X"),0)
SET ABMP("C0")=ABMP("B0")
+10 ;
GET SET (ABM("DISC"),ABM("PNUM"))=""
+1 IF $PIECE(ABM("X0"),U,2)=""
QUIT
+2 IF '$DATA(^VA(200,$PIECE(ABM("X0"),U),0))
SET ABME(119)="DFN:"_$PIECE(ABM("X0"),U)
QUIT
+3 SET ABM($PIECE(ABM("X0"),U,2))=$PIECE(^VA(200,$PIECE(ABM("X0"),U),0),U)_U_$PIECE(ABM("X0"),U)_U_ABM("X")
+4 SET ABM("DISC")=$PIECE($GET(^VA(200,$PIECE(ABM("X0"),U),"PS")),U,5)
+5 IF ABM("DISC")]""
IF $DATA(^DIC(7,ABM("DISC"),0))
SET ABM("DISC")=$EXTRACT($PIECE(^(0),U),1,30)
+6 IF '$TEST
SET ABME(118)=""
DR ;PHYSICIAN'S PROVIDER NUMBER
+1 SET ABMNPIUS=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
+2 IF ABMNPIUS="N"
IF ($PIECE($$NPI^XUSNPI("Individual_ID",+ABM("X0")),U)<0)&($PIECE($$NPI^XUSNPI("Organization_ID",+ABMP("LDFN")),U)<0)
SET ABME(220)=""
+3 IF ABMNPIUS="B"
IF ($PIECE($$NPI^XUSNPI("Individual_ID",+ABM("X0")),U)<0)&($PIECE($$NPI^XUSNPI("Organization_ID",+ABMP("LDFN")),U)<0)
SET ABME(221)=""
+4 IF (ABMNPIUS="N"!(ABMNPIUS="B"))
IF ($PIECE($$NPI^XUSNPI("Individual_ID",+ABM("X0")),U)<0)&($PIECE($$NPI^XUSNPI("Organization_ID",ABMP("LDFN")),U)>0)
SET ABME(232)=""
+5 IF '$DATA(ABMP("CDFN"))
IF $DATA(ABMP("BDFN"))
SET ABMP("CDFN")=+$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U)
+6 IF +ABMP("CDFN")
Begin DoDot:1
+7 IF ABMP("VTYP")=""
SET ABMP("VTYP")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,7)
+8 IF ABMP("INS")=""
SET ABMP("INS")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,8)
+9 ;S:ABMP("INS")'="" ABMP("ITYP")=$P($G(^AUTNINS(ABMP("INS"),2)),U) ;abm*2.6*10 HEAT73780
+10 ;abm*2.6*10 HEAT73780
IF ABMP("INS")'=""
SET ABMP("ITYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")
+11 IF ABMP("EXP")=""
SET ABMP("EXP")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,14)
+12 IF ABMP("LDFN")=""
SET ABMP("LDFN")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,3)
+13 ;start old code abm*2.6*9 NOHEAT
+14 ;I ABMP("VTYP")=999 D
+15 ;.I $G(ABMP("ITYP"))="R" D ;abm*2.6*1 NOHEAT
+16 ;.;I $G(ABMP("ITYP"))="R",(ABMNPIUS'="N") D ;abm*2.6*1 NOHEAT
+17 ;..I +ABMP("EXP"),(($P($G(^ABMDEXP(+ABMP("EXP"),0)),U)["HCFA")!($P($G(^ABMDEXP(+ABMP("EXP"),0)),U)["CMS")) D
+18 ;...S ABM("PNUM")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),3,+ABM("X0"),0)),U,2)
+19 ;...S:ABM("PNUM")="" ABME(189)=""
+20 ;.I $P(^AUTNINS(ABMP("INS"),0),U)["OKLAHOMA MEDICAID" D
+21 ;..S ABM("PNUM")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),3,+ABM("X0"),0)),U,2)
+22 ;end old start new abm*2.6*9
+23 IF $GET(ABMP("ITYP"))="R"
IF ABMP("VTYP")=999
Begin DoDot:2
+24 IF +ABMP("EXP")
IF (($PIECE($GET">GET(^ABMDEXP(+ABMP("EXP"),0)),U)["HCFA")!($PIECE($GET">GET(^ABMDEXP(+ABMP("EXP"),0)),U)["CMS"))
Begin DoDot:3
+25 SET ABM("PNUM")=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),3,+ABM("X0"),0)),U,2)
+26 IF ABM("PNUM")=""
SET ABME(189)=""
End DoDot:3
End DoDot:2
+27 IF $PIECE(^AUTNINS(ABMP("INS"),0),U)["OKLAHOMA MEDICAID"
Begin DoDot:2
+28 SET ABM("PNUM")=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),3,+ABM("X0"),0)),U,2)
End DoDot:2
End DoDot:1
IF $DATA(ABME(189))
QUIT
+29 ;end new ABM*2.6*9
+30 IF $GET(ABM("PNUM"))=""
Begin DoDot:1
+31 SET ABM("PNUM")=$PIECE($GET(^VA(200,+ABM("X0"),9999999.18,+ABMP("INS"),0)),"^",2)
End DoDot:1
+32 IF ABM("PNUM")=""
Begin DoDot:1
+33 ;I $P($G(^AUTNINS(+ABMP("INS"),2)),U)="R" D ;abm*2.6*10 HEAT73780
+34 ;abm*2.6*10 HEAT73780
IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="R"
Begin DoDot:2
+35 SET ABM("PNUM")=$PIECE($GET(^VA(200,+ABM("X0"),9999999)),U,6)
+36 IF ABM("PNUM")=""
SET ABM("PNUM")=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),3,+ABM("X0"),0)),U,2)
+37 IF ABM("PNUM")=""
SET ABME(170)=""
+38 IF ABM("PNUM")=""
SET ABM("PNUM")=$PIECE($GET(^VA(200,+ABM("X0"),9999999)),"^",8)
+39 IF ABM("PNUM")=""
SET ABM("PNUM")="PHS000"
End DoDot:2
+40 ;I $P($G(^AUTNINS(+ABMP("INS"),2)),U)="D" D ;IHS/SD/SDR 9/25/09
+41 ;I $P($G(^AUTNINS(+ABMP("INS"),2)),U)="D",(ABMNPIUS'="N") D ;IHS/SD/SDR 9/25/09 ;abm*2.6*10 HEAT73780
+42 ;IHS/SD/SDR 9/25/09 ;abm*2.6*10 HEAT73780
IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMP("INS"),".211","I"),1,"I")="D"
IF (ABMNPIUS'="N")
Begin DoDot:2
+43 SET ABM("PNUM")=$PIECE($GET(^VA(200,+ABM("X0"),9999999)),U,7)
+44 IF ABM("PNUM")=""
SET ABME(170)=""
End DoDot:2
End DoDot:1
+45 IF ABM("PNUM")=""
IF (ABMNPIUS'="N")
Begin DoDot:1
+46 SET ABM("ST")=$PIECE(ABMP("C0"),U,3)
+47 SET ABM("ST")=$PIECE($GET(^AUTTLOC(+ABM("ST"),0)),U,23)
+48 IF ABM("ST")=""
SET ABM("ST")=$PIECE($GET(^AUTTLOC(+ABM("ST"),0)),U,14)
+49 IF ABM("ST")=""
SET ABME(120)=""
+50 SET ABM("PNUM")=$$SLN^ABMERUTL(+ABM("X0"),ABM("ST"))
End DoDot:1
+51 IF ABM("PNUM")=""
SET ABM("PNUM")=$PIECE($GET(^VA(200,+ABM("X0"),9999999)),U,8)
+52 IF ABM("PNUM")=""
IF (ABMNPIUS'="N")
SET ABME(115)=""
+53 ;
COV ;
+1 IF $PIECE(^ABMDEXP(ABMP("EXP"),0),U)[837!($GET(ABMP("EXP"))=25)
Begin DoDot:1
+2 IF '("OAR"[$PIECE(ABM("X0"),U,2))
QUIT
+3 IF $$PTAX^ABMEEPRV(+ABM("X0"))'=""
QUIT
+4 SET ABME(190)=""
End DoDot:1
+5 IF $GET(ABMP("COV"))=""
QUIT
+6 IF $GET(ABM("DISC"))=""
QUIT
+7 FOR ABMX("C")=1:1
SET ABM("COVD")=$PIECE(ABMP("COV"),";",ABMX("C"))
IF 'ABM("COVD")
QUIT
Begin DoDot:1
+8 SET ABM("COVD")=$PIECE($GET(^VA(200,$PIECE(ABM("X0"),U),"PS")),U,5)
+9 IF $PIECE($GET(^AUTTPIC(ABMP("COV"),15,ABM("COVD"),0)),"^",2)'="U"
QUIT
+10 SET ABME(160)=""
End DoDot:1
+11 QUIT
+12 ;
CONTR ;EP - Entry Point to determine if Contract Provider
+1 IF '$DATA(ABMP("CDFN"))
SET ABMP("CDFN")=ABMP("BDFN")
+2 SET ABM("CONTRACT")=0
+3 SET ABMX("D")=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C","A",""))
IF ABMX("D")]""
IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,ABMX("D"),0))
IF $PIECE($GET(^VA(200,$PIECE(^(0),U),9999999)),U)=2
SET ABM("CONTRACT")=1
QUIT
+4 SET ABMX("D")=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C","O",""))
IF ABMX("D")]""
IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,ABMX("D"),0))
IF $PIECE($GET(^VA(200,$PIECE(^(0),U),9999999)),U)=2
SET ABM("CONTRACT")=1
+5 QUIT
+6 ;
AFFL ;EP - Entry Point to determine Provider's Affiliation
+1 IF ABM("MD")
QUIT
IF $PIECE($GET(^VA(200,+ABM("X0"),"PS")),U,5)=""
QUIT
IF $PIECE($GET(^DIC(7,$PIECE(^("PS"),U,5),9999999)),U)=""
QUIT
SET ABM("MD")=$PIECE(^(9999999),U)
+2 SET ABM("MD")=$SELECT(ABM("MD")="00"!(ABM("MD")>69&(ABM("MD")<87))!(ABM("MD")=49)!(ABM("MD")=18)!(ABM("MD")=25)!(ABM("MD")=33)!(ABM("MD")=41)!(ABM("MD")=44)!(ABM("MD")=45):1,1:0)
+3 QUIT
