PRCHQRP5 ;WISC/KMB-2237 TRACKING REPORT ;10/6/96 08:53
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
START ;
N RFQLINE,X,P,PDATE,XXZ,Z,Z1,STR,XI,ODA,RDA,ITEMNO,COUNT,Y,RFQ,RFQNUM,IMF,PONUM,OLINE,NREC,NLINE,I,LNR
N Q,OREC,PHONE,PA,L,STR,RDATA,SORT,DA,DIRUT,DIROUT,DTOUT,DUOUT,II,POP
;
W @IOF D EN3^PRCSUT Q:'$D(PRC("SITE")) Q:Y<0
S DIC="^PRCS(410,",DIC(0)="AEMQZ",DIC("A")="Select 2237 transaction number: "
S DIC("S")="I +^(0),$P($G(^(0)),""^"",4)'=1,$D(^(3)),+^(3)=+$P(PRC(""CP""),"" ""),$P(^(0),""^"",5)=PRC(""SITE"")"
D ^DIC K DIC Q:Y<0 S DA=+Y
I '$O(^PRC(444,"C",DA,0)) W !,"No RFQ has been created for this 2237.",! H 2 G START
S DIR(0)="SM^1:Destination;2:Original 2237 line item"
S DIR("?",1)="Enter 1 to sort by destination (PO, RFQ, new 2237)",DIR("?")="or 2 to sort by original 2237 line number"
D ^DIR Q:$D(DIRUT) S SORT=Y K DIR
W @IOF S %ZIS="MQ" D ^%ZIS Q:POP
I $D(IO("Q")) S ZTRTN="PROCESS^PRCHQRP5",ZTSAVE("SORT")="",ZTSAVE("DA")="",ZTSAVE("DUZ")="" D ^%ZTLOAD,^%ZISC G START
D PROCESS,^%ZISC H 2 W @IOF G START
PROCESS ;
S P=1,I=0
D NOW^%DTC S Y=X D DD^%DT S PDATE=Y
S RFQ=0 F S RFQ=$O(^PRC(444,"C",DA,RFQ)) Q:RFQ="" D
.S OREC=$P($G(^PRCS(410,DA,0)),"^")
.S RFQNUM=$P($G(^PRC(444,RFQ,0)),"^")
.S RFQLINE=0 F S RFQLINE=$O(^PRC(444,"C",DA,RFQ,RFQLINE)) Q:RFQLINE="" D
..S (PONUM,NREC)=""
..S PA=$P($G(^PRC(444,RFQ,0)),"^",4) S:$G(PA)'="" PHONE=$P($G(^VA(200,PA,.13)),"^",5)
..S:$G(PA)'="" PA=$P($G(^VA(200,PA,0)),"^")
..S IMF=$P($G(^PRC(444,RFQ,2,RFQLINE,0)),"^")
..S OLINE=$P($G(^(3)),"^",2),NREC=$P($G(^(3)),"^",6)
..I NREC'="" S NREC=$P($G(^PRCS(410,NREC,0)),"^"),PONUM=$P($G(^PRCS(410,NREC,4)),"^",5)
..S RDATA=OREC_"^"_OLINE_"^"_IMF_"^"_PA_"^"_PHONE
..I SORT=1 F I=PONUM,RFQNUM,NREC I $G(I)'="" S STR(I,OLINE)=RDATA
..I SORT=2 S STR(OLINE)=OREC_"^"_OLINE_"^"_IMF_"^"_RFQNUM_" LINE # "_RFQLINE
WRITE ;
I '$D(STR) W !,"No data was available for your sort criteria" H 2 Q
U IO S (P,Z1)=1 D HDR
S Q="" F S Q=$O(STR(Q)) Q:(Z1[U)!(Q="") D
.I IOSL-($Y#IOSL)<6 D HOLD Q:Z1[U D HDR
.I SORT=2 W !,$P(STR(Q),"^"),?20,$P(STR(Q),"^",2),?28,$P(STR(Q),"^",3),?35,$P(STR(Q),"^",4),?60,$P(STR(Q),"^",5)
.I SORT=1 W !,?10,Q S L="" F S L=$O(STR(Q,L)) Q:L="" W !,$P(STR(Q,L),"^"),?20,$P(STR(Q,L),"^",2),?28,$P(STR(Q,L),"^",3),?35,$P(STR(Q,L),"^",4),?60,$P(STR(Q,L),"^",5)
QUIT
HDR ;
W @IOF W !,"2237 TRACKING REPORT",?40,PDATE,?60,"PAGE ",P,!
I SORT=1 W !,?10,"DESTINATION",!,"ORIGINAL 2237",?20,"LINE #",?28,"IMF #",?35,"PURCHASING AGENT",?60,"PA PHONE",!
I SORT=2 W !,"ORIGINAL 2237",?20,"LINE #",?28,"IMF #",?35,"DESTINATION DESCRIPTION",!
;
F II=1:1:8 W "----------"
S P=P+1 Q
HOLD G HDR:$D(ZTQUEUED) W !,"Press return to continue, '^' to exit: " R XXZ:DTIME S:'$T Z1=U D:Z1'=U HDR Q
NOTIFY ; notify users that RFQ quotes are due
N %,X,Y,COUNT,STR,XXZ,PDATE,TDATE,SDA,PA,RNUM,I,Z1,ZIP,P,PRCI
Q:'$D(DUZ) S I=1,COUNT=0
D NOW^%DTC S (Y,TDATE)=$P(%,".") D DD^%DT S PDATE=Y
S ZIP="" F S ZIP=$O(^PRC(444,"QD",ZIP)) Q:ZIP="" D
.Q:ZIP'=TDATE
.S SDA="" F S SDA=$O(^PRC(444,"QD",ZIP,SDA)) Q:SDA="" D
..Q:$P($G(^PRC(444,SDA,0)),"^",4)'=DUZ S PA=$P($G(^VA(200,DUZ,0)),"^")
..S COUNT=COUNT+1,RNUM=$P($G(^PRC(444,SDA,0)),"^"),STR(COUNT)=RNUM_"^"_PA
I $D(STR),$D(FLAG) W !,"You have ",COUNT," RFQ(s) which have quotations due today",!,"Use the RFQs Due Report to review them." K FLAG QUIT
I $D(FLAG) K FLAG QUIT
I '$D(STR) W !,"There are no RFQs with quotes due today." QUIT
W !,"Use this option to create a report of RFQs which require quotations.",!
W ! S %ZIS="MQ" D ^%ZIS Q:POP
I $D(IO("Q")) S ZTRTN="QUOTES^PRCHQRP5",ZTSAVE("PDATE")="",ZTSAVE("COUNT")="",ZTSAVE("STR(")="" D ^%ZTLOAD,HOME^%ZIS K ZTSK QUIT
D QUOTES QUIT
QUOTES ;
S XXZ=""
U IO S (P,Z1)=1 D HDR1
F PRCI=1:1:COUNT D Q:XXZ["^"
. I PRCL+3>IOSL D HOLD1 Q:XXZ["^"
.W !,?20,$P(STR(PRCI),"^"),?45,$P(STR(PRCI),"^",2) S PRCL=PRCL+1
I $E(IOST,1,2)="C-"&'$D(ZTQUEUED) R !,"Enter RETURN to continue ",XXZ:DTIME
K XXZ,P,Z1,STR,PRCI,PRCL
S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC
QUIT
HOLD1 I $E(IOST,1,2)="C-"&'$D(ZTQUEUED) W !,"Enter RETURN to continue or '^' to exit: " R XXZ:DTIME Q:XXZ["^"
HDR1 ;
W @IOF
W !,"RFQ WITH QUOTATIONS DUE REPORT",?40,PDATE,?70,"PAGE ",P,!
W !,?20,"RFQ REFERENCE",?45,"PURCHASING AGENT"
S P=P+1,PRCL=4 W ! F I=1:1:8 W "----------"
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHQRP5 4434 printed Dec 13, 2024@02:10:03 Page 2
PRCHQRP5 ;WISC/KMB-2237 TRACKING REPORT ;10/6/96 08:53
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
START ;
+1 NEW RFQLINE,X,P,PDATE,XXZ,Z,Z1,STR,XI,ODA,RDA,ITEMNO,COUNT,Y,RFQ,RFQNUM,IMF,PONUM,OLINE,NREC,NLINE,I,LNR
+2 NEW Q,OREC,PHONE,PA,L,STR,RDATA,SORT,DA,DIRUT,DIROUT,DTOUT,DUOUT,II,POP
+3 ;
+4 WRITE @IOF
DO EN3^PRCSUT
if '$DATA(PRC("SITE"))
QUIT
if Y<0
QUIT
+5 SET DIC="^PRCS(410,"
SET DIC(0)="AEMQZ"
SET DIC("A")="Select 2237 transaction number: "
+6 SET DIC("S")="I +^(0),$P($G(^(0)),""^"",4)'=1,$D(^(3)),+^(3)=+$P(PRC(""CP""),"" ""),$P(^(0),""^"",5)=PRC(""SITE"")"
+7 DO ^DIC
KILL DIC
if Y<0
QUIT
SET DA=+Y
+8 IF '$ORDER(^PRC(444,"C",DA,0))
WRITE !,"No RFQ has been created for this 2237.",!
HANG 2
GOTO START
+9 SET DIR(0)="SM^1:Destination;2:Original 2237 line item"
+10 SET DIR("?",1)="Enter 1 to sort by destination (PO, RFQ, new 2237)"
SET DIR("?")="or 2 to sort by original 2237 line number"
+11 DO ^DIR
if $DATA(DIRUT)
QUIT
SET SORT=Y
KILL DIR
+12 WRITE @IOF
SET %ZIS="MQ"
DO ^%ZIS
if POP
QUIT
+13 IF $DATA(IO("Q"))
SET ZTRTN="PROCESS^PRCHQRP5"
SET ZTSAVE("SORT")=""
SET ZTSAVE("DA")=""
SET ZTSAVE("DUZ")=""
DO ^%ZTLOAD
DO ^%ZISC
GOTO START
+14 DO PROCESS
DO ^%ZISC
HANG 2
WRITE @IOF
GOTO START
PROCESS ;
+1 SET P=1
SET I=0
+2 DO NOW^%DTC
SET Y=X
DO DD^%DT
SET PDATE=Y
+3 SET RFQ=0
FOR
SET RFQ=$ORDER(^PRC(444,"C",DA,RFQ))
if RFQ=""
QUIT
Begin DoDot:1
+4 SET OREC=$PIECE($GET(^PRCS(410,DA,0)),"^")
+5 SET RFQNUM=$PIECE($GET(^PRC(444,RFQ,0)),"^")
+6 SET RFQLINE=0
FOR
SET RFQLINE=$ORDER(^PRC(444,"C",DA,RFQ,RFQLINE))
if RFQLINE=""
QUIT
Begin DoDot:2
+7 SET (PONUM,NREC)=""
+8 SET PA=$PIECE($GET(^PRC(444,RFQ,0)),"^",4)
if $GET(PA)'=""
SET PHONE=$PIECE($GET(^VA(200,PA,.13)),"^",5)
+9 if $GET(PA)'=""
SET PA=$PIECE($GET(^VA(200,PA,0)),"^")
+10 SET IMF=$PIECE($GET(^PRC(444,RFQ,2,RFQLINE,0)),"^")
+11 SET OLINE=$PIECE($GET(^(3)),"^",2)
SET NREC=$PIECE($GET(^(3)),"^",6)
+12 IF NREC'=""
SET NREC=$PIECE($GET(^PRCS(410,NREC,0)),"^")
SET PONUM=$PIECE($GET(^PRCS(410,NREC,4)),"^",5)
+13 SET RDATA=OREC_"^"_OLINE_"^"_IMF_"^"_PA_"^"_PHONE
+14 IF SORT=1
FOR I=PONUM,RFQNUM,NREC
IF $GET(I)'=""
SET STR(I,OLINE)=RDATA
+15 IF SORT=2
SET STR(OLINE)=OREC_"^"_OLINE_"^"_IMF_"^"_RFQNUM_" LINE # "_RFQLINE
End DoDot:2
End DoDot:1
WRITE ;
+1 IF '$DATA(STR)
WRITE !,"No data was available for your sort criteria"
HANG 2
QUIT
+2 USE IO
SET (P,Z1)=1
DO HDR
+3 SET Q=""
FOR
SET Q=$ORDER(STR(Q))
if (Z1[U)!(Q="")
QUIT
Begin DoDot:1
+4 IF IOSL-($Y#IOSL)<6
DO HOLD
if Z1[U
QUIT
DO HDR
+5 IF SORT=2
WRITE !,$PIECE(STR(Q),"^"),?20,$PIECE(STR(Q),"^",2),?28,$PIECE(STR(Q),"^",3),?35,$PIECE(STR(Q),"^",4),?60,$PIECE(STR(Q),"^",5)
+6 IF SORT=1
WRITE !,?10,Q
SET L=""
FOR
SET L=$ORDER(STR(Q,L))
if L=""
QUIT
WRITE !,$PIECE(STR(Q,L),"^"),?20,$PIECE(STR(Q,L),"^",2),?28,$PIECE(STR(Q,L),"^",3),?35,$PIECE(STR(Q,L),"^",4),?60,$PIECE(STR(Q,L),"^",5)
End DoDot:1
+7 QUIT
HDR ;
+1 WRITE @IOF
WRITE !,"2237 TRACKING REPORT",?40,PDATE,?60,"PAGE ",P,!
+2 IF SORT=1
WRITE !,?10,"DESTINATION",!,"ORIGINAL 2237",?20,"LINE #",?28,"IMF #",?35,"PURCHASING AGENT",?60,"PA PHONE",!
+3 IF SORT=2
WRITE !,"ORIGINAL 2237",?20,"LINE #",?28,"IMF #",?35,"DESTINATION DESCRIPTION",!
+4 ;
+5 FOR II=1:1:8
WRITE "----------"
+6 SET P=P+1
QUIT
HOLD if $DATA(ZTQUEUED)
GOTO HDR
WRITE !,"Press return to continue, '^' to exit: "
READ XXZ:DTIME
if '$TEST
SET Z1=U
if Z1'=U
DO HDR
QUIT
NOTIFY ; notify users that RFQ quotes are due
+1 NEW %,X,Y,COUNT,STR,XXZ,PDATE,TDATE,SDA,PA,RNUM,I,Z1,ZIP,P,PRCI
+2 if '$DATA(DUZ)
QUIT
SET I=1
SET COUNT=0
+3 DO NOW^%DTC
SET (Y,TDATE)=$PIECE(%,".")
DO DD^%DT
SET PDATE=Y
+4 SET ZIP=""
FOR
SET ZIP=$ORDER(^PRC(444,"QD",ZIP))
if ZIP=""
QUIT
Begin DoDot:1
+5 if ZIP'=TDATE
QUIT
+6 SET SDA=""
FOR
SET SDA=$ORDER(^PRC(444,"QD",ZIP,SDA))
if SDA=""
QUIT
Begin DoDot:2
+7 if $PIECE($GET(^PRC(444,SDA,0)),"^",4)'=DUZ
QUIT
SET PA=$PIECE($GET(^VA(200,DUZ,0)),"^")
+8 SET COUNT=COUNT+1
SET RNUM=$PIECE($GET(^PRC(444,SDA,0)),"^")
SET STR(COUNT)=RNUM_"^"_PA
End DoDot:2
End DoDot:1
+9 IF $DATA(STR)
IF $DATA(FLAG)
WRITE !,"You have ",COUNT," RFQ(s) which have quotations due today",!,"Use the RFQs Due Report to review them."
KILL FLAG
QUIT
+10 IF $DATA(FLAG)
KILL FLAG
QUIT
+11 IF '$DATA(STR)
WRITE !,"There are no RFQs with quotes due today."
QUIT
+12 WRITE !,"Use this option to create a report of RFQs which require quotations.",!
+13 WRITE !
SET %ZIS="MQ"
DO ^%ZIS
if POP
QUIT
+14 IF $DATA(IO("Q"))
SET ZTRTN="QUOTES^PRCHQRP5"
SET ZTSAVE("PDATE")=""
SET ZTSAVE("COUNT")=""
SET ZTSAVE("STR(")=""
DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
QUIT
+15 DO QUOTES
QUIT
QUOTES ;
+1 SET XXZ=""
+2 USE IO
SET (P,Z1)=1
DO HDR1
+3 FOR PRCI=1:1:COUNT
Begin DoDot:1
+4 IF PRCL+3>IOSL
DO HOLD1
if XXZ["^"
QUIT
+5 WRITE !,?20,$PIECE(STR(PRCI),"^"),?45,$PIECE(STR(PRCI),"^",2)
SET PRCL=PRCL+1
End DoDot:1
if XXZ["^"
QUIT
+6 IF $EXTRACT(IOST,1,2)="C-"&'$DATA(ZTQUEUED)
READ !,"Enter RETURN to continue ",XXZ:DTIME
+7 KILL XXZ,P,Z1,STR,PRCI,PRCL
+8 if $DATA(ZTQUEUED)
SET ZTREQ="@"
DO ^%ZISC
+9 QUIT
HOLD1 IF $EXTRACT(IOST,1,2)="C-"&'$DATA(ZTQUEUED)
WRITE !,"Enter RETURN to continue or '^' to exit: "
READ XXZ:DTIME
if XXZ["^"
QUIT
HDR1 ;
+1 WRITE @IOF
+2 WRITE !,"RFQ WITH QUOTATIONS DUE REPORT",?40,PDATE,?70,"PAGE ",P,!
+3 WRITE !,?20,"RFQ REFERENCE",?45,"PURCHASING AGENT"
+4 SET P=P+1
SET PRCL=4
WRITE !
FOR I=1:1:8
WRITE "----------"
+5 QUIT
