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