FBAAVD2 ;AISC/DMK - EDIT VENDOR DEMOGRAPHICS ;7/10/14 17:07
;;3.5;FEE BASIS;**9,10,47,65,98,111,122,154**;JAN 30, 1995;Build 12
;;Per VA Directive 6402, 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):$G(DILOCKTM,3) I '$T W !,"Another user is editing this vendor record. Try again later.",! Q
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),FBTXC=$P($G(^(3)),U,3)
.;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
.F L +^FBAAV(FBIEN):$G(DILOCKTM,3) Q:$T W !,"Another user is editing this vendor record. Trying again. ",!
.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
.F L +^FBAAV(FBIEN1):$G(DILOCKTM,3) Q:$T W !,"Another user is editing this vendor record. Trying again. ",!
.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)
I '$D(^XUSEC("FBAA LEVEL 2",DUZ)) W !!?3,$C(7)_"You must be a holder of the FBAA LEVEL 2 security key to edit",!?3,"contracts and rates." Q
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,"
F L +^FBAA(161.21,DA):$G(DILOCKTM,3) Q:$T W !,"This contract is being edited by another user, trying again.",!
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
F L +^FBAA(161.22,X):$G(DILOCKTM,3) Q:$T W !,"Another user is editing this rate record. Trying again. ",!
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAVD2 6085 printed Sep 23, 2025@19:33:09 Page 2
FBAAVD2 ;AISC/DMK - EDIT VENDOR DEMOGRAPHICS ;7/10/14 17:07
+1 ;;3.5;FEE BASIS;**9,10,47,65,98,111,122,154**;JAN 30, 1995;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
EDITV ;entry to edit vendor demographic data
+1 ;DA defined to IEN of vendor file (161.2)
+2 if '$GET(DA)
QUIT
NEW FBADT,FBDA,Z6
SET FBDA=DA
LOCK +^FBAAV(DA):$GET(DILOCKTM,3)
IF '$TEST
WRITE !,"Another user is editing this vendor record. Try again later.",!
QUIT
+3 SET FBT=$SELECT($DATA(FBT):FBT,1:"")
SET FBT=$SELECT(FBT="N":FBT,1:"C")
+4 SET FEEO=""
SET DIE="^FBAAV("
SET DR="[FBAA EDIT VENDOR]"
SET DIE("NO^")="BACKOUTOK"
+5 SET Z1=$GET(^FBAAV(DA,0))
SET Z3=$GET(^(1))
SET Z4=$GET(^("AMS"))
SET Z5=$GET(^("ADEL"))
SET Z6=$PIECE($GET(^(3)),U,2)
+6 DO GETGRP^FBAAUTL6(DA)
+7 DO ^DIE
+8 IF $PIECE($GET(^FBAAV(DA,0)),"^",13)']""
SET DR="3;4;5;5.5"
SET DIE("NO^")=""
DO ^DIE
+9 KILL DIE
+10 LOCK -^FBAAV(DA)
+11 ;check if data was changed
+12 IF $DATA(^FBAAV(DA,0))
IF (($PIECE(Z1,U,2,6)'=$PIECE(^FBAAV(DA,0),U,2,6))!($PIECE(Z1,U,8,16)'=$PIECE(^FBAAV(DA,0),U,8,16))!($PIECE(Z3,U,10)'=$PIECE($GET(^FBAAV(DA,1)),U,10))!$$GRPDIF^FBAAUTL6(DA)!($PIECE($GET(^FBAAV(DA,3)),U,2)'=Z6))
Begin DoDot:1
+13 SET FBVNAME=$PIECE(^FBAAV(DA,0),U)
SET FBIEN1=DA
SET FBADT=$PIECE(Z5,U,4)
SET FBNPI=$PIECE($GET(^FBAAV(FBIEN1,3)),U,2)
SET FBTXC=$PIECE($GET(^(3)),U,3)
+14 ;check if date last received from austin, version 3. If so, then did not receive in upload - send update instead of change
+15 ;fbadt = date received from austin.
+16 ;,FBADT<FBINSTAL D UPDT^FBAAAV(DA) Q
IF '$$CKVEN^FBAADV(DA)
IF FBADT']""
DO UPDT^FBAAAV(FBDA)
QUIT
+17 ;if austin deleted is yes, send update instead of change
+18 IF $PIECE($GET(^FBAAV(FBDA,"ADEL")),"^")="Y"
DO UPDT^FBAAAV(FBDA)
QUIT
+19 ;if editing a newly added vendor, send update instead of change
+20 IF FBT="N"
DO UPDT^FBAAAV(FBDA)
QUIT
+21 ;if only FPDS data was changed
+22 IF $PIECE(Z1,U,2,6)=$PIECE(^FBAAV(DA,0),U,2,6)
IF $PIECE(Z1,U,8,16)=$PIECE(^FBAAV(DA,0),U,8,16)
Begin DoDot:2
+23 ; no pending actions - add "F"
IF '$DATA(^FBAA(161.25,"AF",DA))
IF '$DATA(^FBAA(161.25,DA,0))
SET FBT="F"
QUIT
+24 ; action pending, but not yet transmitted - will incl. FPDS data
IF '$DATA(^FBAA(161.25,"AF",DA))
IF $DATA(^FBAA(161.25,DA,0))
IF $PIECE(^(0),U,5)=""
SET FBT=""
QUIT
End DoDot:2
if FBT=""
QUIT
+25 ; send FEE-ONLY
IF FBT="F"
SET FBIEN1=DA
SET FEEO=""
DO SETGL^FBAAVD
QUIT
+26 ;If date from austin not null then add vendor entry for a change
+27 KILL DD,DO
SET DIC="^FBAAV("
SET DIC(0)="L"
SET DLAYGO=161.2
SET X=FBVNAME
DO FILE^DICN
if Y<0
QUIT
SET FBIEN=+Y
+28 FOR
LOCK +^FBAAV(FBIEN):$GET(DILOCKTM,3)
if $TEST
QUIT
WRITE !,"Another user is editing this vendor record. Trying again. ",!
+29 SET ^FBAAV(FBIEN,0)=$GET(^FBAAV(FBIEN1,0))
+30 SET ^FBAAV(FBIEN,1)=$GET(^FBAAV(FBIEN1,1))
+31 SET ^FBAAV(FBIEN,"AMS")=$GET(^FBAAV(FBIEN1,"AMS"))
SET $PIECE(^FBAAV(FBIEN,"AMS"),"^")=""
+32 KILL FBFDA
+33 SET I=0
FOR
SET I=$ORDER(^FBAAV(FBIEN1,2,I))
if 'I
QUIT
Begin DoDot:2
+34 SET X=$PIECE($GET(^(I,0)),U)
IF X]""
SET FBFDA(161.225,"+"_I_","_FBIEN_",",.01)=X
End DoDot:2
+35 IF $DATA(FBFDA)
DO UPDATE^DIE("","FBFDA")
+36 SET DIK="^FBAAV("
SET DA=FBIEN
DO IX1^DIK
+37 LOCK -^FBAAV(FBIEN)
+38 ;restore original vendor data
+39 FOR
LOCK +^FBAAV(FBIEN1):$GET(DILOCKTM,3)
if $TEST
QUIT
WRITE !,"Another user is editing this vendor record. Trying again. ",!
+40 SET DIE="^FBAAV("
SET DA=FBIEN1
SET DR="[FB VENDOR UPDATE]"
DO ^DIE
KILL DIE
+41 DO UPDGRP^FBAAUTL6(FBIEN1)
+42 LOCK -^FBAAV(FBIEN1)
+43 SET DA=FBIEN
DO SETGL^FBAAVD
End DoDot:1
+44 KILL FBSG,FBVNAME,FBIEN,FBIEN1,Z3,Z4,Z5
+45 ;
CONTR ;enter contract information for a CNH vendor
+1 if $SELECT('$DATA(FBPARCD)
QUIT
+2 IF '$DATA(^XUSEC("FBAA LEVEL 2",DUZ))
WRITE !!?3,$CHAR(7)_"You must be a holder of the FBAA LEVEL 2 security key to edit",!?3,"contracts and rates."
QUIT
+3 if '$GET(DA)
QUIT
SET FBVIEN=DA
+4 SET FBLIEN=$PIECE($GET(^FBAA(161.25,FBVIEN,0)),"^",6)
IF FBLIEN]""
IF FBLIEN'=FBVIEN
WRITE !!,*7,"Cannot add contract information to this vendor until change has been",!,"approved by Austin."
QUIT
+5 WRITE !
SET DIC="^FBAA(161.21,"
SET DIC(0)="AEQLM"
SET DLAYGO=161.21
SET DIC("S")="I $P(^(0),U,4)="_FBVIEN
+6 DO ^DIC
KILL DIC,DLAYGO
if X=""!(X="^")
QUIT
if Y<0
GOTO CONTR
+7 SET DA=+Y
SET FBCNUM=$PIECE(Y,"^",2)
SET DIE="^FBAA(161.21,"
+8 FOR
LOCK +^FBAA(161.21,DA):$GET(DILOCKTM,3)
if $TEST
QUIT
WRITE !,"This contract is being edited by another user, trying again.",!
+9 SET ZO1=^FBAA(161.21,DA,0)
SET DR="[FBNH ENTER CONTRACT]"
SET DIE("NO^")=""
DO ^DIE
KILL DIE,DR
+10 IF '$GET(DA)
KILL ZO1
QUIT
+11 IF $DATA(^FBAA(161.22,"AC",DA))
Begin DoDot:1
+12 if $PIECE(ZO1,"^",1,2)=$PIECE(^FBAA(161.21,DA,0),"^",1,2)
QUIT
WRITE !!,*7,"You cannot change contract numbers or effective dates on",!,"a contract that has rates associated with it."
+13 SET DIE="^FBAA(161.21,"
SET 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)"
DO ^DIE
KILL DIE,DR
WRITE !!,"Contract information reset"
End DoDot:1
+14 LOCK -^FBAA(161.21,DA)
KILL ZO1
+15 if $DATA(DTOUT)
QUIT
+16 IF $GET(FBEXNDT)<$GET(FBEXDT)
DO URATE
KILL FBCIEN,FBEXDT,FBEXNDT,FBURT
+17 ;create rates for a contract. Rates cannot be changed, but the
+18 ;user can enter multiple rates for a contract.
+19 ;FBCIEN=internal entry number for contract in 161.21
+20 SET FBCIEN=DA
KILL FBX
RATE KILL DA
WRITE !
SET DIR(0)="161.22,.02"
SET DIR("A")="Enter Nursing Home Rate"
SET DIR("?")="^K FBX,FBRATE D DISPLAY^FBAAVD1 W !,""Enter an amount between .01 and 9999999.99"""
DO ^DIR
+1 KILL DIR
if $DATA(DIRUT)
QUIT
if 'Y
QUIT
SET FBR=+Y
+2 ;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
+3 IF $DATA(^FBAA(161.22,"AD",FBCIEN,FBR))
KILL FBR
WRITE !,*7,"Rate already exists for that contract!",!
GOTO RATE
+4 SET X=$PIECE(^FBAA(161.22,0),U,3)
RETRY SET X=X+1
if $DATA(^FBAA(161.22,X))
GOTO RETRY
+1 FOR
LOCK +^FBAA(161.22,X):$GET(DILOCKTM,3)
if $TEST
QUIT
WRITE !,"Another user is editing this rate record. Trying again. ",!
+2 KILL DD,DO
SET DIC="^FBAA(161.22,"
SET DIC(0)="L"
SET DLAYGO=161.22
SET DIC("DR")=".02////^S X="_FBR_";.03////^S X="_FBCIEN
DO FILE^DICN
KILL DIC,DLAYGO
+3 LOCK -^FBAA(161.22,+Y)
+4 GOTO RATE
+5 ;
GETVEN KILL FBRATE
DO GETVEN^FBAAUTL1
if 'IFN
GOTO END
+1 SET DA=IFN
KILL DIC,IFN
+2 SET FBPARCD=$PIECE($GET(^FBAAV(DA,0)),U,9)
+3 IF FBPARCD'=5
WRITE !?5,*7,"Vendor selected is not a Community Nursing Home.",!
GOTO GETVEN
+4 DO CONTR
GOTO GETVEN
END KILL DIC,DA,FBVIEN,IFN,FBPARCD,X,Y,FBLIEN
+1 QUIT
URATE ;Update rate when user backs up contract dates.
+1 NEW DA
SET (FBCIEN,FBURT)=0
+2 FOR
SET FBURT=$ORDER(^FBAA(161.23,"AE",FBCNUM,FBURT))
if 'FBURT
QUIT
FOR
SET FBCIEN=$ORDER(^FBAA(161.23,"AE",FBCNUM,FBURT,FBCIEN))
if 'FBCIEN
QUIT
IF $PIECE($GET(^FBAA(161.23,FBCIEN,0)),"^",2)>FBEXNDT
Begin DoDot:1
+3 IF +$GET(^FBAA(161.23,FBCIEN,0))>FBEXNDT
SET DIK="^FBAA(161.23,"
SET DA=FBCIEN
DO ^DIK
KILL DIK
QUIT
+4 SET DIE="^FBAA(161.23,"
SET DA=FBCIEN
SET DR=".02////^S X=FBEXNDT"
DO ^DIE
KILL DIE
End DoDot:1
+5 QUIT
