| 1 | PRCHQ12 ;(WASH IRMFO)/LKG-RFQ QUOTE VIEW ;8/6/96 20:44
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | QUOTEVU ;View an individual quote
|
|---|
| 5 | S DIC=444,DIC(0)="AEMQ",DIC("A")="Select RFQ: ",DIC("S")="I $P($G(^(8,0)),U,4)>0"
|
|---|
| 6 | D ^DIC K DIC
|
|---|
| 7 | G:+Y<1 EX S PRCDA=+Y
|
|---|
| 8 | QLKUP ;Loop for selecting quote
|
|---|
| 9 | K DA S DA(1)=PRCDA,DIR(0)="PAO^PRC(444,DA(1),8,:AEMQ"
|
|---|
| 10 | S DIR("A")="Select Quote Vendor: ",DIR("?",1)="Enter the Name of the Vendor or"
|
|---|
| 11 | S DIR("?")=" enter 'DUN' plus the vendor's Dun & Bradstreet Number."
|
|---|
| 12 | D ^DIR K DIR I +Y<1 G EX:$D(DIROUT)!$D(DTOUT)!$D(DUOUT),QUOTEVU
|
|---|
| 13 | S PRCVEN=$P(Y,U,2),PRCDA2=+Y
|
|---|
| 14 | L +^PRC(444,PRCDA,8,PRCDA2):5 E W !,"This RFQ is in use, please try later!" G QLKUP
|
|---|
| 15 | S PRCMODE="P"
|
|---|
| 16 | I $$TEST^DDBRT D G EX:$D(DIRUT)!$D(DUOUT)
|
|---|
| 17 | . K DIR S DIR(0)="SAM^B:BROWSE;P:PRINT",DIR("B")="BROWSE"
|
|---|
| 18 | . S DIR("A")="Do you wish to Browse or Print this quote? "
|
|---|
| 19 | . S DIR("?",1)="Enter 'B' to use the FileMan Browser or 'P' to display on Terminal in"
|
|---|
| 20 | . S DIR("?")="Scroll Mode or send to Printer" D ^DIR K DIR
|
|---|
| 21 | . S PRCMODE=Y
|
|---|
| 22 | I PRCMODE="B"!(PRCMODE="b") D G QLKUP
|
|---|
| 23 | . D BUILD^PRCHQ12A(PRCVEN,PRCDA,PRCDA2,.PRCTITLE) L -^PRC(444,PRCDA,8,PRCDA2)
|
|---|
| 24 | . D BROWSE^DDBR("^TMP($J,""RPT"")","NR",PRCTITLE)
|
|---|
| 25 | . K ^TMP($J,"RPT"),PRCDA2,PRCVEN
|
|---|
| 26 | I PRCMODE="P"!(PRCMODE="p") D G QLKUP
|
|---|
| 27 | . S %ZIS="QP" D ^%ZIS I POP L -^PRC(444,PRCDA,8,PRCDA2) Q
|
|---|
| 28 | . I $D(IO("Q")) D Q
|
|---|
| 29 | . . S ZTRTN="PRINT^PRCHQ12",ZTDESC="Single Vendor Quote Print"
|
|---|
| 30 | . . S ZTSAVE("PRCVEN")="",ZTSAVE("PRCDA")="",ZTSAVE("PRCDA2")=""
|
|---|
| 31 | . . D ^%ZTLOAD,HOME^%ZIS K ZTSK L -^PRC(444,PRCDA,8,PRCDA2)
|
|---|
| 32 | . D PRINT
|
|---|
| 33 | G QLKUP
|
|---|
| 34 | EX K DIROUT,DIRUT,DTOUT,DUOUT,PRCDA,PRCDA2,PRCMODE,PRCVEN,X,Y,DIC,DA
|
|---|
| 35 | Q
|
|---|
| 36 | PRINT ;Printing text of quote
|
|---|
| 37 | I $D(ZTQUEUED) L +^PRC(444,PRCDA,8,PRCDA2):1200
|
|---|
| 38 | D:'$D(U)!'$D(DT) DT^DICRW U IO
|
|---|
| 39 | D BUILD^PRCHQ12A(PRCVEN,PRCDA,PRCDA2,.PRCTITLE)
|
|---|
| 40 | L -^PRC(444,PRCDA,8,PRCDA2) D NOW^%DTC S Y=% D DD^%DT S PRCDATE=Y
|
|---|
| 41 | S PRCP=0,X="" D HDR G:X["^" EX2 S PRCJ=0
|
|---|
| 42 | F S PRCJ=$O(^TMP($J,"RPT",PRCJ)) Q:PRCJ="" D Q:X["^"
|
|---|
| 43 | . I PRCL+4>IOSL D HDR Q:X["^"
|
|---|
| 44 | . W !,^TMP($J,"RPT",PRCJ) S PRCL=PRCL+1
|
|---|
| 45 | I X'["^",$E(IOST,1,2)="C-",'$D(ZTQUEUED) R !!,"Enter RETURN to continue ",X:DTIME
|
|---|
| 46 | D ^%ZISC S:$D(ZTQUEUED) ZTREC="@"
|
|---|
| 47 | EX2 K ^TMP($J,"RPT"),PRCDA2,PRCVEN,PRCTITLE,PRCP,PRCJ,PRCL,X,Y,%,PRCDATE
|
|---|
| 48 | Q
|
|---|
| 49 | HDR ;Print header at top of each page
|
|---|
| 50 | I PRCP>0,$E(IOST,1,2)="C-",'$D(ZTQUEUED) R !!,"Enter RETURN to continue or '^' to exit: ",X:DTIME Q:X["^"
|
|---|
| 51 | S PRCP=PRCP+1
|
|---|
| 52 | W:$E(IOST,1,2)="C-"!(PRCP>1) @IOF W !,PRCTITLE,!,?26,"Date: ",PRCDATE W:PRCP>1 ?65,"Page: ",PRCP
|
|---|
| 53 | W !! S PRCL=5
|
|---|
| 54 | Q
|
|---|
