- 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
