ACRFEVAX ;IHS/OIRM/DSD/THL,AEF - EVALUATE QUOTES; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;EVALUATE QUOTES
EN D EN1
EXIT K ACR,ACRVEND,ACRVND,ACRITEM,ACRTSIDA,ACRPO1,ACRAMT,ACRTOP,ACRTSI,ACRQUIT,ACROUT,ACRMODE,ACRJ,ACRN1,ACRPID,ACR843,ACRDETL,ACRXAMT,ACRIAMT,ACRSS,ACRPID1,ACRN11,ACRQUAN,ACRSEG,ACRUI,ACRVDA,ACRCOST,ACRCOUNT,ACRDESC,ACRDT,ACRMAX,ACRN11,ACRSEQ
K ACRAMX
Q
EN1 ;
D COUNT^ACRFEVX1,MODE^ACRFEVX1
Q:$D(ACRQUIT)!$D(ACROUT)
D @ACRMODE
Q
VENDOR ;ORDER QUOTES BY PRICE FOR EACH VENDOR
K ACRVND
S ACRTSIDA=$O(^ACREDI("B",843,0))
Q:'ACRTSIDA
S (ACRDT,ACRI)=0
F S ACRDT=$O(^ACREDII("AA",ACRDOCDA,ACRTSIDA,ACRDT)) Q:'ACRDT D
.S ACRSEQ=0
.F S ACRSEQ=$O(^ACREDII("AA",ACRDOCDA,ACRTSIDA,ACRDT,ACRSEQ)) Q:'ACRSEQ D
..S (ACR,ACRN11,ACRPID1,ACRMAX)=0
..F S ACR=$O(^ACREDII("AA",ACRDOCDA,ACRTSIDA,ACRDT,ACRSEQ,ACR)) Q:'ACR S X=$G(^ACREDII(ACR,1)) D:X]""
...S ACRSEG=$P(X,U)
...I ACRSEG="N1",ACRN11=0 D
....S ACRVENDR=$P(X,U,3)
....S ACRN11=ACRN11+1
....S ACRAMT=0
...I ACRSEG="PID",ACRPID1=0 D
....S ACRPID=$P(X,U,3)
....S ACRPID1=ACRPID1+1
....S ACRDESC=$P(X,U,6)
...S ACRI=ACRI+1
...S ^TMP("ACREDII",$J,ACRSEQ,ACRI,ACRSEG)=X
...S ACRJ=ACRSEQ
...I ACRSEG="PO1" S ACRPO1=X D
....S ACRMAX=ACRMAX+1
....S ACRQUAN=$P(ACRPO1,U,3)
....S ACRCOST=$P(ACRPO1,U,5)
....S ACRUI=$P(ACRPO1,U,4)
....S ACRAMT=ACRAMT+(ACRQUAN*ACRCOST)
....S ACRITEM(ACRVENDR,$P(ACRPO1,U,2),ACRSEQ)=ACRAMT_U_ACRQUAN_U_ACRUI_U_ACRCOST
...I ACRSEG="PID" S ACRPID=X D
....S $P(ACRITEM(ACRVENDR,$P(ACRPO1,U,2),ACRSEQ),U,5)=$P(ACRPID,U,6)
..S ACRVND(ACRAMT,ACRVENDR)=ACRMAX
..S ACRVEND(ACRSEQ,ACRVENDR)=ACRAMT
Q:'$D(ACRVND)
D TOP^ACRFEVX1
Q:$D(ACRQUIT)!$D(ACROUT)
D VDISPLAY
Q
ITEM ;ORDER QUOTES BY PRICE FOR EACH ITEM
K ACRITEM
S (ACRTSIDA,ACRJ,ACRMAX)=0
F S ACRTSIDA=$O(^ACRI843I("AA",ACRDOCDA,ACRTSIDA)) Q:'ACRTSIDA!$D(ACRQUIT)!$D(ACROUT) D
.S ACRJ=ACRJ+1
.S ACRN1=$G(^ACRI843(ACRTSIDA,"N1",1,"N1"))
.S ACRVENDR=$P(ACRN1,U,2)
.S ACR843DA=0
.F S ACR843DA=$O(^ACRI843I("AA",ACRDOCDA,ACRTSIDA,ACR843DA)) Q:'ACR843DA!$D(ACRQUIT)!$D(ACROUT) D
..S ACR843=$G(^ACRI843I(ACR843DA,0))
..S ACRPO1=$G(^ACRI843I(ACR843DA,"PO1"))
..S ACRQUAN=$P(ACRPO1,U,2)
..S ACRCOST=$P(ACRPO1,U,4)
..S ACRUI=$P(ACRPO1,U,3)
..S ACRAMT=$P(ACRPO1,U,2)*$P(ACRPO1,U,4)
..S ACRPID=$G(^ACRI843I(ACR843DA,"PID",1,"PID"))
..S ACRDESC=$P(ACRPID,U,5)
..S ACRITEM(+ACRPO1,ACRAMT,ACR843DA)=ACRVENDR_U_ACRQUAN_U_ACRUI_U_ACRCOST_U_ACRDESC
..S:+ACRPO1>ACRMAX ACRMAX=+ACRPO1
Q:'$D(ACRITEM)
D TOP^ACRFEVX1
Q:$D(ACRQUIT)!$D(ACROUT)
D IDISPLAY
Q
VDISPLAY ;DISPLAY VENDORS IN PRICE ORDER
I $D(ACRDETL) D I $D(ACROUT)!$D(ACRQUIT) K ACRQUIT Q
.S DIR(0)="NO^1:"_ACRJ
.S DIR("A")="Review selected Vendor"
.W !
.D DIR^ACRFDIC
.K ACRQUIT
.Q:$D(ACROUT)
.I +Y D
.S ACRI=+Y
.S ACRVND=$O(ACRVEND(ACRI,""))
.I ACRVND]"" D
..S ACRAMT=ACRVEND(ACRI,ACRVND)
..D VD
..S ACRQUIT=""
D VHEAD^ACRFEVX1
S (ACRAMT,ACRI)=0
F ACRJ=1:1 S ACRAMT=$O(ACRVND(ACRAMT)) Q:'ACRAMT!$D(ACRQUIT)!$D(ACROUT)!(ACRJ>ACRTOP) D
.S ACRVND=""
.F S ACRVND=$O(ACRVND(ACRAMT,ACRVND)) Q:ACRVND=""!$D(ACRQUIT)!$D(ACROUT) D
..S ACRI=ACRI+1
..S ACRAMX=+ACRVND(ACRAMT,ACRVND)
..D VD
D PAUSE^ACRFWARN
Q
VD D:$D(ACRDETL) VHEAD^ACRFEVX1
W !?10,ACRI
W ?13,$S(ACRCOUNT>ACRMAX:"**",1:"")
W ?15,ACRVND
W ?50,$J($FN(ACRAMT,"P",2),14)
I $D(ACRDETL) D
.S ACRXAMT=ACRAMT
.S ACRSS=0
.F ACRK=1:1 S ACRSS=$O(ACRITEM(ACRVENDR,ACRSS)) Q:'ACRSS!$D(ACRQUIT) D
..S ACR843DA=0
..F S ACR843DA=$O(ACRITEM(ACRVENDR,ACRSS,ACR843DA)) Q:'ACR843DA!$D(ACRQUIT) D
...S X=ACRITEM(ACRVENDR,ACRSS,ACR843DA)
...S ACRAMT=+X
...D IDW
..I ACRK#5=0 D PAUSE^ACRFWARN
.S ACRAMT=ACRXAMT
.D PAUSE^ACRFWARN
I '$D(ACRDETL),IOSL-4<$Y D PAUSE^ACRFWARN
Q
IDISPLAY ;DISPLAY ITEMS IN PRICE ORDER
S DIR(0)="NO^1:"_ACRMAX
S DIR("A")="Review selected item"
W !
D DIR^ACRFDIC
K ACRQUIT
Q:$D(ACROUT)
I +Y S ACRI=+Y D ID Q
D IHEAD^ACRFEVX1
S (ACRI,ACRX)=0
F S ACRI=$O(ACRITEM(ACRI)) Q:'ACRI!$D(ACRQUIT)!$D(ACROUT) D ID
Q
ID D IHEAD^ACRFEVX1
S ACRAMT=0
F ACRJ=1:1 S ACRAMT=$O(ACRITEM(ACRI,ACRAMT)) Q:'ACRAMT!$D(ACRQUIT)!$D(ACROUT)!(ACRJ>ACRTOP) D
.S ACR843DA=0
.F S ACR843DA=$O(ACRITEM(ACRI,ACRAMT,ACR843DA)) Q:'ACR843DA!$D(ACRQUIT)!$D(ACROUT) D
..S X=ACRITEM(ACRI,ACRAMT,ACR843DA)
..S ACRQUAN=$P(X,U,2)
..S ACRUI=$P(X,U,3)
..S ACRCOST=$P(X,U,4)
..S ACRDESC=$E($P(X,U,5),1,75)
..D IDW
..I IOSL-4<$Y D PAUSE^ACRFWARN
D PAUSE^ACRFWARN
Q:$D(ACRQUIT)!$D(ACROUT)
D IHEAD^ACRFEVX1
Q
IDW ;WRITE ITEM
S:'$D(ACRDETL) ACRVENDR=$E($P(X,U),1,30)
S ACRQUAN=$P(X,U,2)
S ACRUI=$P(X,U,3)
S ACRCOST=$P(X,U,4)
S ACRDESC=$E($P(X,U,5),1,75)
W !,$S('$D(ACRDETL):ACRI,1:ACRSS)
W ?4,ACRDESC
W !?4,ACRVENDR
W ?46,$J(ACRQUAN,7)
W ?56,ACRUI
W ?68,$J($FN(ACRAMT,"P",2),12)
Q
ACRFEVAX ;IHS/OIRM/DSD/THL,AEF - EVALUATE QUOTES; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;EVALUATE QUOTES
EN DO EN1
EXIT KILL ACR,ACRVEND,ACRVND,ACRITEM,ACRTSIDA,ACRPO1,ACRAMT,ACRTOP,ACRTSI,ACRQUIT,ACROUT,ACRMODE,ACRJ,ACRN1,ACRPID,ACR843,ACRDETL,ACRXAMT,ACRIAMT,ACRSS,ACRPID1,ACRN11,ACRQUAN,ACRSEG,ACRUI,ACRVDA,ACRCOST,ACRCOUNT,ACRDESC,ACRDT,ACRMAX,ACRN11,ACRSEQ
+1 KILL ACRAMX
+2 QUIT
EN1 ;
+1 DO COUNT^ACRFEVX1
DO MODE^ACRFEVX1
+2 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+3 DO @ACRMODE
+4 QUIT
VENDOR ;ORDER QUOTES BY PRICE FOR EACH VENDOR
+1 KILL ACRVND
+2 SET ACRTSIDA=$ORDER(^ACREDI("B",843,0))
+3 IF 'ACRTSIDA
QUIT
+4 SET (ACRDT,ACRI)=0
+5 FOR
SET ACRDT=$ORDER(^ACREDII("AA",ACRDOCDA,ACRTSIDA,ACRDT))
IF 'ACRDT
QUIT
Begin DoDot:1
+6 SET ACRSEQ=0
+7 FOR
SET ACRSEQ=$ORDER(^ACREDII("AA",ACRDOCDA,ACRTSIDA,ACRDT,ACRSEQ))
IF 'ACRSEQ
QUIT
Begin DoDot:2
+8 SET (ACR,ACRN11,ACRPID1,ACRMAX)=0
+9 FOR
SET ACR=$ORDER(^ACREDII("AA",ACRDOCDA,ACRTSIDA,ACRDT,ACRSEQ,ACR))
IF 'ACR
QUIT
SET X=$GET(^ACREDII(ACR,1))
IF X]""
Begin DoDot:3
+10 SET ACRSEG=$PIECE(X,U)
+11 IF ACRSEG="N1"
IF ACRN11=0
Begin DoDot:4
+12 SET ACRVENDR=$PIECE(X,U,3)
+13 SET ACRN11=ACRN11+1
+14 SET ACRAMT=0
End DoDot:4
+15 IF ACRSEG="PID"
IF ACRPID1=0
Begin DoDot:4
+16 SET ACRPID=$PIECE(X,U,3)
+17 SET ACRPID1=ACRPID1+1
+18 SET ACRDESC=$PIECE(X,U,6)
End DoDot:4
+19 SET ACRI=ACRI+1
+20 SET ^TMP("ACREDII",$JOB,ACRSEQ,ACRI,ACRSEG)=X
+21 SET ACRJ=ACRSEQ
+22 IF ACRSEG="PO1"
SET ACRPO1=X
Begin DoDot:4
+23 SET ACRMAX=ACRMAX+1
+24 SET ACRQUAN=$PIECE(ACRPO1,U,3)
+25 SET ACRCOST=$PIECE(ACRPO1,U,5)
+26 SET ACRUI=$PIECE(ACRPO1,U,4)
+27 SET ACRAMT=ACRAMT+(ACRQUAN*ACRCOST)
+28 SET ACRITEM(ACRVENDR,$PIECE(ACRPO1,U,2),ACRSEQ)=ACRAMT_U_ACRQUAN_U_ACRUI_U_ACRCOST
End DoDot:4
+29 IF ACRSEG="PID"
SET ACRPID=X
Begin DoDot:4
+30 SET $PIECE(ACRITEM(ACRVENDR,$PIECE(ACRPO1,U,2),ACRSEQ),U,5)=$PIECE(ACRPID,U,6)
End DoDot:4
End DoDot:3
+31 SET ACRVND(ACRAMT,ACRVENDR)=ACRMAX
+32 SET ACRVEND(ACRSEQ,ACRVENDR)=ACRAMT
End DoDot:2
End DoDot:1
+33 IF '$DATA(ACRVND)
QUIT
+34 DO TOP^ACRFEVX1
+35 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+36 DO VDISPLAY
+37 QUIT
ITEM ;ORDER QUOTES BY PRICE FOR EACH ITEM
+1 KILL ACRITEM
+2 SET (ACRTSIDA,ACRJ,ACRMAX)=0
+3 FOR
SET ACRTSIDA=$ORDER(^ACRI843I("AA",ACRDOCDA,ACRTSIDA))
IF 'ACRTSIDA!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:1
+4 SET ACRJ=ACRJ+1
+5 SET ACRN1=$GET(^ACRI843(ACRTSIDA,"N1",1,"N1"))
+6 SET ACRVENDR=$PIECE(ACRN1,U,2)
+7 SET ACR843DA=0
+8 FOR
SET ACR843DA=$ORDER(^ACRI843I("AA",ACRDOCDA,ACRTSIDA,ACR843DA))
IF 'ACR843DA!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:2
+9 SET ACR843=$GET(^ACRI843I(ACR843DA,0))
+10 SET ACRPO1=$GET(^ACRI843I(ACR843DA,"PO1"))
+11 SET ACRQUAN=$PIECE(ACRPO1,U,2)
+12 SET ACRCOST=$PIECE(ACRPO1,U,4)
+13 SET ACRUI=$PIECE(ACRPO1,U,3)
+14 SET ACRAMT=$PIECE(ACRPO1,U,2)*$PIECE(ACRPO1,U,4)
+15 SET ACRPID=$GET(^ACRI843I(ACR843DA,"PID",1,"PID"))
+16 SET ACRDESC=$PIECE(ACRPID,U,5)
+17 SET ACRITEM(+ACRPO1,ACRAMT,ACR843DA)=ACRVENDR_U_ACRQUAN_U_ACRUI_U_ACRCOST_U_ACRDESC
+18 IF +ACRPO1>ACRMAX
SET ACRMAX=+ACRPO1
End DoDot:2
End DoDot:1
+19 IF '$DATA(ACRITEM)
QUIT
+20 DO TOP^ACRFEVX1
+21 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+22 DO IDISPLAY
+23 QUIT
VDISPLAY ;DISPLAY VENDORS IN PRICE ORDER
+1 IF $DATA(ACRDETL)
Begin DoDot:1
+2 SET DIR(0)="NO^1:"_ACRJ
+3 SET DIR("A")="Review selected Vendor"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 KILL ACRQUIT
+7 IF $DATA(ACROUT)
QUIT
+8 IF +Y
Begin DoDot:2
End DoDot:2
+9 SET ACRI=+Y
+10 SET ACRVND=$ORDER(ACRVEND(ACRI,""))
+11 IF ACRVND]""
Begin DoDot:2
+12 SET ACRAMT=ACRVEND(ACRI,ACRVND)
+13 DO VD
+14 SET ACRQUIT=""
End DoDot:2
End DoDot:1
IF $DATA(ACROUT)!$DATA(ACRQUIT)
KILL ACRQUIT
QUIT
+15 DO VHEAD^ACRFEVX1
+16 SET (ACRAMT,ACRI)=0
+17 FOR ACRJ=1:1
SET ACRAMT=$ORDER(ACRVND(ACRAMT))
IF 'ACRAMT!$DATA(ACRQUIT)!$DATA(ACROUT)!(ACRJ>ACRTOP)
QUIT
Begin DoDot:1
+18 SET ACRVND=""
+19 FOR
SET ACRVND=$ORDER(ACRVND(ACRAMT,ACRVND))
IF ACRVND=""!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:2
+20 SET ACRI=ACRI+1
+21 SET ACRAMX=+ACRVND(ACRAMT,ACRVND)
+22 DO VD
End DoDot:2
End DoDot:1
+23 DO PAUSE^ACRFWARN
+24 QUIT
VD IF $DATA(ACRDETL)
DO VHEAD^ACRFEVX1
+1 WRITE !?10,ACRI
+2 WRITE ?13,$SELECT(ACRCOUNT>ACRMAX:"**",1:"")
+3 WRITE ?15,ACRVND
+4 WRITE ?50,$JUSTIFY($FNUMBER(ACRAMT,"P",2),14)
+5 IF $DATA(ACRDETL)
Begin DoDot:1
+6 SET ACRXAMT=ACRAMT
+7 SET ACRSS=0
+8 FOR ACRK=1:1
SET ACRSS=$ORDER(ACRITEM(ACRVENDR,ACRSS))
IF 'ACRSS!$DATA(ACRQUIT)
QUIT
Begin DoDot:2
+9 SET ACR843DA=0
+10 FOR
SET ACR843DA=$ORDER(ACRITEM(ACRVENDR,ACRSS,ACR843DA))
IF 'ACR843DA!$DATA(ACRQUIT)
QUIT
Begin DoDot:3
+11 SET X=ACRITEM(ACRVENDR,ACRSS,ACR843DA)
+12 SET ACRAMT=+X
+13 DO IDW
End DoDot:3
+14 IF ACRK#5=0
DO PAUSE^ACRFWARN
End DoDot:2
+15 SET ACRAMT=ACRXAMT
+16 DO PAUSE^ACRFWARN
End DoDot:1
+17 IF '$DATA(ACRDETL)
IF IOSL-4<$Y
DO PAUSE^ACRFWARN
+18 QUIT
IDISPLAY ;DISPLAY ITEMS IN PRICE ORDER
+1 SET DIR(0)="NO^1:"_ACRMAX
+2 SET DIR("A")="Review selected item"
+3 WRITE !
+4 DO DIR^ACRFDIC
+5 KILL ACRQUIT
+6 IF $DATA(ACROUT)
QUIT
+7 IF +Y
SET ACRI=+Y
DO ID
QUIT
+8 DO IHEAD^ACRFEVX1
+9 SET (ACRI,ACRX)=0
+10 FOR
SET ACRI=$ORDER(ACRITEM(ACRI))
IF 'ACRI!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
DO ID
+11 QUIT
ID DO IHEAD^ACRFEVX1
+1 SET ACRAMT=0
+2 FOR ACRJ=1:1
SET ACRAMT=$ORDER(ACRITEM(ACRI,ACRAMT))
IF 'ACRAMT!$DATA(ACRQUIT)!$DATA(ACROUT)!(ACRJ>ACRTOP)
QUIT
Begin DoDot:1
+3 SET ACR843DA=0
+4 FOR
SET ACR843DA=$ORDER(ACRITEM(ACRI,ACRAMT,ACR843DA))
IF 'ACR843DA!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:2
+5 SET X=ACRITEM(ACRI,ACRAMT,ACR843DA)
+6 SET ACRQUAN=$PIECE(X,U,2)
+7 SET ACRUI=$PIECE(X,U,3)
+8 SET ACRCOST=$PIECE(X,U,4)
+9 SET ACRDESC=$EXTRACT($PIECE(X,U,5),1,75)
+10 DO IDW
+11 IF IOSL-4<$Y
DO PAUSE^ACRFWARN
End DoDot:2
End DoDot:1
+12 DO PAUSE^ACRFWARN
+13 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+14 DO IHEAD^ACRFEVX1
+15 QUIT
IDW ;WRITE ITEM
+1 IF '$DATA(ACRDETL)
SET ACRVENDR=$EXTRACT($PIECE(X,U),1,30)
+2 SET ACRQUAN=$PIECE(X,U,2)
+3 SET ACRUI=$PIECE(X,U,3)
+4 SET ACRCOST=$PIECE(X,U,4)
+5 SET ACRDESC=$EXTRACT($PIECE(X,U,5),1,75)
+6 WRITE !,$SELECT('$DATA(ACRDETL):ACRI,1:ACRSS)
+7 WRITE ?4,ACRDESC
+8 WRITE !?4,ACRVENDR
+9 WRITE ?46,$JUSTIFY(ACRQUAN,7)
+10 WRITE ?56,ACRUI
+11 WRITE ?68,$JUSTIFY($FNUMBER(ACRAMT,"P",2),12)
+12 QUIT
