Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMDE4A

ABMDE4A.m

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