- 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 ;