- PRCHQ11 ;(WASH IRMFO)/LKG-RFQ QUOTE VENDOR INQUIRY ;9/19/96 13:35
- ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- EN ;Entry for Quote's Vendor Inquiry
- S DIC=444,DIC(0)="AEMQ",DIC("A")="Select RFQ: " D ^DIC K DIC
- G:+Y<1 EX
- S PRCDA=+Y
- I $P($G(^PRC(444,PRCDA,8,0)),U,4)'>0 W !," No Quotes on File!" G EN
- VLKUP ;Loop for selecting vendor
- K DA S DA(1)=PRCDA,DIR(0)="PAO^PRC(444,DA(1),8,:AEMQ"
- S DIR("A")="Select Quote Vendor: ",DIR("?",1)="Enter the Name of the Vendor or"
- S DIR("?")=" enter 'DUN' plus the vendor's Dun & Bradstreet Number."
- D ^DIR K DIR I +Y<1 G EX:$D(DIROUT)!$D(DTOUT)!$D(DUOUT),EN
- 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))
- G:PRCX="" VLKUP
- S DIC="^"_$P(PRCVEN,";",2),L=0,FLDS="[CAPTIONED]",BY=".01"
- S FR=$TR(PRCX,","," "),TO=$TR(PRCX,",","-"),DIS(0)="I $P(PRCVEN,"";"")=D0"
- D EN1^DIP K DIC,FLDS,BY,FR,TO,DHD,L,DIS
- G VLKUP
- EX K DA,PRCDA,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,PRCVEN,PRCX
- Q
- PRTMSG ;Entry point for Printing 864 Text Messages for RFQ
- S DIC=444,DIC(0)="AEMQ",DIC("A")="Select RFQ: " D ^DIC K DIC
- G:+Y<1 EX2
- S PRCDA=+Y,PRCRFQ=$P(Y,U,2)
- S DIC=444,L=0,BY="[PRCHQ RFQ MESSAGE SORT]",FLDS="[PRCHQ RFQ MESSAGES 2]"
- S (FR,TO)=PRCRFQ_",?",DHD="TEXT MESSAGES FOR RFQ #: "_PRCRFQ D EN1^DIP
- K DIC,FLDS,BY,FR,TO,DHD,L
- G PRTMSG
- EX2 K DTOUT,DUOUT,Y,PRCDA,PRCRFQ
- Q
- PRTRFQ ;Entry point for Viewing RFQ request portion
- K DIC S DIC=444,DIC(0)="AEMQ",DIC("A")="Select RFQ: " D ^DIC K DIC
- G:+Y<1 EX3
- S PRCRFQ=$P(Y,U,2)
- S DIC=444,BY=.01,FLDS="[PRCHQ RFQ FULL]",L=0,(FR,TO)=PRCRFQ,DHD="@"
- D EN1^DIP K BY,DIC,DHD,FLDS,FR,L,TO
- G PRTRFQ
- EX3 K DTOUT,DUOUT,PRCRFQ,Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHQ11 1760 printed Feb 18, 2025@23:35:55 Page 2
- PRCHQ11 ;(WASH IRMFO)/LKG-RFQ QUOTE VENDOR INQUIRY ;9/19/96 13:35
- +1 ;;5.1;IFCAP;;Oct 20, 2000
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- EN ;Entry for Quote's Vendor Inquiry
- +1 SET DIC=444
- SET DIC(0)="AEMQ"
- SET DIC("A")="Select RFQ: "
- DO ^DIC
- KILL DIC
- +2 if +Y<1
- GOTO EX
- +3 SET PRCDA=+Y
- +4 IF $PIECE($GET(^PRC(444,PRCDA,8,0)),U,4)'>0
- WRITE !," No Quotes on File!"
- GOTO EN
- VLKUP ;Loop for selecting vendor
- +1 KILL DA
- SET DA(1)=PRCDA
- SET DIR(0)="PAO^PRC(444,DA(1),8,:AEMQ"
- +2 SET DIR("A")="Select Quote Vendor: "
- SET DIR("?",1)="Enter the Name of the Vendor or"
- +3 SET DIR("?")=" enter 'DUN' plus the vendor's Dun & Bradstreet Number."
- +4 DO ^DIR
- KILL DIR
- IF +Y<1
- if $DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)
- GOTO EX
- GOTO EN
- +5 SET PRCVEN=$PIECE(Y,U,2)
- SET PRCX=$SELECT(PRCVEN["PRC(440,":$PIECE($GET(^PRC(440,$PIECE(PRCVEN,";"),0)),U),1:$PIECE($GET(^PRC(444.1,$PIECE(PRCVEN,";"),0)),U))
- +6 if PRCX=""
- GOTO VLKUP
- +7 SET DIC="^"_$PIECE(PRCVEN,";",2)
- SET L=0
- SET FLDS="[CAPTIONED]"
- SET BY=".01"
- +8 SET FR=$TRANSLATE(PRCX,","," ")
- SET TO=$TRANSLATE(PRCX,",","-")
- SET DIS(0)="I $P(PRCVEN,"";"")=D0"
- +9 DO EN1^DIP
- KILL DIC,FLDS,BY,FR,TO,DHD,L,DIS
- +10 GOTO VLKUP
- EX KILL DA,PRCDA,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,PRCVEN,PRCX
- +1 QUIT
- PRTMSG ;Entry point for Printing 864 Text Messages for RFQ
- +1 SET DIC=444
- SET DIC(0)="AEMQ"
- SET DIC("A")="Select RFQ: "
- DO ^DIC
- KILL DIC
- +2 if +Y<1
- GOTO EX2
- +3 SET PRCDA=+Y
- SET PRCRFQ=$PIECE(Y,U,2)
- +4 SET DIC=444
- SET L=0
- SET BY="[PRCHQ RFQ MESSAGE SORT]"
- SET FLDS="[PRCHQ RFQ MESSAGES 2]"
- +5 SET (FR,TO)=PRCRFQ_",?"
- SET DHD="TEXT MESSAGES FOR RFQ #: "_PRCRFQ
- DO EN1^DIP
- +6 KILL DIC,FLDS,BY,FR,TO,DHD,L
- +7 GOTO PRTMSG
- EX2 KILL DTOUT,DUOUT,Y,PRCDA,PRCRFQ
- +1 QUIT
- PRTRFQ ;Entry point for Viewing RFQ request portion
- +1 KILL DIC
- SET DIC=444
- SET DIC(0)="AEMQ"
- SET DIC("A")="Select RFQ: "
- DO ^DIC
- KILL DIC
- +2 if +Y<1
- GOTO EX3
- +3 SET PRCRFQ=$PIECE(Y,U,2)
- +4 SET DIC=444
- SET BY=.01
- SET FLDS="[PRCHQ RFQ FULL]"
- SET L=0
- SET (FR,TO)=PRCRFQ
- SET DHD="@"
- +5 DO EN1^DIP
- KILL BY,DIC,DHD,FLDS,FR,L,TO
- +6 GOTO PRTRFQ
- EX3 KILL DTOUT,DUOUT,PRCRFQ,Y
- +1 QUIT
