- ACGSICR ;IHS/OIRM/DSD/THL,AEF - INDIRECT COST REPORT; [ 03/27/2000 2:22 PM ]
- ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
- ;;ROUTINE TO PRINT THE INDIRECT 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^ACGSICR",ZTDESC="CIS QT INDIRECT COST 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,ACG(1)="^^COLLEGES & UNIVERSITIES (C1,D1)",ACG(2)="^^HOSPITALS (C2,D2)",ACG(3)="^^STATE & LOCAL GOV'T (D3,D4)",ACG(4)="^^NON-PROFITS (C1,C3,C4,C5)",ACG(5)="^^FOR PROFITS (A1-B2)"
- F S ACGBEG=$O(^ACGS("T",ACGBEG)) Q:'ACGBEG!(ACGBEG>ACGEND) S ACG=0 F S ACG=$O(^ACGS("T",ACGBEG,ACG)) Q:'ACG S ACG15=$P(^ACGS($P(^ACGS(ACG,0),U,3),"DT"),U,15) I ACG15>19,ACG15<25 D
- .S ACG13=$P(^ACGS(ACG,"DT"),U,13),ACG2=$P(^("DT"),U,2),ACG26=$P(^("DT1"),U,5),ACG36=$P(^("DT2"),U)
- .I ACG4X=88,ACG4'=$E(ACG2,1,3) Q
- .I ACG4'=99,ACG4'=236,ACG4'=$E(ACG2,1,3) Q
- .Q:'ACG13
- .Q:'$D(^AUTTTOB(ACG13,0))
- .S ACG13=$P(^AUTTTOB(ACG13,0),U) S:'$D(ACG(ACG13)) ACG(ACG13)="^^"_$P(^(0),U)_" "_$P(^(0),U,2)
- .S $P(ACG(ACG13),U)=$P(ACG(ACG13),U)+ACG26,$P(ACG(ACG13),U,2)=$P(ACG(ACG13),U,2)+ACG36
- .I "C1D1"[ACG13 S $P(ACG(1),U)=$P(ACG(1),U)+ACG26,$P(ACG(1),U,2)=$P(ACG(1),U,2)+ACG36
- .I "C2D2"[ACG13 S $P(ACG(2),U)=$P(ACG(2),U)+ACG26,$P(ACG(2),U,2)=$P(ACG(2),U,2)+ACG36
- .I "D3D4"[ACG13 S $P(ACG(3),U)=$P(ACG(3),U)+ACG26,$P(ACG(3),U,2)=$P(ACG(3),U,2)+ACG36
- .I "C3C4C5"[ACG13 S $P(ACG(4),U)=$P(ACG(4),U)+ACG26,$P(ACG(4),U,2)=$P(ACG(4),U,2)+ACG36
- .I "A1A2A3B1B2"[ACG13 S $P(ACG(5),U)=$P(ACG(5),U)+ACG26,$P(ACG(5),U,2)=$P(ACG(5),U,2)+ACG36
- .S $P(ACGT,U)=$P(ACGT,U)+ACG26,$P(ACGT,U,2)=$P(ACGT,U,2)+ACG36
- D EN3
- I $D(IOST),$E(IOST,1,2)="C-" D HOLD^ACGSMENU
- Q
- EN3 S ACGX="QUARTERLY INDIRECT COST REPORT"
- D RDATE
- W !!?5,"TYPE OF BUSINESS",?43,"TOTAL COSTS",?59,"TOTAL INDIRECT COSTS",!?5,"---------------------------------",?41,"----------------",?59,"---------------------"
- S ACG="99"
- F S ACG=$O(ACG(ACG)) Q:ACG="" S ACGX=ACG(ACG) D
- .W !?5,$P(ACGX,U,3),?41,$J($FN($P(ACGX,U),"P,",2),16),?60,$J($FN($P(ACGX,U,2),"P,",2),16)
- W !?41,"----------------",?60,"----------------",!?30,"TOTALS",?41,$J($FN($P(ACGT,U),"P,",2),16),?60,$J($FN($P(ACGT,U,2),"P,",2),16)
- F ACG=1:1:5 W !!?5,$P(ACG(ACG),U,3),?41,$J($FN($P(ACG(ACG),U),"P,",2),16),?60,$J($FN($P(ACG(ACG),U,2),"P,",2),16)
- Q
- RDATE ;EP
- S Y=DT X ^DD("DD")
- W !?15,"IHS CONTRACT INFORMATION SYSTEM",?50,"REPORT DATE: ",Y,!!?15,ACGX,!!?15,"BEGINNING DATE: ",$E(ACGBEGIN,2,7),!?15,"ENDING DATE...: ",$E(ACGEND,2,7)
- W !?15,"PROCUREMENT OFFICE: ",$S($D(^ACGPO("C",ACG4)):ACG4_" "_$P(^ACGPO($O(^ACGPO("C",ACG4,0)),0),U),1:"COMBINED REPORT")
- Q
- ACGSICR ;IHS/OIRM/DSD/THL,AEF - INDIRECT COST REPORT; [ 03/27/2000 2:22 PM ]
- +1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
- +2 ;;ROUTINE TO PRINT THE INDIRECT 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^ACGSICR"
- SET ZTDESC="CIS QT INDIRECT COST 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
- SET ACG(1)="^^COLLEGES & UNIVERSITIES (C1,D1)"
- SET ACG(2)="^^HOSPITALS (C2,D2)"
- SET ACG(3)="^^STATE & LOCAL GOV'T (D3,D4)"
- SET ACG(4)="^^NON-PROFITS (C1,C3,C4,C5)"
- SET ACG(5)="^^FOR PROFITS (A1-B2)"
- +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
- SET ACG15=$PIECE(^ACGS($PIECE(^ACGS(ACG,0),U,3),"DT"),U,15)
- IF ACG15>19
- IF ACG15<25
- Begin DoDot:1
- +3 SET ACG13=$PIECE(^ACGS(ACG,"DT"),U,13)
- SET ACG2=$PIECE(^("DT"),U,2)
- SET ACG26=$PIECE(^("DT1"),U,5)
- SET ACG36=$PIECE(^("DT2"),U)
- +4 IF ACG4X=88
- IF ACG4'=$EXTRACT(ACG2,1,3)
- QUIT
- +5 IF ACG4'=99
- IF ACG4'=236
- IF ACG4'=$EXTRACT(ACG2,1,3)
- QUIT
- +6 IF 'ACG13
- QUIT
- +7 IF '$DATA(^AUTTTOB(ACG13,0))
- QUIT
- +8 SET ACG13=$PIECE(^AUTTTOB(ACG13,0),U)
- IF '$DATA(ACG(ACG13))
- SET ACG(ACG13)="^^"_$PIECE(^(0),U)_" "_$PIECE(^(0),U,2)
- +9 SET $PIECE(ACG(ACG13),U)=$PIECE(ACG(ACG13),U)+ACG26
- SET $PIECE(ACG(ACG13),U,2)=$PIECE(ACG(ACG13),U,2)+ACG36
- +10 IF "C1D1"[ACG13
- SET $PIECE(ACG(1),U)=$PIECE(ACG(1),U)+ACG26
- SET $PIECE(ACG(1),U,2)=$PIECE(ACG(1),U,2)+ACG36
- +11 IF "C2D2"[ACG13
- SET $PIECE(ACG(2),U)=$PIECE(ACG(2),U)+ACG26
- SET $PIECE(ACG(2),U,2)=$PIECE(ACG(2),U,2)+ACG36
- +12 IF "D3D4"[ACG13
- SET $PIECE(ACG(3),U)=$PIECE(ACG(3),U)+ACG26
- SET $PIECE(ACG(3),U,2)=$PIECE(ACG(3),U,2)+ACG36
- +13 IF "C3C4C5"[ACG13
- SET $PIECE(ACG(4),U)=$PIECE(ACG(4),U)+ACG26
- SET $PIECE(ACG(4),U,2)=$PIECE(ACG(4),U,2)+ACG36
- +14 IF "A1A2A3B1B2"[ACG13
- SET $PIECE(ACG(5),U)=$PIECE(ACG(5),U)+ACG26
- SET $PIECE(ACG(5),U,2)=$PIECE(ACG(5),U,2)+ACG36
- +15 SET $PIECE(ACGT,U)=$PIECE(ACGT,U)+ACG26
- SET $PIECE(ACGT,U,2)=$PIECE(ACGT,U,2)+ACG36
- End DoDot:1
- +16 DO EN3
- +17 IF $DATA(IOST)
- IF $EXTRACT(IOST,1,2)="C-"
- DO HOLD^ACGSMENU
- +18 QUIT
- EN3 SET ACGX="QUARTERLY INDIRECT COST REPORT"
- +1 DO RDATE
- +2 WRITE !!?5,"TYPE OF BUSINESS",?43,"TOTAL COSTS",?59,"TOTAL INDIRECT COSTS",!?5,"---------------------------------",?41,"----------------",?59,"---------------------"
- +3 SET ACG="99"
- +4 FOR
- SET ACG=$ORDER(ACG(ACG))
- IF ACG=""
- QUIT
- SET ACGX=ACG(ACG)
- Begin DoDot:1
- +5 WRITE !?5,$PIECE(ACGX,U,3),?41,$JUSTIFY($FNUMBER($PIECE(ACGX,U),"P,",2),16),?60,$JUSTIFY($FNUMBER($PIECE(ACGX,U,2),"P,",2),16)
- End DoDot:1
- +6 WRITE !?41,"----------------",?60,"----------------",!?30,"TOTALS",?41,$JUSTIFY($FNUMBER($PIECE(ACGT,U),"P,",2),16),?60,$JUSTIFY($FNUMBER($PIECE(ACGT,U,2),"P,",2),16)
- +7 FOR ACG=1:1:5
- WRITE !!?5,$PIECE(ACG(ACG),U,3),?41,$JUSTIFY($FNUMBER($PIECE(ACG(ACG),U),"P,",2),16),?60,$JUSTIFY($FNUMBER($PIECE(ACG(ACG),U,2),"P,",2),16)
- +8 QUIT
- RDATE ;EP
- +1 SET Y=DT
- XECUTE ^DD("DD")
- +2 WRITE !?15,"IHS CONTRACT INFORMATION SYSTEM",?50,"REPORT DATE: ",Y,!!?15,ACGX,!!?15,"BEGINNING DATE: ",$EXTRACT(ACGBEGIN,2,7),!?15,"ENDING DATE...: ",$EXTRACT(ACGEND,2,7)
- +3 WRITE !?15,"PROCUREMENT OFFICE: ",$SELECT($DATA(^ACGPO("C",ACG4)):ACG4_" "_$PIECE(^ACGPO($ORDER(^ACGPO("C",ACG4,0)),0),U),1:"COMBINED REPORT")
- +4 QUIT
