source: FOIAVistA/tag/r/FEE_BASIS-FB/FBAAVD.m@ 628

FBAAVD ;AISC/DMK-DISPLAY/EDIT VENDOR DEMOGRAPHICS ;11 Apr 2006  2:54 PM
 ;;3.5;FEE BASIS;**9,98**;JAN 30, 1995;Build 54
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;FBTEMP set = 1 if called from input template
RDV ;ask vendor
 W ! K DFN,FBRATE S FEEO="",DIC="^FBAAV(",DIC(0)="AEQLM",DLAYGO=161.2,DIC("DR")="1;6;7;8" D ^DIC K DIC,DLAYGO G Q:$D(DTOUT)!(X="")!($D(DUOUT)),RDV:Y<0 S DA=+Y
 D NEW:$P(Y,U,3)=1 D EN1
 I $G(DA) W ! I $D(^XUSEC("FBAA ESTABLISH VENDOR",DUZ)) S DIR(0)="Y",DIR("B")="No",DIR("A")="Want to edit data" D ^DIR K DIR I $G(Y) D EDITV
 Q:$G(FBTEMP)
 G RDV
 ;
EN1 ;display vendor demographics
 ;DA = IEN of vendor in file 161.2
 ;
 N C,I
 Q:'$G(DA)
 S Z=$G(^FBAAV(DA,0)),V=$G(^(1)),T=$G(^("AMS")),A=$G(^("ADEL")),FBNPI=$P($G(^(3)),U,2)
 F X=1:1:17 S Z(X)=$P(Z,U,X)
 S FBDEL=$S($P(A,U)="Y":1,1:0),FBAAPN=$P(V,U),FBAAFN=$P(V,U,9)
 ;Z=zero node,V=one node,T=ams node,A=adel node
 ;
 S IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS W @IOF K IOP
 I +$G(DFN)>0 W !,"Patient Name: ",$P($G(^DPT(DFN,0)),U),?48,"Pt.ID: ",$$SSN^FBAAUTL(DFN),!
 W !?22,"***  VENDOR DEMOGRAPHICS  ***" D
 .I FBDEL W !?19,"==> FLAGGED FOR DELETION <==" Q
 .I $$CKVEN^FBAADV(DA) W !?20,"==> AWAITING AUSTIN APPROVAL <=="
 W !!,$J("Name:",13),?15,$E(Z(1),1,30),?47,"ID Number: ",Z(2)
 W !?40,"Billing Prov NPI: ",FBNPI
 W !,$J("Address:",13),?15,Z(3),?47,"Specialty: ",$E($P($G(^FBAA(161.6,+Z(8),0)),U),1,20)
 I Z(14)]"" W !,$J("Address [2]:",13),?15,Z(14)
 W !,$J("City:",13),?15,Z(4),?52,"Type:",?58,$P($P(^DD(161.2,6,0),Z(7)_":",2),";")
 ;
 W !,$J("State:",13),?15,$P($G(^DIC(5,+Z(5),0)),U),?38,"Participation Code:",?58,$S($D(^FBAA(161.81,+Z(9),0)):$E($P(^(0),U),1,21),1:"UNKNOWN")
 W !,$J("ZIP:",13),?15,Z(6),?38,"Medicare ID Number:",?59,Z(17)
 W !,$J("County:",13),?15,$P($G(^DIC(5,+Z(5),1,+Z(13),0)),U)
 W ?51,"Chain: ",Z(10)
 W !,$J("Phone:",13),?15,FBAAPN,!,$J("Fax:",13),?15,FBAAFN
 W:$P(T,U,2)="Y" ?44,"Pricer Exempt: Yes"
 W !,$J("Type (FPDS):",13),?15,$$EXTERNAL^DILFD(161.2,24,"",$P(V,U,10))
 S (C,I)=0 F  S I=$O(^FBAAV(DA,2,I)) Q:'I  D
 . S X=$P($G(^FBAAV(DA,2,I,0)),U) Q:'X
 . S X=$$GET1^DIQ(420.6,X,1) Q:X=""
 . S C=C+1
 . I '(C#2) W !,$J("Group (FPDS):",13),?15,$E(X,1,21)
 . I (C#2) W ?44,"Group (FPDS):",?59,$E(X,1,21)
 W !,$J("Austin Name:",13),?15,$P(T,U)
 W !,$J("Last Change ",13),?43,"Last Change" I $P(A,U,5)]"" W " by ",$S($P(A,U,5)="000":"Non-Fee User",1:"Station "_$P(A,U,5))
 W !,$J("TO Austin:",13),?15,$$DATX^FBAAUTL($P(A,U,2))
 W ?45,"FROM Austin:  ",$$DATX^FBAAUTL($P(A,U,4))
 ;
 I Z(9)=5 D ^FBAAVD1
 K A,T,V,Z,FBAAFN
 Q
 ;
