54 lines
2.8 KiB
Mathematica
54 lines
2.8 KiB
Mathematica
PRCB1E2 ;WISC/PLT-PRCB1E continue ;3/4/97 15:59
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
QUIT ;invalid entry
|
|
;
|
|
;prcduz - user id #
|
|
;prcopt data ^1=option #, ^2=yyyy-q, ^3=station #, ^4=cp ri
|
|
;prcdes = description
|
|
;
|
|
;prca = prcopt, prcb=fund control point ri
|
|
CPBAL(PRCA,PRCB) ;carry forward cp ballance
|
|
N PRC,PRCRI,PRCC,PRCD,PRCCOM
|
|
N A,B,C,X,Y,Z,DA
|
|
S PRC("SITE")=$P(PRCA,"^",3),PRCRI(420)=+PRC("SITE"),PRCRI(420.01)=+PRCB
|
|
S PRC("CP")=$P($G(^PRC(420,PRCRI(420),1,PRCRI(420.01),0)),"^")
|
|
S PRCC=$$QTRDT^PRC0G(PRCRI(420)_"^"_PRCRI(420.01)_"^"_+$P(PRCA,"^",2)_"^"_"F")
|
|
QUIT:$P(PRCA,"^",5)'<$P(PRCC,"^",2) ;last qtr always open
|
|
S A=$P(PRCOPT,"^",2),PRC("FY")=$E(A,3,4),PRC("QTR")=$P(A,"-",2)
|
|
L +^PRC(420,PRCRI(420),1,PRCRI(420.01),4,PRC("FY"),0):5
|
|
E S PRC("MSG")="Note: Carry forward from "_$P(PRC("CP")," ")_" failed. File locked by another user." D EN^DDIOL(PRC("MSG")) QUIT
|
|
S A=$G(^PRC(420,PRCRI(420),1,PRCRI(420.01),4,PRC("FY"),0))
|
|
L -^PRC(420,PRCRI(420),1,PRCRI(420.01),4,PRC("FY"),0)
|
|
QUIT:A=""
|
|
S PRCCOM=$P(A,"^",1+PRC("QTR"))
|
|
I +PRCCOM=0 S PRC("MSG")=PRC("CP")_" Qtr "_$E($P(PRCOPT,"^",2),3,999)_" adjusted with $"_$J(PRCCOM,0,2)_"."
|
|
;zero out from CP quarter balances
|
|
S A=$$BBFY^PRCSUT(PRC("SITE"),PRC("FY"),PRC("CP"),1)
|
|
S X=PRC("SITE")_"-"_PRC("FY")_"-"_$P(PRC("CP")," ")
|
|
S Z=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$P(PRC("CP")," ")
|
|
D EN1^PRCSUT3 S PRC("TXNTO")=X D EN2^PRCSUT3 S PRCRI(410)=DA
|
|
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
|
|
S A="1///A;40////"_DUZ_";449////"_$P(PRCA,"^",5)_";450////O;25.5////Y;24////QTRADJ;26///T"
|
|
D EDIT^PRC0B(.X,"410;^PRCS(410,;"_PRCRI(410),A)
|
|
D EDIT^PRC0B(.X,"410;^PRCS(410,;"_PRCRI(410),"25////"_PRCCOM)
|
|
;adjust new CP quarter balance
|
|
S PRCCOM=-PRCCOM
|
|
S A=$P(PRCOPT,"^",7),PRC("FY")=$E(A,3,4),PRC("QTR")=$P(A,"-",2)
|
|
S A=$$BBFY^PRCSUT(PRC("SITE"),PRC("FY"),PRC("CP"),1)
|
|
S X=PRC("SITE")_"-"_PRC("FY")_"-"_$P(PRC("CP")," ")
|
|
S Z=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$P(PRC("CP")," ")
|
|
D EN1^PRCSUT3 S PRC("TXNFR")=X D EN2^PRCSUT3 S PRCRI(410)=DA
|
|
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
|
|
S A="1///A;40////"_DUZ_";449////"_$P(PRCA,"^",6)_";450////O;25.5////Y;24////QTRADJ;26///T"
|
|
D EDIT^PRC0B(.X,"410;^PRCS(410,;"_PRCRI(410),A)
|
|
D EDIT^PRC0B(.X,"410;^PRCS(410,;"_PRCRI(410),"25////"_PRCCOM)
|
|
S PRC("MSG")=PRC("CP")_" Qtr "_$E($P(PRCOPT,"^",2),3,999)_" adjusted with $"_$J(PRCCOM,0,2)_"."
|
|
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
|
|
. N A,B,X,Y,XMY
|
|
. D NAMES^PRCBBUL
|
|
. S X(1)=PRC("MSG")
|
|
. D:$O(XMY("")) MM^PRC0B2(PRCDES,"X(",.XMY)
|
|
. QUIT
|
|
QUIT
|