- 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
