| 1 | FBAAPV ;AISC/CMR-Vendors Pending Austin Approval;9/17/93
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | S (VAR,VAL)="",PGM="START^FBAAPV" D ZIS^FBAAUTL G EXIT:FBPOP
|
|---|
| 5 | START S (FBAAOUT,FBI)=0 F S FBI=$O(^FBAA(161.25,FBI)) Q:'FBI D
|
|---|
| 6 | .S FBIN=$G(^FBAA(161.25,FBI,0)) I FBIN["N"!(FBIN["C") S FBDT=$P(FBIN,"^",5),FBNAME=$$VNAME^FBNHEXP(FBI),^TMP($J,"FBPV",FBNAME,FBI)=FBDT
|
|---|
| 7 | I '$D(^TMP($J,"FBPV")) G MSG
|
|---|
| 8 | U IO W:$E(IOST,1,2)["C-" @IOF D HED
|
|---|
| 9 | S FBNAME="",FBI=0 F S FBNAME=$O(^TMP($J,"FBPV",FBNAME)) Q:FBNAME']""!FBAAOUT F S FBI=$O(^TMP($J,"FBPV",FBNAME,FBI)) Q:'FBI!FBAAOUT S FBDT=+^(FBI) D
|
|---|
| 10 | .I $Y+3>IOSL,($E(IOST,1,2)["C-") S DIR(0)="E" D ^DIR K DIR I 'Y S FBAAOUT=1 Q
|
|---|
| 11 | .I $Y+3>IOSL W @IOF D HED
|
|---|
| 12 | .F FBT=2,3,4,5,6,14 S FBT(FBT)=$P(^FBAAV(FBI,0),"^",FBT)
|
|---|
| 13 | .W !!,FBNAME,?35,FBT(2),?60,$S(FBDT>0:$$DATX^FBAAUTL(FBDT),1:"Not Transmitted"),!?5,FBT(3) W:FBT(14)]"" !?5,FBT(14) W !?5,FBT(4)," ",$P($G(^DIC(5,+FBT(5),0)),U,2)," ",FBT(6)
|
|---|
| 14 | EXIT K FBI,FBIN,FBDT,FBNAME,FBQ,FBAAOUT,^TMP($J,"FBPV")
|
|---|
| 15 | D CLOSE^FBAAUTL
|
|---|
| 16 | Q
|
|---|
| 17 | HED W !?18,"FEE BASIS VENDORS AWAITING AUSTIN APPROVAL"
|
|---|
| 18 | W !?33,$$DATX^FBAAUTL(DT),!?18 F FBQ=1:1:42 W "-"
|
|---|
| 19 | W !!,"VENDOR",?38,"ID",?54,"DATE TRANSMITTED TO AUSTIN" F FBQ=1:1:80 W "="
|
|---|
| 20 | W ! Q
|
|---|
| 21 | MSG W !!,"There are no venders awaiting Austin approval."
|
|---|
| 22 | G EXIT
|
|---|
