- PRCHQRP4 ;WISC/KMB-DISPLAY ABS/AGGREGATE QUOTE ;8/6/96 21:05
- ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- START ;Entry point for aggregate 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,PRCDA,Y Q
- S PRCDA=+Y
- ;
- W ! S %ZIS="MQ" D ^%ZIS I POP K PRCDA,Y Q
- I $D(IO("Q")) S ZTRTN="PROCESS^PRCHQRP4",ZTSAVE("DUZ")="",ZTSAVE("PRCDA")="" D ^%ZTLOAD,^%ZISC K ZTSK G START
- D PROCESS,^%ZISC K PRCDA,Y G START
- PROCESS ;
- N Q,Z1,ITEMNO,ID,I,J,K,L,VEN,ID,ITEMNO,P,STRING,VDUN,VNAME,VN,FOB,TOT,FILE
- N ZIP1,ZIP2,ZIP3,ZIP4,ZIP5,VENDOR,FLAG,PRCFLG,X,Y K ^TMP($J)
- 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,RFQLOAD^PRCHQRP3,DETAIL,WRITE
- K PRCDA,^TMP($J) S:$D(ZTQUEUED) ZTREQ="@"
- QUIT
- WRITE ;
- U IO S (P,Z1)=1 D HDR
- I '$D(STRING) W !,"No dollar totals were entered for vendor quotes",!
- S Q=""
- F S Q=$O(STRING(Q)) Q:Q="" D Q:Z1[U
- . S J=""
- . F S J=$O(STRING(Q,J)) Q:J="" D Q:Z1[U
- . . S K=""
- . . F S K=$O(STRING(Q,J,K)) Q:K="" D Q:Z1[U
- . . . I IOSL-$Y<6 D HDR Q:Z1[U
- . . . W !,$P(STRING(Q,J,K),"^"),?20,$P(STRING(Q,J,K),"^",2),?25,$J($FN($P(STRING(Q,J,K),"^",3),"",2),10)
- . . . W ?40,$P(STRING(Q,J,K),"^",4),?47,$P(STRING(Q,J,K),"^",5),?56,$P(STRING(Q,J,K),"^",6)
- 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
- I Z1'[U,$E(IOST,1,2)="C-",'$D(ZTQUEUED) R !,"Enter RETURN to continue ",Z1:DTIME
- QUIT
- 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,?70,"Page ",P,!,"Quotations Due Date: ",ZIP2,!,"Number of Quotes: ",ZIP3,!,"Number of Items on RFQ: ",ZIP4,!,"Point of Contact: ",ZIP5,!
- W !,?20,"#Items",?30,"Total",?47,"Total"
- W !,"Vendor",?20,"Quoted",?30,"Price",?40,"FOB",?47,"#Msgs.",?56,"Flags",!
- F I=1:1:8 W "----------"
- S P=P+1
- QUIT
- DETAIL ;
- S I=0
- F S I=$O(^PRC(444,PRCDA,8,I)) Q:+I'=I D
- .S TOT=$P($G(^PRC(444,PRCDA,8,I,1)),"^",3) Q:+TOT=0
- .S FOB=$P($G(^PRC(444,PRCDA,8,I,1)),"^")
- .S J=0
- .F S J=$O(^PRC(444,PRCDA,8,I,3,J)) Q:+J'=J D
- . . S K=$G(^PRC(444,PRCDA,8,I,3,J,0)) Q:K=""
- . . I $P(K,"^",10)]"",$P(K,"^",10)'=$P(FOB,"/") S $P(FOB,"/",FOB]""+1)=$P(K,"^",10)
- .S VEN=$P($G(^PRC(444,PRCDA,8,I,0)),"^")
- .S VN=$P(VEN,";"),FILE=$P(VEN,";",2),VNAME="^"_FILE_VN_",0)"
- .S VDUN=0 S:FILE[440 VDUN=$P($G(^PRC(440,VN,7)),"^",12) S:FILE[444.1 VDUN=$P($G(^PRC(444.1,VN,0)),"^",2) S:VDUN="" VDUN=0
- .S VNAME=$P($G(@VNAME),"^") Q:VNAME="" S VNAME=$E(VNAME,1,18)
- .S ITEMNO=$P($G(^PRC(444,PRCDA,8,I,3,0)),"^",4)
- .S STRING(TOT,VNAME,I)=VNAME_"^"_ITEMNO_"^"_TOT_"^"_FOB_"^"_$G(VENDOR(VDUN))
- . K PRCFLG
- . I FOB'=^TMP($J,"RFQ","FOB") S PRCFLG("FOB")=""
- . I $P($G(^PRC(444,PRCDA,8,I,0)),"^",4)>^TMP($J,"RFQ","QUOTE DUE") S PRCFLG("RECVD DATE")=""
- . I ^TMP($J,"RFQ","SET ASIDE") D
- . . I FILE[440,$P($G(^PRC(440,VN,2)),"^",3)='1 S PRCFLG("SIZE")=""
- . . I FILE[444.1,$P($G(^PRC(444.1,VN,0)),"^",5)'=1 S PRCFLG("SIZE")=""
- . I $P($G(^PRC(444,PRCDA,8,I,3,0)),"^",4)'=^TMP($J,"RFQ","NBR ITEMS") S PRCFLG("NBR")=""
- . I $P($G(^PRC(444,PRCDA,8,I,0)),"^",7)]"" S PRCFLG("CONTRACT")=""
- . S J=0
- . F S J=$O(^PRC(444,PRCDA,8,I,3,J)) Q:+J'=J D
- . . S X=$G(^PRC(444,PRCDA,8,I,3,J,0)) Q:X=""
- . . S L=$P(X,"^")
- . . I $P(X,"^",2)'=$G(^TMP($J,"RFQ","ITEM",L,"QUANTITY")) S PRCFLG("QUANTITY")=""
- . . S K=$S($P(X,"^",3)]"":$P($G(^PRCD(420.5,$P(X,"^",3),0)),"^",2),1:"")
- . . I K'=$G(^TMP($J,"RFQ","ITEM",L,"UNIT")) S PRCFLG("UNIT")=""
- . . I $P(X,"^",9)'=$G(^TMP($J,"RFQ","ITEM",L,"MFG PART")) S PRCFLG("MFG PART")=""
- . . I $P($G(^PRC(444,PRCDA,8,I,3,J,1)),"^",6)]"" S PRCFLG("CONTRACT")=""
- . . I $P(X,"^",4)]"" S PRCFLG("VENDOR PRODUCT #")=""
- . . I $P(X,"^",8)'=$G(^TMP($J,"RFQ","ITEM",L,"NDC")) S PRCFLG("NDC")=""
- . . I $P(X,"^",6)'=$G(^TMP($J,"RFQ","ITEM",L,"NSN")) S PRCFLG("NSN")=""
- . S FLAG=""
- . F J="FOB^F","QUANTITY^Q","UNIT^U","RECVD DATE^DT","SIZE^S","NBR^LI","CONTRACT^C","MFG PART^M","VENDOR PRODUCT #^V","NSN^NSN","NDC^NDC" I $D(PRCFLG($P(J,"^"))) S FLAG=FLAG_$S(FLAG]"":",",1:"")_$P(J,"^",2)
- . S $P(STRING(TOT,VNAME,I),"^",6)=FLAG
- QUIT
- VENDOR ; determine 864 messages for each vendor
- S J=0
- F S J=$O(^PRC(444,PRCDA,7,J)) Q:+J'=J D
- .S ID=$P($G(^PRC(444,PRCDA,7,J,0)),"^",3) Q:ID=""
- .S:'$D(VENDOR(ID)) VENDOR(ID)=0 S VENDOR(ID)=VENDOR(ID)+1
- QUIT
- LEGEND ;Print Flags Legend at end of last page.
- W !!,?5,"Flags Legend:"
- W !,"F=FOB is Different from That Requested"
- W !,"Q=Quantity Quoted is Different from RFQ"
- W !,"U=Unit of Purchase is Different from RFQ"
- W !,"DT=Quote Received at Station after Date/Time Set for Receipt of Quotes"
- W !,"S=RFQ Set-Aside for Small Business But Size Status of Vendor is Large or Missing"
- W !,"LI=Number of Line Items Quoted Differs from Number of RFQ Line Items"
- W !,"C=Vendor Indicates Item(s) on Contract"
- W !,"M=Quoted Mfg. Part Number is Different from that Requested"
- W !,"V=Vendor has Quoted a Vendor Product Number"
- W !,"NSN=National Stock Number Quoted is Different from that Requested"
- W !,"NDC=National Drug Code is Different from that Requested"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHQRP4 5445 printed Apr 23, 2025@18:24:31 Page 2
- PRCHQRP4 ;WISC/KMB-DISPLAY ABS/AGGREGATE QUOTE ;8/6/96 21:05
- +1 ;;5.1;IFCAP;;Oct 20, 2000
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- START ;Entry point for aggregate 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,PRCDA,Y
- 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^PRCHQRP4"
- SET ZTSAVE("DUZ")=""
- SET ZTSAVE("PRCDA")=""
- DO ^%ZTLOAD
- DO ^%ZISC
- KILL ZTSK
- GOTO START
- +7 DO PROCESS
- DO ^%ZISC
- KILL PRCDA,Y
- GOTO START
- PROCESS ;
- +1 NEW Q,Z1,ITEMNO,ID,I,J,K,L,VEN,ID,ITEMNO,P,STRING,VDUN,VNAME,VN,FOB,TOT,FILE
- +2 NEW ZIP1,ZIP2,ZIP3,ZIP4,ZIP5,VENDOR,FLAG,PRCFLG,X,Y
- KILL ^TMP($JOB)
- +3 SET ZIP1=$PIECE($GET(^PRC(444,PRCDA,0)),"^")
- SET ZIP2=$PIECE($GET(^(0)),"^",3)
- SET ZIP3=$PIECE($GET(^(8,0)),"^",4)
- +4 SET ZIP5=$PIECE($GET(^PRC(444,PRCDA,0)),"^",12)
- if ZIP5'=""
- SET ZIP5=$PIECE($GET(^VA(200,ZIP5,0)),"^")
- +5 SET ZIP4=$PIECE($GET(^PRC(444,PRCDA,2,0)),"^",4)
- +6 SET Y=ZIP2
- DO DD^%DT
- SET ZIP2=Y
- +7 DO VENDOR
- DO RFQLOAD^PRCHQRP3
- DO DETAIL
- DO WRITE
- +8 KILL PRCDA,^TMP($JOB)
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +9 QUIT
- WRITE ;
- +1 USE IO
- SET (P,Z1)=1
- DO HDR
- +2 IF '$DATA(STRING)
- WRITE !,"No dollar totals were entered for vendor quotes",!
- +3 SET Q=""
- +4 FOR
- SET Q=$ORDER(STRING(Q))
- if Q=""
- QUIT
- Begin DoDot:1
- +5 SET J=""
- +6 FOR
- SET J=$ORDER(STRING(Q,J))
- if J=""
- QUIT
- Begin DoDot:2
- +7 SET K=""
- +8 FOR
- SET K=$ORDER(STRING(Q,J,K))
- if K=""
- QUIT
- Begin DoDot:3
- +9 IF IOSL-$Y<6
- DO HDR
- if Z1[U
- QUIT
- +10 WRITE !,$PIECE(STRING(Q,J,K),"^"),?20,$PIECE(STRING(Q,J,K),"^",2),?25,$JUSTIFY($FNUMBER($PIECE(STRING(Q,J,K),"^",3),"",2),10)
- +11 WRITE ?40,$PIECE(STRING(Q,J,K),"^",4),?47,$PIECE(STRING(Q,J,K),"^",5),?56,$PIECE(STRING(Q,J,K),"^",6)
- End DoDot:3
- if Z1[U
- QUIT
- End DoDot:2
- if Z1[U
- QUIT
- End DoDot:1
- if Z1[U
- QUIT
- +12 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
- +13 if Z1'[U
- DO LEGEND
- +14 IF Z1'[U
- IF $EXTRACT(IOST,1,2)="C-"
- IF '$DATA(ZTQUEUED)
- READ !,"Enter RETURN to continue ",Z1:DTIME
- +15 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,?70,"Page ",P,!,"Quotations Due Date: ",ZIP2,!,"Number of Quotes: ",ZIP3,!,"Number of Items on RFQ: ",ZIP4,!,"Point of Contact: ",ZIP5,!
- +4 WRITE !,?20,"#Items",?30,"Total",?47,"Total"
- +5 WRITE !,"Vendor",?20,"Quoted",?30,"Price",?40,"FOB",?47,"#Msgs.",?56,"Flags",!
- +6 FOR I=1:1:8
- WRITE "----------"
- +7 SET P=P+1
- +8 QUIT
- DETAIL ;
- +1 SET I=0
- +2 FOR
- SET I=$ORDER(^PRC(444,PRCDA,8,I))
- if +I'=I
- QUIT
- Begin DoDot:1
- +3 SET TOT=$PIECE($GET(^PRC(444,PRCDA,8,I,1)),"^",3)
- if +TOT=0
- QUIT
- +4 SET FOB=$PIECE($GET(^PRC(444,PRCDA,8,I,1)),"^")
- +5 SET J=0
- +6 FOR
- SET J=$ORDER(^PRC(444,PRCDA,8,I,3,J))
- if +J'=J
- QUIT
- Begin DoDot:2
- +7 SET K=$GET(^PRC(444,PRCDA,8,I,3,J,0))
- if K=""
- QUIT
- +8 IF $PIECE(K,"^",10)]""
- IF $PIECE(K,"^",10)'=$PIECE(FOB,"/")
- SET $PIECE(FOB,"/",FOB]""+1)=$PIECE(K,"^",10)
- End DoDot:2
- +9 SET VEN=$PIECE($GET(^PRC(444,PRCDA,8,I,0)),"^")
- +10 SET VN=$PIECE(VEN,";")
- SET FILE=$PIECE(VEN,";",2)
- SET VNAME="^"_FILE_VN_",0)"
- +11 SET VDUN=0
- if FILE[440
- SET VDUN=$PIECE($GET(^PRC(440,VN,7)),"^",12)
- if FILE[444.1
- SET VDUN=$PIECE($GET(^PRC(444.1,VN,0)),"^",2)
- if VDUN=""
- SET VDUN=0
- +12 SET VNAME=$PIECE($GET(@VNAME),"^")
- if VNAME=""
- QUIT
- SET VNAME=$EXTRACT(VNAME,1,18)
- +13 SET ITEMNO=$PIECE($GET(^PRC(444,PRCDA,8,I,3,0)),"^",4)
- +14 SET STRING(TOT,VNAME,I)=VNAME_"^"_ITEMNO_"^"_TOT_"^"_FOB_"^"_$GET(VENDOR(VDUN))
- +15 KILL PRCFLG
- +16 IF FOB'=^TMP($JOB,"RFQ","FOB")
- SET PRCFLG("FOB")=""
- +17 IF $PIECE($GET(^PRC(444,PRCDA,8,I,0)),"^",4)>^TMP($JOB,"RFQ","QUOTE DUE")
- SET PRCFLG("RECVD DATE")=""
- +18 IF ^TMP($JOB,"RFQ","SET ASIDE")
- Begin DoDot:2
- +19 IF FILE[440
- IF $PIECE($GET(^PRC(440,VN,2)),"^",3)='1
- SET PRCFLG("SIZE")=""
- +20 IF FILE[444.1
- IF $PIECE($GET(^PRC(444.1,VN,0)),"^",5)'=1
- SET PRCFLG("SIZE")=""
- End DoDot:2
- +21 IF $PIECE($GET(^PRC(444,PRCDA,8,I,3,0)),"^",4)'=^TMP($JOB,"RFQ","NBR ITEMS")
- SET PRCFLG("NBR")=""
- +22 IF $PIECE($GET(^PRC(444,PRCDA,8,I,0)),"^",7)]""
- SET PRCFLG("CONTRACT")=""
- +23 SET J=0
- +24 FOR
- SET J=$ORDER(^PRC(444,PRCDA,8,I,3,J))
- if +J'=J
- QUIT
- Begin DoDot:2
- +25 SET X=$GET(^PRC(444,PRCDA,8,I,3,J,0))
- if X=""
- QUIT
- +26 SET L=$PIECE(X,"^")
- +27 IF $PIECE(X,"^",2)'=$GET(^TMP($JOB,"RFQ","ITEM",L,"QUANTITY"))
- SET PRCFLG("QUANTITY")=""
- +28 SET K=$SELECT($PIECE(X,"^",3)]"":$PIECE($GET(^PRCD(420.5,$PIECE(X,"^",3),0)),"^",2),1:"")
- +29 IF K'=$GET(^TMP($JOB,"RFQ","ITEM",L,"UNIT"))
- SET PRCFLG("UNIT")=""
- +30 IF $PIECE(X,"^",9)'=$GET(^TMP($JOB,"RFQ","ITEM",L,"MFG PART"))
- SET PRCFLG("MFG PART")=""
- +31 IF $PIECE($GET(^PRC(444,PRCDA,8,I,3,J,1)),"^",6)]""
- SET PRCFLG("CONTRACT")=""
- +32 IF $PIECE(X,"^",4)]""
- SET PRCFLG("VENDOR PRODUCT #")=""
- +33 IF $PIECE(X,"^",8)'=$GET(^TMP($JOB,"RFQ","ITEM",L,"NDC"))
- SET PRCFLG("NDC")=""
- +34 IF $PIECE(X,"^",6)'=$GET(^TMP($JOB,"RFQ","ITEM",L,"NSN"))
- SET PRCFLG("NSN")=""
- End DoDot:2
- +35 SET FLAG=""
- +36 FOR J="FOB^F","QUANTITY^Q","UNIT^U","RECVD DATE^DT","SIZE^S","NBR^LI","CONTRACT^C","MFG PART^M","VENDOR PRODUCT #^V","NSN^NSN","NDC^NDC"
- IF $DATA(PRCFLG($PIECE(J,"^")))
- SET FLAG=FLAG_$SELECT(FLAG]"":",",1:"")_$PIECE(J,"^",2)
- +37 SET $PIECE(STRING(TOT,VNAME,I),"^",6)=FLAG
- End DoDot:1
- +38 QUIT
- VENDOR ; determine 864 messages for each vendor
- +1 SET J=0
- +2 FOR
- SET J=$ORDER(^PRC(444,PRCDA,7,J))
- if +J'=J
- QUIT
- Begin DoDot:1
- +3 SET ID=$PIECE($GET(^PRC(444,PRCDA,7,J,0)),"^",3)
- if ID=""
- QUIT
- +4 if '$DATA(VENDOR(ID))
- SET VENDOR(ID)=0
- SET VENDOR(ID)=VENDOR(ID)+1
- End DoDot:1
- +5 QUIT
- LEGEND ;Print Flags Legend at end of last page.
- +1 WRITE !!,?5,"Flags Legend:"
- +2 WRITE !,"F=FOB is Different from That Requested"
- +3 WRITE !,"Q=Quantity Quoted is Different from RFQ"
- +4 WRITE !,"U=Unit of Purchase is Different from RFQ"
- +5 WRITE !,"DT=Quote Received at Station after Date/Time Set for Receipt of Quotes"
- +6 WRITE !,"S=RFQ Set-Aside for Small Business But Size Status of Vendor is Large or Missing"
- +7 WRITE !,"LI=Number of Line Items Quoted Differs from Number of RFQ Line Items"
- +8 WRITE !,"C=Vendor Indicates Item(s) on Contract"
- +9 WRITE !,"M=Quoted Mfg. Part Number is Different from that Requested"
- +10 WRITE !,"V=Vendor has Quoted a Vendor Product Number"
- +11 WRITE !,"NSN=National Stock Number Quoted is Different from that Requested"
- +12 WRITE !,"NDC=National Drug Code is Different from that Requested"
- +13 QUIT
