Routine: ACGSSR

ACGSSR ;IHS/OIRM/DSD/THL,AEF - DEFAULT DATA FOR STANDARD REPORTS; [ 03/27/2000   2:22 PM ]

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

 ;;ROUTINE TO SET DEFAULT DATA FOR STANDARD REPORTS

EN F  D EN1 Q:$D(ACGQUIT)

EXIT K ACG,ACGI,ACGION,ACGIOPAR,ACGIOP,ACGQUIT,ACGRPT,ACGYY,ACGY,BY,DHD,DIC,DIOEND,FLDS,FR,POP,TO,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ACGEIN,ACGCNO,ACGRPTX,DIS

EN1 D HEAD^ACGSMENU

 W !!?32,"STANDARD REPORTS",!

 Q:$D(ACGQUIT)

LIST W !

 F ACGI=1:1 S ACG=$P($T(REPORTS+ACGI),";;",2,99) Q:ACG=""  S ACG(ACGI)=ACG W !?10,ACGI,?20,$P(ACG,";;")

 S DIR(0)="LOA^1:"_(ACGI-1),DIR("A")="          Which one(s): "

W !

 D DIR^ACGSDIC

 Q:$D(ACGQUIT)

 S ACGY=","_Y

 I ACGY[",12," S ACGYY=ACGY S DIR(0)="FOA^10:12",DIR("A")="Contractor's EIN: ",DIR("?")="Enter the Contractor's 10-12 digit EIN number" W ! D DIR^ACGSDIC D

 .S ACGY=ACGYY

 .I $D(ACGQUIT) K ACGQUIT S ACGY=$P(ACGY,",12,")_","_$P(ACGY,",12,",2) Q

 .I '$D(^ACGS("M",Y)) S ACGY=$P(ACGY,",12,")_","_$P(ACGY,",12,",2) Q

 .E  S ACGEIN=Y

 I ACGY[",13," S ACGYY=ACGY S DIR(0)="FOA^9:9",DIR("A")="Contract Number: ",DIR("?")="Enter the first 9 digits of the contract number" W ! D DIR^ACGSDIC D

 .S ACGY=ACGYY

 .I $D(ACGQUIT) K ACGQUIT S ACGY=$P(ACGY,",13,")_","_$P(ACGY,",13,",2) Q

 .S Y=Y_"000"

 .I '$D(^ACGS("B",Y)) S ACGY=$P(ACGY,",13,")_","_$P(ACGY,",13,",2) Q

 .E  S ACGCNO=Y

 S ACGY=$E(ACGY,2,99)

 Q:ACGY=""

 S ACGYY=ACGY,(ACGFY,ACGCO)=""

 S DIR(0)="YO",DIR("A")="Print Report for one Fiscal Year only",DIR("B")="NO"

W !

 D DIR^ACGSDIC

 Q:$D(ACGQUIT)

 I Y=1 D FY^ACGSEXP

 I ACG4=236 D

 .S DIR(0)="YO",DIR("A")="Print Report for one Contract Office only",DIR("B")="NO"

 .W !

 .D DIR^ACGSDIC

 .Q:$D(ACGQUIT)

 .I Y=1 S DIR(0)="POA^9002334:AEMQZ",DIR("A")="Contract Office: " D DIR^ACGSDIC I +Y>0,$D(Y(0)) S ACGCO=$P(Y(0),U,2)

 I $D(ACGQUIT) K ACGQUIT Q

 S ZTDESC="CIS STANDARD REPORTS",ZTRTN="PRINT^ACGSSR"

 D ^ACGSZIS

 Q:$D(IO("Q"))!$D(ACGQUIT)

PRINT N ACGI

 F ACGI=1:1 S ACGRPTX=$P(ACGYY,",",ACGI) Q:ACGRPTX=""  I $D(ACG(ACGRPTX)) S ACGRPT=ACG(ACGRPTX) D P1

P1 S DIC="^ACGS(",FLDS="[ACG SUMMARY]",TO=$P(ACGRPT,";;",2),BY=$P(TO,";"),FR=$P(TO,";",2),TO=$P(TO,";",3),ACGRPT=$P(ACGRPT,";;"),DHD="[ACG REPORT HEAD]",DIOEND="D TAIL^ACGSPSUM W:$D(IOF) @IOF"

 I ACGION["HOST" S:$D(ACGIO("HFSIO")) IO("HFSIO")=ACGIO("HFSIO") S %ZIS("IOPAR")=ACGIOPAR

 I ACGRPTX=12 S (FR,TO)=ACGEIN_FR

 I ACGRPTX=13 S (FR,TO)=ACGCNO

 I ACGRPTX<12,+ACGCO,+ACGFY S DIS(0)="I $D(^ACGS(D0,""DT"")),$E($P(^(""DT""),U,2),1,5)="_+ACGCO_+ACGFY_$S($D(DIS(0)):" "_DIS(0),1:"")

 E  I ACGRPTX<12,+ACGFY S DIS(0)="I $D(^ACGS(D0,""DT"")),$E($P(^(""DT""),U,2),4,5)="_ACGFY_$S($D(DIS(0)):" "_DIS(0),1:"")

 E  I ACGRPTX<12,+ACGCO S DIS(0)="I $D(^ACGS(D0,""DT"")),$E($P(^(""DT""),U,2),1,3)="_ACGCO_$S($D(DIS(0)):" "_DIS(0),1:"")

 S IOP=ACGION

 K DXS,DIP,DC

 S DIS(0)="I $D(^ACGS(D0,""DT"")),""^15^17^""'[(U_+^(""DT"")_U) "_$S($D(DIS(0)):DIS(0),1:"")

 D EN1^DIP

 K DXS,DIP,DC,IOP

DIR D ^DIR S:$D(DIRUT) ACGQUIT="" K DIR,DIRUT,DUOUT,DTOUT Q

REPORTS ;;

1 ;;ACTIVE CONTRACTS;;@121,@.01,2;1,0,;1,0,

2 ;;ACTIVE COMPETITIVE CONTRACTS;;@121,12,@.01,2;1,A,0,;1,A,0,

3 ;;ACTIVE NON-COMPETITIVE CONTRACTS;;@121,@12,@.01,2;1,B,0,;1,D,0,

4 ;;ACTIVE & INACTIVE 638 CONTRACTS;;@19,@.01,2;61,0,;61,0,

5 ;;ACTIVE 638 CONTRACTS;;@19,@121,@.01,2;61,1,0,;61,1,0,

6 ;;ACTIVE COMPETITIVE BUY INDIAN CONTRACTS;;@19,@121,@.01,2;58,1,0,;58,1,0,

7 ;;ACTIVE NON-COMPETITIVE BUY INDIAN CONTRACTS;;@19,@121,@.01,2;62,1,0,;62,1,0,

8 ;;AWARDS TO WOMAN-OWNED ORGANIZATIONS;;@30,@.01,2;1,0,;1,0,

9 ;;ADVISORY AND ASSISTANCE SERVICES CONTRACTS;;@16,@.01,2;1,0,;1,0,

10 ;;COST CONTRACTS $100,000 OR LESS;;'15,'26,@.01,2,@15;20,0,0,;24,100000,0,

11 ;;CONTRACT WITH 99 IN NEG-AUTHORITY;;@14,@.01,2;99,0,;99,0,

12 ;;ALL CONTRACTS FOR SPECIFIED CONTRACTOR;;11,@.01,2;,0,;,0,

13 ;;SUMMARY FOR ONE CONTRACT;;2,@.01;,0;,0

ACGSSR    ;IHS/OIRM/DSD/THL,AEF - DEFAULT DATA FOR STANDARD REPORTS; [ 03/27/2000   2:22 PM ]

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

 +2       ;;ROUTINE TO SET DEFAULT DATA FOR STANDARD REPORTS

EN         FOR

               DO EN1

               IF $DATA(ACGQUIT)

                   QUIT

EXIT       KILL ACG,ACGI,ACGION,ACGIOPAR,ACGIOP,ACGQUIT,ACGRPT,ACGYY,ACGY,BY,DHD,DIC,DIOEND,FLDS,FR,POP,TO,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ACGEIN,ACGCNO,ACGRPTX,DIS

 +1        QUIT

EN1        DO HEAD^ACGSMENU

 +1        WRITE !!?32,"STANDARD REPORTS",!

 +2        IF $DATA(ACGQUIT)

               QUIT

LIST       WRITE !

 +1        FOR ACGI=1:1

               SET ACG=$PIECE($TEXT(REPORTS+ACGI),";;",2,99)

               IF ACG=""

                   QUIT

               SET ACG(ACGI)=ACG

               WRITE !?10,ACGI,?20,$PIECE(ACG,";;")

 +2        SET DIR(0)="LOA^1:"_(ACGI-1)

           SET DIR("A")="          Which one(s): "

 +3        WRITE !

 +4        DO DIR^ACGSDIC

 +5        IF $DATA(ACGQUIT)

               QUIT

 +6        SET ACGY=","_Y

 +7        IF ACGY[",12,"

               SET ACGYY=ACGY

               SET DIR(0)="FOA^10:12"

               SET DIR("A")="Contractor's EIN: "

               SET DIR("?")="Enter the Contractor's 10-12 digit EIN number"

               WRITE !

               DO DIR^ACGSDIC

               Begin DoDot:1

 +8                SET ACGY=ACGYY

 +9                IF $DATA(ACGQUIT)

                       KILL ACGQUIT

                       SET ACGY=$PIECE(ACGY,",12,")_","_$PIECE(ACGY,",12,",2)

                       QUIT

 +10               IF '$DATA(^ACGS("M",Y))

                       SET ACGY=$PIECE(ACGY,",12,")_","_$PIECE(ACGY,",12,",2)

                       QUIT

 +11              IF '$TEST

                       SET ACGEIN=Y

               End DoDot:1

 +12       IF ACGY[",13,"

               SET ACGYY=ACGY

               SET DIR(0)="FOA^9:9"

               SET DIR("A")="Contract Number: "

               SET DIR("?")="Enter the first 9 digits of the contract number"

               WRITE !

               DO DIR^ACGSDIC

               Begin DoDot:1

 +13               SET ACGY=ACGYY

 +14               IF $DATA(ACGQUIT)

                       KILL ACGQUIT

                       SET ACGY=$PIECE(ACGY,",13,")_","_$PIECE(ACGY,",13,",2)

                       QUIT

 +15               SET Y=Y_"000"

 +16               IF '$DATA(^ACGS("B",Y))

                       SET ACGY=$PIECE(ACGY,",13,")_","_$PIECE(ACGY,",13,",2)

                       QUIT

 +17              IF '$TEST

                       SET ACGCNO=Y

               End DoDot:1

 +18       SET ACGY=$EXTRACT(ACGY,2,99)

 +19       IF ACGY=""

               QUIT

 +20       SET ACGYY=ACGY

           SET (ACGFY,ACGCO)=""

 +21       SET DIR(0)="YO"

           SET DIR("A")="Print Report for one Fiscal Year only"

           SET DIR("B")="NO"

 +22       WRITE !

 +23       DO DIR^ACGSDIC

 +24       IF $DATA(ACGQUIT)

               QUIT

 +25       IF Y=1

               DO FY^ACGSEXP

 +26       IF ACG4=236

               Begin DoDot:1

 +27               SET DIR(0)="YO"

                   SET DIR("A")="Print Report for one Contract Office only"

                   SET DIR("B")="NO"

 +28               WRITE !

 +29               DO DIR^ACGSDIC

 +30               IF $DATA(ACGQUIT)

                       QUIT

 +31               IF Y=1

                       SET DIR(0)="POA^9002334:AEMQZ"

                       SET DIR("A")="Contract Office: "

                       DO DIR^ACGSDIC

                       IF +Y>0

                           IF $DATA(Y(0))

                               SET ACGCO=$PIECE(Y(0),U,2)

               End DoDot:1

 +32       IF $DATA(ACGQUIT)

               KILL ACGQUIT

               QUIT

 +33       SET ZTDESC="CIS STANDARD REPORTS"

           SET ZTRTN="PRINT^ACGSSR"

 +34       DO ^ACGSZIS

 +35       IF $DATA(IO("Q"))!$DATA(ACGQUIT)

               QUIT

PRINT      NEW ACGI

 +1        FOR ACGI=1:1

               SET ACGRPTX=$PIECE(ACGYY,",",ACGI)

               IF ACGRPTX=""

                   QUIT

               IF $DATA(ACG(ACGRPTX))

                   SET ACGRPT=ACG(ACGRPTX)

                   DO P1

 +2        QUIT

P1         SET DIC="^ACGS("

           SET FLDS="[ACG SUMMARY]"

           SET TO=$PIECE(ACGRPT,";;",2)

           SET BY=$PIECE(TO,";")

           SET FR=$PIECE(TO,";",2)

           SET TO=$PIECE(TO,";",3)

           SET ACGRPT=$PIECE(ACGRPT,";;")

           SET DHD="[ACG REPORT HEAD]"

           SET DIOEND="D TAIL^ACGSPSUM W:$D(IOF) @IOF"

 +1        IF ACGION["HOST"

               IF $DATA(ACGIO("HFSIO"))

                   SET IO("HFSIO")=ACGIO("HFSIO")

               SET %ZIS("IOPAR")=ACGIOPAR

 +2        IF ACGRPTX=12

               SET (FR,TO)=ACGEIN_FR

 +3        IF ACGRPTX=13

               SET (FR,TO)=ACGCNO

 +4        IF ACGRPTX<12

               IF +ACGCO

                   IF +ACGFY

                       SET DIS(0)="I $D(^ACGS(D0,""DT"")),$E($P(^(""DT""),U,2),1,5)="_+ACGCO_+ACGFY_$SELECT($DATA(DIS(0)):" "_DIS(0),1:"")

 +5       IF '$TEST

               IF ACGRPTX<12

                   IF +ACGFY

                       SET DIS(0)="I $D(^ACGS(D0,""DT"")),$E($P(^(""DT""),U,2),4,5)="_ACGFY_$SELECT($DATA(DIS(0)):" "_DIS(0),1:"")

 +6       IF '$TEST

               IF ACGRPTX<12

                   IF +ACGCO

                       SET DIS(0)="I $D(^ACGS(D0,""DT"")),$E($P(^(""DT""),U,2),1,3)="_ACGCO_$SELECT($DATA(DIS(0)):" "_DIS(0),1:"")

 +7        SET IOP=ACGION

 +8        KILL DXS,DIP,DC

 +9        SET DIS(0)="I $D(^ACGS(D0,""DT"")),""^15^17^""'[(U_+^(""DT"")_U) "_$SELECT($DATA(DIS(0)):DIS(0),1:"")

 +10       DO EN1^DIP

 +11       KILL DXS,DIP,DC,IOP

 +12       QUIT

DIR        DO ^DIR

           IF $DATA(DIRUT)

               SET ACGQUIT=""

           KILL DIR,DIRUT,DUOUT,DTOUT

           QUIT

REPORTS   ;;

1         ;;ACTIVE CONTRACTS;;@121,@.01,2;1,0,;1,0,

2         ;;ACTIVE COMPETITIVE CONTRACTS;;@121,12,@.01,2;1,A,0,;1,A,0,

3         ;;ACTIVE NON-COMPETITIVE CONTRACTS;;@121,@12,@.01,2;1,B,0,;1,D,0,

4         ;;ACTIVE & INACTIVE 638 CONTRACTS;;@19,@.01,2;61,0,;61,0,

5         ;;ACTIVE 638 CONTRACTS;;@19,@121,@.01,2;61,1,0,;61,1,0,

6         ;;ACTIVE COMPETITIVE BUY INDIAN CONTRACTS;;@19,@121,@.01,2;58,1,0,;58,1,0,

7         ;;ACTIVE NON-COMPETITIVE BUY INDIAN CONTRACTS;;@19,@121,@.01,2;62,1,0,;62,1,0,

8         ;;AWARDS TO WOMAN-OWNED ORGANIZATIONS;;@30,@.01,2;1,0,;1,0,

9         ;;ADVISORY AND ASSISTANCE SERVICES CONTRACTS;;@16,@.01,2;1,0,;1,0,

10        ;;COST CONTRACTS $100,000 OR LESS;;'15,'26,@.01,2,@15;20,0,0,;24,100000,0,

11        ;;CONTRACT WITH 99 IN NEG-AUTHORITY;;@14,@.01,2;99,0,;99,0,

12        ;;ALL CONTRACTS FOR SPECIFIED CONTRACTOR;;11,@.01,2;,0,;,0,

13        ;;SUMMARY FOR ONE CONTRACT;;2,@.01;,0;,0

ACGSSR.m