ACGS2811.m

ACGS2811 ;IHS/OIRM/DSD/THL,AEF - UTILITY TO PRINT THE SMALL PURCHASE 281 REPORT - CONT;  [ 03/27/2000   2:22 PM ]

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

 ;;UTILITY TO PRINT THE SMALL PURCHASE 281 REPORT - CONT

 D L2

 W !,"1. TARIFF/REGULATED"

 D L111

 W !,"   ACQUISITION"

 D L111

 D L2

 W !,"2. CONTRACT FOR GOV"

 D L111

 W !,"   OR INTNAT ORG"

 D L111

 D L2

 I $D(IOST),$E(IOST,1,2)="C-" D HOLD^ACGSMENU

 W !,"3. SMALL PURCHASE"

 D L11

 W !,"   (FAR PART 13)"

 S ACGX=1 D L4 ;W ?20,"|",?30,"|",?40,"|",?50,"|",?60,"|",?70,"|"

 D L2

 W !,"4. DO (GSA SCHED)"

 S ACGX=2 D L4 ;W ?20,"|",?30,"|",?40,"|",?50,"|",?60,"|",?70,"|"

 D L2

 W !,"5. DO (OTH FED SCHED"

 S ACGX=3 D L4 ;W ?20,"|",?30,"|",?40,"|",?50,"|",?60,"|",?70,"|"

 D L2

 W !,"6. DO (ALL OTHER)"

 S ACGX=4 D L4 ;W ?20,"|",?30,"|",?40,"|",?50,"|",?60,"|",?70,"|"

 D L2

 W !,"7. OTHER PROC METHOD"

 S ACGX=5 D L4

 D L2

 W !,"   PERRY POINT"

 S ACGX=6 D L4

 D L2

 W !,"   VA - HINES"

 S ACGX=7 D L4

 D L2

 W !,"   FEDSTRIP"

 S ACGX=8 D L4

 D L2

 W !,"   IMPREST FUND"

 S ACGX=9 D L4

 D L2

 W !,"   SF-44"

 S ACGX=0 D L4

 D L2

 W !,"8. TOTAL NEW AWARDS"

 D L11

 W !,"   AND MODIFICATIONS"

 W ?20,"|",$J($P(ACGPM(ACG4XX,1),U,3),8),?30,"|",$J($FN(ACGPM(ACG4XX,"A1"),"P",0),9),?40,"|",$J($FN(ACGPM(ACG4XX,"A2"),"P",0),9),?50,"|",$J($FN(ACGPM(ACG4XX,"A3"),"P",0),9),?60,"|",$J($FN(ACGPM(ACG4XX,"A4"),"P",0),9),?70,"|"

 W $J($FN($P(ACGPM(ACG4XX,1),U,4),"P",0),9)

 I $D(IOST),$E(IOST,1,2)="C-" D HOLD^ACGSMENU I 1

 D L

 W !?4,"COMPETITION"

 D L

 W ! D L11

 W !,"9. COMPETED"

 S ACGX="A" D L4 ;W ?20,"|",?30,"|",?40,"|",?50,"|",?60,"|",?70,"|"

 D L2

 W !,"10.NOT AVAILABLE FOR"

 D L11

 W !,"   COMPETITION"

 S ACGX="B" D L4 ;W ?20,"|",?30,"|",?40,"|",?50,"|",?60,"|",?70,"|"

 D L2

 W ! D L11

 W !,"11.NOT COMPETED"

 S ACGX="C" D L4 ;W ?20,"|",?30,"|",?40,"|",?50,"|",?60,"|",?70,"|"

 D L2

 W !,"12.TOT MODIFICATIONS"

 D L111

 W !,"  (EXCLUDING -L 3)"

 D L111

 D L

 I $D(IOST),$E(IOST,1,2)="C-" D HOLD^ACGSMENU

 W @IOF,!?15,"PART II - SELECTED SOCIOECONOMIC STATISTICS"

 W !?15,"(includes both new awards and modifications)"

 D L

 W !?10,"PREFERENCE PROGRAM",?40,"|",?50,"TYPE OF CONTRACTOR"

 W !,"----------------------------------------|---------------------------------------"

 W !?20,"| NUMBER  |  TOTAL  |                   | NUMBER  |  TOTAL"

 W !?5,"CATEGORY",?20,"|   OF    |   NET   |    CATEGORY       |   OF    |   NET"

 W !?20,"| ACTIONS | DOLLARS |                   | ACTIONS | DOLLARS"

 D L3

 W !,"13.SMALL BUS. SMALL |",?30,"|",?40,"|18.SMALL DISADVAN  |",?70,"|"

 W !,"   PURCHASE SETASIDE|" S X=ACGPP(ACG4XX,1) D L5

 W ?40,"|   BUSINESS        |" S X=ACGTC(ACG4XX,1) D L5

 W !,"14.LABOR SURPLUS    |",?30,"|",?40,"|19.WOMAN OWND SMALL|",?70,"|"

 W !,"   AREA SET-ASIDE   |" S X=ACGPP(ACG4XX,2) D L5

 W ?40,"|   BUSINESS        |" S X=ACGTC(ACG4XX,2) D L5

 W !,"15.COMB LABOR SURP/ |",?30,"|",?40,"|20.SHELTERED       |",?70,"|"

 W !,"   SM BUS. SET-ASIDE|" S X=ACGPP(ACG4XX,3) D L5

 W ?40,"|   WORKSHOP        |" S X=ACGTC(ACG4XX,3) D L5

 W !,"16.BUY INDIAN       |" S X=ACGPP(ACG4XX,4) D L5

 W ?40,"|21.UNICOR          |" S X=ACGTC(ACG4XX,4) D L5

 W !,"17.OTHER            |" S X=ACGPP(ACG4XX,5) D L5

 W ?40,"|22.BUY INDIAN      |" S X=ACGTC(ACG4XX,6) D L5

 W !?40,"|23.OTHER           |" S X=ACGTC(ACG4XX,5) D L5

 D L

 W !,"PERSON SUBMITTING REPORT"

 D L

 W !,"NAME",?25,"| SIGNATURE",?50,"| PHONE",?65,"| DATE"

 W !,ACGDUZ,?25,"|",?50,"| ",ACGPHONE,?65,"| ",ACGTODAY

 I $D(IOST),$E(IOST,1,2)="C-" D HOLD^ACGSMENU I 1

 E  D L

 Q

