| 1 | PRCS0A ;WISC/PLT-UTILITY FOR PRCS-ROUTINE ; 08/08/94 12:09 PM
|
|---|
| 2 | V ;;5.1;IFCAP;**23**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | QUIT ;invalid entry
|
|---|
| 5 | ;
|
|---|
| 6 | ;PRCA data ^1=station #,^2=fcp #,^3=rb fy (4-digit), ^4=rb qtr
|
|---|
| 7 | ;PRCB=amount entered
|
|---|
| 8 | ;PRCC=1 if obligated, 2 if committed amount
|
|---|
| 9 | ;Z=0 if allowed, 1 if st/fcp swich fail, 2 if rollover fail
|
|---|
| 10 | OVCOM(PRCA,PRCB,PRCC) ;EF over commit switch and rollover check for commited/obligated amount entered
|
|---|
| 11 | N A,B,C,D,E,F,G,H,Z
|
|---|
| 12 | I PRCB'>0 QUIT 0
|
|---|
| 13 | ; Patch 5.1*23 ; comment out the statement that skip rest of the check
|
|---|
| 14 | ; when dealing with 4th quarter 1358 in new Fiscal year.
|
|---|
| 15 | ; (Overcommit check is not working on prior 4th quarter 1358 only.)
|
|---|
| 16 | ;I $P($$DATE^PRC0C($P(^PRC(420,+PRCA,0),"^",9),"I"),"^",1,2)]$P(PRCA,"^",3,4) QUIT 0
|
|---|
| 17 | S Z=1 S:$G(PRCC)="" PRCC=2
|
|---|
| 18 | S A=$P($$DATE^PRC0C("T","E"),"^",1,2)
|
|---|
| 19 | S B=$P(PRCA,"^",3,4) ;S B=$$QTRDATE^PRC0D($P(PRCA,"^",3),$P(PRCA,"^",4)),B=$P(B,"^",1,2)
|
|---|
| 20 | S C=$P($G(^PRC(420,+PRCA,0)),"^",2) S:C=4 C=$P($G(^PRC(420,+PRCA,1,+$P(PRCA,"^",2),0)),"^",13)
|
|---|
| 21 | S D=$P($G(^PRC(420,+PRCA,0)),"^",8)
|
|---|
| 22 | S:D-2 D=$P($G(^PRC(420,+PRCA,1,+$P(PRCA,"^",2),0)),"^",20)
|
|---|
| 23 | S E=$$FCPBAL^PRC0D(+PRCA,+$P(PRCA,"^",2),$E(B,3,4),PRCC)
|
|---|
| 24 | S F=$P(PRCA,"^",4)
|
|---|
| 25 | ;S:PRCB'>$P(E,"^",F)!(C=5)!(B<A) Z=0
|
|---|
| 26 | S:PRCB'>$P(E,"^",F)!(C=5) Z=0
|
|---|
| 27 | I Z,C=1 S:A=B Z=0 I 1
|
|---|
| 28 | E I Z,C=2 S:B]A Z=0 I 1
|
|---|
| 29 | E I Z,C=3 S:A']B Z=0
|
|---|
| 30 | I Z,D=2 D
|
|---|
| 31 | . S Z=2,G="" F H=$P(B,"^",2):-1:1 S G=G+$P(E,"^",H)
|
|---|
| 32 | . S:PRCB'>G Z=0
|
|---|
| 33 | . QUIT
|
|---|
| 34 | QUIT Z
|
|---|
| 35 | ;
|
|---|
