- ACGSVCTR ;IHS/OIRM/DSD/THL,AEF - LOOKUP CONTRACT NUMBER FOR ITEM VENDOR; [ 03/27/2000 2:22 PM ]
- ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
- ;;ROUTINE TO LOOKUP CONTRACT NUMBER FOR ITEM VENDOR
- ;;renovated for y2k 1/31/2000;mlp
- EN D EN1
- EXIT K ACGJ
- Q
- EN1 K ACGCNO
- S ACGXREF=$S(ACG4'=236:"H",1:"O")
- I '$D(^ACGS(ACGXREF,ACG5DA)) W !?10,"NO CONTRACTS ON FILE FOR ",$S(ACGXREF'=236:$P(^AUTTVNDR(ACG5DA,0),U),1:ACG5DA) H 2 S:'$D(ACGNEW) ACGQUIT="" Q
- D DISPLAY,SELECT:ACGJ&'$D(ACGNC)
- I 'ACGJ S ACGQUIT="" W !?10,"NO CONTRACTS ON FILE FOR ",$S(ACGXREF'=236:$P(^AUTTVNDR(ACG5DA,0),U),1:ACG5DA) H 2
- Q
- DISPLAY D HEAD
- S (ACG,ACGJ)=0
- F S ACG=$O(^ACGS(ACGXREF,ACG5DA,ACG)) Q:'ACG!$D(ACGQUIT) I $D(^ACGS(ACG,0)),$D(^("DT")),$D(^("DT1")) D
- .I ACG=$P(^ACGS(ACG,0),U,3) S ACG0=^(0),ACGDT=$G(^("DT")),ACGDT1=$G(^("DT1")),ACGSP=$G(^("SP")) D
- ..S ACGX=$P(ACGDT,U,2)_U_$P(ACGDT1,U,3,5)_U_$S("^15^17^"'[(U_+ACGDT_U):$P(ACGDT1,U),1:"SMALL PURCHASE")_U_$P(ACGDT1,U,2)_U_$P(ACG0,U,3)_U D DISP
- K ACGQUIT
- Q
- SELECT I ACGJ=1 S Y=1 D SEL1 Q
- S DIR(0)="NO^1:"_ACGJ,DIR("A")="Which contract"
- W !
- D DIR^ACGSDIC
- Q:$D(ACGQUIT)
- SEL1 ;S (ACGX,ACGCNO)=ACGX(Y),ACG22=$P(ACGCNO,U,5),ACG23=$E($P(ACGCNO,U,6),2,7),ACG24=$E($P(ACGCNO,U,2),2,7),ACG25=$E($P(ACGCNO,U,3),2,7),ACGCDA=$P(ACGCNO,U,10),ACGCNO=$P(ACGCNO,U,7)
- S (ACGX,ACGCNO)=ACGX(Y),ACG22=$P(ACGCNO,U,5),ACG23=$E($P(ACGCNO,U,6),1,7),ACG24=$E($P(ACGCNO,U,2),1,7),ACG25=$E($P(ACGCNO,U,3),1,7),ACGCDA=$P(ACGCNO,U,10),ACGCNO=$P(ACGCNO,U,7) ;y2k;mlp
- Q
- DISP S ACGB=$P(ACGX,U,2)
- S ACGE=$P(ACGX,U,3)
- S:ACGB'="" ACGB=$E(ACGB,4,5)_"/"_$E(ACGB,6,7)_"/"_$E(ACGB,2,3)
- S:ACGE'="" ACGE=$E(ACGE,4,5)_"/"_$E(ACGE,6,7)_"/"_$E(ACGE,2,3)
- S ACGJ=ACGJ+1,ACGX(ACGJ)=ACGX
- W W !,ACGJ,?3,$P(ACGX,U),?19,ACGB,?28,ACGE,?37,$J($FN($P(ACGX,U,4),"P",0),12),?50,$E($P(ACGX,U,5),1,30)
- D:ACGJ#20=0 HOLD^ACGSMENU
- Q
- DIR D ^DIR S:$D(DIRUT) ACGQUIT="" K DIR,DIRUT,DUOUT,DTOUT Q
- HEAD I ACG4'=236 D
- .W:$D(IOF) @IOF W "CONTRACTOR: ",@ACGON,$P(^AUTTVNDR(ACG5DA,0),U),@ACGOF W !!,"# CONTRACT NO.",?20,"BEGIN",?30,"END",?40,"AMOUNT",?59,"DESCRIPTION",!,"-- --------------- -------- -------- ------------ ------------------------------"
- I ACG4=236 D
- .W:$D(IOF) @IOF W "CONTRACTOR: ",@ACGON,ACG5DA,@ACGOF W !!,"# CONTRACT NO.",?20,"BEGIN",?30,"END",?40,"AMOUNT",?59,"DESCRIPTION",!,"-- --------------- -------- -------- ------------ ------------------------------"
- Q
- ACGSVCTR ;IHS/OIRM/DSD/THL,AEF - LOOKUP CONTRACT NUMBER FOR ITEM VENDOR; [ 03/27/2000 2:22 PM ]
- +1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
- +2 ;;ROUTINE TO LOOKUP CONTRACT NUMBER FOR ITEM VENDOR
- +3 ;;renovated for y2k 1/31/2000;mlp
- EN DO EN1
- EXIT KILL ACGJ
- +1 QUIT
- EN1 KILL ACGCNO
- +1 SET ACGXREF=$SELECT(ACG4'=236:"H",1:"O")
- +2 IF '$DATA(^ACGS(ACGXREF,ACG5DA))
- WRITE !?10,"NO CONTRACTS ON FILE FOR ",$SELECT(ACGXREF'=236:$PIECE(^AUTTVNDR(ACG5DA,0),U),1:ACG5DA)
- HANG 2
- IF '$DATA(ACGNEW)
- SET ACGQUIT=""
- QUIT
- +3 DO DISPLAY
- IF ACGJ&'$DATA(ACGNC)
- DO SELECT
- +4 IF 'ACGJ
- SET ACGQUIT=""
- WRITE !?10,"NO CONTRACTS ON FILE FOR ",$SELECT(ACGXREF'=236:$PIECE(^AUTTVNDR(ACG5DA,0),U),1:ACG5DA)
- HANG 2
- +5 QUIT
- DISPLAY DO HEAD
- +1 SET (ACG,ACGJ)=0
- +2 FOR
- SET ACG=$ORDER(^ACGS(ACGXREF,ACG5DA,ACG))
- IF 'ACG!$DATA(ACGQUIT)
- QUIT
- IF $DATA(^ACGS(ACG,0))
- IF $DATA(^("DT"))
- IF $DATA(^("DT1"))
- Begin DoDot:1
- +3 IF ACG=$PIECE(^ACGS(ACG,0),U,3)
- SET ACG0=^(0)
- SET ACGDT=$GET(^("DT"))
- SET ACGDT1=$GET(^("DT1"))
- SET ACGSP=$GET(^("SP"))
- Begin DoDot:2
- +4 SET ACGX=$PIECE(ACGDT,U,2)_U_$PIECE(ACGDT1,U,3,5)_U_$SELECT("^15^17^"'[(U_+ACGDT_U):$PIECE(ACGDT1,U),1:"SMALL PURCHASE")_U_$PIECE(ACGDT1,U,2)_U_$PIECE(ACG0,U,3)_U
- DO DISP
- End DoDot:2
- End DoDot:1
- +5 KILL ACGQUIT
- +6 QUIT
- SELECT IF ACGJ=1
- SET Y=1
- DO SEL1
- QUIT
- +1 SET DIR(0)="NO^1:"_ACGJ
- SET DIR("A")="Which contract"
- +2 WRITE !
- +3 DO DIR^ACGSDIC
- +4 IF $DATA(ACGQUIT)
- QUIT
- SEL1 ;S (ACGX,ACGCNO)=ACGX(Y),ACG22=$P(ACGCNO,U,5),ACG23=$E($P(ACGCNO,U,6),2,7),ACG24=$E($P(ACGCNO,U,2),2,7),ACG25=$E($P(ACGCNO,U,3),2,7),ACGCDA=$P(ACGCNO,U,10),ACGCNO=$P(ACGCNO,U,7)
- +1 ;y2k;mlp
- SET (ACGX,ACGCNO)=ACGX(Y)
- SET ACG22=$PIECE(ACGCNO,U,5)
- SET ACG23=$EXTRACT($PIECE(ACGCNO,U,6),1,7)
- SET ACG24=$EXTRACT($PIECE(ACGCNO,U,2),1,7)
- SET ACG25=$EXTRACT($PIECE(ACGCNO,U,3),1,7)
- SET ACGCDA=$PIECE(ACGCNO,U,10)
- SET ACGCNO=$PIECE(ACGCNO,U,7)
- +2 QUIT
- DISP SET ACGB=$PIECE(ACGX,U,2)
- +1 SET ACGE=$PIECE(ACGX,U,3)
- +2 IF ACGB'=""
- SET ACGB=$EXTRACT(ACGB,4,5)_"/"_$EXTRACT(ACGB,6,7)_"/"_$EXTRACT(ACGB,2,3)
- +3 IF ACGE'=""
- SET ACGE=$EXTRACT(ACGE,4,5)_"/"_$EXTRACT(ACGE,6,7)_"/"_$EXTRACT(ACGE,2,3)
- +4 SET ACGJ=ACGJ+1
- SET ACGX(ACGJ)=ACGX
- W WRITE !,ACGJ,?3,$PIECE(ACGX,U),?19,ACGB,?28,ACGE,?37,$JUSTIFY($FNUMBER($PIECE(ACGX,U,4),"P",0),12),?50,$EXTRACT($PIECE(ACGX,U,5),1,30)
- +1 IF ACGJ#20=0
- DO HOLD^ACGSMENU
- +2 QUIT
- DIR DO ^DIR
- IF $DATA(DIRUT)
- SET ACGQUIT=""
- KILL DIR,DIRUT,DUOUT,DTOUT
- QUIT
- HEAD IF ACG4'=236
- Begin DoDot:1
- +1 IF $DATA(IOF)
- WRITE @IOF
- WRITE "CONTRACTOR: ",@ACGON,$PIECE(^AUTTVNDR(ACG5DA,0),U),@ACGOF
- WRITE !!,"# CONTRACT NO.",?20,"BEGIN",?30,"END",?40,"AMOUNT",?59,"DESCRIPTION",!,"-- --------------- -------- -------- ------------ ------------------------------"
- End DoDot:1
- +2 IF ACG4=236
- Begin DoDot:1
- +3 IF $DATA(IOF)
- WRITE @IOF
- WRITE "CONTRACTOR: ",@ACGON,ACG5DA,@ACGOF
- WRITE !!,"# CONTRACT NO.",?20,"BEGIN",?30,"END",?40,"AMOUNT",?59,"DESCRIPTION",!,"-- --------------- -------- -------- ------------ ------------------------------"
- End DoDot:1
- +4 QUIT
