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

BMCVDV.m

Go to the documentation of this file. 
  1. 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
  1.  ;BMC*4.0*5 5.13.2009 IHS.OIT.FCJ ORIGIAL ROUTINE FR ACHSVDV
  1.  ;
  1. A1 ;EP
  1.  D HDR
  1.  S DIC(0)="AEQMZ"_$S($D(^XUSEC("BMCZVEN",DUZ)):"L",1:""),DIC="^AUTTVNDR(",DIC("A")="Enter Provider/Vendor:  "
  1.  S:DIC(0)["L" DLAYGO=9999999.11
  1.  D ^DIC
  1.  K DIC,DLAYGO
  1.  G END:Y=-1
  1.  S BMCPROV=+Y
  1.  G ^BMCVDVD
  1.  ;
  1. A1A ;EP
  1.  S:'$D(^AUTTVNDR(BMCPROV,11))#2 ^AUTTVNDR(BMCPROV,11)=""
  1.  S:'$D(^AUTTVNDR(BMCPROV,13))#2 ^AUTTVNDR(BMCPROV,13)=""
  1. A2 ;EP
  1.  Q:'$D(BMCPROV)
  1.  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:"")
  1.  I $D(^AUTTVNDR(BMCPROV,11)),$P($G(^AUTTVNDR(BMCPROV,11)),U)="" G MESSAGE^BMCVDVD
  1.  D HDR
  1.  S BMCVT=$P(BMC11,U,3),BMCDISP=""
  1.  I BMCVT]"",BMCVT?1N.N S BMCVT=$P(^AUTTVTYP(+BMCVT,0),U,2)
  1.  S BMCEDOS=DT
  1.  K BMCRT,BMCCTNA
  1.  D A1^BMCVURT
  1.  S BMCACO="",P=BMCPROV
  1.  D ^BMCVUCN
  1.  K BMCRT,BMCCTNA
  1.  D A1^BMCVURT
  1.  S BMCMS=$P(BMC13,U,3)
  1.  I BMCMS?1N.N S BMCMS=$P(^DIC(5,BMCMS,0),U)
  1.  S BMCBS=$P(BMC13,U,8)
  1.  I BMCBS?1N.N S BMCBS=$P(^DIC(5,BMCBS,0),U)
  1.  W !," 1) ",$P(^AUTTVNDR(BMCPROV,0),U),?46," 2) EIN No: ",$P(BMC11,U),$S($P(BMC11,U,2)]"":"-"_$P(BMC11,U,2),1:"")
  1.  W !," 3) Status: ",$S(+$P(BMC0,U,5):"IN",1:""),"ACTIVE"
  1.  W ?46," 4) Contracts: ",$S(BMCACO="N":"NONE ACTIVE",+C>0:"ACTIVE="_+C,1:"NONE")
  1.  I '$D(BMCRT("RQ")) S BMCRT("RQ")=-1
  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:"")
  1.  W !," 7) Type of Business: "
  1.  S X=$P(BMC11,U,26)
  1.  I X W $P($G(^AUTTTOB(X,0)),U)
  1.  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:"")
  1.  I $D(^AUTTVNDR(BMCPROV,23)) S BMCMP=$P($G(^(23)),U) S BMCMP=$$EXTSET^XBFUNC(9999999.11,2301,BMCMP)
  1.  I '$D(^AUTTVNDR(BMCPROV,23)) S BMCMP=""
  1.  W !," 9) Medicare Provider: ",$S(BMCMP="":"No entry",BMCMP'="":BMCMP,1:"")
  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:"")
  1.  W !,"11) E-Mail: ",$$VAL^XBDIQ1(9999999.11,BMCPROV,2103)   ;BMC*4.0*7 IHS.OIT.FCJ
  1.  W ?46,"12) DUNS: ",$$VAL^XBDIQ1(9999999.11,BMCPROV,.07)
  1.  W !,"13) Direct Participant: ",$$VAL^XBDIQ1(9999999.11,BMCPROV,2104)   ;BMC*4.0*8 IHS.OIT.FCJ
  1.  W !,"14) Direct E-Mail: ",$$VAL^XBDIQ1(9999999.11,BMCPROV,2105)   ;BMC*4.0*8 IHS.OIT.FCJ
  1.  W !!,"**** MAILING/BILLING ADDRESS ****",?44,"**** PROVIDER LOCATION ADDRESS ****"
  1.  W !,"15) Street: ",$P(BMC13,U),?46,"16) Street: ",$E($P(BMC13,U,6),1,17)
  1.  ;BMC*4.0*7 IHS.OIT.FCJ CHANGES FOR FAX
  1.  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
  1.  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)
  1.  W !,"17) Vendor Type: ",BMCVT
  1.  W ?46,"18) Fed/Non-Fed: ",$S($P(BMC11,U,10)=1:"NON-FED",$P(BMC11,U,10)=2:"FED",$P(BMC11,U,10)="":"")
  1.  W !,"19) Specialty: ",$S($P(BMC11,U,4):$P(^DIC(7,$P(BMC11,U,4),0),U),1:"")
  1.  W ?46,"20) Geographic Loc: ",$S($P(BMC11,U,25)="":"",$P(BMC11,U,25):$P(^AUTTGL($P(BMC11,U,25),0),U))
  1.  W !,$$REPEAT^XLFSTR("*",79)
  1.  G:'$D(^XUSEC("BMCZVEN",DUZ)) A4^BMCVDV1
  1.  ;BMC*4.0*8 CHANGED 14 TO 17 IN NXT LINE
  1.  I BMCVT="" W *7,!!,"MUST HAVE VENDOR TYPE." D 17^BMCVDVA G A2:'$D(Y),A1
  1. A3 ;
  1.  K BMCCTFL,BMCRQFL,BMCPAFL,BMCBPFL
  1.  S Y=$$DIR^XBDIR("Y","Want to Edit","NO","","","",2)
  1.  G END:$D(DTOUT),A1:$D(DUOUT),A4^BMCVDV1:('Y),EDIT^BMCVDVA:Y
  1.  G A3
  1.  ;
  1. END ;EP
  1.  K X,P,S,C,L,D,D0,DA,DI,DIC,DR
  1.  K BMCMP,BMC0,BMC11,BMC13,BMC17,BMCACO,BMCBS,BMCCTNA,BMCDISP,BMCEDOS,BMCEIN,BMCEINS,BMCI
  1.  K BMCMS,BMCPROV,BMCRT,BMCSUFF,BMCVT,BMCYAYA
  1.  ;D EN^XBVK("BMC")
  1.  Q
  1.  ;
  1. HDR ;
  1.  S X="PROVIDER/VENDOR UPDATE",Y="BMC"
  1.  W @IOF,!,$$C^XBFUNC(X),!
  1.  W $$REPEAT^XLFSTR("*",79)
  1.  Q
  1.  ;