ACGSFYA.m

ACGSFYA ;IHS/OIRM/DSD/THL,AEF - CALCULATE FY AWARD; [ 03/27/2000   2:22 PM ]

 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000

 ;;ROUTINE USED TO CALCULATE FY AWARD FOR A CONTRACT

 ;;modified for y2k;mlp

EN ;EP;TO CALCULATE FY AWARD

 S (ACG,ACGFYT,ACGTOT,ACGTOTI)=0

 F  S ACG=$O(^ACGS("C",D0,ACG)) Q:'ACG  D

 .S ACGDT1=$G(^ACGS(ACG,"DT1"))

 .S ACGDT2=$G(^("DT2"))

 .S ACGFYA=$P(ACGDT1,U,3)

 .S ACGFYA=$S($E(ACGFYA,4,5)>9:($E(ACGFYA,1,3)+1700)+1,1:($E(ACGFYA,1,3)+1700)),ACGTOT=ACGTOT+$P(ACGDT1,U,5),ACGTOTI=ACGTOTI+ACGDT2 S:ACGFYA=ACGFY ACGFYT=ACGFYT+$P(ACGDT1,U,5) ;y2k;mlp

 Q

FYT W $J($FN(ACGFYT,"P,","0"),10) Q

TOT W $J($FN(ACGTOT,"P,","0"),10) Q

TOTI W $J($FN(ACGTOTI,"P,","0"),10) Q

ACGSFYA   ;IHS/OIRM/DSD/THL,AEF - CALCULATE FY AWARD; [ 03/27/2000   2:22 PM ]

 +1       ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000

 +2       ;;ROUTINE USED TO CALCULATE FY AWARD FOR A CONTRACT

 +3       ;;modified for y2k;mlp

EN        ;EP;TO CALCULATE FY AWARD

 +1        SET (ACG,ACGFYT,ACGTOT,ACGTOTI)=0

 +2        FOR 

               SET ACG=$ORDER(^ACGS("C",D0,ACG))

               IF 'ACG

                   QUIT 

               Begin DoDot:1

 +3                SET ACGDT1=$GET(^ACGS(ACG,"DT1"))

 +4                SET ACGDT2=$GET(^("DT2"))

 +5                SET ACGFYA=$PIECE(ACGDT1,U,3)

 +6       ;y2k;mlp

                   SET ACGFYA=$SELECT($EXTRACT(ACGFYA,4,5)>9:($EXTRACT(ACGFYA,1,3)+1700)+1,1:($EXTRACT(ACGFYA,1,3)+1700))

                   SET ACGTOT=ACGTOT+$PIECE(ACGDT1,U,5)

                   SET ACGTOTI=ACGTOTI+ACGDT2

                   IF ACGFYA=ACGFY

                       SET ACGFYT=ACGFYT+$PIECE(ACGDT1,U,5)

               End DoDot:1

 +7        QUIT 

FYT        WRITE $JUSTIFY($FNUMBER(ACGFYT,"P,","0"),10)

           QUIT 

TOT        WRITE $JUSTIFY($FNUMBER(ACGTOT,"P,","0"),10)

           QUIT 

TOTI       WRITE $JUSTIFY($FNUMBER(ACGTOTI,"P,","0"),10)

           QUIT