ACGSSPR ;IHS/OIRM/DSD/THL,AEF - SOCIOECONOMIC PROCUREMENT REPORT; [ 03/27/2000 2:22 PM ]
;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
;;PRINT SOCIOECONOMIC PROCUREMENT REPORT
EN D EN1
EXIT K ACGQUIT,ACG,ACG13,ACG26,ACGBEGIN,ACGEND,ACG1,ACG2,ACG3,ACG5,ACGI,ACGJ,ACGION,ACG19,ACG27,ACG30,ACGBEG,ACGFY,ACGQT,ACGX
Q
EN1 K ACGQUIT
S:'$D(ACGPARA) ACGPARA=^ACGPARA(ACGPODA,0),ACG4=$P(ACGPARA,U,3)
D QT^ACGSCPAR
I $D(ACGQUIT) K ACGQUIT Q
S:'$D(ACG4) ACG4=$P(ACGPARA,U,3)
I ACG4=236 D CO^ACGSCPAR Q:$D(ACGQUIT) I 1
E S (ACG4,ACG4X)=ACG4
ZIS S ZTRTN="EN2^ACGSSPR",ZTDESC="CIS QT SOCIOECONOMIC PROCUREMENT REPORT",ZTSAVE("ACG*")=""
D ^ACGSZIS
Q:$D(ACGQUIT)
EN2 I '$D(ZTQUEUED) S (ACGIOP,IOP)=ION D ^%ZIS I POP S ACGQUIT="" Q
U IO
I ACG4X=88 F ACG4=102,121,161,235,239,241:1:249,284,285 K ACGQUIT D R1
G:ACG4X=88 DONE
R1 G:$D(ACGQUIT) DONE
D ENX
W:$D(IOF) @IOF
D:ACG4X'=88 DONE
Q
DONE D DONE^ACGSZIS
Q
ENX U IO
S ACGBEG=ACGBEGIN,ACG(1)="0^0^TOTAL PROCUREMENTS (EXCLUDING 8(A))",ACG(2)="0^0^SMALL BUSINESS DIRECT AWARDS OTHER THAN DISADV (ITEM 13 = A2 OR A3)",ACG(3)="0^0^DISADVANTAGED SMALL BUSINESS DIRECT AWARDS (ITEM 13 = A1)"
S ACG(4)="0^0^LARGE MINORITY BUSINESS DIRECT AWARDS (ITEM 13 = B1)",ACG(5)="0^0^WOMEN OWNED (ITEM 30 = YES)",ACG(6)="0^0^LABOR SURPLUS AREA SET ASIDES (ITEM 19 = 51 OR 54)",ACG(7)="0^0^8(A) AWARDS (ITEM 19 = 59 OR 60)"
S ACG(8)="0^0^MINORITY NON-PROFIT",ACGXREF="T"
F ACGI=1:1:8 F ACGJ=1:1:4 S ACG(ACGI,ACGJ)="0^0^"
F S ACGBEG=$O(^ACGS(ACGXREF,ACGBEG)) Q:'ACGBEG!(ACGBEG>ACGEND) S ACG=0 F S ACG=$O(^ACGS(ACGXREF,ACGBEG,ACG)) Q:'ACG D
.F X="DT","DT1","IHS" I '$D(^ACGS(ACG,X)) S ACGQUIT="" Q
.I $D(ACGQUIT) K ACGQUIT Q
.S ACGVDA=+^ACGS(ACG,10),ACGDT=^("DT"),ACGDT1=^("DT1"),ACGIHS=^("IHS")
.S ACG13=$P(ACGDT,U,13),ACG1=+ACGDT,ACG2=$P(ACGDT,U,2),ACG19=$P(ACGDT,U,19),ACG23=$P(ACGDT1,U,2),ACG26=$P(ACGDT1,U,5),ACG27=$P(ACGDT1,U,6),ACG30=$P(ACGDT1,U,9),ACG111=$S('ACGVDA:"",$D(^AUTTVNDR(ACGVDA,11)):$P(^(11),U,21),1:"")
.Q:"^15^17^"[(U_ACG1_U)
.I ACG4X=88,ACG4'=$E(ACG2,1,3) Q
.I ACG4'=99,ACG4'=236,ACG4'=$E(ACG2,1,3) Q
.Q:'ACG13!'ACG19!'ACG27
.Q:'$D(^AUTTTOB(ACG13,0))
.Q:'$D(^ACGEOC(ACG19,0))
.Q:'$D(^ACGPPC(ACG27,0)) S ACG27=^(0)
.I $P(ACG27,U,4)="I" S ACG27=1
.E S ACG27=$E(ACG27)
.I ACG27'=1 S ACG27=$S(ACG27="A":3,ACG27="Y":2,1:4)
.S ACG13=$P(^AUTTTOB(ACG13,0),U)
.S $P(ACG(1),U)=$P(ACG(1),U)+1,$P(ACG(1),U,2)=$P(ACG(1),U,2)+ACG26,$P(ACG(1,ACG27),U)=$P(ACG(1,ACG27),U)+1,$P(ACG(1,ACG27),U,2)=$P(ACG(1,ACG27),U,2)+ACG26
.I ACG111=1 S $P(ACG(8),U)=$P(ACG(8),U)+1,$P(ACG(8),U,2)=$P(ACG(8),U,2)+ACG26,$P(ACG(8,ACG27),U)=$P(ACG(8,ACG27),U)+1,$P(ACG(8,ACG27),U,2)=$P(ACG(8,ACG27),U,2)+ACG26 S ^TMP("ACG",$J,ACG)=ACG(8) Q
.I $E(ACG30)="Y" S $P(ACG(5),U)=$P(ACG(5),U)+1,$P(ACG(5),U,2)=$P(ACG(5),U,2)+ACG26,$P(ACG(5,ACG27),U)=$P(ACG(5,ACG27),U)+1,$P(ACG(5,ACG27),U,2)=$P(ACG(5,ACG27),U,2)+ACG26 Q
.I ACG19=51 S $P(ACG(6),U)=$P(ACG(6),U)+1,$P(ACG(6),U,2)=$P(ACG(6),U,2)+ACG26,$P(ACG(6,ACG27),U)=$P(ACG(6,ACG27),U)+1,$P(ACG(6,ACG27),U,2)=$P(ACG(6,ACG27),U,2)+ACG26 Q
.I "5960"[ACG19 S $P(ACG(7),U)=$P(ACG(7),U)+1,$P(ACG(7),U,2)=$P(ACG(7),U,2)+ACG26,$P(ACG(7,ACG27),U)=$P(ACG(7,ACG27),U)+1,$P(ACG(7,ACG27),U,2)=$P(ACG(7,ACG27),U,2)+ACG26 Q
.I "A2A3"[ACG13 S $P(ACG(2),U)=$P(ACG(2),U)+1,$P(ACG(2),U,2)=$P(ACG(2),U,2)+ACG26,$P(ACG(2,ACG27),U)=$P(ACG(2,ACG27),U)+1,$P(ACG(2,ACG27),U,2)=$P(ACG(2,ACG27),U,2)+ACG26 Q
.I "A1"[ACG13 S $P(ACG(3),U)=$P(ACG(3),U)+1,$P(ACG(3),U,2)=$P(ACG(3),U,2)+ACG26,$P(ACG(3,ACG27),U)=$P(ACG(3,ACG27),U)+1,$P(ACG(3,ACG27),U,2)=$P(ACG(3,ACG27),U,2)+ACG26 Q
.I "B1B2"[ACG13 S $P(ACG(4),U)=$P(ACG(4),U)+1,$P(ACG(4),U,2)=$P(ACG(4),U,2)+ACG26,$P(ACG(4,ACG27),U)=$P(ACG(4,ACG27),U)+1,$P(ACG(4,ACG27),U,2)=$P(ACG(4,ACG27),U,2)+ACG26 Q
.S ACG(8,ACG13)=""
D EN3
I $D(IOST),$E(IOST,1,2)="C-" D HOLD^ACGSMENU
Q
EN3 S ACGX="QUARTERLY SOCIOECONOMIC PROCUREMENT REPORT"
D RDATE^ACGSICR
W !!,"TOTAL CONTRACTS ADVIS SERVICES CONSTRUCTION RES AND DEV OTHER",!,"------------------ -------------- ------------- ------------- --------------"
F ACGI=1:1:8 D
.W !?10,$P(ACG(ACGI),U,3),!,$J($P(ACG(ACGI),U),4)
.F ACGJ=1:1:4 S ACGX=$S(ACGJ=1:20,ACGJ=2:35,ACGJ=3:50,1:65) W ?ACGX,"|",$J($P(ACG(ACGI,ACGJ),U),5)
.W !,$J($FN($P(ACG(ACGI),U,2),"P,",0),16)
.F ACGJ=1:1:4 S ACGX=$S(ACGJ=1:20,ACGJ=2:35,ACGJ=3:50,1:65) W ?ACGX,"|",$J($FN($P(ACG(ACGI,ACGJ),U,2),"P,",0),14)
.W !,"--------------------------------------------------------------------------------",!
.I $D(IOST),$E(IOST,1,2)="C-" D HOLD^ACGSMENU
Q
ACGSSPR ;IHS/OIRM/DSD/THL,AEF - SOCIOECONOMIC PROCUREMENT REPORT; [ 03/27/2000 2:22 PM ]
+1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
+2 ;;PRINT SOCIOECONOMIC PROCUREMENT REPORT
EN DO EN1
EXIT KILL ACGQUIT,ACG,ACG13,ACG26,ACGBEGIN,ACGEND,ACG1,ACG2,ACG3,ACG5,ACGI,ACGJ,ACGION,ACG19,ACG27,ACG30,ACGBEG,ACGFY,ACGQT,ACGX
+1 QUIT
EN1 KILL ACGQUIT
+1 IF '$DATA(ACGPARA)
SET ACGPARA=^ACGPARA(ACGPODA,0)
SET ACG4=$PIECE(ACGPARA,U,3)
+2 DO QT^ACGSCPAR
+3 IF $DATA(ACGQUIT)
KILL ACGQUIT
QUIT
+4 IF '$DATA(ACG4)
SET ACG4=$PIECE(ACGPARA,U,3)
+5 IF ACG4=236
DO CO^ACGSCPAR
IF $DATA(ACGQUIT)
QUIT
IF 1
+6 IF '$TEST
SET (ACG4,ACG4X)=ACG4
ZIS SET ZTRTN="EN2^ACGSSPR"
SET ZTDESC="CIS QT SOCIOECONOMIC PROCUREMENT REPORT"
SET ZTSAVE("ACG*")=""
+1 DO ^ACGSZIS
+2 IF $DATA(ACGQUIT)
QUIT
EN2 IF '$DATA(ZTQUEUED)
SET (ACGIOP,IOP)=ION
DO ^%ZIS
IF POP
SET ACGQUIT=""
QUIT
+1 USE IO
+2 IF ACG4X=88
FOR ACG4=102,121,161,235,239,241:1:249,284,285
KILL ACGQUIT
DO R1
+3 IF ACG4X=88
GOTO DONE
R1 IF $DATA(ACGQUIT)
GOTO DONE
+1 DO ENX
+2 IF $DATA(IOF)
WRITE @IOF
+3 IF ACG4X'=88
DO DONE
+4 QUIT
DONE DO DONE^ACGSZIS
+1 QUIT
ENX USE IO
+1 SET ACGBEG=ACGBEGIN
SET ACG(1)="0^0^TOTAL PROCUREMENTS (EXCLUDING 8(A))"
SET ACG(2)="0^0^SMALL BUSINESS DIRECT AWARDS OTHER THAN DISADV (ITEM 13 = A2 OR A3)"
SET ACG(3)="0^0^DISADVANTAGED SMALL BUSINESS DIRECT AWARDS (ITEM 13 = A1)"
+2 SET ACG(4)="0^0^LARGE MINORITY BUSINESS DIRECT AWARDS (ITEM 13 = B1)"
SET ACG(5)="0^0^WOMEN OWNED (ITEM 30 = YES)"
SET ACG(6)="0^0^LABOR SURPLUS AREA SET ASIDES (ITEM 19 = 51 OR 54)"
SET ACG(7)="0^0^8(A) AWARDS (ITEM 19 = 59 OR 60)"
+3 SET ACG(8)="0^0^MINORITY NON-PROFIT"
SET ACGXREF="T"
+4 FOR ACGI=1:1:8
FOR ACGJ=1:1:4
SET ACG(ACGI,ACGJ)="0^0^"
+5 FOR
SET ACGBEG=$ORDER(^ACGS(ACGXREF,ACGBEG))
IF 'ACGBEG!(ACGBEG>ACGEND)
QUIT
SET ACG=0
FOR
SET ACG=$ORDER(^ACGS(ACGXREF,ACGBEG,ACG))
IF 'ACG
QUIT
Begin DoDot:1
+6 FOR X="DT","DT1","IHS"
IF '$DATA(^ACGS(ACG,X))
SET ACGQUIT=""
QUIT
+7 IF $DATA(ACGQUIT)
KILL ACGQUIT
QUIT
+8 SET ACGVDA=+^ACGS(ACG,10)
SET ACGDT=^("DT")
SET ACGDT1=^("DT1")
SET ACGIHS=^("IHS")
+9 SET ACG13=$PIECE(ACGDT,U,13)
SET ACG1=+ACGDT
SET ACG2=$PIECE(ACGDT,U,2)
SET ACG19=$PIECE(ACGDT,U,19)
SET ACG23=$PIECE(ACGDT1,U,2)
SET ACG26=$PIECE(ACGDT1,U,5)
SET ACG27=$PIECE(ACGDT1,U,6)
SET ACG30=$PIECE(ACGDT1,U,9)
SET ACG111=$SELECT('ACGVDA:"",$DATA(^AUTTVNDR(ACGVDA,11)):$PIECE(^(11),U,21),1:"")
+10 IF "^15^17^"[(U_ACG1_U)
QUIT
+11 IF ACG4X=88
IF ACG4'=$EXTRACT(ACG2,1,3)
QUIT
+12 IF ACG4'=99
IF ACG4'=236
IF ACG4'=$EXTRACT(ACG2,1,3)
QUIT
+13 IF 'ACG13!'ACG19!'ACG27
QUIT
+14 IF '$DATA(^AUTTTOB(ACG13,0))
QUIT
+15 IF '$DATA(^ACGEOC(ACG19,0))
QUIT
+16 IF '$DATA(^ACGPPC(ACG27,0))
QUIT
SET ACG27=^(0)
+17 IF $PIECE(ACG27,U,4)="I"
SET ACG27=1
+18 IF '$TEST
SET ACG27=$EXTRACT(ACG27)
+19 IF ACG27'=1
SET ACG27=$SELECT(ACG27="A":3,ACG27="Y":2,1:4)
+20 SET ACG13=$PIECE(^AUTTTOB(ACG13,0),U)
+21 SET $PIECE(ACG(1),U)=$PIECE(ACG(1),U)+1
SET $PIECE(ACG(1),U,2)=$PIECE(ACG(1),U,2)+ACG26
SET $PIECE(ACG(1,ACG27),U)=$PIECE(ACG(1,ACG27),U)+1
SET $PIECE(ACG(1,ACG27),U,2)=$PIECE(ACG(1,ACG27),U,2)+ACG26
+22 IF ACG111=1
SET $PIECE(ACG(8),U)=$PIECE(ACG(8),U)+1
SET $PIECE(ACG(8),U,2)=$PIECE(ACG(8),U,2)+ACG26
SET $PIECE(ACG(8,ACG27),U)=$PIECE(ACG(8,ACG27),U)+1
SET $PIECE(ACG(8,ACG27),U,2)=$PIECE(ACG(8,ACG27),U,2)+ACG26
SET ^TMP("ACG",$JOB,ACG)=ACG(8)
QUIT
+23 IF $EXTRACT(ACG30)="Y"
SET $PIECE(ACG(5),U)=$PIECE(ACG(5),U)+1
SET $PIECE(ACG(5),U,2)=$PIECE(ACG(5),U,2)+ACG26
SET $PIECE(ACG(5,ACG27),U)=$PIECE(ACG(5,ACG27),U)+1
SET $PIECE(ACG(5,ACG27),U,2)=$PIECE(ACG(5,ACG27),U,2)+ACG26
QUIT
+24 IF ACG19=51
SET $PIECE(ACG(6),U)=$PIECE(ACG(6),U)+1
SET $PIECE(ACG(6),U,2)=$PIECE(ACG(6),U,2)+ACG26
SET $PIECE(ACG(6,ACG27),U)=$PIECE(ACG(6,ACG27),U)+1
SET $PIECE(ACG(6,ACG27),U,2)=$PIECE(ACG(6,ACG27),U,2)+ACG26
QUIT
+25 IF "5960"[ACG19
SET $PIECE(ACG(7),U)=$PIECE(ACG(7),U)+1
SET $PIECE(ACG(7),U,2)=$PIECE(ACG(7),U,2)+ACG26
SET $PIECE(ACG(7,ACG27),U)=$PIECE(ACG(7,ACG27),U)+1
SET $PIECE(ACG(7,ACG27),U,2)=$PIECE(ACG(7,ACG27),U,2)+ACG26
QUIT
+26 IF "A2A3"[ACG13
SET $PIECE(ACG(2),U)=$PIECE(ACG(2),U)+1
SET $PIECE(ACG(2),U,2)=$PIECE(ACG(2),U,2)+ACG26
SET $PIECE(ACG(2,ACG27),U)=$PIECE(ACG(2,ACG27),U)+1
SET $PIECE(ACG(2,ACG27),U,2)=$PIECE(ACG(2,ACG27),U,2)+ACG26
QUIT
+27 IF "A1"[ACG13
SET $PIECE(ACG(3),U)=$PIECE(ACG(3),U)+1
SET $PIECE(ACG(3),U,2)=$PIECE(ACG(3),U,2)+ACG26
SET $PIECE(ACG(3,ACG27),U)=$PIECE(ACG(3,ACG27),U)+1
SET $PIECE(ACG(3,ACG27),U,2)=$PIECE(ACG(3,ACG27),U,2)+ACG26
QUIT
+28 IF "B1B2"[ACG13
SET $PIECE(ACG(4),U)=$PIECE(ACG(4),U)+1
SET $PIECE(ACG(4),U,2)=$PIECE(ACG(4),U,2)+ACG26
SET $PIECE(ACG(4,ACG27),U)=$PIECE(ACG(4,ACG27),U)+1
SET $PIECE(ACG(4,ACG27),U,2)=$PIECE(ACG(4,ACG27),U,2)+ACG26
QUIT
+29 SET ACG(8,ACG13)=""
End DoDot:1
+30 DO EN3
+31 IF $DATA(IOST)
IF $EXTRACT(IOST,1,2)="C-"
DO HOLD^ACGSMENU
+32 QUIT
EN3 SET ACGX="QUARTERLY SOCIOECONOMIC PROCUREMENT REPORT"
+1 DO RDATE^ACGSICR
+2 WRITE !!,"TOTAL CONTRACTS ADVIS SERVICES CONSTRUCTION RES AND DEV OTHER",!,"------------------ -------------- ------------- ------------- --------------"
+3 FOR ACGI=1:1:8
Begin DoDot:1
+4 WRITE !?10,$PIECE(ACG(ACGI),U,3),!,$JUSTIFY($PIECE(ACG(ACGI),U),4)
+5 FOR ACGJ=1:1:4
SET ACGX=$SELECT(ACGJ=1:20,ACGJ=2:35,ACGJ=3:50,1:65)
WRITE ?ACGX,"|",$JUSTIFY($PIECE(ACG(ACGI,ACGJ),U),5)
+6 WRITE !,$JUSTIFY($FNUMBER($PIECE(ACG(ACGI),U,2),"P,",0),16)
+7 FOR ACGJ=1:1:4
SET ACGX=$SELECT(ACGJ=1:20,ACGJ=2:35,ACGJ=3:50,1:65)
WRITE ?ACGX,"|",$JUSTIFY($FNUMBER($PIECE(ACG(ACGI,ACGJ),U,2),"P,",0),14)
+8 WRITE !,"--------------------------------------------------------------------------------",!
+9 IF $DATA(IOST)
IF $EXTRACT(IOST,1,2)="C-"
DO HOLD^ACGSMENU
End DoDot:1
+10 QUIT