L W !,"--------------------------------------------------------------------------------"

 Q

L1 W !?20,"|---------|---------|---------|---------|---------|---------"

 Q

L11 W ?20,"|         |         |         |         |         |"

 Q

L111 W ?20,"|         |XXXXXXXXX|XXXXXXXXX|XXXXXXXXX|XXXXXXXXX|"

 Q

L2 W !,"--------------------|---------|---------|---------|---------|---------|---------"

 Q

L3 W !,"--------------------|---------|---------|-------------------|---------|---------"

 Q

L4 S ACG5=0

 F X=1:1:4 S X(X)=+ACGPM(ACG4XX,ACGX,"A"_X) D Y S ACG5=ACG5+X(X)

 S X=$P(ACGPM(ACG4XX,ACGX),U,2),X=$S(X:X,1:0)

 W ?20,"|",$J(X,8),?30,"|",$J($FN(X(1),"P",0),9),?40,"|",$J($FN(X(2),"P",0),9),?50,"|",$J($FN(X(3),"P",0),9),?60,"|",$J($FN(X(4),"P",0),9),?70,"|",$J($FN(ACG5,"P",0),9)

 Q

L5 S X(1)=X,X=1

 D Y

 W $J($S($P(X(1),U,2):$P(X(1),U,2),1:0),8)," |",$J($FN(+X(1),"P",0),9)

 Q

Y Q  S Y=X(X),Y=$E(Y,1,$L(Y)-3)+$S($E(Y,$L(Y)-2)>4:1,1:0),X(X)=Y

 Q

