- 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
