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 Nov 22, 2024@17:19:39 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
