- 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 Mar 13, 2025@21:01:01 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
