source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHQRP6.m@ 1638

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

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1PRCHQRP6 ;WISC/KMB-UNAWARDED RFQS BY STATUS 3/5/96 ;8/6/96 21:06
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4START ;
5 N SCR,X,Y,VALUE,TITLE,DIR,POP,DIRUT
6 W @IOF
7 W !,"Using this option, you can create a report of unawarded RFQs"
8 W !,"sorted by status or sorted by status for a selected purchasing agent"
9 S DIR(0)="SM^A:Status;B:RFQs entered by selected PA"
10 S DIR("?")="Enter A to select a status, B to enter a PA name"
11 S DIR("A")="Enter A, B, or '^' to exit"
12 D ^DIR Q:$D(DIRUT) S VALUE=Y K DIR
13 ;
14 D @VALUE G START
15A ;
16 W @IOF
17 S DIS(0)="I $P($G(^PRC(444,D0,0)),""^"",8)'=5,$P($G(^PRC(444,D0,0)),""^"",8)'=0",TITLE="STATUS" D PRINT QUIT
18B ;
19 W @IOF
20B1 S DIC("A")="Select purchasing agent name, or '^' to exit: "
21 S DIC="^VA(200,",DIC(0)="AEQZ" D ^DIC K DIC Q:+Y<1 S VALUE=+Y
22 I +$P($G(^VA(200,VALUE,400)),"^")<3 W !?5,$P($G(^VA(200,VALUE,0)),U)," is not a purchasing agent." G B1
23 S DIS(0)="I $P($G(^PRC(444,D0,0)),""^"",4)=VALUE,$P($G(^PRC(444,D0,0)),""^"",8)'=5,$P($G(^PRC(444,D0,0)),""^"",8)'=0",TITLE="PURCHASING AGENT"
24 D PRINT QUIT
25 ;
26PRINT ;
27 S L=0,BY=7,DIC="^PRC(444,",DHD="UNAWARDED RFQ REPORT BY "_TITLE,FLDS="[PRCHQ UNAWARDED]"
28 S DIOEND="I $E(IOST,1,2)=""C-"",'$D(ZTQUEUED) R !,""Press return to continue "",X:DTIME"
29 D EN1^DIP
30 K L,FLDS,DIC,DIS,BY,DIOEND,DHD
31 Q
Note: See TracBrowser for help on using the repository browser.