ABMDE4A ; IHS/ASDST/DMJ - PAGE 4 - PROVIDERS VIEW ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
;IHS/DSD/DMJ - 5/5/1999 - NOIS PEB-0599-90005 Patch 1
; Modified for incorrect provider information (looking at
; wrong file) new code at line PCCPRV+5
;
; IHS/SD/SDR - v2.5 p10 - IM20776
; Display provider taxonomy code on view
;
; IHS/SD/SDR v2.5 p11 - NPI
;
S ABMA("D")="",$P(ABMA("D"),"-",80)=""
S ABMZ("TITL")="PROVIDER VIEW OPTION"
D SUM^ABMDE1
D PRV,PCC,^ABMDERR
G XIT
;
PRV ;
ATTN I '$D(ABM("A")) G OPER
W !,"Attn Prov..: ",$P(ABM("A"),U)
W ?50,"Phone #....: " I $D(^VA(200,$P(ABM("A"),U,2),.13)) W $P(^(.13),U)
W !,"Discipline.: "
W $P($G(^DIC(7,+$P($G(^VA(200,$P(ABM("A"),U,2),"PS")),U,5),0)),U)
I "RD"[$P($G(^AUTNINS(ABMP("INS"),2)),U),$P(^(2),U)]"" W ?50,"MCR/MCD #..: "
E W ?50,"Licensure #: "
S ABMA("ST")=$P(^AUTTLOC(ABMP("LDFN"),0),U,23)
S:ABMA("ST")="" ABMA("ST")=$P(^AUTTLOC(ABMP("LDFN"),0),U,14)
I ABMA("ST")="" S ABME(120)=ABMP("LDFN")
PNUM W $$SLN^ABMERUTL($P(ABM("A"),"^",2),ABMA("ST"))
W !,"Affilliation: "
DD I $D(^VA(200,$P(ABM("A"),U,2),9999999)),$P(^(9999999),U)]"" S ABMA("Y")=$P(^(9999999),U)
I S ABMA("Y0")=$P(^DD(200,9999999.01,0),U,3),ABMA("Y0")=$P($P(ABMA("Y0"),ABMA("Y")_":",2),";",1) W ABMA("Y0")
W ?50,"DEA #......: ",$P($G(^VA(200,$P(ABM("A"),U,2),"PS")),U,2)
S ABMNPI=$P($$NPI^XUSNPI("Individual_ID",$P(ABM("A"),U,2)),U)
W !,"NPI.........: ",$S(+ABMNPI>0:ABMNPI,1:"")
W ?50,"Provider Taxonomy:",$$PTAX^ABMEEPRV($P(ABM("A"),U,2))
W !
OPER I '$D(ABM("O")) Q
W !,"Oper Prov..: ",$P(ABM("O"),U)
W ?50,"Phone #....: " I $D(^VA(200,$P(ABM("O"),U,2),.13)) W $P(^(.13),U)
W !,"Discipline.: "
W $P($G(^DIC(7,+$P($G(^VA(200,$P(ABM("O"),U,2),"PS")),U,5),0)),U)
I "RD"[$P($G(^AUTNINS(ABMP("INS"),2)),U),$P(^(2),U)]"" W ?50,"MCR/MCD #..: "
E W ?50,"Licensure #: "
S ABMA("ST")=$P(^AUTTLOC(ABMP("LDFN"),0),U,23) S:ABMA("ST")="" ABMA("ST")=$P(^(0),U,14)
I ABMA("ST")="" S ABME(120)=ABMP("LDFN")
OPNUM W $$SLN^ABMERUTL($P(ABM("O"),"^",2),ABMA("ST"))
W !,"Afilliation: "
I $D(^VA(200,$P(ABM("O"),U,2),9999999)),$P(^(9999999),U)]"" S ABMA("Y")=$P(^(9999999),U)
I S ABMA("Y0")=$P(^DD(200,9999999.01,0),U,3),ABMA("Y0")=$P($P(ABMA("Y0"),ABMA("Y")_":",2),";",1) W ABMA("Y0")
W ?50,"DEA #......: ",$P($G(^VA(200,$P(ABM("O"),U,2),"PS")),U,2)
S ABMNPI=$P($$NPI^XUSNPI("Individual_ID",$P(ABM("O"),U,2)),U)
W !,"NPI.........: ",$S(+ABMNPI>0:ABMNPI,1:"")
W ?50,"Provider Taxonomy:",$$PTAX^ABMEEPRV($P(ABM("O"),U,2))
Q
;
PCC W !,ABMA("D")
S ABMA("C")=0
W !?13,"***** Provider Information Entered Through PCC *****"
W !,"PRI",?11,"PROVIDER",?50,"DISCIPLINE"
W !,"===",?4,"====================================",?43,"=============================="
S ABMA=0 F ABMA("I")=1:1 S ABMA=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,ABMA)) Q:'ABMA D V1
I ABMA("I")=1 W *7,!," There are no PCC visits to view."
Q
V1 ; view
S ABMA("V")="" F ABMA("J")=1:1 S ABMA("V")=$O(^AUPNVPRV("AD",ABMA,ABMA("V"))) Q:'ABMA("V") D PCCPRV
Q
;
PCCPRV I $D(^AUPNVPRV(ABMA("V"),0)) S ABMA(0)=^(0)
E Q
I ^DD(9000010.06,.01,0)["VA(200" D
.S ABMA("PRV")=$P($G(^VA(200,+ABMA(0),0)),U)
.S ABMA("DISC")=$P($G(^VA(200,+ABMA(0),"PS")),U,5)
I ^DD(9000010.06,.01,0)["DIC(6" D
.S ABMA("PRV")=$P($G(^DIC(16,+ABMA(0),0)),U)
.S ABMA("DISC")=$P($G(^DIC(6,+ABMA(0),0)),U,4)
I ABMA("DISC")]"",$D(^DIC(7,ABMA("DISC"),0)) S ABMA("DISC")=$E($P(^(0),U),1,30)
S ABMA("C")=ABMA("C")+1
W !,$S($P(ABMA(0),U,4)="P":" P",1:" S")
W ?4,ABMA("PRV"),?43,ABMA("DISC")
Q
;
XIT K ABMA
Q
ABMDE4A ; IHS/ASDST/DMJ - PAGE 4 - PROVIDERS VIEW ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ;IHS/DSD/DMJ - 5/5/1999 - NOIS PEB-0599-90005 Patch 1
+4 ; Modified for incorrect provider information (looking at
+5 ; wrong file) new code at line PCCPRV+5
+6 ;
+7 ; IHS/SD/SDR - v2.5 p10 - IM20776
+8 ; Display provider taxonomy code on view
+9 ;
+10 ; IHS/SD/SDR v2.5 p11 - NPI
+11 ;
+12 SET ABMA("D")=""
SET $PIECE(ABMA("D"),"-",80)=""
+13 SET ABMZ("TITL")="PROVIDER VIEW OPTION"
+14 DO SUM^ABMDE1
+15 DO PRV
DO PCC
DO ^ABMDERR
+16 GOTO XIT
+17 ;
PRV ;
ATTN IF '$DATA(ABM("A"))
GOTO OPER
+1 WRITE !,"Attn Prov..: ",$PIECE(ABM("A"),U)
+2 WRITE ?50,"Phone #....: "
IF $DATA(^VA(200,$PIECE(ABM("A"),U,2),.13))
WRITE $PIECE(^(.13),U)
+3 WRITE !,"Discipline.: "
+4 WRITE $PIECE($GET(^DIC(7,+$PIECE($GET(^VA(200,$PIECE(ABM("A"),U,2),"PS")),U,5),0)),U)
+5 IF "RD"[$PIECE($GET(^AUTNINS(ABMP("INS"),2)),U)
IF $PIECE(^(2),U)]""
WRITE ?50,"MCR/MCD #..: "
+6 IF '$TEST
WRITE ?50,"Licensure #: "
+7 SET ABMA("ST")=$PIECE(^AUTTLOC(ABMP("LDFN"),0),U,23)
+8 IF ABMA("ST")=""
SET ABMA("ST")=$PIECE(^AUTTLOC(ABMP("LDFN"),0),U,14)
+9 IF ABMA("ST")=""
SET ABME(120)=ABMP("LDFN")
PNUM WRITE $$SLN^ABMERUTL($PIECE(ABM("A"),"^",2),ABMA("ST"))
+1 WRITE !,"Affilliation: "
DD IF $DATA(^VA(200,$PIECE(ABM("A"),U,2),9999999))
IF $PIECE(^(9999999),U)]""
SET ABMA("Y")=$PIECE(^(9999999),U)
+1 IF $TEST
SET ABMA("Y0")=$PIECE(^DD(200,9999999.01,0),U,3)
SET ABMA("Y0")=$PIECE($PIECE(ABMA("Y0"),ABMA("Y")_":",2),";",1)
WRITE ABMA("Y0")
+2 WRITE ?50,"DEA #......: ",$PIECE($GET(^VA(200,$PIECE(ABM("A"),U,2),"PS")),U,2)
+3 SET ABMNPI=$PIECE($$NPI^XUSNPI("Individual_ID",$PIECE(ABM("A"),U,2)),U)
+4 WRITE !,"NPI.........: ",$SELECT(+ABMNPI>0:ABMNPI,1:"")
+5 WRITE ?50,"Provider Taxonomy:",$$PTAX^ABMEEPRV($PIECE(ABM("A"),U,2))
+6 WRITE !
OPER IF '$DATA(ABM("O"))
QUIT
+1 WRITE !,"Oper Prov..: ",$PIECE(ABM("O"),U)
+2 WRITE ?50,"Phone #....: "
IF $DATA(^VA(200,$PIECE(ABM("O"),U,2),.13))
WRITE $PIECE(^(.13),U)
+3 WRITE !,"Discipline.: "
+4 WRITE $PIECE($GET(^DIC(7,+$PIECE($GET(^VA(200,$PIECE(ABM("O"),U,2),"PS")),U,5),0)),U)
+5 IF "RD"[$PIECE($GET(^AUTNINS(ABMP("INS"),2)),U)
IF $PIECE(^(2),U)]""
WRITE ?50,"MCR/MCD #..: "
+6 IF '$TEST
WRITE ?50,"Licensure #: "
+7 SET ABMA("ST")=$PIECE(^AUTTLOC(ABMP("LDFN"),0),U,23)
IF ABMA("ST")=""
SET ABMA("ST")=$PIECE(^(0),U,14)
+8 IF ABMA("ST")=""
SET ABME(120)=ABMP("LDFN")
OPNUM WRITE $$SLN^ABMERUTL($PIECE(ABM("O"),"^",2),ABMA("ST"))
+1 WRITE !,"Afilliation: "
+2 IF $DATA(^VA(200,$PIECE(ABM("O"),U,2),9999999))
IF $PIECE(^(9999999),U)]""
SET ABMA("Y")=$PIECE(^(9999999),U)
+3 IF $TEST
SET ABMA("Y0")=$PIECE(^DD(200,9999999.01,0),U,3)
SET ABMA("Y0")=$PIECE($PIECE(ABMA("Y0"),ABMA("Y")_":",2),";",1)
WRITE ABMA("Y0")
+4 WRITE ?50,"DEA #......: ",$PIECE($GET(^VA(200,$PIECE(ABM("O"),U,2),"PS")),U,2)
+5 SET ABMNPI=$PIECE($$NPI^XUSNPI("Individual_ID",$PIECE(ABM("O"),U,2)),U)
+6 WRITE !,"NPI.........: ",$SELECT(+ABMNPI>0:ABMNPI,1:"")
+7 WRITE ?50,"Provider Taxonomy:",$$PTAX^ABMEEPRV($PIECE(ABM("O"),U,2))
+8 QUIT
+9 ;
PCC WRITE !,ABMA("D")
+1 SET ABMA("C")=0
+2 WRITE !?13,"***** Provider Information Entered Through PCC *****"
+3 WRITE !,"PRI",?11,"PROVIDER",?50,"DISCIPLINE"
+4 WRITE !,"===",?4,"====================================",?43,"=============================="
+5 SET ABMA=0
FOR ABMA("I")=1:1
SET ABMA=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,ABMA))
IF 'ABMA
QUIT
DO V1
+6 IF ABMA("I")=1
WRITE *7,!," There are no PCC visits to view."
+7 QUIT
V1 ; view
+1 SET ABMA("V")=""
FOR ABMA("J")=1:1
SET ABMA("V")=$ORDER(^AUPNVPRV("AD",ABMA,ABMA("V")))
IF 'ABMA("V")
QUIT
DO PCCPRV
+2 QUIT
+3 ;
PCCPRV IF $DATA(^AUPNVPRV(ABMA("V"),0))
SET ABMA(0)=^(0)
+1 IF '$TEST
QUIT
+2 IF ^DD(9000010.06,.01,0)["VA(200"
Begin DoDot:1
+3 SET ABMA("PRV")=$PIECE($GET(^VA(200,+ABMA(0),0)),U)
+4 SET ABMA("DISC")=$PIECE($GET(^VA(200,+ABMA(0),"PS")),U,5)
End DoDot:1
+5 IF ^DD(9000010.06,.01,0)["DIC(6"
Begin DoDot:1
+6 SET ABMA("PRV")=$PIECE($GET(^DIC(16,+ABMA(0),0)),U)
+7 SET ABMA("DISC")=$PIECE($GET(^DIC(6,+ABMA(0),0)),U,4)
End DoDot:1
+8 IF ABMA("DISC")]""
IF $DATA(^DIC(7,ABMA("DISC"),0))
SET ABMA("DISC")=$EXTRACT($PIECE(^(0),U),1,30)
+9 SET ABMA("C")=ABMA("C")+1
+10 WRITE !,$SELECT($PIECE(ABMA(0),U,4)="P":" P",1:" S")
+11 WRITE ?4,ABMA("PRV"),?43,ABMA("DISC")
+12 QUIT
+13 ;
XIT KILL ABMA
+1 QUIT
