ACGSSWS ;IHS/OIRM/DSD/THL,AEF - HANDICAPPED REPORT; [ 03/27/2000 2:22 PM ]
;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
;;PRINT HANDICAPPED 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
S:'$D(ACGPARA) ACGPARA=^ACGPARA(ACGPODA,0),ACG4=$P(ACGPARA,U,3)
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^ACGSSWS",ZTDESC="CIS QT HANDICAPPED 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,ACGT2)=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 ACG13=$P(^ACGS(ACG,"DT"),U,13),ACG1=+^("DT"),ACG2=$P(^("DT"),U,2),ACG23=$E($P(^("DT1"),U,2),4,7),ACG26=$P(^("DT1"),U,5),ACG68=$S($D(^("DT3")):$P(^("DT3"),U,13),1:"")
.Q:'ACG13!'ACG1
.Q:ACG1=15!(ACG1=17)
.Q:'$D(^AUTTTOB(ACG13,0)) S ACG13=$P(^(0),U)
.Q:ACG13'="C5"
.I ACG4X=88,ACG4'=$E(ACG2,1,3) Q
.I ACG4'=99,ACG4'=236,ACG4'=$E(ACG2,1,3) Q
.S ACG(ACG2)=ACG26_U_ACG23_U_ACG26_U_ACG68,ACGT=ACGT+ACG26,ACGT2=ACGT2+ACG68
D EN3
I $D(IOST),$E(IOST,1,2)="C-" D HOLD^ACGSMENU
Q
EN3 S ACGX="MONTHLY SHELTERED WORKSHOPS REPORT"
D RDATE^ACGSICR
W !!?50,"NEXT HIGHER FOR-",!?22,"AWARD",?30,"HANDICAPPED",?50,"PROFIT SMALL",!?5,"CONTRACT NUMBER",?22,"DATE",?30,"CONTRACT AMT",?50,"BUSINESS BID",!?5,"---------------",?22,"----",?30,"----------------",?50,"---------------"
S ACG=""
F S ACG=$O(ACG(ACG)) Q:ACG="" S ACGX=ACG(ACG) D
.W !?5,ACG,?22,$P(ACGX,U,2),?30,$J($FN($P(ACGX,U,3),"P,",0),15),?50,$J($FN($P(ACGX,U,4),"P,",0),15)
W !?50,"---------------------",!?30,"TOTALS",?50,$J($FN(ACGT,"P,",0),15)
Q
ACGSSWS ;IHS/OIRM/DSD/THL,AEF - HANDICAPPED REPORT; [ 03/27/2000 2:22 PM ]
+1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
+2 ;;PRINT HANDICAPPED 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 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 ACG4=236
DO CO^ACGSCPAR
IF $DATA(ACGQUIT)
QUIT
IF 1
+5 IF '$TEST
SET (ACG4,ACG4X)=ACG4
ZIS SET ZTRTN="EN2^ACGSSWS"
SET ZTDESC="CIS QT HANDICAPPED 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,ACGT2)=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 ACG13=$PIECE(^ACGS(ACG,"DT"),U,13)
SET ACG1=+^("DT")
SET ACG2=$PIECE(^("DT"),U,2)
SET ACG23=$EXTRACT($PIECE(^("DT1"),U,2),4,7)
SET ACG26=$PIECE(^("DT1"),U,5)
SET ACG68=$SELECT($DATA(^("DT3")):$PIECE(^("DT3"),U,13),1:"")
+4 IF 'ACG13!'ACG1
QUIT
+5 IF ACG1=15!(ACG1=17)
QUIT
+6 IF '$DATA(^AUTTTOB(ACG13,0))
QUIT
SET ACG13=$PIECE(^(0),U)
+7 IF ACG13'="C5"
QUIT
+8 IF ACG4X=88
IF ACG4'=$EXTRACT(ACG2,1,3)
QUIT
+9 IF ACG4'=99
IF ACG4'=236
IF ACG4'=$EXTRACT(ACG2,1,3)
QUIT
+10 SET ACG(ACG2)=ACG26_U_ACG23_U_ACG26_U_ACG68
SET ACGT=ACGT+ACG26
SET ACGT2=ACGT2+ACG68
End DoDot:1
+11 DO EN3
+12 IF $DATA(IOST)
IF $EXTRACT(IOST,1,2)="C-"
DO HOLD^ACGSMENU
+13 QUIT
EN3 SET ACGX="MONTHLY SHELTERED WORKSHOPS REPORT"
+1 DO RDATE^ACGSICR
+2 WRITE !!?50,"NEXT HIGHER FOR-",!?22,"AWARD",?30,"HANDICAPPED",?50,"PROFIT SMALL",!?5,"CONTRACT NUMBER",?22,"DATE",?30,"CONTRACT AMT",?50,"BUSINESS BID",!?5,"---------------",?22,"----",?30,"----------------",?50,"---------------"
+3 SET ACG=""
+4 FOR
SET ACG=$ORDER(ACG(ACG))
IF ACG=""
QUIT
SET ACGX=ACG(ACG)
Begin DoDot:1
+5 WRITE !?5,ACG,?22,$PIECE(ACGX,U,2),?30,$JUSTIFY($FNUMBER($PIECE(ACGX,U,3),"P,",0),15),?50,$JUSTIFY($FNUMBER($PIECE(ACGX,U,4),"P,",0),15)
End DoDot:1
+6 WRITE !?50,"---------------------",!?30,"TOTALS",?50,$JUSTIFY($FNUMBER(ACGT,"P,",0),15)
+7 QUIT
