ACRFEVAL ;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,ACRVND,ACRITEM,ACRTSIDA,ACR843DA,ACR843,ACRPO1,ACRAMT,ACRTOP,ACRTSI,ACRQUIT,ACROUT,ACRMODE,ACRJ,ACRN1,ACRPID,ACR843,ACRDETL,ACRXAMT,ACRIAMT,ACRSS,ACRVENDR
Q
EN1 ;
D COUNT^ACRFEVA1
D MODE^ACRFEVA1
Q:$D(ACRQUIT)!$D(ACROUT)
D @ACRMODE
Q
VENDOR ;ORDER QUOTES BY PRICE FOR EACH VENDOR
K ACRVND
S (ACRTSIDA,ACRJ)=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 (ACR843DA,ACRAMT)=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 ACRPID=$G(^ACRI843I(ACR843DA,"PID",1,"PID"))
..S ACRQUAN=$P(ACRPO1,U,2)
..S ACRCOST=$P(ACRPO1,U,4)
..S ACRUI=$P(ACRPO1,U,3)
..S ACRDESC=$P(ACRPID,U,5)
..S ACRAMT=ACRAMT+(ACRQUAN*ACRCOST)
..S ACRVENDR=$P(ACRN1,U,2)
..Q:'$D(ACRDETL)
..S ACRITEM(ACRVENDR,+ACRPO1,ACR843DA)=(ACRQUAN*ACRCOST)_U_ACRQUAN_U_ACRUI_U_ACRCOST_U_ACRDESC
.S ACRVND(ACRAMT,ACRVENDR)=""
.S ACRVEND(ACRJ,ACRVENDR)=ACRAMT
Q:'$D(ACRVND)
D TOP^ACRFEVA1
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^ACRFEVA1
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 S ACRI=+Y,ACRVND=$O(ACRVEND(ACRI,"")) I ACRVND]"" D
..S ACRAMT=ACRVEND(ACRI,ACRVND)
..D VD
..S ACRQUIT=""
D VHEAD^ACRFEVA1
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:$D(ACRDETL) ACRVENDR=ACRVND
..D VD
D PAUSE^ACRFWARN
Q
VD D:$D(ACRDETL) VHEAD^ACRFEVA1
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#10=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^ACRFEVA1
S (ACRI,ACRX)=0
F S ACRI=$O(ACRITEM(ACRI)) Q:'ACRI!$D(ACRQUIT)!$D(ACROUT) D ID
Q
ID D IHEAD^ACRFEVA1
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^ACRFEVA1
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
ACRFEVAL ;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,ACRVND,ACRITEM,ACRTSIDA,ACR843DA,ACR843,ACRPO1,ACRAMT,ACRTOP,ACRTSI,ACRQUIT,ACROUT,ACRMODE,ACRJ,ACRN1,ACRPID,ACR843,ACRDETL,ACRXAMT,ACRIAMT,ACRSS,ACRVENDR
+1 QUIT
EN1 ;
+1 DO COUNT^ACRFEVA1
+2 DO MODE^ACRFEVA1
+3 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+4 DO @ACRMODE
+5 QUIT
VENDOR ;ORDER QUOTES BY PRICE FOR EACH VENDOR
+1 KILL ACRVND
+2 SET (ACRTSIDA,ACRJ)=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 (ACR843DA,ACRAMT)=0
+7 FOR
SET ACR843DA=$ORDER(^ACRI843I("AA",ACRDOCDA,ACRTSIDA,ACR843DA))
IF 'ACR843DA!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:2
+8 SET ACR843=$GET(^ACRI843I(ACR843DA,0))
+9 SET ACRPO1=$GET(^ACRI843I(ACR843DA,"PO1"))
+10 SET ACRPID=$GET(^ACRI843I(ACR843DA,"PID",1,"PID"))
+11 SET ACRQUAN=$PIECE(ACRPO1,U,2)
+12 SET ACRCOST=$PIECE(ACRPO1,U,4)
+13 SET ACRUI=$PIECE(ACRPO1,U,3)
+14 SET ACRDESC=$PIECE(ACRPID,U,5)
+15 SET ACRAMT=ACRAMT+(ACRQUAN*ACRCOST)
+16 SET ACRVENDR=$PIECE(ACRN1,U,2)
+17 IF '$DATA(ACRDETL)
QUIT
+18 SET ACRITEM(ACRVENDR,+ACRPO1,ACR843DA)=(ACRQUAN*ACRCOST)_U_ACRQUAN_U_ACRUI_U_ACRCOST_U_ACRDESC
End DoDot:2
+19 SET ACRVND(ACRAMT,ACRVENDR)=""
+20 SET ACRVEND(ACRJ,ACRVENDR)=ACRAMT
End DoDot:1
+21 IF '$DATA(ACRVND)
QUIT
+22 DO TOP^ACRFEVA1
+23 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+24 DO VDISPLAY
+25 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^ACRFEVA1
+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
SET ACRI=+Y
SET ACRVND=$ORDER(ACRVEND(ACRI,""))
IF ACRVND]""
Begin DoDot:2
+9 SET ACRAMT=ACRVEND(ACRI,ACRVND)
+10 DO VD
+11 SET ACRQUIT=""
End DoDot:2
End DoDot:1
IF $DATA(ACROUT)!$DATA(ACRQUIT)
KILL ACRQUIT
QUIT
+12 DO VHEAD^ACRFEVA1
+13 SET (ACRAMT,ACRI)=0
+14 FOR ACRJ=1:1
SET ACRAMT=$ORDER(ACRVND(ACRAMT))
IF 'ACRAMT!$DATA(ACRQUIT)!$DATA(ACROUT)!(ACRJ>ACRTOP)
QUIT
Begin DoDot:1
+15 SET ACRVND=""
+16 FOR
SET ACRVND=$ORDER(ACRVND(ACRAMT,ACRVND))
IF ACRVND=""!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:2
+17 SET ACRI=ACRI+1
+18 IF $DATA(ACRDETL)
SET ACRVENDR=ACRVND
+19 DO VD
End DoDot:2
End DoDot:1
+20 DO PAUSE^ACRFWARN
+21 QUIT
VD IF $DATA(ACRDETL)
DO VHEAD^ACRFEVA1
+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#10=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^ACRFEVA1
+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^ACRFEVA1
+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^ACRFEVA1
+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
