| [613] | 1 | PRCFY ;WISC@ALTOONA/CTB/DL-PLACE FY INFO INTO APPROPRIATION SYMBOL ; 1/30/98 0845
|
|---|
| 2 | V ;;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 | ;
|
|---|
| 9 | 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)
|
|---|
| 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
|
|---|
| 13 | EN1 ;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
|
|---|
| 16 | EN2 ; 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
|
|---|
| 20 | EN3 ; MULTI YEAR APPROPRIATION OR FUND
|
|---|
| 21 | S B=PRC("APP") Q
|
|---|
