- 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