source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFY.m@ 1420

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

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1PRCFY ;WISC@ALTOONA/CTB/DL-PLACE FY INFO INTO APPROPRIATION SYMBOL ; 1/30/98 0845
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;REQUIRES FOLLOWING LOCAL VARIABLES
5 ; PRC("APP")= APPROPRIATION SYMBOL, FROM CONTROL POINT FILE
6 ; PRC("FY")=FISCAL YEAR TO BE PLACED INTO APPROPRIATION SYMBOL
7 ;RETURNS COMPLETED SYMBOL IN PRC("APP")
8 ;
9SE S U="^" I '$D(PRC("FY")) S %DT="",X="T" D ^%DT S A=$E(Y,2,3),B=$E(Y,4,5),PRC("FY")=$E(100+$S(+B>9:A+1,1:A),2,3)
10 I '$D(PRC("APP")) W !,"NO ACTION TAKEN, INCOMPLETE DATA GIVEN",!! Q
11 S A=PRC("APP"),B=$S(A["_/_":"EN1",A["_":"EN2",1:"EN3")
12 D @(B) S PRC("APP")=B Q
13EN1 ;TWO YEAR APPROPRIATION
14 I '$D(PRC("FYI")) W !!,"ENTER FIRST YEAR OF THIS TWO YEAR APPROPRIATION: ",PRC("FY")," // " R X:$S($D(DTIME):DTIME,1:300) Q:X=U I X["?"!(X'?.4N) W !,"ENTER FISCAL YEAR IN FORMAT '1' '81' OR '1981'",!! G EN1
15 S:$D(PRC("FYI")) X=PRC("FYI") S:X="" X=PRC("FY") S X=$E(X,$L(X)),B=$P(A,"_",1)_X_"/"_(X+1#10)_$P(A,"_",3) Q
16EN2 ; SINGLE YEAR APPROPRIATION
17 S X="" I '$D(PRC("FY")) W !!,"ENTER FISCAL YEAR: " R X:$S($D(DTIME):DTIME,1:300) Q:X=U!(X="") I X["?"!(X'?.4N) W !,"ENTER FISCAL YEAR IN FORMAT '1', '81', OR '1981'",!! G EN2
18 I X=""&($D(PRC("FY"))) S X=PRC("FY")
19 S X=$E(X,$L(X)),B=+A_X_$P(A,"_",2) Q
20EN3 ; MULTI YEAR APPROPRIATION OR FUND
21 S B=PRC("APP") Q
Note: See TracBrowser for help on using the repository browser.