source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHQRP5.m@ 1582

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