source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHQRP3.m@ 810

Last change on this file since 810 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.7 KB
RevLine 
[613]1PRCHQRP3 ;WISC/KMB-DISPLAY LINE ITEM QUOTE REPORT ;8/8/96 10:14
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4START ;Entry for Line Report
5 W @IOF S DIC="^PRC(444,",DIC("S")="I $P(^(0),""^"",8)>1"
6 S DIC(0)="AEMQZ" D ^DIC K DIC I Y<0 K DTOUT,DUOUT,Y,PRCDA Q
7 S PRCDA=+Y
8 ;
9 W ! S %ZIS="MQ" D ^%ZIS I POP K PRCDA,Y Q
10 I $D(IO("Q")) S ZTRTN="PROCESS^PRCHQRP3",ZTSAVE("PRCDA")="",ZTSAVE("DUZ")="" D ^%ZTLOAD,^%ZISC K ZTSK,PRCDA G START
11 D PROCESS,^%ZISC G START
12PROCESS ;
13 N Z1,UOP,VEN,QTY,FOB,UPRICE,COST,I,P
14 N Y,ITEM,JJ,ID,L,PPRICE,SUB,ZIP1,ZIP2,ZIP3,ZIP4,ZIP5
15 N Q1,Q2,Q3,Q4,REF,KK,J,ID,SIZE,VENDOR,FILE,FLAG
16 S ZIP1=$P($G(^PRC(444,PRCDA,0)),"^"),ZIP2=$P($G(^(0)),"^",3),ZIP3=$P($G(^(8,0)),"^",4)
17 S ZIP5=$P($G(^PRC(444,PRCDA,0)),"^",12) S:ZIP5'="" ZIP5=$P($G(^VA(200,ZIP5,0)),"^")
18 S ZIP4=$P($G(^PRC(444,PRCDA,2,0)),"^",4)
19 S Y=ZIP2 D DD^%DT S ZIP2=Y
20 D VENDOR^PRCHQRP4,RFQLOAD,ITEM,WRITE K PRCDA,^TMP($J) S:$D(ZTQUEUED) ZTREQ="@"
21 QUIT
22WRITE ;
23 U IO S (P,Z1)=1,U="^"
24 D HDR
25 I '$D(^TMP($J,"PRT")) W !!," ** No Quote Data **"
26 S Q1=0 F S Q1=$O(^TMP($J,"PRT",Q1)) Q:Q1="" D Q:Z1[U
27 . I IOSL-$Y<6 D HDR Q:Z1[U
28 .W !!,?10,"LINE ITEM # ",Q1 I $D(SUB(Q1)) W ?40,"LAST PRICE ",SUB(Q1)
29 .W ! S (Q2,Q3)=0 F S Q2=$O(^TMP($J,"PRT",Q1,Q2)) Q:Q2="" D Q:Z1[U
30 ..F S Q3=$O(^TMP($J,"PRT",Q1,Q2,Q3)) Q:Q3="" D Q:Z1[U
31 ...S Q4="" F S Q4=$O(^TMP($J,"PRT",Q1,Q2,Q3,Q4)) Q:Q4="" D Q:Z1[U
32 ....I IOSL-$Y<4 D HDR Q:Z1[U
33 ....W !,$E($P(^TMP($J,"PRT",Q1,Q2,Q3,Q4),"^"),1,23),?25,$P(^TMP($J,"PRT",Q1,Q2,Q3,Q4),"^",2),?35,$P(^TMP($J,"PRT",Q1,Q2,Q3,Q4),"^",3),?40,$P(^TMP($J,"PRT",Q1,Q2,Q3,Q4),"^",4)
34 ....W ?45,$J($FN($P(^TMP($J,"PRT",Q1,Q2,Q3,Q4),"^",5),"",2),10),?58,$J($FN($P(^TMP($J,"PRT",Q1,Q2,Q3,Q4),"^",8),"",2),10),?70,$P(^TMP($J,"PRT",Q1,Q2,Q3,Q4),"^",6),?75,$P(^TMP($J,"PRT",Q1,Q2,Q3,Q4),"^",7)
35 ....W:IOM>120 ?90,$P(^TMP($J,"PRT",Q1,Q2,Q3,Q4),"^",9)
36 ....W:IOM'>80&($P(^TMP($J,"PRT",Q1,Q2,Q3,Q4),"^",9)]"") !?10,$P(^(Q4),"^",9)
37 I Z1'[U,IOSL-$Y<14 R:$E(IOST,1,2)="C-"&'$D(ZTQUEUED) !,"Enter RETURN to continue or '^' to exit: ",Z1:DTIME W @IOF
38 D:Z1'[U LEGEND^PRCHQRP4
39 I Z1'[U,$E(IOST,1,2)="C-",'$D(ZTQUEUED) R !,"Enter RETURN to continue",Z1:DTIME
40 Q
41HDR ;
42 I $E(IOST,1,2)="C-",P>1,'$D(ZTQUEUED) R !,"Enter RETURN to continue or '^' to exit: ",Z1:DTIME Q:Z1["^"
43 W @IOF
44 W !,"RFQ #",ZIP1,?60,"PAGE ",P,!,"Quotations Due Date: ",ZIP2,!,"Number of Quotes: ",ZIP3,!,"Number of Items on RFQ: ",ZIP4,!,"Point of Contact: ",ZIP5,!
45 W !,?25,"Size",?40,"Unit of",?50,"Unit",?60,"Extended"
46 W !,"Vendor" W:IOM'>80 ?10,"Flags" W ?25,"Status",?35,"Qty",?40,"Issue",?50,"Price",?60,"Price",?70,"FOB",?75,"#MSGS" W:IOM>120 ?90,"Flags" W !
47 F I=1:1:$S(IOM>120:12,1:8) W "----------"
48 S P=P+1 QUIT
49ITEM ;
50 K ^TMP($J,"PRT") S I=0
51 F S I=$O(^PRC(444,PRCDA,8,I)) Q:+I'=I D
52 .S SIZE=""
53 .S ID=$P($G(^PRC(444,PRCDA,8,I,0)),"^") Q:ID=""
54 .S KK=$P(ID,";"),FILE=$P(ID,";",2),REF="^"_FILE_KK_",0)"
55 . I FILE["PRC(440" S SIZE=$P($G(^PRC(440,KK,2)),U,3)
56 . I FILE["PRC(444.1" S SIZE=$P($G(^PRC(444.1,KK,0)),U,5)
57 . S SIZE=$P("SMALL^LARGE",U,SIZE)
58 .S VEN=@REF,VEN=$P(VEN,"^") S:VEN="" VEN=0
59 .S JJ=0 S:FILE[440 JJ=$P($G(^PRC(440,KK,7)),"^",12) S:FILE[444.1 JJ=$P($G(^PRC(444.1,KK,0)),"^",2) S:JJ="" JJ=0
60 . S J=0 F S J=$O(^PRC(444,PRCDA,8,I,3,J)) Q:+J'=J D
61 ..S FLAG=""
62 ..S ITEM=$P($G(^PRC(444,PRCDA,8,I,3,J,0)),"^") Q:ITEM=""
63 ..S QTY=$P($G(^PRC(444,PRCDA,8,I,3,J,0)),"^",2),UOP=$P($G(^(0)),"^",3)
64 ..S FOB=$P($G(^PRC(444,PRCDA,8,I,3,J,0)),"^",10)
65 ..S:FOB="" FOB=$P($G(^PRC(444,PRCDA,8,I,1)),"^")
66 ..S UPRICE=$P($G(^PRC(444,PRCDA,8,I,3,J,1)),"^",3),COST=$P($G(^(1)),"^",7)
67 ..I UOP'="" S UOP=$P($G(^PRCD(420.5,UOP,0)),"^",2)
68 ..S:COST="" COST=0 S:ITEM="" ITEM=0
69 .. I FOB'=^TMP($J,"RFQ","FOB") S FLAG=FLAG_$S(FLAG]"":",",1:"")_"F"
70 .. I QTY'=$G(^TMP($J,"RFQ","ITEM",ITEM,"QUANTITY")) S FLAG=FLAG_$S(FLAG]"":",",1:"")_"Q"
71 .. I UOP'=$G(^TMP($J,"RFQ","ITEM",ITEM,"UNIT")) S FLAG=FLAG_$S(FLAG]"":",",1:"")_"U"
72 .. I $P($G(^PRC(444,PRCDA,8,I,0)),"^",4)>^TMP($J,"RFQ","QUOTE DUE") S FLAG=FLAG_$S(FLAG]"":",",1:"")_"DT"
73 .. I ^TMP($J,"RFQ","SET ASIDE"),SIZE'="SMALL" S FLAG=FLAG_$S(FLAG]"":",",1:"")_"S"
74 .. I $P($G(^PRC(444,PRCDA,8,I,3,0)),"^",4)'=^TMP($J,"RFQ","NBR ITEMS") S FLAG=FLAG_$S(FLAG]"":",",1:"")_"LI"
75 .. I $P($G(^PRC(444,PRCDA,8,I,3,J,1)),"^",6)]""!($P($G(^PRC(444,PRCDA,8,I,0)),"^",7)]"") S FLAG=FLAG_$S(FLAG]"":",",1:"")_"C"
76 .. S X=$G(^PRC(444,PRCDA,8,I,3,J,0))
77 .. I $P(X,"^",9)'=$G(^TMP($J,"RFQ","ITEM",ITEM,"MFG PART")) S FLAG=FLAG_$S(FLAG]"":",",1:"")_"M"
78 .. I $P(X,"^",4)]"" S FLAG=FLAG_$S(FLAG]"":",",1:"")_"V"
79 .. I $P(X,"^",6)'=$G(^TMP($J,"RFQ","ITEM",ITEM,"NSN")) S FLAG=FLAG_$S(FLAG]"":",",1:"")_"NSN"
80 .. I $P(X,"^",8)'=$G(^TMP($J,"RFQ","ITEM",ITEM,"NDC")) S FLAG=FLAG_$S(FLAG]"":",",1:"")_"NDC"
81 ..S ^TMP($J,"PRT",ITEM,+COST,VEN,I)=VEN_"^"_SIZE_"^"_QTY_"^"_UOP_"^"_UPRICE_"^"_FOB_"^"_$G(VENDOR(JJ))_"^"_(+COST)_"^"_FLAG
82 S L=0
83 F S L=$O(^PRC(444,PRCDA,2,L)) Q:+L'=L D
84 . S ITEM=$P($G(^PRC(444,PRCDA,2,L,0)),U) Q:ITEM="" S PPRICE=$P($G(^PRC(444,PRCDA,2,L,1)),"^",5) S:PPRICE'="" SUB(ITEM)=PPRICE
85 QUIT
86RFQLOAD ;Load RFQ information to compare with quote
87 K ^TMP($J,"RFQ") N X,L
88 S ^TMP($J,"RFQ","FOB")=$P($G(^PRC(444,PRCDA,1)),"^")
89 S ^TMP($J,"RFQ","QUOTE DUE")=$P($G(^PRC(444,PRCDA,0)),"^",3)
90 S ^TMP($J,"RFQ","SET ASIDE")=$P($G(^PRC(444,PRCDA,1)),"^",7)
91 S ^TMP($J,"RFQ","NBR ITEMS")=$P($G(^PRC(444,PRCDA,2,0)),"^",4)
92 S I=0
93 F S I=$O(^PRC(444,PRCDA,2,I)) Q:+I'=I D
94 . S X=$G(^PRC(444,PRCDA,2,I,0)) Q:X=""
95 . S L=$P(X,"^")
96 . S ^TMP($J,"RFQ","ITEM",L,"QUANTITY")=$P(X,"^",2)
97 . S ^TMP($J,"RFQ","ITEM",L,"UNIT")=$S($P(X,"^",3)]"":$P($G(^PRCD(420.5,$P(X,"^",3),0)),"^",2),1:"")
98 . S ^TMP($J,"RFQ","ITEM",L,"NSN")=$P(X,"^",6)
99 . S ^TMP($J,"RFQ","ITEM",L,"NDC")=$P(X,"^",8)
100 . S ^TMP($J,"RFQ","ITEM",L,"MFG PART")=$P(X,"^",9)
101 Q
Note: See TracBrowser for help on using the repository browser.