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
