FBAAVD2 ;AISC/DMK-EDIT VENDOR DEMOGRAPHICS ;07/17/06
 ;;3.5;FEE BASIS;**9,10,47,65,98**;JAN 30, 1995;Build 54
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
EDITV ;entry to edit vendor demographic data
 ;DA defined to IEN of vendor file (161.2)
 Q:'$G(DA)  N FBADT,FBDA,Z6 S FBDA=DA L +^FBAAV(DA):1 I '$T W !,"Unable to access vendor record. Trying again.",! G EDITV
 S FBT=$S($D(FBT):FBT,1:""),FBT=$S(FBT="N":FBT,1:"C")
 S FEEO="",DIE="^FBAAV(",DR="[FBAA EDIT VENDOR]",DIE("NO^")="BACKOUTOK"
 S Z1=$G(^FBAAV(DA,0)),Z3=$G(^(1)),Z4=$G(^("AMS")),Z5=$G(^("ADEL")),Z6=$P($G(^(3)),U,2)
 D GETGRP^FBAAUTL6(DA)
 D ^DIE
 I $P($G(^FBAAV(DA,0)),"^",13)']"" S DR="3;4;5;5.5",DIE("NO^")="" D ^DIE
 K DIE
 L -^FBAAV(DA)
 ;check if data was changed
 I $D(^FBAAV(DA,0)),(($P(Z1,U,2,6)'=$P(^FBAAV(DA,0),U,2,6))!($P(Z1,U,8,16)'=$P(^FBAAV(DA,0),U,8,16))!($P(Z3,U,10)'=$P($G(^FBAAV(DA,1)),U,10))!$$GRPDIF^FBAAUTL6(DA))!($P($G(^FBAAV(DA,3)),U,2))'=Z6 D
 .S FBVNAME=$P(^FBAAV(DA,0),U),FBIEN1=DA,FBADT=$P(Z5,U,4),FBNPI=$P($G(^FBAAV(FBIEN1,3)),U,2)
 .;check if date last received from austin, version 3.  If so, then did not receive in upload - send update instead of change
 .;fbadt = date received from austin.
 .I '$$CKVEN^FBAADV(DA),FBADT']"" D UPDT^FBAAAV(FBDA) Q  ;,FBADT<FBINSTAL D UPDT^FBAAAV(DA) Q
 .;if austin deleted is yes, send update instead of change
 .I $P($G(^FBAAV(FBDA,"ADEL")),"^")="Y" D UPDT^FBAAAV(FBDA) Q
 .;if editing a newly added vendor, send update instead of change
 .I FBT="N" D UPDT^FBAAAV(FBDA) Q
 .;if only FPDS data was changed
 .I $P(Z1,U,2,6)=$P(^FBAAV(DA,0),U,2,6),$P(Z1,U,8,16)=$P(^FBAAV(DA,0),U,8,16) D  Q:FBT=""
 ..I '$D(^FBAA(161.25,"AF",DA)),'$D(^FBAA(161.25,DA,0)) S FBT="F" Q  ; no pending actions - add "F"
 ..I '$D(^FBAA(161.25,"AF",DA)),$D(^FBAA(161.25,DA,0)),$P(^(0),U,5)="" S FBT="" Q  ; action pending, but not yet transmitted - will incl. FPDS data
 .I FBT="F" S FBIEN1=DA,FEEO="" D SETGL^FBAAVD Q  ; send FEE-ONLY
 .;If date from austin not null then add vendor entry for a change
 .K DD,DO S DIC="^FBAAV(",DIC(0)="L",DLAYGO=161.2,X=FBVNAME D FILE^DICN Q:Y<0  S FBIEN=+Y
 .L +^FBAAV(FBIEN)
 .S ^FBAAV(FBIEN,0)=$G(^FBAAV(FBIEN1,0))
 .S ^FBAAV(FBIEN,1)=$G(^FBAAV(FBIEN1,1))
 .S ^FBAAV(FBIEN,"AMS")=$G(^FBAAV(FBIEN1,"AMS")),$P(^FBAAV(FBIEN,"AMS"),"^")=""
 .K FBFDA
 .S I=0 F  S I=$O(^FBAAV(FBIEN1,2,I)) Q:'I  D
 ..S X=$P($G(^(I,0)),U) I X]"" S FBFDA(161.225,"+"_I_","_FBIEN_",",.01)=X
 .I $D(FBFDA) D UPDATE^DIE("","FBFDA")
 .S DIK="^FBAAV(",DA=FBIEN D IX1^DIK
 .L -^FBAAV(FBIEN)
 .;restore original vendor data
 .L +^FBAAV(FBIEN1)
 .S DIE="^FBAAV(",DA=FBIEN1,DR="[FB VENDOR UPDATE]" D ^DIE K DIE
 .D UPDGRP^FBAAUTL6(FBIEN1)
 .L -^FBAAV(FBIEN1)
 .S DA=FBIEN D SETGL^FBAAVD
 K FBSG,FBVNAME,FBIEN,FBIEN1,Z3,Z4,Z5
 ;
