PRCBCPR.m

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 ---PRCBCPR   1863     printed  Apr 09, 2024@21:10:12                                                                                                                                                                                                     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