ACGSPSUM ;IHS/OIRM/DSD/THL,AEF - SUMMARY OF MODS FOR ACGPSUM; [ 03/27/2000 2:22 PM ]
;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
;;ROUTINE WHICH CREATES SUMMARY OF MODS FOR THE CONTRACT SUMMARY REPORT
EN D EN1
EXIT ;
Q
EN1 S:'$D(ACGTD)!'$D(ACGTI) (ACGTD,ACGTI)=0
S:'$D(ACGTOTD) (ACGTOTD,ACGTOTI)=0
S:'$D(ACGTOTDT) (ACGTOTDT,ACGTOTIT)=0
N ACGI,ACG
S ACG=0
F ACGI=1:1:3 S ACG=$O(^ACGS("C",D0,ACG)) Q:'ACG
S ACG=0
F ACGJ=0:1 S ACG=$O(^ACGS("C",D0,ACG)) Q:'ACG I $D(^ACGS(ACG,"DT")),$D(^("DT1")),$D(^("DT2")) S ACGDT=^("DT"),ACGDT1=^("DT1"),ACGDT2=^("DT2") D
.S ACG($P(^ACGS(ACG,0),U))=$P(ACGDT1,U,5)_U_$P(ACGDT1,U,3)_U_$P(ACGDT2,U)_U_$P(ACGDT,U),ACGTD=ACGTD+$P(ACGDT1,U,5)-$P(ACGDT2,U),ACGTI=ACGTI+$P(ACGDT2,U)
S ACGTOTD=ACGTOTD+ACGTD,ACGTOTI=ACGTOTI+ACGTI,ACGTOTDT=ACGTOTDT+ACGTD,ACGTOTIT=ACGTOTIT+ACGTI
I $Y>(IOSL-5-ACGJ) S DC=$G(DC)+1 W @IOF,!?60,"PAGE: ",DC,!,$P(^ACGS(D0,"DT"),U,2)," (CON'T)"
W:ACGI=3 !!?25,"MOD #",?32,"TYPE",?39,"AMOUNT",?54,"DATE",?68,"INDIRECT",!?25,"-----",?32,"----",?39,"-----------",?54,"--------",?68,"-----------"
I ACGI=3 S (ACGI,ACG)=0 F S ACG=$O(ACG(ACG)) Q:'ACG D
.W !?26,ACG,?33,$P(^ACGTPA($P(ACG(ACG),U,4),0),U),?39,$J($FN($P(ACG(ACG),U),"P,",0),12) W:$P(ACG(ACG),U,2)?7N ?54,$E($P(ACG(ACG),U,2),4,5),"/",$E($P(ACG(ACG),U,2),6,7),"/",$E($P(ACG(ACG),U,2),2,3) W ?68,$J($FN($P(ACG(ACG),U,3),"P,",0),12)
W !!?30,"TOTAL AMOUNT",?45,"TOTAL DIRECT",?60,"TOTAL INDIR",!?30,"------------",?45,"------------",?60,"------------",!?30,$J($FN((ACGTD+ACGTI),"P,",0),12),?45,$J($FN(ACGTD,"P,",0),12),?60,$J($FN(ACGTI,"P,",0),12)
S (ACGTD,ACGTI)=0
Q
TAIL ;EP;
W !!?18,"TOTALS FOR: ",ACGRPT
S:'$D(ACGTOTD) (ACGTOTD,ACGTOTI)=0
W !?30,"TOTAL AMOUNT",?45,"TOTAL DIRECT",?60,"TOTAL INDIRECT",!?30,"------------",?45,"------------",?60,"------------",!?30,$J($FN((ACGTOTD+ACGTOTI),"P,",0),12),?45,$J($FN(ACGTOTD,"P,",0),12),?60,$J($FN(ACGTOTI,"P,",0),12)
S (ACGTOTD,ACGTOTI)=0
I $D(IOST),$E(IOST,1,2)["C-" D HOLD^ACGSMENU
Q
TOTAL W !!?18,"TOTALS FOR PROCUREMENT OFFICE: ",$S($D(ACG4N):ACG4N,1:ACG4)
S:'$D(ACGTOTDT) (ACGTOTDT,ACGTOTIT)=0
W !?30,"TOTAL AMOUNT",?45,"TOTAL DIRECT",?60,"TOTAL INDIRECT",!?30,"------------",?45,"------------",?60,"------------",!?30,$J($FN((ACGTOTDT+ACGTOTIT),"P,",0),12),?45,$J($FN(ACGTOTDT,"P,",0),12),?60,$J($FN(ACGTOTIT,"P,",0),12)
S (ACGTOTDT,ACGTOTIT)=0
I $D(IOST),$E(IOST,1,2)["C-" D HOLD^ACGSMENU
Q
ADHOC ;EP
D:$E(IOST,1,2)="C-" HOLD^ACGSMENU
I $D(ACGQUIT) K ACGQUIT Q
S (ACGX,ACGRDAM)=D0
F S ACGRDAM=$O(^ACGS("C",ACGX,ACGRDAM)) Q:'ACGRDAM K DXS,DIP S D0=ACGRDAM,ACGDC(1)=$G(ACGDC(1))+1 D ^ACGPTCS K DXS,DIP D:$E(IOST,1,2)="C-" HOLD^ACGSMENU I $D(ACGQUIT) K ACGQUIT Q
K ACGRDAM
S D0=ACGX
Q
;
ACGSPSUM ;IHS/OIRM/DSD/THL,AEF - SUMMARY OF MODS FOR ACGPSUM; [ 03/27/2000 2:22 PM ]
+1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
+2 ;;ROUTINE WHICH CREATES SUMMARY OF MODS FOR THE CONTRACT SUMMARY REPORT
EN DO EN1
EXIT ;
+1 QUIT
EN1 IF '$DATA(ACGTD)!'$DATA(ACGTI)
SET (ACGTD,ACGTI)=0
+1 IF '$DATA(ACGTOTD)
SET (ACGTOTD,ACGTOTI)=0
+2 IF '$DATA(ACGTOTDT)
SET (ACGTOTDT,ACGTOTIT)=0
+3 NEW ACGI,ACG
+4 SET ACG=0
+5 FOR ACGI=1:1:3
SET ACG=$ORDER(^ACGS("C",D0,ACG))
IF 'ACG
QUIT
+6 SET ACG=0
+7 FOR ACGJ=0:1
SET ACG=$ORDER(^ACGS("C",D0,ACG))
IF 'ACG
QUIT
IF $DATA(^ACGS(ACG,"DT"))
IF $DATA(^("DT1"))
IF $DATA(^("DT2"))
SET ACGDT=^("DT")
SET ACGDT1=^("DT1")
SET ACGDT2=^("DT2")
Begin DoDot:1
+8 SET ACG($PIECE(^ACGS(ACG,0),U))=$PIECE(ACGDT1,U,5)_U_$PIECE(ACGDT1,U,3)_U_$PIECE(ACGDT2,U)_U_$PIECE(ACGDT,U)
SET ACGTD=ACGTD+$PIECE(ACGDT1,U,5)-$PIECE(ACGDT2,U)
SET ACGTI=ACGTI+$PIECE(ACGDT2,U)
End DoDot:1
+9 SET ACGTOTD=ACGTOTD+ACGTD
SET ACGTOTI=ACGTOTI+ACGTI
SET ACGTOTDT=ACGTOTDT+ACGTD
SET ACGTOTIT=ACGTOTIT+ACGTI
+10 IF $Y>(IOSL-5-ACGJ)
SET DC=$GET(DC)+1
WRITE @IOF,!?60,"PAGE: ",DC,!,$PIECE(^ACGS(D0,"DT"),U,2)," (CON'T)"
+11 IF ACGI=3
WRITE !!?25,"MOD #",?32,"TYPE",?39,"AMOUNT",?54,"DATE",?68,"INDIRECT",!?25,"-----",?32,"----",?39,"-----------",?54,"--------",?68,"-----------"
+12 IF ACGI=3
SET (ACGI,ACG)=0
FOR
SET ACG=$ORDER(ACG(ACG))
IF 'ACG
QUIT
Begin DoDot:1
+13 WRITE !?26,ACG,?33,$PIECE(^ACGTPA($PIECE(ACG(ACG),U,4),0),U),?39,$JUSTIFY($FNUMBER($PIECE(ACG(ACG),U),"P,",0),12)
IF $PIECE(ACG(ACG),U,2)?7N
WRITE ?54,$EXTRACT($PIECE(ACG(ACG),U,2),4,5),"/",$EXTRACT($PIECE(ACG(ACG),U,2),6,7),"/",$EXTRACT($PIECE(ACG(ACG),U,2),2,3)
WRITE ?68,$JUSTIFY($FNUMBER($PIECE(ACG(ACG),U,3),"P,",0),12)
End DoDot:1
+14 WRITE !!?30,"TOTAL AMOUNT",?45,"TOTAL DIRECT",?60,"TOTAL INDIR",!?30,"------------",?45,"------------",?60,"------------",!?30,$JUSTIFY($FNUMBER((ACGTD+ACGTI),"P,",0),12),?45,$JUSTIFY($FNUMBER(ACGTD,"P,",0),12),?60,$JUSTIFY($FNUMBER(ACGTI,"P,",
0),12)
+15 SET (ACGTD,ACGTI)=0
+16 QUIT
TAIL ;EP;
+1 WRITE !!?18,"TOTALS FOR: ",ACGRPT
+2 IF '$DATA(ACGTOTD)
SET (ACGTOTD,ACGTOTI)=0
+3 WRITE !?30,"TOTAL AMOUNT",?45,"TOTAL DIRECT",?60,"TOTAL INDIRECT",!?30,"------------",?45,"------------",?60,"------------",!?30,$JUSTIFY($FNUMBER((ACGTOTD+ACGTOTI),"P,",0),12),?45,$JUSTIFY($FNUMBER(ACGTOTD,"P,",0),12),?60,$JUSTIFY(...
... $FNUMBER(ACGTOTI,"P,",0),12)
+4 SET (ACGTOTD,ACGTOTI)=0
+5 IF $DATA(IOST)
IF $EXTRACT(IOST,1,2)["C-"
DO HOLD^ACGSMENU
+6 QUIT
TOTAL WRITE !!?18,"TOTALS FOR PROCUREMENT OFFICE: ",$SELECT($DATA(ACG4N):ACG4N,1:ACG4)
+1 IF '$DATA(ACGTOTDT)
SET (ACGTOTDT,ACGTOTIT)=0
+2 WRITE !?30,"TOTAL AMOUNT",?45,"TOTAL DIRECT",?60,"TOTAL INDIRECT",!?30,"------------",?45,"------------",?60,"------------",!?30,$JUSTIFY($FNUMBER((ACGTOTDT+ACGTOTIT),"P,",0),12),?45,$JUSTIFY($FNUMBER(ACGTOTDT,"P,",0),12),?60,...
... $JUSTIFY($FNUMBER(ACGTOTIT,"P,",0),12)
+3 SET (ACGTOTDT,ACGTOTIT)=0
+4 IF $DATA(IOST)
IF $EXTRACT(IOST,1,2)["C-"
DO HOLD^ACGSMENU
+5 QUIT
ADHOC ;EP
+1 IF $EXTRACT(IOST,1,2)="C-"
DO HOLD^ACGSMENU
+2 IF $DATA(ACGQUIT)
KILL ACGQUIT
QUIT
+3 SET (ACGX,ACGRDAM)=D0
+4 FOR
SET ACGRDAM=$ORDER(^ACGS("C",ACGX,ACGRDAM))
IF 'ACGRDAM
QUIT
KILL DXS,DIP
SET D0=ACGRDAM
SET ACGDC(1)=$GET(ACGDC(1))+1
DO ^ACGPTCS
KILL DXS,DIP
IF $EXTRACT(IOST,1,2)="C-"
DO HOLD^ACGSMENU
IF $DATA(ACGQUIT)
KILL ACGQUIT
QUIT
+5 KILL ACGRDAM
+6 SET D0=ACGX
+7 QUIT
+8 ;
