source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHQRP5.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1PRCHQRP5 ;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.
4START ;
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
19PROCESS ;
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
35WRITE ;
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
43HDR ;
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
50HOLD G HDR:$D(ZTQUEUED) W !,"Press return to continue, '^' to exit: " R XXZ:DTIME S:'$T Z1=U D:Z1'=U HDR Q
51NOTIFY ; 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
67QUOTES ;
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
77HOLD1 I $E(IOST,1,2)="C-"&'$D(ZTQUEUED) W !,"Enter RETURN to continue or '^' to exit: " R XXZ:DTIME Q:XXZ["^"
78HDR1 ;
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
Note: See TracBrowser for help on using the repository browser.