CONTR ;enter contract information for a CNH vendor
 Q:$S('$D(FBPARCD):1,FBPARCD'=5:1,1:0)
 Q:'$G(DA)  S FBVIEN=DA
 S FBLIEN=$P($G(^FBAA(161.25,FBVIEN,0)),"^",6) I FBLIEN]"",FBLIEN'=FBVIEN W !!,*7,"Cannot add contract information to this vendor until change has been",!,"approved by Austin." Q
 W ! S DIC="^FBAA(161.21,",DIC(0)="AEQLM",DLAYGO=161.21,DIC("S")="I $P(^(0),U,4)="_FBVIEN
 D ^DIC K DIC,DLAYGO Q:X=""!(X="^")  G CONTR:Y<0
 S DA=+Y,FBCNUM=$P(Y,"^",2),DIE="^FBAA(161.21," L +^FBAA(161.21,DA)
 S ZO1=^FBAA(161.21,DA,0),DR="[FBNH ENTER CONTRACT]",DIE("NO^")="" D ^DIE K DIE,DR
 I '$G(DA) K ZO1 Q
 I $D(^FBAA(161.22,"AC",DA)) D
 .Q:$P(ZO1,"^",1,2)=$P(^FBAA(161.21,DA,0),"^",1,2)  W !!,*7,"You cannot change contract numbers or effective dates on",!,"a contract that has rates associated with it."
 .S DIE="^FBAA(161.21,",DR=".01////^S X=$P(ZO1,U);.02////^S X=$P(ZO1,U,2);.03////^S X=$P(ZO1,U,3);.04////^S X=$P(ZO1,U,4)" D ^DIE K DIE,DR W !!,"Contract information reset"
 L -^FBAA(161.21,DA) K ZO1
 Q:$D(DTOUT)
 I $G(FBEXNDT)<$G(FBEXDT) D URATE K FBCIEN,FBEXDT,FBEXNDT,FBURT
 ;create rates for a contract. Rates cannot be changed, but the
 ;user can enter multiple rates for a contract.
 ;FBCIEN=internal entry number for contract in 161.21
 S FBCIEN=DA K FBX
RATE K DA W ! S DIR(0)="161.22,.02",DIR("A")="Enter Nursing Home Rate",DIR("?")="^K FBX,FBRATE D DISPLAY^FBAAVD1 W !,""Enter an amount between .01 and 9999999.99""" D ^DIR
 K DIR Q:$D(DIRUT)  Q:'Y  S FBR=+Y
 I $L($$RATE^FBAAVD1($P(^FBAA(161.21,FBCIEN,0),"^",1)))+$L("^"_FBR)>510 W !,*7,"There are too many rates loaded for that contract! Please remove obsolete rates.",! Q
 I $D(^FBAA(161.22,"AD",FBCIEN,FBR)) K FBR W !,*7,"Rate already exists for that contract!",! G RATE
 S X=$P(^FBAA(161.22,0),U,3)
RETRY S X=X+1 G:$D(^FBAA(161.22,X)) RETRY
 L +^FBAA(161.22,X)
 K DD,DO S DIC="^FBAA(161.22,",DIC(0)="L",DLAYGO=161.22,DIC("DR")=".02////^S X="_FBR_";.03////^S X="_FBCIEN D FILE^DICN K DIC,DLAYGO
 L -^FBAA(161.22,+Y)
 G RATE
 ;
GETVEN K FBRATE D GETVEN^FBAAUTL1 G END:'IFN
 S DA=IFN K DIC,IFN
 S FBPARCD=$P($G(^FBAAV(DA,0)),U,9)
 I FBPARCD'=5 W !?5,*7,"Vendor selected is not a Community Nursing Home.",! G GETVEN
 D CONTR G GETVEN
END K DIC,DA,FBVIEN,IFN,FBPARCD,X,Y,FBLIEN
 Q
URATE ;Update rate when user backs up contract dates.
 N DA S (FBCIEN,FBURT)=0
 F  S FBURT=$O(^FBAA(161.23,"AE",FBCNUM,FBURT)) Q:'FBURT  F  S FBCIEN=$O(^FBAA(161.23,"AE",FBCNUM,FBURT,FBCIEN)) Q:'FBCIEN  I $P($G(^FBAA(161.23,FBCIEN,0)),"^",2)>FBEXNDT D
 .I +$G(^FBAA(161.23,FBCIEN,0))>FBEXNDT S DIK="^FBAA(161.23,",DA=FBCIEN D ^DIK K DIK Q
 .S DIE="^FBAA(161.23,",DA=FBCIEN,DR=".02////^S X=FBEXNDT" D ^DIE K DIE
 Q