FBAAPV ;AISC/CMR-Vendors Pending Austin Approval;9/17/93
;;3.5;FEE BASIS;;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
S (VAR,VAL)="",PGM="START^FBAAPV" D ZIS^FBAAUTL G EXIT:FBPOP
START S (FBAAOUT,FBI)=0 F S FBI=$O(^FBAA(161.25,FBI)) Q:'FBI D
.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
I '$D(^TMP($J,"FBPV")) G MSG
U IO W:$E(IOST,1,2)["C-" @IOF D HED
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
.I $Y+3>IOSL,($E(IOST,1,2)["C-") S DIR(0)="E" D ^DIR K DIR I 'Y S FBAAOUT=1 Q
.I $Y+3>IOSL W @IOF D HED
.F FBT=2,3,4,5,6,14 S FBT(FBT)=$P(^FBAAV(FBI,0),"^",FBT)
.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)
EXIT K FBI,FBIN,FBDT,FBNAME,FBQ,FBAAOUT,^TMP($J,"FBPV")
D CLOSE^FBAAUTL
Q
HED W !?18,"FEE BASIS VENDORS AWAITING AUSTIN APPROVAL"
W !?33,$$DATX^FBAAUTL(DT),!?18 F FBQ=1:1:42 W "-"
W !!,"VENDOR",?38,"ID",?54,"DATE TRANSMITTED TO AUSTIN" F FBQ=1:1:80 W "="
W ! Q
MSG W !!,"There are no venders awaiting Austin approval."
G EXIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAPV 1337 printed Nov 22, 2024@17:06:29 Page 2
FBAAPV ;AISC/CMR-Vendors Pending Austin Approval;9/17/93
+1 ;;3.5;FEE BASIS;;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 SET (VAR,VAL)=""
SET PGM="START^FBAAPV"
DO ZIS^FBAAUTL
if FBPOP
GOTO EXIT
START SET (FBAAOUT,FBI)=0
FOR
SET FBI=$ORDER(^FBAA(161.25,FBI))
if 'FBI
QUIT
Begin DoDot:1
+1 SET FBIN=$GET(^FBAA(161.25,FBI,0))
IF FBIN["N"!(FBIN["C")
SET FBDT=$PIECE(FBIN,"^",5)
SET FBNAME=$$VNAME^FBNHEXP(FBI)
SET ^TMP($JOB,"FBPV",FBNAME,FBI)=FBDT
End DoDot:1
+2 IF '$DATA(^TMP($JOB,"FBPV"))
GOTO MSG
+3 USE IO
if $EXTRACT(IOST,1,2)["C-"
WRITE @IOF
DO HED
+4 SET FBNAME=""
SET FBI=0
FOR
SET FBNAME=$ORDER(^TMP($JOB,"FBPV",FBNAME))
if FBNAME']""!FBAAOUT
QUIT
FOR
SET FBI=$ORDER(^TMP($JOB,"FBPV",FBNAME,FBI))
if 'FBI!FBAAOUT
QUIT
SET FBDT=+^(FBI)
Begin DoDot:1
+5 IF $Y+3>IOSL
IF ($EXTRACT(IOST,1,2)["C-")
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET FBAAOUT=1
QUIT
+6 IF $Y+3>IOSL
WRITE @IOF
DO HED
+7 FOR FBT=2,3,4,5,6,14
SET FBT(FBT)=$PIECE(^FBAAV(FBI,0),"^",FBT)
+8 WRITE !!,FBNAME,?35,FBT(2),?60,$SELECT(FBDT>0:$$DATX^FBAAUTL(FBDT),1:"Not Transmitted"),!?5,FBT(3)
if FBT(14)]""
WRITE !?5,FBT(14)
WRITE !?5,FBT(4)," ",$PIECE($GET(^DIC(5,+FBT(5),0)),U,2)," ",FBT(6)
End DoDot:1
EXIT KILL FBI,FBIN,FBDT,FBNAME,FBQ,FBAAOUT,^TMP($JOB,"FBPV")
+1 DO CLOSE^FBAAUTL
+2 QUIT
HED WRITE !?18,"FEE BASIS VENDORS AWAITING AUSTIN APPROVAL"
+1 WRITE !?33,$$DATX^FBAAUTL(DT),!?18
FOR FBQ=1:1:42
WRITE "-"
+2 WRITE !!,"VENDOR",?38,"ID",?54,"DATE TRANSMITTED TO AUSTIN"
FOR FBQ=1:1:80
WRITE "="
+3 WRITE !
QUIT
MSG WRITE !!,"There are no venders awaiting Austin approval."
+1 GOTO EXIT
