PRCHQRP3 ;WISC/KMB-DISPLAY LINE ITEM QUOTE REPORT ;8/8/96 10:14
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
START ;Entry for Line Report
W @IOF S DIC="^PRC(444,",DIC("S")="I $P(^(0),""^"",8)>1"
S DIC(0)="AEMQZ" D ^DIC K DIC I Y<0 K DTOUT,DUOUT,Y,PRCDA Q
S PRCDA=+Y
;
W ! S %ZIS="MQ" D ^%ZIS I POP K PRCDA,Y Q
I $D(IO("Q")) S ZTRTN="PROCESS^PRCHQRP3",ZTSAVE("PRCDA")="",ZTSAVE("DUZ")="" D ^%ZTLOAD,^%ZISC K ZTSK,PRCDA G START
D PROCESS,^%ZISC G START
PROCESS ;
N Z1,UOP,VEN,QTY,FOB,UPRICE,COST,I,P
N Y,ITEM,JJ,ID,L,PPRICE,SUB,ZIP1,ZIP2,ZIP3,ZIP4,ZIP5
N Q1,Q2,Q3,Q4,REF,KK,J,ID,SIZE,VENDOR,FILE,FLAG
S ZIP1=$P($G(^PRC(444,PRCDA,0)),"^"),ZIP2=$P($G(^(0)),"^",3),ZIP3=$P($G(^(8,0)),"^",4)
S ZIP5=$P($G(^PRC(444,PRCDA,0)),"^",12) S:ZIP5'="" ZIP5=$P($G(^VA(200,ZIP5,0)),"^")
S ZIP4=$P($G(^PRC(444,PRCDA,2,0)),"^",4)
S Y=ZIP2 D DD^%DT S ZIP2=Y
D VENDOR^PRCHQRP4,RFQLOAD,ITEM,WRITE K PRCDA,^TMP($J) S:$D(ZTQUEUED) ZTREQ="@"
QUIT
WRITE ;
U IO S (P,Z1)=1,U="^"
D HDR
I '$D(^TMP($J,"PRT")) W !!," ** No Quote Data **"
S Q1=0 F S Q1=$O(^TMP($J,"PRT",Q1)) Q:Q1="" D Q:Z1[U
. I IOSL-$Y<6 D HDR Q:Z1[U
.W !!,?10,"LINE ITEM # ",Q1 I $D(SUB(Q1)) W ?40,"LAST PRICE ",SUB(Q1)
.W ! S (Q2,Q3)=0 F S Q2=$O(^TMP($J,"PRT",Q1,Q2)) Q:Q2="" D Q:Z1[U
..F S Q3=$O(^TMP($J,"PRT",Q1,Q2,Q3)) Q:Q3="" D Q:Z1[U
...S Q4="" F S Q4=$O(^TMP($J,"PRT",Q1,Q2,Q3,Q4)) Q:Q4="" D Q:Z1[U
....I IOSL-$Y<4 D HDR Q:Z1[U
....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)
....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)
....W:IOM>120 ?90,$P(^TMP($J,"PRT",Q1,Q2,Q3,Q4),"^",9)
....W:IOM'>80&($P(^TMP($J,"PRT",Q1,Q2,Q3,Q4),"^",9)]"") !?10,$P(^(Q4),"^",9)
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
D:Z1'[U LEGEND^PRCHQRP4
I Z1'[U,$E(IOST,1,2)="C-",'$D(ZTQUEUED) R !,"Enter RETURN to continue",Z1:DTIME
Q
HDR ;
I $E(IOST,1,2)="C-",P>1,'$D(ZTQUEUED) R !,"Enter RETURN to continue or '^' to exit: ",Z1:DTIME Q:Z1["^"
W @IOF
W !,"RFQ #",ZIP1,?60,"PAGE ",P,!,"Quotations Due Date: ",ZIP2,!,"Number of Quotes: ",ZIP3,!,"Number of Items on RFQ: ",ZIP4,!,"Point of Contact: ",ZIP5,!
W !,?25,"Size",?40,"Unit of",?50,"Unit",?60,"Extended"
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 !
F I=1:1:$S(IOM>120:12,1:8) W "----------"
S P=P+1 QUIT
ITEM ;
K ^TMP($J,"PRT") S I=0
F S I=$O(^PRC(444,PRCDA,8,I)) Q:+I'=I D
.S SIZE=""
.S ID=$P($G(^PRC(444,PRCDA,8,I,0)),"^") Q:ID=""
.S KK=$P(ID,";"),FILE=$P(ID,";",2),REF="^"_FILE_KK_",0)"
. I FILE["PRC(440" S SIZE=$P($G(^PRC(440,KK,2)),U,3)
. I FILE["PRC(444.1" S SIZE=$P($G(^PRC(444.1,KK,0)),U,5)
. S SIZE=$P("SMALL^LARGE",U,SIZE)
.S VEN=@REF,VEN=$P(VEN,"^") S:VEN="" VEN=0
.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
. S J=0 F S J=$O(^PRC(444,PRCDA,8,I,3,J)) Q:+J'=J D
..S FLAG=""
..S ITEM=$P($G(^PRC(444,PRCDA,8,I,3,J,0)),"^") Q:ITEM=""
..S QTY=$P($G(^PRC(444,PRCDA,8,I,3,J,0)),"^",2),UOP=$P($G(^(0)),"^",3)
..S FOB=$P($G(^PRC(444,PRCDA,8,I,3,J,0)),"^",10)
..S:FOB="" FOB=$P($G(^PRC(444,PRCDA,8,I,1)),"^")
..S UPRICE=$P($G(^PRC(444,PRCDA,8,I,3,J,1)),"^",3),COST=$P($G(^(1)),"^",7)
..I UOP'="" S UOP=$P($G(^PRCD(420.5,UOP,0)),"^",2)
..S:COST="" COST=0 S:ITEM="" ITEM=0
.. I FOB'=^TMP($J,"RFQ","FOB") S FLAG=FLAG_$S(FLAG]"":",",1:"")_"F"
.. I QTY'=$G(^TMP($J,"RFQ","ITEM",ITEM,"QUANTITY")) S FLAG=FLAG_$S(FLAG]"":",",1:"")_"Q"
.. I UOP'=$G(^TMP($J,"RFQ","ITEM",ITEM,"UNIT")) S FLAG=FLAG_$S(FLAG]"":",",1:"")_"U"
.. I $P($G(^PRC(444,PRCDA,8,I,0)),"^",4)>^TMP($J,"RFQ","QUOTE DUE") S FLAG=FLAG_$S(FLAG]"":",",1:"")_"DT"
.. I ^TMP($J,"RFQ","SET ASIDE"),SIZE'="SMALL" S FLAG=FLAG_$S(FLAG]"":",",1:"")_"S"
.. I $P($G(^PRC(444,PRCDA,8,I,3,0)),"^",4)'=^TMP($J,"RFQ","NBR ITEMS") S FLAG=FLAG_$S(FLAG]"":",",1:"")_"LI"
.. 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"
.. S X=$G(^PRC(444,PRCDA,8,I,3,J,0))
.. I $P(X,"^",9)'=$G(^TMP($J,"RFQ","ITEM",ITEM,"MFG PART")) S FLAG=FLAG_$S(FLAG]"":",",1:"")_"M"
.. I $P(X,"^",4)]"" S FLAG=FLAG_$S(FLAG]"":",",1:"")_"V"
.. I $P(X,"^",6)'=$G(^TMP($J,"RFQ","ITEM",ITEM,"NSN")) S FLAG=FLAG_$S(FLAG]"":",",1:"")_"NSN"
.. I $P(X,"^",8)'=$G(^TMP($J,"RFQ","ITEM",ITEM,"NDC")) S FLAG=FLAG_$S(FLAG]"":",",1:"")_"NDC"
..S ^TMP($J,"PRT",ITEM,+COST,VEN,I)=VEN_"^"_SIZE_"^"_QTY_"^"_UOP_"^"_UPRICE_"^"_FOB_"^"_$G(VENDOR(JJ))_"^"_(+COST)_"^"_FLAG
S L=0
F S L=$O(^PRC(444,PRCDA,2,L)) Q:+L'=L D
. 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
QUIT
RFQLOAD ;Load RFQ information to compare with quote
K ^TMP($J,"RFQ") N X,L
S ^TMP($J,"RFQ","FOB")=$P($G(^PRC(444,PRCDA,1)),"^")
S ^TMP($J,"RFQ","QUOTE DUE")=$P($G(^PRC(444,PRCDA,0)),"^",3)
S ^TMP($J,"RFQ","SET ASIDE")=$P($G(^PRC(444,PRCDA,1)),"^",7)
S ^TMP($J,"RFQ","NBR ITEMS")=$P($G(^PRC(444,PRCDA,2,0)),"^",4)
S I=0
F S I=$O(^PRC(444,PRCDA,2,I)) Q:+I'=I D
. S X=$G(^PRC(444,PRCDA,2,I,0)) Q:X=""
. S L=$P(X,"^")
. S ^TMP($J,"RFQ","ITEM",L,"QUANTITY")=$P(X,"^",2)
. S ^TMP($J,"RFQ","ITEM",L,"UNIT")=$S($P(X,"^",3)]"":$P($G(^PRCD(420.5,$P(X,"^",3),0)),"^",2),1:"")
. S ^TMP($J,"RFQ","ITEM",L,"NSN")=$P(X,"^",6)
. S ^TMP($J,"RFQ","ITEM",L,"NDC")=$P(X,"^",8)
. S ^TMP($J,"RFQ","ITEM",L,"MFG PART")=$P(X,"^",9)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHQRP3 5888 printed Nov 22, 2024@17:20:06 Page 2
PRCHQRP3 ;WISC/KMB-DISPLAY LINE ITEM QUOTE REPORT ;8/8/96 10:14
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
START ;Entry for Line Report
+1 WRITE @IOF
SET DIC="^PRC(444,"
SET DIC("S")="I $P(^(0),""^"",8)>1"
+2 SET DIC(0)="AEMQZ"
DO ^DIC
KILL DIC
IF Y<0
KILL DTOUT,DUOUT,Y,PRCDA
QUIT
+3 SET PRCDA=+Y
+4 ;
+5 WRITE !
SET %ZIS="MQ"
DO ^%ZIS
IF POP
KILL PRCDA,Y
QUIT
+6 IF $DATA(IO("Q"))
SET ZTRTN="PROCESS^PRCHQRP3"
SET ZTSAVE("PRCDA")=""
SET ZTSAVE("DUZ")=""
DO ^%ZTLOAD
DO ^%ZISC
KILL ZTSK,PRCDA
GOTO START
+7 DO PROCESS
DO ^%ZISC
GOTO START
PROCESS ;
+1 NEW Z1,UOP,VEN,QTY,FOB,UPRICE,COST,I,P
+2 NEW Y,ITEM,JJ,ID,L,PPRICE,SUB,ZIP1,ZIP2,ZIP3,ZIP4,ZIP5
+3 NEW Q1,Q2,Q3,Q4,REF,KK,J,ID,SIZE,VENDOR,FILE,FLAG
+4 SET ZIP1=$PIECE($GET(^PRC(444,PRCDA,0)),"^")
SET ZIP2=$PIECE($GET(^(0)),"^",3)
SET ZIP3=$PIECE($GET(^(8,0)),"^",4)
+5 SET ZIP5=$PIECE($GET(^PRC(444,PRCDA,0)),"^",12)
if ZIP5'=""
SET ZIP5=$PIECE($GET(^VA(200,ZIP5,0)),"^")
+6 SET ZIP4=$PIECE($GET(^PRC(444,PRCDA,2,0)),"^",4)
+7 SET Y=ZIP2
DO DD^%DT
SET ZIP2=Y
+8 DO VENDOR^PRCHQRP4
DO RFQLOAD
DO ITEM
DO WRITE
KILL PRCDA,^TMP($JOB)
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+9 QUIT
WRITE ;
+1 USE IO
SET (P,Z1)=1
SET U="^"
+2 DO HDR
+3 IF '$DATA(^TMP($JOB,"PRT"))
WRITE !!," ** No Quote Data **"
+4 SET Q1=0
FOR
SET Q1=$ORDER(^TMP($JOB,"PRT",Q1))
if Q1=""
QUIT
Begin DoDot:1
+5 IF IOSL-$Y<6
DO HDR
if Z1[U
QUIT
+6 WRITE !!,?10,"LINE ITEM # ",Q1
IF $DATA(SUB(Q1))
WRITE ?40,"LAST PRICE ",SUB(Q1)
+7 WRITE !
SET (Q2,Q3)=0
FOR
SET Q2=$ORDER(^TMP($JOB,"PRT",Q1,Q2))
if Q2=""
QUIT
Begin DoDot:2
+8 FOR
SET Q3=$ORDER(^TMP($JOB,"PRT",Q1,Q2,Q3))
if Q3=""
QUIT
Begin DoDot:3
+9 SET Q4=""
FOR
SET Q4=$ORDER(^TMP($JOB,"PRT",Q1,Q2,Q3,Q4))
if Q4=""
QUIT
Begin DoDot:4
+10 IF IOSL-$Y<4
DO HDR
if Z1[U
QUIT
+11 WRITE !,$EXTRACT($PIECE(^TMP($JOB,"PRT",Q1,Q2,Q3,Q4),"^"),1,23),?25,$PIECE(^TMP($JOB,"PRT",Q1,Q2,Q3,Q4),"^",2),?35,$PIECE(^TMP($JOB,"PRT",Q1,Q2,Q3,Q4),"^",3),?40,$PIECE(^TMP($JOB,"PRT",Q1,Q2,Q3,Q4),"^",4)
+12 WRITE ?45,$JUSTIFY($FNUMBER($PIECE(^TMP($JOB,"PRT",Q1,Q2,Q3,Q4),"^",5),"",2),10),?58,$JUSTIFY($FNUMBER($PIECE(^TMP($JOB,"PRT",Q1,Q2,Q3,Q4),"^",8),"",2),10),?70,$PIECE(^TMP($JOB,"PRT",Q1,Q2,Q3,Q4),"^",6),?75,$PIEC
E(^TMP($JOB,"PRT",Q1,Q2,Q3,Q4),"^",7)
+13 if IOM>120
WRITE ?90,$PIECE(^TMP($JOB,"PRT",Q1,Q2,Q3,Q4),"^",9)
+14 if IOM'>80&($PIECE(^TMP($JOB,"PRT",Q1,Q2,Q3,Q4),"^",9)]"")
WRITE !?10,$PIECE(^(Q4),"^",9)
End DoDot:4
if Z1[U
QUIT
End DoDot:3
if Z1[U
QUIT
End DoDot:2
if Z1[U
QUIT
End DoDot:1
if Z1[U
QUIT
+15 IF Z1'[U
IF IOSL-$Y<14
if $EXTRACT(IOST,1,2)="C-"&'$DATA(ZTQUEUED)
READ !,"Enter RETURN to continue or '^' to exit: ",Z1:DTIME
WRITE @IOF
+16 if Z1'[U
DO LEGEND^PRCHQRP4
+17 IF Z1'[U
IF $EXTRACT(IOST,1,2)="C-"
IF '$DATA(ZTQUEUED)
READ !,"Enter RETURN to continue",Z1:DTIME
+18 QUIT
HDR ;
+1 IF $EXTRACT(IOST,1,2)="C-"
IF P>1
IF '$DATA(ZTQUEUED)
READ !,"Enter RETURN to continue or '^' to exit: ",Z1:DTIME
if Z1["^"
QUIT
+2 WRITE @IOF
+3 WRITE !,"RFQ #",ZIP1,?60,"PAGE ",P,!,"Quotations Due Date: ",ZIP2,!,"Number of Quotes: ",ZIP3,!,"Number of Items on RFQ: ",ZIP4,!,"Point of Contact: ",ZIP5,!
+4 WRITE !,?25,"Size",?40,"Unit of",?50,"Unit",?60,"Extended"
+5 WRITE !,"Vendor"
if IOM'>80
WRITE ?10,"Flags"
WRITE ?25,"Status",?35,"Qty",?40,"Issue",?50,"Price",?60,"Price",?70,"FOB",?75,"#MSGS"
if IOM>120
WRITE ?90,"Flags"
WRITE !
+6 FOR I=1:1:$SELECT(IOM>120:12,1:8)
WRITE "----------"
+7 SET P=P+1
QUIT
ITEM ;
+1 KILL ^TMP($JOB,"PRT")
SET I=0
+2 FOR
SET I=$ORDER(^PRC(444,PRCDA,8,I))
if +I'=I
QUIT
Begin DoDot:1
+3 SET SIZE=""
+4 SET ID=$PIECE($GET(^PRC(444,PRCDA,8,I,0)),"^")
if ID=""
QUIT
+5 SET KK=$PIECE(ID,";")
SET FILE=$PIECE(ID,";",2)
SET REF="^"_FILE_KK_",0)"
+6 IF FILE["PRC(440"
SET SIZE=$PIECE($GET(^PRC(440,KK,2)),U,3)
+7 IF FILE["PRC(444.1"
SET SIZE=$PIECE($GET(^PRC(444.1,KK,0)),U,5)
+8 SET SIZE=$PIECE("SMALL^LARGE",U,SIZE)
+9 SET VEN=@REF
SET VEN=$PIECE(VEN,"^")
if VEN=""
SET VEN=0
+10 SET JJ=0
if FILE[440
SET JJ=$PIECE($GET(^PRC(440,KK,7)),"^",12)
if FILE[444.1
SET JJ=$PIECE($GET(^PRC(444.1,KK,0)),"^",2)
if JJ=""
SET JJ=0
+11 SET J=0
FOR
SET J=$ORDER(^PRC(444,PRCDA,8,I,3,J))
if +J'=J
QUIT
Begin DoDot:2
+12 SET FLAG=""
+13 SET ITEM=$PIECE($GET(^PRC(444,PRCDA,8,I,3,J,0)),"^")
if ITEM=""
QUIT
+14 SET QTY=$PIECE($GET(^PRC(444,PRCDA,8,I,3,J,0)),"^",2)
SET UOP=$PIECE($GET(^(0)),"^",3)
+15 SET FOB=$PIECE($GET(^PRC(444,PRCDA,8,I,3,J,0)),"^",10)
+16 if FOB=""
SET FOB=$PIECE($GET(^PRC(444,PRCDA,8,I,1)),"^")
+17 SET UPRICE=$PIECE($GET(^PRC(444,PRCDA,8,I,3,J,1)),"^",3)
SET COST=$PIECE($GET(^(1)),"^",7)
+18 IF UOP'=""
SET UOP=$PIECE($GET(^PRCD(420.5,UOP,0)),"^",2)
+19 if COST=""
SET COST=0
if ITEM=""
SET ITEM=0
+20 IF FOB'=^TMP($JOB,"RFQ","FOB")
SET FLAG=FLAG_$SELECT(FLAG]"":",",1:"")_"F"
+21 IF QTY'=$GET(^TMP($JOB,"RFQ","ITEM",ITEM,"QUANTITY"))
SET FLAG=FLAG_$SELECT(FLAG]"":",",1:"")_"Q"
+22 IF UOP'=$GET(^TMP($JOB,"RFQ","ITEM",ITEM,"UNIT"))
SET FLAG=FLAG_$SELECT(FLAG]"":",",1:"")_"U"
+23 IF $PIECE($GET(^PRC(444,PRCDA,8,I,0)),"^",4)>^TMP($JOB,"RFQ","QUOTE DUE")
SET FLAG=FLAG_$SELECT(FLAG]"":",",1:"")_"DT"
+24 IF ^TMP($JOB,"RFQ","SET ASIDE")
IF SIZE'="SMALL"
SET FLAG=FLAG_$SELECT(FLAG]"":",",1:"")_"S"
+25 IF $PIECE($GET(^PRC(444,PRCDA,8,I,3,0)),"^",4)'=^TMP($JOB,"RFQ","NBR ITEMS")
SET FLAG=FLAG_$SELECT(FLAG]"":",",1:"")_"LI"
+26 IF $PIECE($GET(^PRC(444,PRCDA,8,I,3,J,1)),"^",6)]""!($PIECE($GET(^PRC(444,PRCDA,8,I,0)),"^",7)]"")
SET FLAG=FLAG_$SELECT(FLAG]"":",",1:"")_"C"
+27 SET X=$GET(^PRC(444,PRCDA,8,I,3,J,0))
+28 IF $PIECE(X,"^",9)'=$GET(^TMP($JOB,"RFQ","ITEM",ITEM,"MFG PART"))
SET FLAG=FLAG_$SELECT(FLAG]"":",",1:"")_"M"
+29 IF $PIECE(X,"^",4)]""
SET FLAG=FLAG_$SELECT(FLAG]"":",",1:"")_"V"
+30 IF $PIECE(X,"^",6)'=$GET(^TMP($JOB,"RFQ","ITEM",ITEM,"NSN"))
SET FLAG=FLAG_$SELECT(FLAG]"":",",1:"")_"NSN"
+31 IF $PIECE(X,"^",8)'=$GET(^TMP($JOB,"RFQ","ITEM",ITEM,"NDC"))
SET FLAG=FLAG_$SELECT(FLAG]"":",",1:"")_"NDC"
+32 SET ^TMP($JOB,"PRT",ITEM,+COST,VEN,I)=VEN_"^"_SIZE_"^"_QTY_"^"_UOP_"^"_UPRICE_"^"_FOB_"^"_$GET(VENDOR(JJ))_"^"_(+COST)_"^"_FLAG
End DoDot:2
End DoDot:1
+33 SET L=0
+34 FOR
SET L=$ORDER(^PRC(444,PRCDA,2,L))
if +L'=L
QUIT
Begin DoDot:1
+35 SET ITEM=$PIECE($GET(^PRC(444,PRCDA,2,L,0)),U)
if ITEM=""
QUIT
SET PPRICE=$PIECE($GET(^PRC(444,PRCDA,2,L,1)),"^",5)
if PPRICE'=""
SET SUB(ITEM)=PPRICE
End DoDot:1
+36 QUIT
RFQLOAD ;Load RFQ information to compare with quote
+1 KILL ^TMP($JOB,"RFQ")
NEW X,L
+2 SET ^TMP($JOB,"RFQ","FOB")=$PIECE($GET(^PRC(444,PRCDA,1)),"^")
+3 SET ^TMP($JOB,"RFQ","QUOTE DUE")=$PIECE($GET(^PRC(444,PRCDA,0)),"^",3)
+4 SET ^TMP($JOB,"RFQ","SET ASIDE")=$PIECE($GET(^PRC(444,PRCDA,1)),"^",7)
+5 SET ^TMP($JOB,"RFQ","NBR ITEMS")=$PIECE($GET(^PRC(444,PRCDA,2,0)),"^",4)
+6 SET I=0
+7 FOR
SET I=$ORDER(^PRC(444,PRCDA,2,I))
if +I'=I
QUIT
Begin DoDot:1
+8 SET X=$GET(^PRC(444,PRCDA,2,I,0))
if X=""
QUIT
+9 SET L=$PIECE(X,"^")
+10 SET ^TMP($JOB,"RFQ","ITEM",L,"QUANTITY")=$PIECE(X,"^",2)
+11 SET ^TMP($JOB,"RFQ","ITEM",L,"UNIT")=$SELECT($PIECE(X,"^",3)]"":$PIECE($GET(^PRCD(420.5,$PIECE(X,"^",3),0)),"^",2),1:"")
+12 SET ^TMP($JOB,"RFQ","ITEM",L,"NSN")=$PIECE(X,"^",6)
+13 SET ^TMP($JOB,"RFQ","ITEM",L,"NDC")=$PIECE(X,"^",8)
+14 SET ^TMP($JOB,"RFQ","ITEM",L,"MFG PART")=$PIECE(X,"^",9)
End DoDot:1
+15 QUIT
