source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFOOR1.m@ 1166

PRCFOOR1 ;WISC@ALTOONA/CTB-SNAPSHOT OF CP BALANCES ;9/29/94  8:40 AM
V ;;5.1;IFCAP;;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ;;THIS ROUTINE WILL RECALCULATE ALL CP BALANCES FOR THE CURRENT FY,
 ;;THEN TAKE A SNAPSHOT OF THE BALANCE FOR THE CURRENT QUARTER
 ;;AND STORE THE BALANCE IN 420.  IT WILL THEN ZERO OUT ALL QUARTERS
 ;;IN THE CURRENT FY - EXCEPT FOR THE CURRENT QUARTER.
 ;;
 ;RECALCULATE ALL CONTROL POINTS
 S X="Beginning recalculation of balances for ALL Fund Control Points." D MSG^PRCFQ
 D ALLCP^PRCBRCP
 S X="<  Recalculation complete>*" D MSG^PRCFQ
X S X=DT D FYQ^PRCFSITE
STA W !! S X="Beginning process to record existing Fund Control Point balances in file 420.99. (Snapshot)" D MSG^PRCFQ
 F PRC("SITE")=0:0 S PRC("SITE")=$O(^PRC(420,PRC("SITE"))) Q:+PRC("SITE")=0  W !,PRC("SITE") D CP
 S X="<  Snapshot complete>*" D MSG^PRCFQ
ZERO W !! S X="Beginning process to 'zero' out previous quarter balances.*" D MSG^PRCFQ
 N PRCRI S PRCRI(420.99)=0
 F  S PRCRI(420.99)=$O(^PRCU(420.99,PRCRI(420.99))) Q:'PRCRI(420.99)  S DA=PRCRI(420.99) D XF
 S X="<  Process complete>*" D MSG^PRCFQ
GPF W !! S X="Beginning process to summarize General Post Fund Control Points" D MSG^PRCFQ
 ;CREATE RECORD FOR GENERAL POST FUND SUMMARY CONTROL POINT
 ;SUMMARIZE, BY STATION, GPF BALANCES
 ;SET BALANCES
 ;ZERO CURRENT QUARTER
 S XDA=0 F  S XDA=$O(^PRCU(420.99,XDA)) Q:'XDA  I $P(^(XDA,0),"^",11)=1 D GPF1(XDA)
 S SITE=0
 F  S SITE=$O(GPFBAL(SITE)) Q:'SITE  D GPF2(SITE,GPFBAL(SITE))
 K PRC
 S X="<  Process complete>*" D MSG^PRCFQ
 QUIT
GPF2(SITE,AMT) ;SET BALANCE TO GPF SUMMARY CONTROL POINT
 S PRC("CP")=$O(^PRC(420,SITE,1,"C","GPFS FMS CONVERSION",0))
 I PRC("CP")="" QUIT
 S PRC("CP")=$P(^PRC(420,SITE,1,PRC("CP"),0)," ")
 S STRING=SITE_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_PRC("CP")
 S X=STRING,DIC=420.99,DIC(0)="M" D ^DIC Q:+Y<0
 S $P(^PRCU(420.99,+Y,0),"^",3)=AMT
 D CONV^PRCSREC2(STRING,-AMT,"FMS CONVERSION ADJUSTMENT")
 QUIT
GPF1(XDA) ;ZERO BALANCE IN EXISTING GPF CONTROL POINTS
 N BAL,SITE,NODE,ID,AMT,STRING
 S SITE=$P(^PRCU(420.99,XDA,0),"-"),BAL=$P(^(0),"^",3),GPFBAL(SITE)=$G(GPFBAL(SITE))+BAL
 ;ZERO CURRENT QUARTER FOR GPF CP
 S NODE=$G(^PRCU(420.99,XDA,0)) Q:NODE=""
 S ID=$P(NODE,"^"),AMT=+$P(NODE,"^",3)
 Q:AMT=0
 S STRING=ID,$P(STRING,"-",3)=PRC("QTR") D CONV^PRCSREC2(STRING,+AMT,"FMS CONVERSION ADJUSTMENT")
 S $P(^PRCU(420.99,XDA,0),"^",3)=0
 W "."
 QUIT
XF ;
 N NODE,ID,QTR,I,STRING
 S NODE=$G(^PRCU(420.99,DA,0)) Q:NODE=""
 S ID=$P(NODE,"^"),QTR(1)=$P(NODE,"^",4),QTR(2)=$P(NODE,"^",5),QTR(3)=$P(NODE,"^",6)
 F I=1:1:3 Q:'$D(QTR(I))  I +QTR(I)'=0 S STRING=ID,$P(STRING,"-",3)=I D CONV^PRCSREC2(STRING,+QTR(I),"FMS CONVERSION ADJUSTMENT")
 W "."
 QUIT
CP F PRC("CPN")=0:0 S PRC("CPN")=$O(^PRC(420,PRC("SITE"),1,PRC("CPN"))),PRC("CP")="" Q:+PRC("CPN")=0!(PRC("CPN")=9999)  I $D(^(PRC("CPN"),0)) S PRC("CP")=$P(^(0)," ") Q:PRC("CP")=""  D QTR
 Q
QTR ;
 NEW SNAP,DIC,DLAYGO,AMT,DATE,Y,DA,DR,DIE,TYPE,QTRBAL
 S TYPE=$P($G(^PRC(420,PRC("SITE"),1,+PRC("CP"),0)),"^",12)
 S X=$G(^PRC(420,PRC("SITE"),1,+PRC("CP"),4,PRC("FY"),0))
 S SNAP=$P(X,"^",PRC("QTR")+5),SNAP=0 ;mod for conversion 3 only
 I PRC("QTR")>1 F I=1:1:(PRC("QTR")-1) S QTRBAL(I)=$P(X,"^",I+5)
 S (DIC,DLAYGO)=420.99,DIC(0)="MNL",AMT=X,X=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_PRC("CP"),DATE=DT D ^DIC
 I Y<0 S FAIL="" QUIT
 S DA=+Y,$P(^PRCU(420.99,DA,0),"^",2)=DATE,$P(^(0),"^",3)=SNAP,$P(^(0),"^",4)=$G(QTRBAL(1)),$P(^(0),"^",5)=$G(QTRBAL(2)),$P(^(0),"^",6)=$G(QTRBAL(3))
 S $P(^PRCU(420.99,DA,0),"^",11)=+TYPE,$P(^(0),"^",7)=PRC("QTR")
 W "." QUIT