PRCFY ;WISC@ALTOONA/CTB/DL-PLACE FY INFO INTO APPROPRIATION SYMBOL ; 1/30/98 0845
V ;;5.1;IFCAP;;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ;REQUIRES FOLLOWING LOCAL VARIABLES
 ;    PRC("APP")= APPROPRIATION SYMBOL, FROM CONTROL POINT FILE
 ;    PRC("FY")=FISCAL YEAR TO BE PLACED INTO APPROPRIATION SYMBOL
 ;RETURNS COMPLETED SYMBOL IN PRC("APP")
 ;
SE 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)
 I '$D(PRC("APP")) W !,"NO ACTION TAKEN, INCOMPLETE DATA GIVEN",!! Q
 S A=PRC("APP"),B=$S(A["_/_":"EN1",A["_":"EN2",1:"EN3")
 D @(B) S PRC("APP")=B Q
EN1 ;TWO YEAR APPROPRIATION
 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
 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
EN2 ; SINGLE YEAR APPROPRIATION
 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
 I X=""&($D(PRC("FY"))) S X=PRC("FY")
 S X=$E(X,$L(X)),B=+A_X_$P(A,"_",2) Q
EN3 ; MULTI YEAR APPROPRIATION OR FUND
 S B=PRC("APP") Q