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