NEW ;called when adding a new vendor
 Q:'$G(DA)
 S FBT="N",DIE="^FBAAV(",DR="[FBAA NEW VENDOR]" D ^DIE S Y=$G(^FBAAV(DA,0)) S FBOVEN="" D  I +FBOVEN K FBOVEN W ! S DR="3;4;5;5.5" D ^DIE K DIE,DR D CHKVEN Q:'$G(DA)
 .I $P(Y,U,4)']"" S FBOVEN=1
 .I '$P(Y,U,5) S FBOVEN=$S(+FBOVEN:FBOVEN_"^"_2,1:2)
 .I $P(Y,U,6)']"" S FBOVEN=$S(+FBOVEN:FBOVEN_"^"_3,1:3)
 .I $P(Y,U,13)']"" S FBOVEN=$S(+FBOVEN:FBOVEN_"^"_4,1:4)
 .I +FBOVEN D  K XX,X
 ..W !!?9,"The following data must be entered when adding a new vendor:",!
 ..W !?28,">>> W A R N I N G <<<",!?14,"Entering an '^' at this point will delete vendor!",!
 ..F XX=1:1 S X=$P(FBOVEN,U,XX) Q:'X  D
 ...W !?8,$P($T(ERROR+X),";;",2)
 D SETGL
 S FBVIEN=DA D CONTR^FBAAVD2 S DA=FBVIEN Q
 ;
EDITV ;called when editing an existing vendor
 N FBHDA Q:'$G(DA)
 N FBAAOUT G:$G(FBT)="N" EDITV1 I $D(^FBAA(161.25,DA,0))!($D(^FBAA(161.25,"AF",DA))) W !!?5,*7,"Current Vendor information is pending Austin processing.  Changing Vendor" D  I $G(FBAAOUT) K FBAAOUT Q
 .W !?5,"information at this time may jeopardize the processing of the existing",!?5,"Master Record Adjustment!",! D
 ..S DIR(0)="Y",DIR("A")="Do you wish to continue editing this Vendor",DIR("B")="No" D ^DIR K DIR S:$D(DIRUT)!('Y) FBAAOUT=1
EDITV1 D ^FBAAVD2 K FBCIEN,FBR,FBT
 Q
 ;
SETGL ;called to file an entry in 161.25 (vendor correction file)
 I $S('$G(DA):1,$G(FBT)="C"&('$D(FBIEN1)):1,1:0) Q
 S Z1=$G(^FBAAV(DA,0)),FBTOV=$S($P(Z1,U,7)=3:"P",1:"O")
 I $G(FBT)="N"!($G(FBT)="R") S DIE="^FBAAV(",DR="9///@;13///@" D ^DIE K DIE
 I '$D(^FBAA(161.25,DA,0)) L +^FBAA(161.25,DA) K DD,DO S (X,DINUM)=DA,DIC="^FBAA(161.25,",DIC(0)="L",DLAYGO=161.25 D FILE^DICN K DLAYGO L -^FBAA(161.25,DA) Q:Y<0
NEXT L +^FBAA(161.25,DA):1 I '$T W:'$D(ZTQUEUED) !,"Unable to setup MRA transaction.  Trying again.",! G NEXT
 S DIE="^FBAA(161.25,",DR="[FBAA VENDOR MRA]" D ^DIE L -^FBAA(161.25,DA)
 K DIE,DIC,Y
 Q
 ;
Q K DA,DR,DIC,DIE,DIRUT,DTOUT,DUOUT,A,D,FBX,FBOUT,X2,FY,FBAAPN,FEEO,FBDEL,FBPARCD,FBT,FBTOV,FBTV,X,Y,Z0,Z1,Z2,ZZ,FBCNUM,FBID,FBVIEN,FBLIEN,FBAAFN
 Q
ERROR ;edit check text when adding a new vendor
 ;;CITY
 ;;STATE
 ;;ZIP CODE
 ;;COUNTY CODE
CHKVEN ;check if fields 3,4,5,5.5 have been answered. If not delete vendor
 S Y=$G(^FBAAV(DA,0))
 F X=4,5,6,13 I $P(Y,U,X)']"" D  Q
 .S DIK="^FBAAV(" D ^DIK K DIK,DA W !?3,$C(7),".... Vendor deleted",!
 Q