source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHQ11.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1PRCHQ11 ;(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.
4EN ;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
9VLKUP ;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
20EX K DA,PRCDA,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,PRCVEN,PRCX
21 Q
22PRTMSG ;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
30EX2 K DTOUT,DUOUT,Y,PRCDA,PRCRFQ
31 Q
32PRTRFQ ;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
39EX3 K DTOUT,DUOUT,PRCRFQ,Y
40 Q
Note: See TracBrowser for help on using the repository browser.