source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCBCPR.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1PRCBCPR ;WISC@ALTOONA/CTB-CONTROL POINT REPORT ; 05/18/93 2:10 PM
2V ;;5.1;IFCAP;**97**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 D ^PRCFSITE Q:'% D QT^PRCBSUT Q
5INDIV 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
6 W !!,"CONTROL POINT OFFICIAL'S BALANCE: ",?35,"$"_$J(PRCS("C"),10,2),!,"FISCAL UNOBLIGATED BALANCE: ",?35,"$"_$J(PRCS("O"),10,2)
7 W !,"TOTAL COMMITTED, NOT OBLIGATED: ",?35,"$"_$J((PRCS("O")-PRCS("C")),10,2) K %DT,%P,I,N,PRCS,Z,Z1 W ! G INDIV
8OUT K %,C,DIC,J,POP,PRCSQTT,T,T1,X,Y,Z Q
9QALL ;;PRINT ALL CONTROL POINT BALANCES
10 D V G:'% OUT S ZTDESC=$P($T(QALL),";",3),ZTRTN="ALL^PRCBCPR",ZTSAVE("PRC*")="" D ^PRCFQ G OUT
11ALL ;PRINT BALANCES FOR ALL CONTROL POINTS
12 D:$D(ZTQUEUED) KILL^%ZTLOAD S DA=0,ZZ=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"
13 S PAGE=1,$P(LINE,"-",IOM-2)="" D HDR
14 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")
15 W !,"DONE" Q
16LINE 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
17HDR ;HEADER
18 D NOW^%DTC S Y=% D DD^%DT S DATETIME=Y
19 W @IOF,"FUND CONTROL POINT BALANCE LISTING",?IOM-40,"PAGE: ",PAGE,?IOM-20,DATETIME,!,"FOR STATION: ",PRC("SITE")," FY-QTR: ",PRC("FY")_"-"_PRC("QTR")
20 W !!,"FUND CONTROL POINT",?32,"UNCOMMITTED",?49,"UNOBLIGATED",?70,"PENDING",!,LINE S PAGE=PAGE+1 Q
21QUE ;
22 S PRCS("O")=$$FCPBAL^PRC0D(PRC("SITE"),PRC("CP"),PRC("FY"),1),PRCS("O")=$P(PRCS("O"),"^",PRC("QTR"))
23 S PRCS("C")=$$FCPBAL^PRC0D(PRC("SITE"),PRC("CP"),PRC("FY"),2),PRCS("C")=$P(PRCS("C"),"^",PRC("QTR"))
24 QUIT
Note: See TracBrowser for help on using the repository browser.