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

ABMDPINQ.m

Go to the documentation of this file. 
  1. ABMDPINQ ; IHS/SD/SDR - Inquire UTILITY ;  
  1.  ;;2.6;IHS Third Party Billing;**1**;NOV 12, 2009
  1.  ;
  1.  ; IHS/SD/SDR - abm*2.6*1 - NO HEAT - Split Provider inquire
  1.  ;   into separate routine and added fields
  1.  ;
  1. PRV ;EP for displaying Provider Record
  1.  S ABM("SUB")="PROVIDER"
  1.  D HD
  1.  S DIC="^VA(200,"
  1.  S DIC("S")="I $D(^(""PS""))"
  1.  ;
  1. DIC W !!
  1.  S DIC("A")="Select "_ABM("SUB")_": "
  1.  S DIC(0)="QEAM"
  1.  D ^DIC
  1.  G XIT:X=""!(X["^")!$D(DUOUT)!$D(DTOUT)
  1.  I +Y<1 G DIC
  1.  S DA=+Y
  1.  W $$EN^ABMVDF("IOF")
  1.  W !?80-$L(ABM("SUB"))-21\2,"*** ",ABM("SUB")," FILE INQUIRY ***"
  1.  S ABM="",$P(ABM,"=",80)=""
  1.  S $P(ABMDASH,"-",80)=""
  1.  W !!,ABM
  1.  K S
  1.  D GETS^DIQ(200,DA,".01;8;20.2;29;53.5;9999999.01;9999999.06;9999999.07;9999999.08","E","ABMZ")
  1.  S ABMPRV=DA_","
  1.  D WRITE
  1.  W ABM
  1.  G DIC
  1.  ;
  1. XIT K ABM,DIR,DIC,DIE
  1.  Q
  1.  ;
  1. HD K DIC,DR
  1.  Q
  1. WRITE ;
  1.  W !,"NAME: ",$G(ABMZ(200,ABMPRV,.01,"E"))
  1.  W ?50,"TITLE: ",$G(ABMZ(200,ABMPRV,8,"E"))
  1.  W !,"PROVIDER CLASS: ",$G(ABMZ(200,ABMPRV,53.5,"E"))
  1.  W ?50,"AFFILIATION: ",$G(ABMZ(200,ABMPRV,9999999.01,"E"))
  1.  W !!,"SERVICE/SECTION.............: ",$G(ABMZ(200,ABMPRV,29,"E"))
  1.  W !,"SIGNATURE BLOCK PRINTED NAME: ",$G(ABMZ(200,ABMPRV,20.2,"E"))
  1.  ;
  1.  W !,$E(ABMDASH,1,26),"National Provider Identifier",$E(ABMDASH,1,26)
  1.  W !?3,"NPI",?20,"Effective Date",?40,"Status"
  1.  S ABMI=0
  1.  F  S ABMI=$O(^VA(200,+ABMPRV,"NPISTATUS",ABMI)) Q:+ABMI=0  D
  1.  .W !?3,$P($G(^VA(200,+ABMPRV,"NPISTATUS",ABMI,0)),U,3)  ;NPI
  1.  .W ?20,$$CDT^ABMDUTL($P($G(^VA(200,+ABMPRV,"NPISTATUS",ABMI,0)),U))  ;effective date
  1.  .W ?40,$S($P($G(^VA(200,+ABMPRV,"NPISTATUS",ABMI,0)),U,2)=1:"ACTIVE",$P($G(^VA(200,+ABMPRV,"NPISTATUS",ABMI,0)),U,2)=0:"INSACTIVE",1:"")  ;status
  1.  K ABMI
  1.  ;
  1.  W !!,$E(ABMDASH,1,32),"Provider Numbers",$E(ABMDASH,1,32)
  1.  W !,"MEDICARE PROVIDER NUMBER.....: ",$G(ABMZ(200,ABMPRV,9999999.06,"E"))
  1.  W !,"MEDICAID PROVIDER NUMBER.....: ",$G(ABMZ(200,ABMPRV,9999999.07,"E"))
  1.  W !,"UPIN NUMBER..................: ",$G(ABMZ(200,ABMPRV,9999999.08,"E"))
  1.  W !,"TAXONOMY CODE................: ",$$PTAX^ABMEEPRV(+ABMPRV)
  1.  ;
  1.  W !,$E(ABMDASH,1,32),"Licensing States",$E(ABMDASH,1,32)
  1.  W !?3,"State",?10,"License Number"
  1.  S ABMI=0
  1.  F  S ABMI=$O(^VA(200,+ABMPRV,"PS1",ABMI)) Q:+ABMI=0  D
  1.  .W !?3,$P($G(^DIC(5,$P($G(^VA(200,+ABMPRV,"PS1",ABMI,0)),U),0)),U,2)
  1.  .W ?10,$P($G(^VA(200,+ABMPRV,"PS1",ABMI,0)),U,2)
  1.  K ABMI
  1.  ;
  1.  W !,$E(ABMDASH,1,25),"Payer Assigned Provider Number",$E(ABMDASH,1,25)
  1.  W !?3,"Insurer",?35,"Payer Assigned Provider Number"
  1.  S ABMI=""
  1.  D GETS^DIQ("200",ABMPRV,"9999999.18*","E","ABMINS")
  1.  F  S ABMI=$O(ABMINS(200.9999918,ABMI)) Q:$G(ABMI)=""  D
  1.  .W !?3,ABMINS(200.9999918,ABMI,.01,"E")
  1.  .W ?35,$G(ABMINS(200.9999918,ABMI,.02,"E"))
  1.  K ABMINS
  1.  ;
  1.  W !!,$E(ABMDASH,1,34),"Person Class",$E(ABMDASH,1,34)
  1.  W !,"Effective Date  Ending Date  Person Class"
  1.  S ABMI=0
  1.  F  S ABMI=$O(^VA(200,+ABMPRV,"USC1",ABMI)) Q:+ABMI=0  D
  1.  .W !,$$SDT^ABMDUTL($P($G(^VA(200,+ABMPRV,"USC1",ABMI,0)),U,2))
  1.  .W ?16,$$SDT^ABMDUTL($P($G(^VA(200,+ABMPRV,"USC1",ABMI,0)),U,3))
  1.  .W ?29,$P($G(^USC(8932.1,$P($G(^VA(200,+ABMPRV,"USC1",ABMI,0)),U),0)),U)
  1.  K ABMI
  1.  W !
  1.  Q