Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFPCC

ACRFPCC.m

Go to the documentation of this file. 
  1. ACRFPCC ;IHS/OIRM/DSD/THL,AEF - DISPLAY COST COMPARISON; [ 11/01/2001   9:44 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
  1.  ;;ROUTINE TO DISPLAY VENDORS FOR A STOCK ITEM
  1. EN ;EP      
  1.  D SET,DISPLAY
  1. EXIT K ACRVDA,ACRVCON,ACRVON,ACRVUI,ACRVUC,ACRVSP,ACRVNAM,ACRVEIN,ACRVCIT,ACRVPHN,ACRVA1,ACRVA2,ACRVA3,ACRVZIP,ACR11,ACR13,ACRDT1,ACRFOB,ACRBR,ACRCT,ACRDT,ACRMAN,ACRVNDC,ACRP1,ACRP2,ACRP3
  1.  Q
  1. ZIS ;EP;TO PRINT COST COMPARISON
  1.  S (ACRRTN,ZTRTN)="EN^ACRFPCC"
  1.  S ZTDESC="PRINT COST COMPARISON FOR DOCUMENT "_$P(^ACRDOC(ACRDOCDA,0),U)
  1.  D ^ACRFZIS
  1.  Q
  1. SET W:$E(IOST,1,2)="C-" @IOF
  1.  W !?12,@ACRON,"COST COMPARISON",@ACROF
  1.  W !,"--------------------------------------------------------------------------------"
  1.  W !?11,"| VENDOR 1"
  1.  W ?34,"| VENDOR 2"
  1.  W ?57,"| VENDOR 3"
  1.  W !,"--------------------------------------------------------------------------------"
  1.  S ACR=0
  1.  D SET1
  1.  Q
  1. SET1 ;SET VENDOR INFO FOR COST COMPARISON
  1.  N X,Y
  1.  S ACRV(1)=$P(^ACRDOC(ACRDOCDA,"PO"),U,5)
  1.  S Y=$G(^ACRDOC(ACRDOCDA,13))
  1.  S ACRV(2)=$P(Y,U,5)
  1.  S ACRV(3)=$P(Y,U,6)
  1.  F ACRI=1:1:3 D S1
  1.  Q
  1. S1 S Z=ACRV(ACRI)
  1.  I Z,$D(^AUTTVNDR(Z,0)) D  I 1
  1.  .S ACR0=$P(^AUTTVNDR(Z,0),U)
  1.  .S X=$G(^AUTTVNDR(Z,11))
  1.  .S Y=$G(^AUTTVNDR(Z,13))
  1.  .S ACRVDA=Z
  1.  .S Z="*"_$E(ACR0,1,20)_U_$P(Y,U)_U_$P(Y,U,10)_U_$P(Y,U,2)_U_$P(Y,U,3)_U_$P(Y,U,4)_U_$P(Y,U,5)_U_$P(X,U,9)_U_$P(X,U,14)_U_$P(X,U,13)_U_$P(X,U,27)_U_$P(X,U,15)_U_$P(X,U,28)_U_$P(X,U,17)
  1.  .S $P(Z,U,30)=ACRVDA
  1.  E  S Z=$G(^ACRDOC(ACRDOCDA,$S(ACRI=1:3,ACRI=2:14,1:15)))
  1.  S $P(Z,U)=$E($P(Z,U),1,21)
  1.  S $P(Z,U,6)=$E($P(Z,U,6),1,5)
  1.  S $P(Z,U,4)=$E($P(Z,U,4),1,13)
  1.  S $P(Z,U,12)="WO: "_$S($P(Z,U,12)=1:"YES",1:"NO")
  1.  S $P(Z,U,13)="BI: "_$S($P(Z,U,13)=6:"YES",1:"NO")
  1.  S $P(Z,U,14)=$S($P(Z,U,14)=1:"YES",1:"NO")
  1.  I $P(Z,U,5),$D(^DIC(5,$P(Z,U,5),0)) S $P(Z,U,5)=$P(^(0),U,2)
  1.  I $P(Z,U,11)]"" D  I 1
  1.  .S $P(Z,U,11)=$E($P($P(^DD(9999999.11,1127,0),($P(Z,U,11)_":"),2),";"),1,21)
  1.  E  S $P(Z,U,11)="NOT STATED"
  1.  S ACRV(ACRI)=Z
  1.  Q
  1. DISPLAY W !,"VENDOR"
  1.  W ?11,"|"
  1.  S ACRP=1
  1.  D W
  1.  W !,"CONTACT"
  1.  W ?11,"|"
  1.  S ACRP=7
  1.  D W
  1.  W !,"STREET 1"
  1.  W ?11,"|"
  1.  S ACRP=2
  1.  D W
  1.  W !,"STREET 2"
  1.  W ?11,"|"
  1.  S ACRP=3
  1.  D W
  1.  W !,"CITY/ST/ZIP"
  1.  W ?11,"|"
  1.  S ACRP="4"
  1.  D W
  1.  W !,"PHONE"
  1.  W ?11,"|"
  1.  S ACRP=8
  1.  D W
  1.  W !,"FAX"
  1.  W ?11,"|"
  1.  S ACRP=9
  1.  D W
  1.  W !,"EIN NO."
  1.  W ?11,"|"
  1.  S ACRP=10
  1.  D W
  1.  W !,"BUS SIZE"
  1.  W ?11,"|"
  1.  S ACRP=11
  1.  D W
  1.  W !,"WOMAN/IND"
  1.  W ?11,"|"
  1.  S ACRP=12
  1.  D W
  1.  W !,"LABOR SURP"
  1.  W ?11,"|"
  1.  S ACRP=14
  1.  D W
  1.  W !,"FOB POINT"
  1.  W ?11,"|"
  1.  S ACRP=15
  1.  D W
  1.  W !,"DELIVRY/ARO"
  1.  W ?11,"|"
  1.  S ACRP=16
  1.  D W
  1.  W !,"PAYMENT TRM"
  1.  W ?11,"|"
  1.  S ACRP=17
  1.  D W
  1.  W !,"MULTI-AWARD"
  1.  W ?11,"|"
  1.  S ACRP=18
  1.  D W
  1.  W !,"CONFIRM ORD"
  1.  W ?11,"|"
  1.  S ACRP=19
  1.  D W
  1.  W !,"MAIL INSTR"
  1.  W ?11,"|"
  1.  S ACRP=20
  1.  D W
  1.  W $$DASH^ACRFMENU
  1.  D SS
  1.  Q
  1. W W ?12,$E($P(ACRV(1),U,ACRP),1,22)
  1.  I ACRP=4 D  S ACRP=4
  1.  .F ACRP=5,6 W:$P(ACRV(1),U,ACRP)]"" ",",$P(ACRV(1),U,ACRP)
  1.  W:ACRP=12 ?25,$P(ACRV(1),U,13)
  1.  W ?34,"|"
  1.  W ?35,$E($P(ACRV(2),U,ACRP),1,22)
  1.  I ACRP=4 D  S ACRP=4
  1.  .F ACRP=5,6 W:$P(ACRV(2),U,ACRP)]"" ",",$P(ACRV(2),U,ACRP)
  1.  W:ACRP=12 ?48,$P(ACRV(2),U,13)
  1.  W ?57,"|"
  1.  W ?58,$E($P(ACRV(3),U,ACRP),1,22)
  1.  I ACRP=4 D  S ACRP=4
  1.  .F ACRP=5,6 W:$P(ACRV(3),U,ACRP)]"" ",",$P(ACRV(3),U,ACRP)
  1.  W:ACRP=12 ?71,$P(ACRV(3),U,13)
  1.  Q
  1. SS ;DISPLAY COST DATA FOR EACH ITEM FOR EACH VENDOR
  1.  D SSH
  1.  N X,Y
  1.  S ACRXREF=$S(ACRREFX=116&($P(^ACRDOC(ACRDOCDA,0),U,4)'=35):"C",ACRREFX=116&($P(^ACRDOC(ACRDOCDA,0),U,4)=35&($P($G(^ACROBL(ACRDOCDA,"APV")),U)'="A")):"C",1:"J")
  1.  S (ACRSSDA,ACRTT1,ACRTT2,ACRTT3)=0
  1.  F  S ACRSSDA=$O(^ACRSS(ACRXREF,ACRDOCDA,ACRSSDA)) Q:'ACRSSDA  D
  1.  .S X=^ACRSS(ACRSSDA,"DT"),Y=$G(^ACRSS(ACRSSDA,2)),Z=+^ACRSS(ACRSSDA,0)
  1.  .S ACRQUAN=$P(X,U)
  1.  .S ACRUI=$P(X,U,2)
  1.  .S ACRP1=$P(X,U,3)
  1.  .S ACRT1=$P(X,U,4)
  1.  .S ACRP2=$P(Y,U,4)
  1.  .S ACRT2=ACRQUAN*ACRP2
  1.  .S ACRP3=$P(Y,U,6)
  1.  .S ACRT3=ACRQUAN*ACRP3
  1.  .S ACRTT1=ACRTT1+ACRT1
  1.  .S ACRTT2=ACRTT2+ACRT2
  1.  .S ACRTT3=ACRTT3+ACRT3
  1.  .W !,Z
  1.  .W ?2,"|",$J(ACRQUAN,5)
  1.  .W ?7,"|",$S($D(^ACRUI(+ACRUI,0)):$P(^(0),U),1:"**")
  1.  .W ?11,"|",$J($FN(ACRP1,"P",2),10)
  1.  .W ?22,"|",$J($FN(ACRT1,"P",2),11)
  1.  .W ?34,"|",$J($FN(ACRP2,"P",2),10)
  1.  .W ?45,"|",$J($FN(ACRT2,"P",2),11)
  1.  .W ?57,"|",$J($FN(ACRP3,"P",2),10)
  1.  .W ?68,"|",$J($FN(ACRT3,"P",2),11)
  1.  W $$DASH^ACRFMENU
  1.  W !,"ORDER AMT"
  1.  W ?11,"|"
  1.  W ?23,$J($FN(ACRTT1,"P",2),11)
  1.  W ?34,"|"
  1.  W ?46,$J($FN(ACRTT2,"P",2),11)
  1.  W ?57,"|"
  1.  W ?69,$J($FN(ACRTT3,"P",2),11)
  1.  D PAUSE^ACRFWARN
  1.  W @IOF
  1.  K ACRT1,ACRT2,ACRT3,ACRTT1,ACRTT2,ACRTT3
  1.  Q
  1. SSH I IOSL-4<$Y D PAUSE^ACRFWARN W @IOF
  1.  W !,"# | QTY |UI|UNIT COST |   TOTAL   |UNIT COST |   TOTAL   |UNIT COST |   TOTAL"
  1.  W !,"--------------------------------------------------------------------------------"
  1.  Q