source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCS0A.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1PRCS0A ;WISC/PLT-UTILITY FOR PRCS-ROUTINE ; 08/08/94 12:09 PM
2V ;;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
10OVCOM(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 ;
Note: See TracBrowser for help on using the repository browser.