ACGS2811  ;IHS/OIRM/DSD/THL,AEF - UTILITY TO PRINT THE SMALL PURCHASE 281 REPORT - CONT;  [ 03/27/2000   2:22 PM ]

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

 +2       ;;UTILITY TO PRINT THE SMALL PURCHASE 281 REPORT - CONT

 +3        DO L2

 +4        WRITE !,"1. TARIFF/REGULATED"

 +5        DO L111

 +6        WRITE !,"   ACQUISITION"

 +7        DO L111

 +8        DO L2

 +9        WRITE !,"2. CONTRACT FOR GOV"

 +10       DO L111

 +11       WRITE !,"   OR INTNAT ORG"

 +12       DO L111

 +13       DO L2

 +14       IF $DATA(IOST)

               IF $EXTRACT(IOST,1,2)="C-"

                   DO HOLD^ACGSMENU

 +15       WRITE !,"3. SMALL PURCHASE"

 +16       DO L11

 +17       WRITE !,"   (FAR PART 13)"

 +18      ;W ?20,"|",?30,"|",?40,"|",?50,"|",?60,"|",?70,"|"

           SET ACGX=1

           DO L4

 +19       DO L2

 +20       WRITE !,"4. DO (GSA SCHED)"

 +21      ;W ?20,"|",?30,"|",?40,"|",?50,"|",?60,"|",?70,"|"

           SET ACGX=2

           DO L4

 +22       DO L2

 +23       WRITE !,"5. DO (OTH FED SCHED"

 +24      ;W ?20,"|",?30,"|",?40,"|",?50,"|",?60,"|",?70,"|"

           SET ACGX=3

           DO L4

 +25       DO L2

 +26       WRITE !,"6. DO (ALL OTHER)"

 +27      ;W ?20,"|",?30,"|",?40,"|",?50,"|",?60,"|",?70,"|"

           SET ACGX=4

           DO L4

 +28       DO L2

 +29       WRITE !,"7. OTHER PROC METHOD"

 +30       SET ACGX=5

           DO L4

 +31       DO L2

 +32       WRITE !,"   PERRY POINT"

 +33       SET ACGX=6

           DO L4

 +34       DO L2

 +35       WRITE !,"   VA - HINES"

 +36       SET ACGX=7

           DO L4

 +37       DO L2

 +38       WRITE !,"   FEDSTRIP"

 +39       SET ACGX=8

           DO L4

 +40       DO L2

 +41       WRITE !,"   IMPREST FUND"

 +42       SET ACGX=9

           DO L4

 +43       DO L2

 +44       WRITE !,"   SF-44"

 +45       SET ACGX=0

           DO L4

 +46       DO L2

 +47       WRITE !,"8. TOTAL NEW AWARDS"

 +48       DO L11

 +49       WRITE !,"   AND MODIFICATIONS"

 +50      WRITE ?20,"|",$JUSTIFY($PIECE(ACGPM(ACG4XX,1),U,3),8),?30,"|",$JUSTIFY($FNUMBER(ACGPM(ACG4XX,"A1"),"P",0),9),?40,"|",$JUSTIFY(...

           ... $FNUMBER(ACGPM(ACG4XX,"A2"),"P",0),9),?50,"|",$JUSTIFY($FNUMBER(ACGPM(ACG4XX,"A3"),"P",0),9),?60,"|",$JUSTIFY($FNUMBER(ACGPM(ACG4XX,"A4"),"P",0),9),?70,"|"

 +51       WRITE $JUSTIFY($FNUMBER($PIECE(ACGPM(ACG4XX,1),U,4),"P",0),9)

 +52       IF $DATA(IOST)

               IF $EXTRACT(IOST,1,2)="C-"

                   DO HOLD^ACGSMENU

                   IF 1

 +53       DO L

 +54       WRITE !?4,"COMPETITION"

 +55       DO L

 +56       WRITE !

           DO L11

 +57       WRITE !,"9. COMPETED"

 +58      ;W ?20,"|",?30,"|",?40,"|",?50,"|",?60,"|",?70,"|"

           SET ACGX="A"

           DO L4

 +59       DO L2

 +60       WRITE !,"10.NOT AVAILABLE FOR"

 +61       DO L11

 +62       WRITE !,"   COMPETITION"

 +63      ;W ?20,"|",?30,"|",?40,"|",?50,"|",?60,"|",?70,"|"

           SET ACGX="B"

           DO L4

 +64       DO L2

 +65       WRITE !

           DO L11

 +66       WRITE !,"11.NOT COMPETED"

 +67      ;W ?20,"|",?30,"|",?40,"|",?50,"|",?60,"|",?70,"|"

           SET ACGX="C"

           DO L4

 +68       DO L2

 +69       WRITE !,"12.TOT MODIFICATIONS"

 +70       DO L111

 +71       WRITE !,"  (EXCLUDING -L 3)"

 +72       DO L111

 +73       DO L

 +74       IF $DATA(IOST)

               IF $EXTRACT(IOST,1,2)="C-"

                   DO HOLD^ACGSMENU

 +75       WRITE @IOF,!?15,"PART II - SELECTED SOCIOECONOMIC STATISTICS"

 +76       WRITE !?15,"(includes both new awards and modifications)"

 +77       DO L

 +78       WRITE !?10,"PREFERENCE PROGRAM",?40,"|",?50,"TYPE OF CONTRACTOR"

 +79       WRITE !,"----------------------------------------|---------------------------------------"

 +80       WRITE !?20,"| NUMBER  |  TOTAL  |                   | NUMBER  |  TOTAL"

 +81       WRITE !?5,"CATEGORY",?20,"|   OF    |   NET   |    CATEGORY       |   OF    |   NET"

 +82       WRITE !?20,"| ACTIONS | DOLLARS |                   | ACTIONS | DOLLARS"

 +83       DO L3

 +84       WRITE !,"13.SMALL BUS. SMALL |",?30,"|",?40,"|18.SMALL DISADVAN  |",?70,"|"

 +85       WRITE !,"   PURCHASE SETASIDE|"

           SET X=ACGPP(ACG4XX,1)

           DO L5

 +86       WRITE ?40,"|   BUSINESS        |"

           SET X=ACGTC(ACG4XX,1)

           DO L5

 +87       WRITE !,"14.LABOR SURPLUS    |",?30,"|",?40,"|19.WOMAN OWND SMALL|",?70,"|"

 +88       WRITE !,"   AREA SET-ASIDE   |"

           SET X=ACGPP(ACG4XX,2)

           DO L5

 +89       WRITE ?40,"|   BUSINESS        |"

           SET X=ACGTC(ACG4XX,2)

           DO L5

 +90       WRITE !,"15.COMB LABOR SURP/ |",?30,"|",?40,"|20.SHELTERED       |",?70,"|"

 +91       WRITE !,"   SM BUS. SET-ASIDE|"

           SET X=ACGPP(ACG4XX,3)

           DO L5

 +92       WRITE ?40,"|   WORKSHOP        |"

           SET X=ACGTC(ACG4XX,3)

           DO L5

 +93       WRITE !,"16.BUY INDIAN       |"

           SET X=ACGPP(ACG4XX,4)

           DO L5

 +94       WRITE ?40,"|21.UNICOR          |"

           SET X=ACGTC(ACG4XX,4)

           DO L5

 +95       WRITE !,"17.OTHER            |"

           SET X=ACGPP(ACG4XX,5)

           DO L5

 +96       WRITE ?40,"|22.BUY INDIAN      |"

           SET X=ACGTC(ACG4XX,6)

           DO L5

 +97       WRITE !?40,"|23.OTHER           |"

           SET X=ACGTC(ACG4XX,5)

           DO L5

 +98       DO L

 +99       WRITE !,"PERSON SUBMITTING REPORT"

 +100      DO L

 +101      WRITE !,"NAME",?25,"| SIGNATURE",?50,"| PHONE",?65,"| DATE"

 +102      WRITE !,ACGDUZ,?25,"|",?50,"| ",ACGPHONE,?65,"| ",ACGTODAY

 +103      IF $DATA(IOST)

               IF $EXTRACT(IOST,1,2)="C-"

                   DO HOLD^ACGSMENU

                   IF 1

 +104     IF '$TEST

               DO L

 +105      QUIT 

