source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCBCPR.m@ 1742

PRCBCPR ;WISC@ALTOONA/CTB-CONTROL POINT REPORT ; 05/18/93  2:10 PM
V ;;5.1;IFCAP;**97**;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 D ^PRCFSITE Q:'%  D QT^PRCBSUT Q
INDIV D V G:'% OUT S DIC="^PRC(420,"_PRC("SITE")_",1,",DIC(0)="AEMNZ" D ^DIC G:Y<0 OUT S Z=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$P(Y(0)," ") D QUE
 W !!,"CONTROL POINT OFFICIAL'S BALANCE: ",?35,"$"_$J(PRCS("C"),10,2),!,"FISCAL UNOBLIGATED BALANCE: ",?35,"$"_$J(PRCS("O"),10,2)
 W !,"TOTAL COMMITTED, NOT OBLIGATED: ",?35,"$"_$J((PRCS("O")-PRCS("C")),10,2) K %DT,%P,I,N,PRCS,Z,Z1 W ! G INDIV
OUT K %,C,DIC,J,POP,PRCSQTT,T,T1,X,Y,Z Q
QALL ;;PRINT ALL CONTROL POINT BALANCES
 D V G:'% OUT S ZTDESC=$P($T(QALL),";",3),ZTRTN="ALL^PRCBCPR",ZTSAVE("PRC*")="" D ^PRCFQ G OUT
ALL ;PRINT BALANCES FOR ALL CONTROL POINTS
 D:$D(ZTQUEUED) KILL^%ZTLOAD S DA=0,ZZ=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"
 S PAGE=1,$P(LINE,"-",IOM-2)="" D HDR
 F K=1:1 S DA=$O(^PRC(420,PRC("SITE"),1,DA)) G OUT:DA>9998!'DA I $D(^(DA,0)) S PRC("CP")=^(0),Z=ZZ_$P(PRC("CP")," ") D QUE S %=1 D:IOSL-$Y<4&(IOST["C-") ENCON^PRCFQ G:'%!(X=U) OUT D:IOSL-$Y<4 HDR D LINE K PRC("CP")
 W !,"DONE" Q
LINE W !!,$P(PRC("CP"),"^"),?32,"$"_$J(PRCS("C"),10,2),?49,"$"_$J(PRCS("O"),10,2),?66,"$"_$J((PRCS("O")-PRCS("C")),10,2) K %DT,%P,I,N,PRCS,Z,Z1 Q
HDR ;HEADER
 D NOW^%DTC S Y=% D DD^%DT S DATETIME=Y
 W @IOF,"FUND CONTROL POINT BALANCE LISTING",?IOM-40,"PAGE: ",PAGE,?IOM-20,DATETIME,!,"FOR STATION: ",PRC("SITE"),"   FY-QTR: ",PRC("FY")_"-"_PRC("QTR")
 W !!,"FUND CONTROL POINT",?32,"UNCOMMITTED",?49,"UNOBLIGATED",?70,"PENDING",!,LINE S PAGE=PAGE+1 Q
QUE ;
 S PRCS("O")=$$FCPBAL^PRC0D(PRC("SITE"),PRC("CP"),PRC("FY"),1),PRCS("O")=$P(PRCS("O"),"^",PRC("QTR"))
 S PRCS("C")=$$FCPBAL^PRC0D(PRC("SITE"),PRC("CP"),PRC("FY"),2),PRCS("C")=$P(PRCS("C"),"^",PRC("QTR"))
 QUIT