ABMDPINQ ; IHS/SD/SDR - Inquire UTILITY ;
;;2.6;IHS Third Party Billing;**1**;NOV 12, 2009
;
; IHS/SD/SDR - abm*2.6*1 - NO HEAT - Split Provider inquire
; into separate routine and added fields
;
PRV ;EP for displaying Provider Record
S ABM("SUB")="PROVIDER"
D HD
S DIC="^VA(200,"
S DIC("S")="I $D(^(""PS""))"
;
DIC W !!
S DIC("A")="Select "_ABM("SUB")_": "
S DIC(0)="QEAM"
D ^DIC
G XIT:X=""!(X["^")!$D(DUOUT)!$D(DTOUT)
I +Y<1 G DIC
S DA=+Y
W $$EN^ABMVDF("IOF")
W !?80-$L(ABM("SUB"))-21\2,"*** ",ABM("SUB")," FILE INQUIRY ***"
S ABM="",$P(ABM,"=",80)=""
S $P(ABMDASH,"-",80)=""
W !!,ABM
K S
D GETS^DIQ(200,DA,".01;8;20.2;29;53.5;9999999.01;9999999.06;9999999.07;9999999.08","E","ABMZ")
S ABMPRV=DA_","
D WRITE
W ABM
G DIC
;
XIT K ABM,DIR,DIC,DIE
Q
;
HD K DIC,DR
Q
WRITE ;
W !,"NAME: ",$G(ABMZ(200,ABMPRV,.01,"E"))
W ?50,"TITLE: ",$G(ABMZ(200,ABMPRV,8,"E"))
W !,"PROVIDER CLASS: ",$G(ABMZ(200,ABMPRV,53.5,"E"))
W ?50,"AFFILIATION: ",$G(ABMZ(200,ABMPRV,9999999.01,"E"))
W !!,"SERVICE/SECTION.............: ",$G(ABMZ(200,ABMPRV,29,"E"))
W !,"SIGNATURE BLOCK PRINTED NAME: ",$G(ABMZ(200,ABMPRV,20.2,"E"))
;
W !,$E(ABMDASH,1,26),"National Provider Identifier",$E(ABMDASH,1,26)
W !?3,"NPI",?20,"Effective Date",?40,"Status"
S ABMI=0
F S ABMI=$O(^VA(200,+ABMPRV,"NPISTATUS",ABMI)) Q:+ABMI=0 D
.W !?3,$P($G(^VA(200,+ABMPRV,"NPISTATUS",ABMI,0)),U,3) ;NPI
.W ?20,$$CDT^ABMDUTL($P($G(^VA(200,+ABMPRV,"NPISTATUS",ABMI,0)),U)) ;effective date
.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
K ABMI
;
W !!,$E(ABMDASH,1,32),"Provider Numbers",$E(ABMDASH,1,32)
W !,"MEDICARE PROVIDER NUMBER.....: ",$G(ABMZ(200,ABMPRV,9999999.06,"E"))
W !,"MEDICAID PROVIDER NUMBER.....: ",$G(ABMZ(200,ABMPRV,9999999.07,"E"))
W !,"UPIN NUMBER..................: ",$G(ABMZ(200,ABMPRV,9999999.08,"E"))
W !,"TAXONOMY CODE................: ",$$PTAX^ABMEEPRV(+ABMPRV)
;
W !,$E(ABMDASH,1,32),"Licensing States",$E(ABMDASH,1,32)
W !?3,"State",?10,"License Number"
S ABMI=0
F S ABMI=$O(^VA(200,+ABMPRV,"PS1",ABMI)) Q:+ABMI=0 D
.W !?3,$P($G(^DIC(5,$P($G(^VA(200,+ABMPRV,"PS1",ABMI,0)),U),0)),U,2)
.W ?10,$P($G(^VA(200,+ABMPRV,"PS1",ABMI,0)),U,2)
K ABMI
;
W !,$E(ABMDASH,1,25),"Payer Assigned Provider Number",$E(ABMDASH,1,25)
W !?3,"Insurer",?35,"Payer Assigned Provider Number"
S ABMI=""
D GETS^DIQ("200",ABMPRV,"9999999.18*","E","ABMINS")
F S ABMI=$O(ABMINS(200.9999918,ABMI)) Q:$G(ABMI)="" D
.W !?3,ABMINS(200.9999918,ABMI,.01,"E")
.W ?35,$G(ABMINS(200.9999918,ABMI,.02,"E"))
K ABMINS
;
W !!,$E(ABMDASH,1,34),"Person Class",$E(ABMDASH,1,34)
W !,"Effective Date Ending Date Person Class"
S ABMI=0
F S ABMI=$O(^VA(200,+ABMPRV,"USC1",ABMI)) Q:+ABMI=0 D
.W !,$$SDT^ABMDUTL($P($G(^VA(200,+ABMPRV,"USC1",ABMI,0)),U,2))
.W ?16,$$SDT^ABMDUTL($P($G(^VA(200,+ABMPRV,"USC1",ABMI,0)),U,3))
.W ?29,$P($G(^USC(8932.1,$P($G(^VA(200,+ABMPRV,"USC1",ABMI,0)),U),0)),U)
K ABMI
W !
Q
ABMDPINQ ; IHS/SD/SDR - Inquire UTILITY ;
+1 ;;2.6;IHS Third Party Billing;**1**;NOV 12, 2009
+2 ;
+3 ; IHS/SD/SDR - abm*2.6*1 - NO HEAT - Split Provider inquire
+4 ; into separate routine and added fields
+5 ;
PRV ;EP for displaying Provider Record
+1 SET ABM("SUB")="PROVIDER"
+2 DO HD
+3 SET DIC="^VA(200,"
+4 SET DIC("S")="I $D(^(""PS""))"
+5 ;
DIC WRITE !!
+1 SET DIC("A")="Select "_ABM("SUB")_": "
+2 SET DIC(0)="QEAM"
+3 DO ^DIC
+4 IF X=""!(X["^")!$DATA(DUOUT)!$DATA(DTOUT)
GOTO XIT
+5 IF +Y<1
GOTO DIC
+6 SET DA=+Y
+7 WRITE $$EN^ABMVDF("IOF")
+8 WRITE !?80-$LENGTH(ABM("SUB"))-21\2,"*** ",ABM("SUB")," FILE INQUIRY ***"
+9 SET ABM=""
SET $PIECE(ABM,"=",80)=""
+10 SET $PIECE(ABMDASH,"-",80)=""
+11 WRITE !!,ABM
+12 KILL S
+13 DO GETS^DIQ(200,DA,".01;8;20.2;29;53.5;9999999.01;9999999.06;9999999.07;9999999.08","E","ABMZ")
+14 SET ABMPRV=DA_","
+15 DO WRITE
+16 WRITE ABM
+17 GOTO DIC
+18 ;
XIT KILL ABM,DIR,DIC,DIE
+1 QUIT
+2 ;
HD KILL DIC,DR
+1 QUIT
WRITE ;
+1 WRITE !,"NAME: ",$GET(ABMZ(200,ABMPRV,.01,"E"))
+2 WRITE ?50,"TITLE: ",$GET(ABMZ(200,ABMPRV,8,"E"))
+3 WRITE !,"PROVIDER CLASS: ",$GET(ABMZ(200,ABMPRV,53.5,"E"))
+4 WRITE ?50,"AFFILIATION: ",$GET(ABMZ(200,ABMPRV,9999999.01,"E"))
+5 WRITE !!,"SERVICE/SECTION.............: ",$GET(ABMZ(200,ABMPRV,29,"E"))
+6 WRITE !,"SIGNATURE BLOCK PRINTED NAME: ",$GET(ABMZ(200,ABMPRV,20.2,"E"))
+7 ;
+8 WRITE !,$EXTRACT(ABMDASH,1,26),"National Provider Identifier",$EXTRACT(ABMDASH,1,26)
+9 WRITE !?3,"NPI",?20,"Effective Date",?40,"Status"
+10 SET ABMI=0
+11 FOR
SET ABMI=$ORDER(^VA(200,+ABMPRV,"NPISTATUS",ABMI))
IF +ABMI=0
QUIT
Begin DoDot:1
+12 ;NPI
WRITE !?3,$PIECE($GET(^VA(200,+ABMPRV,"NPISTATUS",ABMI,0)),U,3)
+13 ;effective date
WRITE ?20,$$CDT^ABMDUTL($PIECE($GET(^VA(200,+ABMPRV,"NPISTATUS",ABMI,0)),U))
+14 ;status
WRITE ?40,$SELECT($PIECE($GET(^VA(200,+ABMPRV,"NPISTATUS",ABMI,0)),U,2)=1:"ACTIVE",$PIECE($GET(^VA(200,+ABMPRV,"NPISTATUS",ABMI,0)),U,2)=0:"INSACTIVE",1:"")
End DoDot:1
+15 KILL ABMI
+16 ;
+17 WRITE !!,$EXTRACT(ABMDASH,1,32),"Provider Numbers",$EXTRACT(ABMDASH,1,32)
+18 WRITE !,"MEDICARE PROVIDER NUMBER.....: ",$GET(ABMZ(200,ABMPRV,9999999.06,"E"))
+19 WRITE !,"MEDICAID PROVIDER NUMBER.....: ",$GET(ABMZ(200,ABMPRV,9999999.07,"E"))
+20 WRITE !,"UPIN NUMBER..................: ",$GET(ABMZ(200,ABMPRV,9999999.08,"E"))
+21 WRITE !,"TAXONOMY CODE................: ",$$PTAX^ABMEEPRV(+ABMPRV)
+22 ;
+23 WRITE !,$EXTRACT(ABMDASH,1,32),"Licensing States",$EXTRACT(ABMDASH,1,32)
+24 WRITE !?3,"State",?10,"License Number"
+25 SET ABMI=0
+26 FOR
SET ABMI=$ORDER(^VA(200,+ABMPRV,"PS1",ABMI))
IF +ABMI=0
QUIT
Begin DoDot:1
+27 WRITE !?3,$PIECE($GET(^DIC(5,$PIECE($GET(^VA(200,+ABMPRV,"PS1",ABMI,0)),U),0)),U,2)
+28 WRITE ?10,$PIECE($GET(^VA(200,+ABMPRV,"PS1",ABMI,0)),U,2)
End DoDot:1
+29 KILL ABMI
+30 ;
+31 WRITE !,$EXTRACT(ABMDASH,1,25),"Payer Assigned Provider Number",$EXTRACT(ABMDASH,1,25)
+32 WRITE !?3,"Insurer",?35,"Payer Assigned Provider Number"
+33 SET ABMI=""
+34 DO GETS^DIQ("200",ABMPRV,"9999999.18*","E","ABMINS")
+35 FOR
SET ABMI=$ORDER(ABMINS(200.9999918,ABMI))
IF $GET(ABMI)=""
QUIT
Begin DoDot:1
+36 WRITE !?3,ABMINS(200.9999918,ABMI,.01,"E")
+37 WRITE ?35,$GET(ABMINS(200.9999918,ABMI,.02,"E"))
End DoDot:1
+38 KILL ABMINS
+39 ;
+40 WRITE !!,$EXTRACT(ABMDASH,1,34),"Person Class",$EXTRACT(ABMDASH,1,34)
+41 WRITE !,"Effective Date Ending Date Person Class"
+42 SET ABMI=0
+43 FOR
SET ABMI=$ORDER(^VA(200,+ABMPRV,"USC1",ABMI))
IF +ABMI=0
QUIT
Begin DoDot:1
+44 WRITE !,$$SDT^ABMDUTL($PIECE($GET(^VA(200,+ABMPRV,"USC1",ABMI,0)),U,2))
+45 WRITE ?16,$$SDT^ABMDUTL($PIECE($GET(^VA(200,+ABMPRV,"USC1",ABMI,0)),U,3))
+46 WRITE ?29,$PIECE($GET(^USC(8932.1,$PIECE($GET(^VA(200,+ABMPRV,"USC1",ABMI,0)),U),0)),U)
End DoDot:1
+47 KILL ABMI
+48 WRITE !
+49 QUIT
