22 lines
1.3 KiB
Mathematica
22 lines
1.3 KiB
Mathematica
|
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
|