BMCVDV ; IHS/OIT/FCJ - 1/2 VIEW/EDIT PROVIDER-VENDOR FILE ;
;;4.0;REFERRED CARE INFO SYSTEM;**5,7,8**;JAN 09, 2006;Build 101
;BMC*4.0*5 5.13.2009 IHS.OIT.FCJ ORIGIAL ROUTINE FR ACHSVDV
;
A1 ;EP
D HDR
S DIC(0)="AEQMZ"_$S($D(^XUSEC("BMCZVEN",DUZ)):"L",1:""),DIC="^AUTTVNDR(",DIC("A")="Enter Provider/Vendor: "
S:DIC(0)["L" DLAYGO=9999999.11
D ^DIC
K DIC,DLAYGO
G END:Y=-1
S BMCPROV=+Y
G ^BMCVDVD
;
A1A ;EP
S:'$D(^AUTTVNDR(BMCPROV,11))#2 ^AUTTVNDR(BMCPROV,11)=""
S:'$D(^AUTTVNDR(BMCPROV,13))#2 ^AUTTVNDR(BMCPROV,13)=""
A2 ;EP
Q:'$D(BMCPROV)
S BMC0=$G(^AUTTVNDR(BMCPROV,0)),BMC11=$S($D(^AUTTVNDR(BMCPROV,11)):^(11),1:""),BMC13=$S($D(^AUTTVNDR(BMCPROV,13)):^(13),1:""),BMC17=$S($D(^AUTTVNDR(BMCPROV,17)):^(17),1:"")
I $D(^AUTTVNDR(BMCPROV,11)),$P($G(^AUTTVNDR(BMCPROV,11)),U)="" G MESSAGE^BMCVDVD
D HDR
S BMCVT=$P(BMC11,U,3),BMCDISP=""
I BMCVT]"",BMCVT?1N.N S BMCVT=$P(^AUTTVTYP(+BMCVT,0),U,2)
S BMCEDOS=DT
K BMCRT,BMCCTNA
D A1^BMCVURT
S BMCACO="",P=BMCPROV
D ^BMCVUCN
K BMCRT,BMCCTNA
D A1^BMCVURT
S BMCMS=$P(BMC13,U,3)
I BMCMS?1N.N S BMCMS=$P(^DIC(5,BMCMS,0),U)
S BMCBS=$P(BMC13,U,8)
I BMCBS?1N.N S BMCBS=$P(^DIC(5,BMCBS,0),U)
W !," 1) ",$P(^AUTTVNDR(BMCPROV,0),U),?46," 2) EIN No: ",$P(BMC11,U),$S($P(BMC11,U,2)]"":"-"_$P(BMC11,U,2),1:"")
W !," 3) Status: ",$S(+$P(BMC0,U,5):"IN",1:""),"ACTIVE"
W ?46," 4) Contracts: ",$S(BMCACO="N":"NONE ACTIVE",+C>0:"ACTIVE="_+C,1:"NONE")
I '$D(BMCRT("RQ")) S BMCRT("RQ")=-1
W !," 5) UPIN: ",$P(BMC17,U),?46," 6) Rate Quotation: ",$S('$D(BMCRT("RQ")):"NONE",'$D(BMCRT("RQ","ACTIVE")):"NONE ACTIVE",BMCRT("RQ","ACTIVE")>0:"ACTIVE="_+$P(BMCRT("RQ","ACTIVE"),U,1),1:"")
W !," 7) Type of Business: "
S X=$P(BMC11,U,26)
I X W $P($G(^AUTTTOB(X,0)),U)
W ?46," 8) Agreement: ",$S('$D(BMCRT("PA")):"NONE",'$D(BMCRT("PA","ACTIVE")):"NONE ACTIVE",BMCRT("PA","ACTIVE")>0:"ACTIVE="_+$P(BMCRT("PA","ACTIVE"),U,1),1:"")
I $D(^AUTTVNDR(BMCPROV,23)) S BMCMP=$P($G(^(23)),U) S BMCMP=$$EXTSET^XBFUNC(9999999.11,2301,BMCMP)
I '$D(^AUTTVNDR(BMCPROV,23)) S BMCMP=""
W !," 9) Medicare Provider: ",$S(BMCMP="":"No entry",BMCMP'="":BMCMP,1:"")
W ?46,"10) BPA: ",$S('$D(BMCRT("BPA")):"NONE",'$D(BMCRT("BPA","ACTIVE")):"NONE ACTIVE",BMCRT("BPA","ACTIVE")>0:"ACTIVE="_+$P(BMCRT("BPA","ACTIVE"),U,1),1:"")
W !,"11) E-Mail: ",$$VAL^XBDIQ1(9999999.11,BMCPROV,2103) ;BMC*4.0*7 IHS.OIT.FCJ
W ?46,"12) DUNS: ",$$VAL^XBDIQ1(9999999.11,BMCPROV,.07)
W !,"13) Direct Participant: ",$$VAL^XBDIQ1(9999999.11,BMCPROV,2104) ;BMC*4.0*8 IHS.OIT.FCJ
W !,"14) Direct E-Mail: ",$$VAL^XBDIQ1(9999999.11,BMCPROV,2105) ;BMC*4.0*8 IHS.OIT.FCJ
W !!,"**** MAILING/BILLING ADDRESS ****",?44,"**** PROVIDER LOCATION ADDRESS ****"
W !,"15) Street: ",$P(BMC13,U),?46,"16) Street: ",$E($P(BMC13,U,6),1,17)
;BMC*4.0*7 IHS.OIT.FCJ CHANGES FOR FAX
W !?6,"City: ",$P(BMC13,U,2),?52,"City: ",$P(BMC13,U,7),!?5,"State: ",BMCMS,?26,"Zip: ",$P(BMC13,U,4),?51,"State: ",BMCBS
W !?5,"Phone: ",$P(BMC11,U,9),?26,"Fax: ",$P(BMC11,U,14),?48,"Zip Code: ",$P(BMC13,U,9),!?7,"Attn: ",$P(BMC13,U,5)
W !,"17) Vendor Type: ",BMCVT
W ?46,"18) Fed/Non-Fed: ",$S($P(BMC11,U,10)=1:"NON-FED",$P(BMC11,U,10)=2:"FED",$P(BMC11,U,10)="":"")
W !,"19) Specialty: ",$S($P(BMC11,U,4):$P(^DIC(7,$P(BMC11,U,4),0),U),1:"")
W ?46,"20) Geographic Loc: ",$S($P(BMC11,U,25)="":"",$P(BMC11,U,25):$P(^AUTTGL($P(BMC11,U,25),0),U))
W !,$$REPEAT^XLFSTR("*",79)
G:'$D(^XUSEC("BMCZVEN",DUZ)) A4^BMCVDV1
;BMC*4.0*8 CHANGED 14 TO 17 IN NXT LINE
I BMCVT="" W *7,!!,"MUST HAVE VENDOR TYPE." D 17^BMCVDVA G A2:'$D(Y),A1
A3 ;
K BMCCTFL,BMCRQFL,BMCPAFL,BMCBPFL
S Y=$$DIR^XBDIR("Y","Want to Edit","NO","","","",2)
G END:$D(DTOUT),A1:$D(DUOUT),A4^BMCVDV1:('Y),EDIT^BMCVDVA:Y
G A3
;
END ;EP
K X,P,S,C,L,D,D0,DA,DI,DIC,DR
K BMCMP,BMC0,BMC11,BMC13,BMC17,BMCACO,BMCBS,BMCCTNA,BMCDISP,BMCEDOS,BMCEIN,BMCEINS,BMCI
K BMCMS,BMCPROV,BMCRT,BMCSUFF,BMCVT,BMCYAYA
;D EN^XBVK("BMC")
Q
;
HDR ;
S X="PROVIDER/VENDOR UPDATE",Y="BMC"
W @IOF,!,$$C^XBFUNC(X),!
W $$REPEAT^XLFSTR("*",79)
Q
;
BMCVDV ; IHS/OIT/FCJ - 1/2 VIEW/EDIT PROVIDER-VENDOR FILE ;
+1 ;;4.0;REFERRED CARE INFO SYSTEM;**5,7,8**;JAN 09, 2006;Build 101
+2 ;BMC*4.0*5 5.13.2009 IHS.OIT.FCJ ORIGIAL ROUTINE FR ACHSVDV
+3 ;
A1 ;EP
+1 DO HDR
+2 SET DIC(0)="AEQMZ"_$SELECT($DATA(^XUSEC("BMCZVEN",DUZ)):"L",1:"")
SET DIC="^AUTTVNDR("
SET DIC("A")="Enter Provider/Vendor: "
+3 IF DIC(0)["L"
SET DLAYGO=9999999.11
+4 DO ^DIC
+5 KILL DIC,DLAYGO
+6 IF Y=-1
GOTO END
+7 SET BMCPROV=+Y
+8 GOTO ^BMCVDVD
+9 ;
A1A ;EP
+1 IF '$DATA(^AUTTVNDR(BMCPROV,11))#2
SET ^AUTTVNDR(BMCPROV,11)=""
+2 IF '$DATA(^AUTTVNDR(BMCPROV,13))#2
SET ^AUTTVNDR(BMCPROV,13)=""
A2 ;EP
+1 IF '$DATA(BMCPROV)
QUIT
+2 SET BMC0=$GET(^AUTTVNDR(BMCPROV,0))
SET BMC11=$SELECT($DATA(^AUTTVNDR(BMCPROV,11)):^(11),1:"")
SET BMC13=$SELECT($DATA(^AUTTVNDR(BMCPROV,13)):^(13),1:"")
SET BMC17=$SELECT($DATA(^AUTTVNDR(BMCPROV,17)):^(17),1:"")
+3 IF $DATA(^AUTTVNDR(BMCPROV,11))
IF $PIECE($GET(^AUTTVNDR(BMCPROV,11)),U)=""
GOTO MESSAGE^BMCVDVD
+4 DO HDR
+5 SET BMCVT=$PIECE(BMC11,U,3)
SET BMCDISP=""
+6 IF BMCVT]""
IF BMCVT?1N.N
SET BMCVT=$PIECE(^AUTTVTYP(+BMCVT,0),U,2)
+7 SET BMCEDOS=DT
+8 KILL BMCRT,BMCCTNA
+9 DO A1^BMCVURT
+10 SET BMCACO=""
SET P=BMCPROV
+11 DO ^BMCVUCN
+12 KILL BMCRT,BMCCTNA
+13 DO A1^BMCVURT
+14 SET BMCMS=$PIECE(BMC13,U,3)
+15 IF BMCMS?1N.N
SET BMCMS=$PIECE(^DIC(5,BMCMS,0),U)
+16 SET BMCBS=$PIECE(BMC13,U,8)
+17 IF BMCBS?1N.N
SET BMCBS=$PIECE(^DIC(5,BMCBS,0),U)
+18 WRITE !," 1) ",$PIECE(^AUTTVNDR(BMCPROV,0),U),?46," 2) EIN No: ",$PIECE(BMC11,U),$SELECT($PIECE(BMC11,U,2)]"":"-"_$PIECE(BMC11,U,2),1:"")
+19 WRITE !," 3) Status: ",$SELECT(+$PIECE(BMC0,U,5):"IN",1:""),"ACTIVE"
+20 WRITE ?46," 4) Contracts: ",$SELECT(BMCACO="N":"NONE ACTIVE",+C>0:"ACTIVE="_+C,1:"NONE")
+21 IF '$DATA(BMCRT("RQ"))
SET BMCRT("RQ")=-1
+22 WRITE !," 5) UPIN: ",$PIECE(BMC17,U),?46," 6) Rate Quotation: ",$SELECT('$DATA(BMCRT("RQ")):"NONE",'$DATA(BMCRT("RQ","ACTIVE")):"NONE ACTIVE",BMCRT("RQ","ACTIVE")>0:"ACTIVE="_+$PIECE(BMCRT("RQ","ACTIVE"),U,1),1:"")
+23 WRITE !," 7) Type of Business: "
+24 SET X=$PIECE(BMC11,U,26)
+25 IF X
WRITE $PIECE($GET(^AUTTTOB(X,0)),U)
+26 WRITE ?46," 8) Agreement: ",$SELECT('$DATA(BMCRT("PA")):"NONE",'$DATA(BMCRT("PA","ACTIVE")):"NONE ACTIVE",BMCRT("PA","ACTIVE")>0:"ACTIVE="_+$PIECE(BMCRT("PA","ACTIVE"),U,1),1:"")
+27 IF $DATA(^AUTTVNDR(BMCPROV,23))
SET BMCMP=$PIECE($GET(^(23)),U)
SET BMCMP=$$EXTSET^XBFUNC(9999999.11,2301,BMCMP)
+28 IF '$DATA(^AUTTVNDR(BMCPROV,23))
SET BMCMP=""
+29 WRITE !," 9) Medicare Provider: ",$SELECT(BMCMP="":"No entry",BMCMP'="":BMCMP,1:"")
+30 WRITE ?46,"10) BPA: ",$SELECT('$DATA(BMCRT("BPA")):"NONE",'$DATA(BMCRT("BPA","ACTIVE")):"NONE ACTIVE",BMCRT("BPA","ACTIVE")>0:"ACTIVE="_+$PIECE(BMCRT("BPA","ACTIVE"),U,1),1:"")
+31 ;BMC*4.0*7 IHS.OIT.FCJ
WRITE !,"11) E-Mail: ",$$VAL^XBDIQ1(9999999.11,BMCPROV,2103)
+32 WRITE ?46,"12) DUNS: ",$$VAL^XBDIQ1(9999999.11,BMCPROV,.07)
+33 ;BMC*4.0*8 IHS.OIT.FCJ
WRITE !,"13) Direct Participant: ",$$VAL^XBDIQ1(9999999.11,BMCPROV,2104)
+34 ;BMC*4.0*8 IHS.OIT.FCJ
WRITE !,"14) Direct E-Mail: ",$$VAL^XBDIQ1(9999999.11,BMCPROV,2105)
+35 WRITE !!,"**** MAILING/BILLING ADDRESS ****",?44,"**** PROVIDER LOCATION ADDRESS ****"
+36 WRITE !,"15) Street: ",$PIECE(BMC13,U),?46,"16) Street: ",$EXTRACT($PIECE(BMC13,U,6),1,17)
+37 ;BMC*4.0*7 IHS.OIT.FCJ CHANGES FOR FAX
+38 WRITE !?6,"City: ",$PIECE(BMC13,U,2),?52,"City: ",$PIECE(BMC13,U,7),!?5,"State: ",BMCMS,?26,"Zip: ",$PIECE(BMC13,U,4),?51,"State: ",BMCBS
+39 WRITE !?5,"Phone: ",$PIECE(BMC11,U,9),?26,"Fax: ",$PIECE(BMC11,U,14),?48,"Zip Code: ",$PIECE(BMC13,U,9),!?7,"Attn: ",$PIECE(BMC13,U,5)
+40 WRITE !,"17) Vendor Type: ",BMCVT
+41 WRITE ?46,"18) Fed/Non-Fed: ",$SELECT($PIECE(BMC11,U,10)=1:"NON-FED",$PIECE(BMC11,U,10)=2:"FED",$PIECE(BMC11,U,10)="":"")
+42 WRITE !,"19) Specialty: ",$SELECT($PIECE(BMC11,U,4):$PIECE(^DIC(7,$PIECE(BMC11,U,4),0),U),1:"")
+43 WRITE ?46,"20) Geographic Loc: ",$SELECT($PIECE(BMC11,U,25)="":"",$PIECE(BMC11,U,25):$PIECE(^AUTTGL($PIECE(BMC11,U,25),0),U))
+44 WRITE !,$$REPEAT^XLFSTR("*",79)
+45 IF '$DATA(^XUSEC("BMCZVEN",DUZ))
GOTO A4^BMCVDV1
+46 ;BMC*4.0*8 CHANGED 14 TO 17 IN NXT LINE
+47 IF BMCVT=""
WRITE *7,!!,"MUST HAVE VENDOR TYPE."
DO 17^BMCVDVA
IF '$DATA(Y)
GOTO A2
GOTO A1
A3 ;
+1 KILL BMCCTFL,BMCRQFL,BMCPAFL,BMCBPFL
+2 SET Y=$$DIR^XBDIR("Y","Want to Edit","NO","","","",2)
+3 IF $DATA(DTOUT)
GOTO END
IF $DATA(DUOUT)
GOTO A1
IF ('Y)
GOTO A4^BMCVDV1
IF Y
GOTO EDIT^BMCVDVA
+4 GOTO A3
+5 ;
END ;EP
+1 KILL X,P,S,C,L,D,D0,DA,DI,DIC,DR
+2 KILL BMCMP,BMC0,BMC11,BMC13,BMC17,BMCACO,BMCBS,BMCCTNA,BMCDISP,BMCEDOS,BMCEIN,BMCEINS,BMCI
+3 KILL BMCMS,BMCPROV,BMCRT,BMCSUFF,BMCVT,BMCYAYA
+4 ;D EN^XBVK("BMC")
+5 QUIT
+6 ;
HDR ;
+1 SET X="PROVIDER/VENDOR UPDATE"
SET Y="BMC"
+2 WRITE @IOF,!,$$C^XBFUNC(X),!
+3 WRITE $$REPEAT^XLFSTR("*",79)
+4 QUIT
+5 ;
