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

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