ACGSCLS ;IHS/OIRM/DSD/THL,AEF - CLOSE OUT REPORT; [ 03/27/2000 2:22 PM ]
;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
;;UTILITY TO PRINT CLOSE-OUT REPORT
EN D ^XBKVAR
D EN1
EXIT K ACG,ACGQUIT,ACG15,ACG154,ACG155,ACG26,ACG26T,ACGAVG,ACGBEG,ACGBEGIN,ACGEND,ACGDOLLR,ACGDT,ACGDT1,ACGDTX,ACGDT1X,ACGIHS1,ACGION,ACGWAIT
Q
EN1 ;SETUP FOR CLOSE OUT REPORT
F ACG="BEGIN","END","DOLLAR","ZIS" D @ACG Q:$D(ACGQUIT)
Q
PRINT ;EP;TO PRINT CLOSE OUT REPORT
S (ACG26,ACG26T,ACG(1),ACG(20),ACGWAIT(1),ACGWAIT(20),ACGAVG(1),ACGAVG(20))=0
F S ACGBEG=$O(^ACGS("X",ACGBEG)) Q:'ACGBEG!(ACGBEG>ACGEND) D
.S ACG=0
.F S ACG=$O(^ACGS("X",ACGBEG,ACG)) Q:'ACG I $D(^ACGS(ACG,0)),$D(^("DT")),$D(^("DT1")),$D(^("IHS1")) S ACGDT=^("DT"),ACGDT1=^("DT1"),ACGIHS1=^("IHS1") D P
D R
Q
P ;
D Q
S ACG154=$P(ACGIHS1,U,4),ACG155=$P(ACGIHS1,U,5)
S ACG15=$S($P(ACGDTX,U,20)>19:20,1:1),$P(ACG(ACG15),U)=$P(ACG(ACG15),U)+1,$P(ACG(ACG15),U,2)=$P(ACG(ACG15),U,2)+ACG26
I 'ACG155 S $P(ACGWAIT(ACG15),U)=$P(ACGWAIT(ACG15),U)+1,$P(ACGWAIT(ACG15),U,2)=$P(ACGWAIT(ACG15),U,2)+ACG26
S X1=ACG155,X2=ACG154
D ^%DTC
S $P(ACGAVG(ACG15),U)=$P(ACGAVG(ACG15),U)+1,$P(ACGAVG(ACG15),U,2)=$P(ACGAVG(ACG15),U,2)+X
Q
Q ;COUNT NUMBERS AND DOLLARS OF ADMINISTRATIVELY CLOSED CONTRACTS
S ACGX=0
F S ACGX=$O(^ACGS("C",ACG,ACGX)) Q:'ACGX I $D(^ACGS(ACGX,0)),$D(^("DT")),$D(^("DT1")) S ACGDTX=^("DT"),ACGDT1X=^("DT1"),ACG26=ACG26+$P(ACGDT1X,U,5)
Q:ACG26'>ACGDOLLR
Q
R ;PRINT REPORT
S Y=ACGBEGIN X ^DD("DD") S ACGBEGIN=Y
S Y=ACGEND X ^DD("DD") S ACGEND=Y
W @IOF,!,"Contracts",$S(ACGDOLLR>0:" over "_$FN(ACGDOLLR,"P",0),1:"")," with associated dollars,",!,"closed out between ",ACGBEGIN," and ",ACGEND,!,"following administrative close-out procedure: "
W !!?10,"Cost type contracts.: Number: ",$J(+ACG(20),10),?$X+3,$J($FN($P(ACG(20),U,2),"P,",0),12)
W !?10,"Other than cost type: Number: ",$J(+ACG(1),10),?$X+3,$J($FN($P(ACG(1),U,2),"P,",0),12)
W !!,"Open contracts awaiting closeout:"
W !!?10,"Cost type contracts.: Number: ",$J(+ACGWAIT(20),10),?$X+3,$J($FN($P(ACGWAIT(20),U,2),"P,",0),12)
W !?10,"Other than cost type: Number: ",$J(+ACGWAIT(1),10),?$X+3,$J($FN($P(ACGWAIT(1),U,2),"P,",0),12)
W !!,"Average length of time required to close out a contract."
W !!?10,"Cost type contracts.: Number: ",$J($S(+ACGAVG(20)<1:0,1:$P(ACGAVG(20),U,2)/30/+ACGAVG(20)),10)
W !?10,"Other than cost type: Number: ",$J($S(+ACGAVG(1)<1:0,1:$P(ACGAVG(1),U,2)/30/+ACGAVG(1)),10)
Q
BEGIN ;ENTER BEGINNING DATE FOR SEARCH
S DIR(0)="DO",DIR("A")="Beginning Date",DIR("?")="Enter the Beginning Date for inclusion of closed Contracts"
W !
D DIR^ACGSDIC
Q:+Y<1!$D(ACGQUIT)
S (ACGBEGIN,ACGBEG)=+Y
Q
END ;ENTER ENDING DATE FOR SEARCH
S DIR(0)="DO",DIR("A")="Ending Date...",DIR("?")="Enter the Ending Date for inclusion of closed Contracts"
W !
D DIR^ACGSDIC
Q:+Y<1!$D(ACGQUIT)
S ACGEND=+Y
Q
CLOSED ;SELECT TYPE OF CLOSURE
S DIR(0)="SO^2:PHYSICALL CLOSED;3:ADMINISTRATIVELY CLOSED",DIR("?")="Enter the code which indicates the type of action for which you wish a report."
W !
D DIR^ACGFDIC
Q:Y<2!$D(ACGQUIT)
S ACGTYPE=Y,ACGXREF=$S(Y=2:"X",1:"Y")
Q
DOLLAR D DOLLAR^ACGSRT
Q:$D(ACGOUT)
I '$D(ACGDOLLR) S ACGDOLLR=0
I ACGDOLLR=0 K ACGQUIT
Q
ZIS S ZTRTN="PRINT^ACGSCLS"
D ^ACGSZIS
I '$D(IO("Q")) D
.I '$D(ZTQUEUED) S (ACGIOP,IOP)=ION D ^%ZIS I POP S ACGQUIT="" Q
.U IO
.D PRINT
.D DONE^ACGSZIS
.I $E(IOST,1,2)="C-" D HOLD^ACGSMENU
Q
ACGSCLS ;IHS/OIRM/DSD/THL,AEF - CLOSE OUT REPORT; [ 03/27/2000 2:22 PM ]
+1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
+2 ;;UTILITY TO PRINT CLOSE-OUT REPORT
EN DO ^XBKVAR
+1 DO EN1
EXIT KILL ACG,ACGQUIT,ACG15,ACG154,ACG155,ACG26,ACG26T,ACGAVG,ACGBEG,ACGBEGIN,ACGEND,ACGDOLLR,ACGDT,ACGDT1,ACGDTX,ACGDT1X,ACGIHS1,ACGION,ACGWAIT
+1 QUIT
EN1 ;SETUP FOR CLOSE OUT REPORT
+1 FOR ACG="BEGIN","END","DOLLAR","ZIS"
DO @ACG
IF $DATA(ACGQUIT)
QUIT
+2 QUIT
PRINT ;EP;TO PRINT CLOSE OUT REPORT
+1 SET (ACG26,ACG26T,ACG(1),ACG(20),ACGWAIT(1),ACGWAIT(20),ACGAVG(1),ACGAVG(20))=0
+2 FOR
SET ACGBEG=$ORDER(^ACGS("X",ACGBEG))
IF 'ACGBEG!(ACGBEG>ACGEND)
QUIT
Begin DoDot:1
+3 SET ACG=0
+4 FOR
SET ACG=$ORDER(^ACGS("X",ACGBEG,ACG))
IF 'ACG
QUIT
IF $DATA(^ACGS(ACG,0))
IF $DATA(^("DT"))
IF $DATA(^("DT1"))
IF $DATA(^("IHS1"))
SET ACGDT=^("DT")
SET ACGDT1=^("DT1")
SET ACGIHS1=^("IHS1")
DO P
End DoDot:1
+5 DO R
+6 QUIT
P ;
+1 DO Q
+2 SET ACG154=$PIECE(ACGIHS1,U,4)
SET ACG155=$PIECE(ACGIHS1,U,5)
+3 SET ACG15=$SELECT($PIECE(ACGDTX,U,20)>19:20,1:1)
SET $PIECE(ACG(ACG15),U)=$PIECE(ACG(ACG15),U)+1
SET $PIECE(ACG(ACG15),U,2)=$PIECE(ACG(ACG15),U,2)+ACG26
+4 IF 'ACG155
SET $PIECE(ACGWAIT(ACG15),U)=$PIECE(ACGWAIT(ACG15),U)+1
SET $PIECE(ACGWAIT(ACG15),U,2)=$PIECE(ACGWAIT(ACG15),U,2)+ACG26
+5 SET X1=ACG155
SET X2=ACG154
+6 DO ^%DTC
+7 SET $PIECE(ACGAVG(ACG15),U)=$PIECE(ACGAVG(ACG15),U)+1
SET $PIECE(ACGAVG(ACG15),U,2)=$PIECE(ACGAVG(ACG15),U,2)+X
+8 QUIT
Q ;COUNT NUMBERS AND DOLLARS OF ADMINISTRATIVELY CLOSED CONTRACTS
+1 SET ACGX=0
+2 FOR
SET ACGX=$ORDER(^ACGS("C",ACG,ACGX))
IF 'ACGX
QUIT
IF $DATA(^ACGS(ACGX,0))
IF $DATA(^("DT"))
IF $DATA(^("DT1"))
SET ACGDTX=^("DT")
SET ACGDT1X=^("DT1")
SET ACG26=ACG26+$PIECE(ACGDT1X,U,5)
+3 IF ACG26'>ACGDOLLR
QUIT
+4 QUIT
R ;PRINT REPORT
+1 SET Y=ACGBEGIN
XECUTE ^DD("DD")
SET ACGBEGIN=Y
+2 SET Y=ACGEND
XECUTE ^DD("DD")
SET ACGEND=Y
+3 WRITE @IOF,!,"Contracts",$SELECT(ACGDOLLR>0:" over "_$FNUMBER(ACGDOLLR,"P",0),1:"")," with associated dollars,",!,"closed out between ",ACGBEGIN," and ",ACGEND,!,"following administrative close-out procedure: "
+4 WRITE !!?10,"Cost type contracts.: Number: ",$JUSTIFY(+ACG(20),10),?$X+3,$JUSTIFY($FNUMBER($PIECE(ACG(20),U,2),"P,",0),12)
+5 WRITE !?10,"Other than cost type: Number: ",$JUSTIFY(+ACG(1),10),?$X+3,$JUSTIFY($FNUMBER($PIECE(ACG(1),U,2),"P,",0),12)
+6 WRITE !!,"Open contracts awaiting closeout:"
+7 WRITE !!?10,"Cost type contracts.: Number: ",$JUSTIFY(+ACGWAIT(20),10),?$X+3,$JUSTIFY($FNUMBER($PIECE(ACGWAIT(20),U,2),"P,",0),12)
+8 WRITE !?10,"Other than cost type: Number: ",$JUSTIFY(+ACGWAIT(1),10),?$X+3,$JUSTIFY($FNUMBER($PIECE(ACGWAIT(1),U,2),"P,",0),12)
+9 WRITE !!,"Average length of time required to close out a contract."
+10 WRITE !!?10,"Cost type contracts.: Number: ",$JUSTIFY($SELECT(+ACGAVG(20)<1:0,1:$PIECE(ACGAVG(20),U,2)/30/+ACGAVG(20)),10)
+11 WRITE !?10,"Other than cost type: Number: ",$JUSTIFY($SELECT(+ACGAVG(1)<1:0,1:$PIECE(ACGAVG(1),U,2)/30/+ACGAVG(1)),10)
+12 QUIT
BEGIN ;ENTER BEGINNING DATE FOR SEARCH
+1 SET DIR(0)="DO"
SET DIR("A")="Beginning Date"
SET DIR("?")="Enter the Beginning Date for inclusion of closed Contracts"
+2 WRITE !
+3 DO DIR^ACGSDIC
+4 IF +Y<1!$DATA(ACGQUIT)
QUIT
+5 SET (ACGBEGIN,ACGBEG)=+Y
+6 QUIT
END ;ENTER ENDING DATE FOR SEARCH
+1 SET DIR(0)="DO"
SET DIR("A")="Ending Date..."
SET DIR("?")="Enter the Ending Date for inclusion of closed Contracts"
+2 WRITE !
+3 DO DIR^ACGSDIC
+4 IF +Y<1!$DATA(ACGQUIT)
QUIT
+5 SET ACGEND=+Y
+6 QUIT
CLOSED ;SELECT TYPE OF CLOSURE
+1 SET DIR(0)="SO^2:PHYSICALL CLOSED;3:ADMINISTRATIVELY CLOSED"
SET DIR("?")="Enter the code which indicates the type of action for which you wish a report."
+2 WRITE !
+3 DO DIR^ACGFDIC
+4 IF Y<2!$DATA(ACGQUIT)
QUIT
+5 SET ACGTYPE=Y
SET ACGXREF=$SELECT(Y=2:"X",1:"Y")
+6 QUIT
DOLLAR DO DOLLAR^ACGSRT
+1 IF $DATA(ACGOUT)
QUIT
+2 IF '$DATA(ACGDOLLR)
SET ACGDOLLR=0
+3 IF ACGDOLLR=0
KILL ACGQUIT
+4 QUIT
ZIS SET ZTRTN="PRINT^ACGSCLS"
+1 DO ^ACGSZIS
+2 IF '$DATA(IO("Q"))
Begin DoDot:1
+3 IF '$DATA(ZTQUEUED)
SET (ACGIOP,IOP)=ION
DO ^%ZIS
IF POP
SET ACGQUIT=""
QUIT
+4 USE IO
+5 DO PRINT
+6 DO DONE^ACGSZIS
+7 IF $EXTRACT(IOST,1,2)="C-"
DO HOLD^ACGSMENU
End DoDot:1
+8 QUIT
