| [613] | 1 | PRCHQRP5 ;WISC/KMB-2237 TRACKING REPORT ;10/6/96 08:53
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | START ;
|
|---|
| 5 | N RFQLINE,X,P,PDATE,XXZ,Z,Z1,STR,XI,ODA,RDA,ITEMNO,COUNT,Y,RFQ,RFQNUM,IMF,PONUM,OLINE,NREC,NLINE,I,LNR
|
|---|
| 6 | N Q,OREC,PHONE,PA,L,STR,RDATA,SORT,DA,DIRUT,DIROUT,DTOUT,DUOUT,II,POP
|
|---|
| 7 | ;
|
|---|
| 8 | W @IOF D EN3^PRCSUT Q:'$D(PRC("SITE")) Q:Y<0
|
|---|
| 9 | S DIC="^PRCS(410,",DIC(0)="AEMQZ",DIC("A")="Select 2237 transaction number: "
|
|---|
| 10 | S DIC("S")="I +^(0),$P($G(^(0)),""^"",4)'=1,$D(^(3)),+^(3)=+$P(PRC(""CP""),"" ""),$P(^(0),""^"",5)=PRC(""SITE"")"
|
|---|
| 11 | D ^DIC K DIC Q:Y<0 S DA=+Y
|
|---|
| 12 | I '$O(^PRC(444,"C",DA,0)) W !,"No RFQ has been created for this 2237.",! H 2 G START
|
|---|
| 13 | S DIR(0)="SM^1:Destination;2:Original 2237 line item"
|
|---|
| 14 | S DIR("?",1)="Enter 1 to sort by destination (PO, RFQ, new 2237)",DIR("?")="or 2 to sort by original 2237 line number"
|
|---|
| 15 | D ^DIR Q:$D(DIRUT) S SORT=Y K DIR
|
|---|
| 16 | W @IOF S %ZIS="MQ" D ^%ZIS Q:POP
|
|---|
| 17 | I $D(IO("Q")) S ZTRTN="PROCESS^PRCHQRP5",ZTSAVE("SORT")="",ZTSAVE("DA")="",ZTSAVE("DUZ")="" D ^%ZTLOAD,^%ZISC G START
|
|---|
| 18 | D PROCESS,^%ZISC H 2 W @IOF G START
|
|---|
| 19 | PROCESS ;
|
|---|
| 20 | S P=1,I=0
|
|---|
| 21 | D NOW^%DTC S Y=X D DD^%DT S PDATE=Y
|
|---|
| 22 | S RFQ=0 F S RFQ=$O(^PRC(444,"C",DA,RFQ)) Q:RFQ="" D
|
|---|
| 23 | .S OREC=$P($G(^PRCS(410,DA,0)),"^")
|
|---|
| 24 | .S RFQNUM=$P($G(^PRC(444,RFQ,0)),"^")
|
|---|
| 25 | .S RFQLINE=0 F S RFQLINE=$O(^PRC(444,"C",DA,RFQ,RFQLINE)) Q:RFQLINE="" D
|
|---|
| 26 | ..S (PONUM,NREC)=""
|
|---|
| 27 | ..S PA=$P($G(^PRC(444,RFQ,0)),"^",4) S:$G(PA)'="" PHONE=$P($G(^VA(200,PA,.13)),"^",5)
|
|---|
| 28 | ..S:$G(PA)'="" PA=$P($G(^VA(200,PA,0)),"^")
|
|---|
| 29 | ..S IMF=$P($G(^PRC(444,RFQ,2,RFQLINE,0)),"^")
|
|---|
| 30 | ..S OLINE=$P($G(^(3)),"^",2),NREC=$P($G(^(3)),"^",6)
|
|---|
| 31 | ..I NREC'="" S NREC=$P($G(^PRCS(410,NREC,0)),"^"),PONUM=$P($G(^PRCS(410,NREC,4)),"^",5)
|
|---|
| 32 | ..S RDATA=OREC_"^"_OLINE_"^"_IMF_"^"_PA_"^"_PHONE
|
|---|
| 33 | ..I SORT=1 F I=PONUM,RFQNUM,NREC I $G(I)'="" S STR(I,OLINE)=RDATA
|
|---|
| 34 | ..I SORT=2 S STR(OLINE)=OREC_"^"_OLINE_"^"_IMF_"^"_RFQNUM_" LINE # "_RFQLINE
|
|---|
| 35 | WRITE ;
|
|---|
| 36 | I '$D(STR) W !,"No data was available for your sort criteria" H 2 Q
|
|---|
| 37 | U IO S (P,Z1)=1 D HDR
|
|---|
| 38 | S Q="" F S Q=$O(STR(Q)) Q:(Z1[U)!(Q="") D
|
|---|
| 39 | .I IOSL-($Y#IOSL)<6 D HOLD Q:Z1[U D HDR
|
|---|
| 40 | .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)
|
|---|
| 41 | .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)
|
|---|
| 42 | QUIT
|
|---|
| 43 | HDR ;
|
|---|
| 44 | W @IOF W !,"2237 TRACKING REPORT",?40,PDATE,?60,"PAGE ",P,!
|
|---|
| 45 | I SORT=1 W !,?10,"DESTINATION",!,"ORIGINAL 2237",?20,"LINE #",?28,"IMF #",?35,"PURCHASING AGENT",?60,"PA PHONE",!
|
|---|
| 46 | I SORT=2 W !,"ORIGINAL 2237",?20,"LINE #",?28,"IMF #",?35,"DESTINATION DESCRIPTION",!
|
|---|
| 47 | ;
|
|---|
| 48 | F II=1:1:8 W "----------"
|
|---|
| 49 | S P=P+1 Q
|
|---|
| 50 | HOLD G HDR:$D(ZTQUEUED) W !,"Press return to continue, '^' to exit: " R XXZ:DTIME S:'$T Z1=U D:Z1'=U HDR Q
|
|---|
| 51 | NOTIFY ; notify users that RFQ quotes are due
|
|---|
| 52 | N %,X,Y,COUNT,STR,XXZ,PDATE,TDATE,SDA,PA,RNUM,I,Z1,ZIP,P,PRCI
|
|---|
| 53 | Q:'$D(DUZ) S I=1,COUNT=0
|
|---|
| 54 | D NOW^%DTC S (Y,TDATE)=$P(%,".") D DD^%DT S PDATE=Y
|
|---|
| 55 | S ZIP="" F S ZIP=$O(^PRC(444,"QD",ZIP)) Q:ZIP="" D
|
|---|
| 56 | .Q:ZIP'=TDATE
|
|---|
| 57 | .S SDA="" F S SDA=$O(^PRC(444,"QD",ZIP,SDA)) Q:SDA="" D
|
|---|
| 58 | ..Q:$P($G(^PRC(444,SDA,0)),"^",4)'=DUZ S PA=$P($G(^VA(200,DUZ,0)),"^")
|
|---|
| 59 | ..S COUNT=COUNT+1,RNUM=$P($G(^PRC(444,SDA,0)),"^"),STR(COUNT)=RNUM_"^"_PA
|
|---|
| 60 | 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
|
|---|
| 61 | I $D(FLAG) K FLAG QUIT
|
|---|
| 62 | I '$D(STR) W !,"There are no RFQs with quotes due today." QUIT
|
|---|
| 63 | W !,"Use this option to create a report of RFQs which require quotations.",!
|
|---|
| 64 | W ! S %ZIS="MQ" D ^%ZIS Q:POP
|
|---|
| 65 | I $D(IO("Q")) S ZTRTN="QUOTES^PRCHQRP5",ZTSAVE("PDATE")="",ZTSAVE("COUNT")="",ZTSAVE("STR(")="" D ^%ZTLOAD,HOME^%ZIS K ZTSK QUIT
|
|---|
| 66 | D QUOTES QUIT
|
|---|
| 67 | QUOTES ;
|
|---|
| 68 | S XXZ=""
|
|---|
| 69 | U IO S (P,Z1)=1 D HDR1
|
|---|
| 70 | F PRCI=1:1:COUNT D Q:XXZ["^"
|
|---|
| 71 | . I PRCL+3>IOSL D HOLD1 Q:XXZ["^"
|
|---|
| 72 | .W !,?20,$P(STR(PRCI),"^"),?45,$P(STR(PRCI),"^",2) S PRCL=PRCL+1
|
|---|
| 73 | I $E(IOST,1,2)="C-"&'$D(ZTQUEUED) R !,"Enter RETURN to continue ",XXZ:DTIME
|
|---|
| 74 | K XXZ,P,Z1,STR,PRCI,PRCL
|
|---|
| 75 | S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC
|
|---|
| 76 | QUIT
|
|---|
| 77 | HOLD1 I $E(IOST,1,2)="C-"&'$D(ZTQUEUED) W !,"Enter RETURN to continue or '^' to exit: " R XXZ:DTIME Q:XXZ["^"
|
|---|
| 78 | HDR1 ;
|
|---|
| 79 | W @IOF
|
|---|
| 80 | W !,"RFQ WITH QUOTATIONS DUE REPORT",?40,PDATE,?70,"PAGE ",P,!
|
|---|
| 81 | W !,?20,"RFQ REFERENCE",?45,"PURCHASING AGENT"
|
|---|
| 82 | S P=P+1,PRCL=4 W ! F I=1:1:8 W "----------"
|
|---|
| 83 | QUIT
|
|---|
