| 1 | PRCB1E2 ;WISC/PLT-PRCB1E continue ;3/4/97 15:59
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | QUIT ;invalid entry
|
|---|
| 5 | ;
|
|---|
| 6 | ;prcduz - user id #
|
|---|
| 7 | ;prcopt data ^1=option #, ^2=yyyy-q, ^3=station #, ^4=cp ri
|
|---|
| 8 | ;prcdes = description
|
|---|
| 9 | ;
|
|---|
| 10 | ;prca = prcopt, prcb=fund control point ri
|
|---|
| 11 | CPBAL(PRCA,PRCB) ;carry forward cp ballance
|
|---|
| 12 | N PRC,PRCRI,PRCC,PRCD,PRCCOM
|
|---|
| 13 | N A,B,C,X,Y,Z,DA
|
|---|
| 14 | S PRC("SITE")=$P(PRCA,"^",3),PRCRI(420)=+PRC("SITE"),PRCRI(420.01)=+PRCB
|
|---|
| 15 | S PRC("CP")=$P($G(^PRC(420,PRCRI(420),1,PRCRI(420.01),0)),"^")
|
|---|
| 16 | S PRCC=$$QTRDT^PRC0G(PRCRI(420)_"^"_PRCRI(420.01)_"^"_+$P(PRCA,"^",2)_"^"_"F")
|
|---|
| 17 | QUIT:$P(PRCA,"^",5)'<$P(PRCC,"^",2) ;last qtr always open
|
|---|
| 18 | S A=$P(PRCOPT,"^",2),PRC("FY")=$E(A,3,4),PRC("QTR")=$P(A,"-",2)
|
|---|
| 19 | L +^PRC(420,PRCRI(420),1,PRCRI(420.01),4,PRC("FY"),0):5
|
|---|
| 20 | E S PRC("MSG")="Note: Carry forward from "_$P(PRC("CP")," ")_" failed. File locked by another user." D EN^DDIOL(PRC("MSG")) QUIT
|
|---|
| 21 | S A=$G(^PRC(420,PRCRI(420),1,PRCRI(420.01),4,PRC("FY"),0))
|
|---|
| 22 | L -^PRC(420,PRCRI(420),1,PRCRI(420.01),4,PRC("FY"),0)
|
|---|
| 23 | QUIT:A=""
|
|---|
| 24 | S PRCCOM=$P(A,"^",1+PRC("QTR"))
|
|---|
| 25 | I +PRCCOM=0 S PRC("MSG")=PRC("CP")_" Qtr "_$E($P(PRCOPT,"^",2),3,999)_" adjusted with $"_$J(PRCCOM,0,2)_"."
|
|---|
| 26 | ;zero out from CP quarter balances
|
|---|
| 27 | S A=$$BBFY^PRCSUT(PRC("SITE"),PRC("FY"),PRC("CP"),1)
|
|---|
| 28 | S X=PRC("SITE")_"-"_PRC("FY")_"-"_$P(PRC("CP")," ")
|
|---|
| 29 | S Z=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$P(PRC("CP")," ")
|
|---|
| 30 | D EN1^PRCSUT3 S PRC("TXNTO")=X D EN2^PRCSUT3 S PRCRI(410)=DA
|
|---|
| 31 | I 'PRCRI(410) S PRC("MSG")="Note: CP balance adjust 'to' fails for "_$P(PRC("CP")," ")_" $"_$J(PRCCOM,10,2) D EN^DDIOL(PRC("MSG")) G MM
|
|---|
| 32 | S A="1///A;40////"_DUZ_";449////"_$P(PRCA,"^",5)_";450////O;25.5////Y;24////QTRADJ;26///T"
|
|---|
| 33 | D EDIT^PRC0B(.X,"410;^PRCS(410,;"_PRCRI(410),A)
|
|---|
| 34 | D EDIT^PRC0B(.X,"410;^PRCS(410,;"_PRCRI(410),"25////"_PRCCOM)
|
|---|
| 35 | ;adjust new CP quarter balance
|
|---|
| 36 | S PRCCOM=-PRCCOM
|
|---|
| 37 | S A=$P(PRCOPT,"^",7),PRC("FY")=$E(A,3,4),PRC("QTR")=$P(A,"-",2)
|
|---|
| 38 | S A=$$BBFY^PRCSUT(PRC("SITE"),PRC("FY"),PRC("CP"),1)
|
|---|
| 39 | S X=PRC("SITE")_"-"_PRC("FY")_"-"_$P(PRC("CP")," ")
|
|---|
| 40 | S Z=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$P(PRC("CP")," ")
|
|---|
| 41 | D EN1^PRCSUT3 S PRC("TXNFR")=X D EN2^PRCSUT3 S PRCRI(410)=DA
|
|---|
| 42 | I 'PRCRI(410) S PRC("MSG")="Note: CP balance adjust 'from' fails for "_$P(PRC("CP")," ")_" $"_$J(PRCCOM,10,2) D EN^DDIOL(PRC("MSG")) G MM
|
|---|
| 43 | S A="1///A;40////"_DUZ_";449////"_$P(PRCA,"^",6)_";450////O;25.5////Y;24////QTRADJ;26///T"
|
|---|
| 44 | D EDIT^PRC0B(.X,"410;^PRCS(410,;"_PRCRI(410),A)
|
|---|
| 45 | D EDIT^PRC0B(.X,"410;^PRCS(410,;"_PRCRI(410),"25////"_PRCCOM)
|
|---|
| 46 | S PRC("MSG")=PRC("CP")_" Qtr "_$E($P(PRCOPT,"^",2),3,999)_" adjusted with $"_$J(PRCCOM,0,2)_"."
|
|---|
| 47 | MM D EN^DDIOL($J($P(PRC("CP")," "),8)_" "_$E($P(PRC("CP")," ",2,999)_$J("",40),1,40)_" (ADJ) $"_$J(PRCCOM,0,2)) D:+PRCCOM'=0
|
|---|
| 48 | . N A,B,X,Y,XMY
|
|---|
| 49 | . D NAMES^PRCBBUL
|
|---|
| 50 | . S X(1)=PRC("MSG")
|
|---|
| 51 | . D:$O(XMY("")) MM^PRC0B2(PRCDES,"X(",.XMY)
|
|---|
| 52 | . QUIT
|
|---|
| 53 | QUIT
|
|---|
