- PRCHQ12 ;(WASH IRMFO)/LKG-RFQ QUOTE VIEW ;8/6/96 20:44
- ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- QUOTEVU ;View an individual quote
- S DIC=444,DIC(0)="AEMQ",DIC("A")="Select RFQ: ",DIC("S")="I $P($G(^(8,0)),U,4)>0"
- D ^DIC K DIC
- G:+Y<1 EX S PRCDA=+Y
- QLKUP ;Loop for selecting quote
- 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),QUOTEVU
- S PRCVEN=$P(Y,U,2),PRCDA2=+Y
- L +^PRC(444,PRCDA,8,PRCDA2):5 E W !,"This RFQ is in use, please try later!" G QLKUP
- S PRCMODE="P"
- I $$TEST^DDBRT D G EX:$D(DIRUT)!$D(DUOUT)
- . K DIR S DIR(0)="SAM^B:BROWSE;P:PRINT",DIR("B")="BROWSE"
- . S DIR("A")="Do you wish to Browse or Print this quote? "
- . S DIR("?",1)="Enter 'B' to use the FileMan Browser or 'P' to display on Terminal in"
- . S DIR("?")="Scroll Mode or send to Printer" D ^DIR K DIR
- . S PRCMODE=Y
- I PRCMODE="B"!(PRCMODE="b") D G QLKUP
- . D BUILD^PRCHQ12A(PRCVEN,PRCDA,PRCDA2,.PRCTITLE) L -^PRC(444,PRCDA,8,PRCDA2)
- . D BROWSE^DDBR("^TMP($J,""RPT"")","NR",PRCTITLE)
- . K ^TMP($J,"RPT"),PRCDA2,PRCVEN
- I PRCMODE="P"!(PRCMODE="p") D G QLKUP
- . S %ZIS="QP" D ^%ZIS I POP L -^PRC(444,PRCDA,8,PRCDA2) Q
- . I $D(IO("Q")) D Q
- . . S ZTRTN="PRINT^PRCHQ12",ZTDESC="Single Vendor Quote Print"
- . . S ZTSAVE("PRCVEN")="",ZTSAVE("PRCDA")="",ZTSAVE("PRCDA2")=""
- . . D ^%ZTLOAD,HOME^%ZIS K ZTSK L -^PRC(444,PRCDA,8,PRCDA2)
- . D PRINT
- G QLKUP
- EX K DIROUT,DIRUT,DTOUT,DUOUT,PRCDA,PRCDA2,PRCMODE,PRCVEN,X,Y,DIC,DA
- Q
- PRINT ;Printing text of quote
- I $D(ZTQUEUED) L +^PRC(444,PRCDA,8,PRCDA2):1200
- D:'$D(U)!'$D(DT) DT^DICRW U IO
- D BUILD^PRCHQ12A(PRCVEN,PRCDA,PRCDA2,.PRCTITLE)
- L -^PRC(444,PRCDA,8,PRCDA2) D NOW^%DTC S Y=% D DD^%DT S PRCDATE=Y
- S PRCP=0,X="" D HDR G:X["^" EX2 S PRCJ=0
- F S PRCJ=$O(^TMP($J,"RPT",PRCJ)) Q:PRCJ="" D Q:X["^"
- . I PRCL+4>IOSL D HDR Q:X["^"
- . W !,^TMP($J,"RPT",PRCJ) S PRCL=PRCL+1
- I X'["^",$E(IOST,1,2)="C-",'$D(ZTQUEUED) R !!,"Enter RETURN to continue ",X:DTIME
- D ^%ZISC S:$D(ZTQUEUED) ZTREC="@"
- EX2 K ^TMP($J,"RPT"),PRCDA2,PRCVEN,PRCTITLE,PRCP,PRCJ,PRCL,X,Y,%,PRCDATE
- Q
- HDR ;Print header at top of each page
- I PRCP>0,$E(IOST,1,2)="C-",'$D(ZTQUEUED) R !!,"Enter RETURN to continue or '^' to exit: ",X:DTIME Q:X["^"
- S PRCP=PRCP+1
- W:$E(IOST,1,2)="C-"!(PRCP>1) @IOF W !,PRCTITLE,!,?26,"Date: ",PRCDATE W:PRCP>1 ?65,"Page: ",PRCP
- W !! S PRCL=5
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHQ12 2595 printed Feb 18, 2025@23:35:56 Page 2
- PRCHQ12 ;(WASH IRMFO)/LKG-RFQ QUOTE VIEW ;8/6/96 20:44
- +1 ;;5.1;IFCAP;;Oct 20, 2000
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- QUOTEVU ;View an individual quote
- +1 SET DIC=444
- SET DIC(0)="AEMQ"
- SET DIC("A")="Select RFQ: "
- SET DIC("S")="I $P($G(^(8,0)),U,4)>0"
- +2 DO ^DIC
- KILL DIC
- +3 if +Y<1
- GOTO EX
- SET PRCDA=+Y
- QLKUP ;Loop for selecting quote
- +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 QUOTEVU
- +5 SET PRCVEN=$PIECE(Y,U,2)
- SET PRCDA2=+Y
- +6 LOCK +^PRC(444,PRCDA,8,PRCDA2):5
- IF '$TEST
- WRITE !,"This RFQ is in use, please try later!"
- GOTO QLKUP
- +7 SET PRCMODE="P"
- +8 IF $$TEST^DDBRT
- Begin DoDot:1
- +9 KILL DIR
- SET DIR(0)="SAM^B:BROWSE;P:PRINT"
- SET DIR("B")="BROWSE"
- +10 SET DIR("A")="Do you wish to Browse or Print this quote? "
- +11 SET DIR("?",1)="Enter 'B' to use the FileMan Browser or 'P' to display on Terminal in"
- +12 SET DIR("?")="Scroll Mode or send to Printer"
- DO ^DIR
- KILL DIR
- +13 SET PRCMODE=Y
- End DoDot:1
- if $DATA(DIRUT)!$DATA(DUOUT)
- GOTO EX
- +14 IF PRCMODE="B"!(PRCMODE="b")
- Begin DoDot:1
- +15 DO BUILD^PRCHQ12A(PRCVEN,PRCDA,PRCDA2,.PRCTITLE)
- LOCK -^PRC(444,PRCDA,8,PRCDA2)
- +16 DO BROWSE^DDBR("^TMP($J,""RPT"")","NR",PRCTITLE)
- +17 KILL ^TMP($JOB,"RPT"),PRCDA2,PRCVEN
- End DoDot:1
- GOTO QLKUP
- +18 IF PRCMODE="P"!(PRCMODE="p")
- Begin DoDot:1
- +19 SET %ZIS="QP"
- DO ^%ZIS
- IF POP
- LOCK -^PRC(444,PRCDA,8,PRCDA2)
- QUIT
- +20 IF $DATA(IO("Q"))
- Begin DoDot:2
- +21 SET ZTRTN="PRINT^PRCHQ12"
- SET ZTDESC="Single Vendor Quote Print"
- +22 SET ZTSAVE("PRCVEN")=""
- SET ZTSAVE("PRCDA")=""
- SET ZTSAVE("PRCDA2")=""
- +23 DO ^%ZTLOAD
- DO HOME^%ZIS
- KILL ZTSK
- LOCK -^PRC(444,PRCDA,8,PRCDA2)
- End DoDot:2
- QUIT
- +24 DO PRINT
- End DoDot:1
- GOTO QLKUP
- +25 GOTO QLKUP
- EX KILL DIROUT,DIRUT,DTOUT,DUOUT,PRCDA,PRCDA2,PRCMODE,PRCVEN,X,Y,DIC,DA
- +1 QUIT
- PRINT ;Printing text of quote
- +1 IF $DATA(ZTQUEUED)
- LOCK +^PRC(444,PRCDA,8,PRCDA2):1200
- +2 if '$DATA(U)!'$DATA(DT)
- DO DT^DICRW
- USE IO
- +3 DO BUILD^PRCHQ12A(PRCVEN,PRCDA,PRCDA2,.PRCTITLE)
- +4 LOCK -^PRC(444,PRCDA,8,PRCDA2)
- DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- SET PRCDATE=Y
- +5 SET PRCP=0
- SET X=""
- DO HDR
- if X["^"
- GOTO EX2
- SET PRCJ=0
- +6 FOR
- SET PRCJ=$ORDER(^TMP($JOB,"RPT",PRCJ))
- if PRCJ=""
- QUIT
- Begin DoDot:1
- +7 IF PRCL+4>IOSL
- DO HDR
- if X["^"
- QUIT
- +8 WRITE !,^TMP($JOB,"RPT",PRCJ)
- SET PRCL=PRCL+1
- End DoDot:1
- if X["^"
- QUIT
- +9 IF X'["^"
- IF $EXTRACT(IOST,1,2)="C-"
- IF '$DATA(ZTQUEUED)
- READ !!,"Enter RETURN to continue ",X:DTIME
- +10 DO ^%ZISC
- if $DATA(ZTQUEUED)
- SET ZTREC="@"
- EX2 KILL ^TMP($JOB,"RPT"),PRCDA2,PRCVEN,PRCTITLE,PRCP,PRCJ,PRCL,X,Y,%,PRCDATE
- +1 QUIT
- HDR ;Print header at top of each page
- +1 IF PRCP>0
- IF $EXTRACT(IOST,1,2)="C-"
- IF '$DATA(ZTQUEUED)
- READ !!,"Enter RETURN to continue or '^' to exit: ",X:DTIME
- if X["^"
- QUIT
- +2 SET PRCP=PRCP+1
- +3 if $EXTRACT(IOST,1,2)="C-"!(PRCP>1)
- WRITE @IOF
- WRITE !,PRCTITLE,!,?26,"Date: ",PRCDATE
- if PRCP>1
- WRITE ?65,"Page: ",PRCP
- +4 WRITE !!
- SET PRCL=5
- +5 QUIT