- 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
