| [613] | 1 | PRCHQ11 ;(WASH IRMFO)/LKG-RFQ QUOTE VENDOR INQUIRY ;9/19/96 13:35
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN ;Entry for Quote's Vendor Inquiry
|
|---|
| 5 | S DIC=444,DIC(0)="AEMQ",DIC("A")="Select RFQ: " D ^DIC K DIC
|
|---|
| 6 | G:+Y<1 EX
|
|---|
| 7 | S PRCDA=+Y
|
|---|
| 8 | I $P($G(^PRC(444,PRCDA,8,0)),U,4)'>0 W !," No Quotes on File!" G EN
|
|---|
| 9 | VLKUP ;Loop for selecting vendor
|
|---|
| 10 | K DA S DA(1)=PRCDA,DIR(0)="PAO^PRC(444,DA(1),8,:AEMQ"
|
|---|
| 11 | S DIR("A")="Select Quote Vendor: ",DIR("?",1)="Enter the Name of the Vendor or"
|
|---|
| 12 | S DIR("?")=" enter 'DUN' plus the vendor's Dun & Bradstreet Number."
|
|---|
| 13 | D ^DIR K DIR I +Y<1 G EX:$D(DIROUT)!$D(DTOUT)!$D(DUOUT),EN
|
|---|
| 14 | S PRCVEN=$P(Y,U,2),PRCX=$S(PRCVEN["PRC(440,":$P($G(^PRC(440,$P(PRCVEN,";"),0)),U),1:$P($G(^PRC(444.1,$P(PRCVEN,";"),0)),U))
|
|---|
| 15 | G:PRCX="" VLKUP
|
|---|
| 16 | S DIC="^"_$P(PRCVEN,";",2),L=0,FLDS="[CAPTIONED]",BY=".01"
|
|---|
| 17 | S FR=$TR(PRCX,","," "),TO=$TR(PRCX,",","-"),DIS(0)="I $P(PRCVEN,"";"")=D0"
|
|---|
| 18 | D EN1^DIP K DIC,FLDS,BY,FR,TO,DHD,L,DIS
|
|---|
| 19 | G VLKUP
|
|---|
| 20 | EX K DA,PRCDA,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,PRCVEN,PRCX
|
|---|
| 21 | Q
|
|---|
| 22 | PRTMSG ;Entry point for Printing 864 Text Messages for RFQ
|
|---|
| 23 | S DIC=444,DIC(0)="AEMQ",DIC("A")="Select RFQ: " D ^DIC K DIC
|
|---|
| 24 | G:+Y<1 EX2
|
|---|
| 25 | S PRCDA=+Y,PRCRFQ=$P(Y,U,2)
|
|---|
| 26 | S DIC=444,L=0,BY="[PRCHQ RFQ MESSAGE SORT]",FLDS="[PRCHQ RFQ MESSAGES 2]"
|
|---|
| 27 | S (FR,TO)=PRCRFQ_",?",DHD="TEXT MESSAGES FOR RFQ #: "_PRCRFQ D EN1^DIP
|
|---|
| 28 | K DIC,FLDS,BY,FR,TO,DHD,L
|
|---|
| 29 | G PRTMSG
|
|---|
| 30 | EX2 K DTOUT,DUOUT,Y,PRCDA,PRCRFQ
|
|---|
| 31 | Q
|
|---|
| 32 | PRTRFQ ;Entry point for Viewing RFQ request portion
|
|---|
| 33 | K DIC S DIC=444,DIC(0)="AEMQ",DIC("A")="Select RFQ: " D ^DIC K DIC
|
|---|
| 34 | G:+Y<1 EX3
|
|---|
| 35 | S PRCRFQ=$P(Y,U,2)
|
|---|
| 36 | S DIC=444,BY=.01,FLDS="[PRCHQ RFQ FULL]",L=0,(FR,TO)=PRCRFQ,DHD="@"
|
|---|
| 37 | D EN1^DIP K BY,DIC,DHD,FLDS,FR,L,TO
|
|---|
| 38 | G PRTRFQ
|
|---|
| 39 | EX3 K DTOUT,DUOUT,PRCRFQ,Y
|
|---|
| 40 | Q
|
|---|
