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