L          WRITE !,"--------------------------------------------------------------------------------"

 +1        QUIT 

L1         WRITE !?20,"|---------|---------|---------|---------|---------|---------"

 +1        QUIT 

L11        WRITE ?20,"|         |         |         |         |         |"

 +1        QUIT 

L111       WRITE ?20,"|         |XXXXXXXXX|XXXXXXXXX|XXXXXXXXX|XXXXXXXXX|"

 +1        QUIT 

L2         WRITE !,"--------------------|---------|---------|---------|---------|---------|---------"

 +1        QUIT 

L3         WRITE !,"--------------------|---------|---------|-------------------|---------|---------"

 +1        QUIT 

L4         SET ACG5=0

 +1        FOR X=1:1:4

               SET X(X)=+ACGPM(ACG4XX,ACGX,"A"_X)

               DO Y

               SET ACG5=ACG5+X(X)

 +2        SET X=$PIECE(ACGPM(ACG4XX,ACGX),U,2)

           SET X=$SELECT(X:X,1:0)

 +3        WRITE ?20,"|",$JUSTIFY(X,8),?30,"|",$JUSTIFY($FNUMBER(X(1),"P",0),9),?40,"|",$JUSTIFY($FNUMBER(X(2),"P",0),9),?50,"|",$JUSTIFY($FNUMBER(X(3),"P",0),9),?60,"|",$JUSTIFY($FNUMBER(X(4),"P",0),9),?70,"|",$JUSTIFY($FNUMBER(ACG5,"P",0),9)

 +4        QUIT 

L5         SET X(1)=X

           SET X=1

 +1        DO Y

 +2        WRITE $JUSTIFY($SELECT($PIECE(X(1),U,2):$PIECE(X(1),U,2),1:0),8)," |",$JUSTIFY($FNUMBER(+X(1),"P",0),9)

 +3        QUIT 

Y          QUIT 

           SET Y=X(X)

           SET Y=$EXTRACT(Y,1,$LENGTH(Y)-3)+$SELECT($EXTRACT(Y,$LENGTH(Y)-2)>4:1,1:0)

           SET X(X)=Y

 +1        QUIT