ACGSUNIC ;IHS/OIRM/DSD/THL,AEF - UNICOR COST REPORT; [ 03/27/2000 2:22 PM ]
;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
;;PRINT UNICOR COST REPORT
EN D EN1
EXIT K ACGQUIT,ACG,ACG2,ACG4,ACG4X,ACG13,ACG26,ACG36,ACGBEGIN,ACGEND,ACG5,ACGBEG,ACGFY,ACGQT,ACGION,ACGX,ACGT
Q
EN1 K ACGQUIT
D QT^ACGSCPAR
I $D(ACGQUIT) K ACGQUIT Q
I ACG4=236 D CO^ACGSCPAR Q:$D(ACGQUIT) I 1
E S (ACG4,ACG4X)=ACG4
ZIS S ZTRTN="EN2^ACGSUNIC",ZTDESC="CIS QT UNICOR 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 K ACG
S ACGBEG=ACGBEGIN,ACGT=0
F S ACGBEG=$O(^ACGS("T",ACGBEG)) Q:'ACGBEG!(ACGBEG>ACGEND) S ACG=0 F S ACG=$O(^ACGS("T",ACGBEG,ACG)) Q:'ACG D
.S ACG5=$P(^ACGS(ACG,"DT"),U,5),ACG1=+^("DT"),ACG2=$P(^("DT"),U,2),ACG26=$P(^("DT1"),U,5),ACG36=$S($D(^("DT2")):$P(^("DT2"),U),1:"")
.Q:'ACG1!(ACG1=15)!(ACG1=17)
.Q:"UNICOR"'=$E(ACG5,1,6)&(ACG5'["FEDERAL PRISON")&(ACG5'["Federal Prison")
.Q:ACG26<100000
.I ACG4X=88,ACG4'=$E(ACG2,1,3) Q
.I ACG4'=99,ACG4'=236,ACG4'=$E(ACG2,1,3) Q
.S ACG(ACG2)=ACG26,ACGT=ACGT+ACG26
D EN3
I $D(IOST),$E(IOST,1,2)="C-" D HOLD^ACGSMENU
Q
EN3 S ACGX="QUARTERLY UNICOR REPORT"
D RDATE^ACGSICR
W !!?5,"Contract awards ($100,000 and above) for products and services",!?5,"obtained from Federal Prison Industries (UNICOR)",!!?5,"CONTRACT NO.",?41,"TOTAL DOLLARS AWARDED",!?5,"---------------",?41,"---------------------"
S ACG=""
F S ACG=$O(ACG(ACG)) Q:ACG="" S ACGX=ACG(ACG) D
.W !?5,ACG,?41,$J($FN(ACGX,"P,",0),16)
W !?41,"---------------------",!?30,"TOTALS",?41,$J($FN(ACGT,"P,",0),16)
Q
ACGSUNIC ;IHS/OIRM/DSD/THL,AEF - UNICOR COST REPORT; [ 03/27/2000 2:22 PM ]
+1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
+2 ;;PRINT UNICOR COST REPORT
EN DO EN1
EXIT KILL ACGQUIT,ACG,ACG2,ACG4,ACG4X,ACG13,ACG26,ACG36,ACGBEGIN,ACGEND,ACG5,ACGBEG,ACGFY,ACGQT,ACGION,ACGX,ACGT
+1 QUIT
EN1 KILL ACGQUIT
+1 DO QT^ACGSCPAR
+2 IF $DATA(ACGQUIT)
KILL ACGQUIT
QUIT
+3 IF ACG4=236
DO CO^ACGSCPAR
IF $DATA(ACGQUIT)
QUIT
IF 1
+4 IF '$TEST
SET (ACG4,ACG4X)=ACG4
ZIS SET ZTRTN="EN2^ACGSUNIC"
SET ZTDESC="CIS QT UNICOR 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 KILL ACG
+1 SET ACGBEG=ACGBEGIN
SET ACGT=0
+2 FOR
SET ACGBEG=$ORDER(^ACGS("T",ACGBEG))
IF 'ACGBEG!(ACGBEG>ACGEND)
QUIT
SET ACG=0
FOR
SET ACG=$ORDER(^ACGS("T",ACGBEG,ACG))
IF 'ACG
QUIT
Begin DoDot:1
+3 SET ACG5=$PIECE(^ACGS(ACG,"DT"),U,5)
SET ACG1=+^("DT")
SET ACG2=$PIECE(^("DT"),U,2)
SET ACG26=$PIECE(^("DT1"),U,5)
SET ACG36=$SELECT($DATA(^("DT2")):$PIECE(^("DT2"),U),1:"")
+4 IF 'ACG1!(ACG1=15)!(ACG1=17)
QUIT
+5 IF "UNICOR"'=$EXTRACT(ACG5,1,6)&(ACG5'["FEDERAL PRISON")&(ACG5'["Federal Prison")
QUIT
+6 IF ACG26<100000
QUIT
+7 IF ACG4X=88
IF ACG4'=$EXTRACT(ACG2,1,3)
QUIT
+8 IF ACG4'=99
IF ACG4'=236
IF ACG4'=$EXTRACT(ACG2,1,3)
QUIT
+9 SET ACG(ACG2)=ACG26
SET ACGT=ACGT+ACG26
End DoDot:1
+10 DO EN3
+11 IF $DATA(IOST)
IF $EXTRACT(IOST,1,2)="C-"
DO HOLD^ACGSMENU
+12 QUIT
EN3 SET ACGX="QUARTERLY UNICOR REPORT"
+1 DO RDATE^ACGSICR
+2 WRITE !!?5,"Contract awards ($100,000 and above) for products and services",!?5,"obtained from Federal Prison Industries (UNICOR)",!!?5,"CONTRACT NO.",?41,"TOTAL DOLLARS AWARDED",!?5,"---------------",?41,"---------------------"
+3 SET ACG=""
+4 FOR
SET ACG=$ORDER(ACG(ACG))
IF ACG=""
QUIT
SET ACGX=ACG(ACG)
Begin DoDot:1
+5 WRITE !?5,ACG,?41,$JUSTIFY($FNUMBER(ACGX,"P,",0),16)
End DoDot:1
+6 WRITE !?41,"---------------------",!?30,"TOTALS",?41,$JUSTIFY($FNUMBER(ACGT,"P,",0),16)
+7 QUIT
