PRCHQRP6 ;WISC/KMB-UNAWARDED RFQS BY STATUS 3/5/96 ;8/6/96 21:06
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
START ;
N SCR,X,Y,VALUE,TITLE,DIR,POP,DIRUT
W @IOF
W !,"Using this option, you can create a report of unawarded RFQs"
W !,"sorted by status or sorted by status for a selected purchasing agent"
S DIR(0)="SM^A:Status;B:RFQs entered by selected PA"
S DIR("?")="Enter A to select a status, B to enter a PA name"
S DIR("A")="Enter A, B, or '^' to exit"
D ^DIR Q:$D(DIRUT) S VALUE=Y K DIR
;
D @VALUE G START
A ;
W @IOF
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
B ;
W @IOF
B1 S DIC("A")="Select purchasing agent name, or '^' to exit: "
S DIC="^VA(200,",DIC(0)="AEQZ" D ^DIC K DIC Q:+Y<1 S VALUE=+Y
I +$P($G(^VA(200,VALUE,400)),"^")<3 W !?5,$P($G(^VA(200,VALUE,0)),U)," is not a purchasing agent." G B1
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"
D PRINT QUIT
;
PRINT ;
S L=0,BY=7,DIC="^PRC(444,",DHD="UNAWARDED RFQ REPORT BY "_TITLE,FLDS="[PRCHQ UNAWARDED]"
S DIOEND="I $E(IOST,1,2)=""C-"",'$D(ZTQUEUED) R !,""Press return to continue "",X:DTIME"
D EN1^DIP
K L,FLDS,DIC,DIS,BY,DIOEND,DHD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHQRP6 1366 printed Nov 22, 2024@17:20:09 Page 2
PRCHQRP6 ;WISC/KMB-UNAWARDED RFQS BY STATUS 3/5/96 ;8/6/96 21:06
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
START ;
+1 NEW SCR,X,Y,VALUE,TITLE,DIR,POP,DIRUT
+2 WRITE @IOF
+3 WRITE !,"Using this option, you can create a report of unawarded RFQs"
+4 WRITE !,"sorted by status or sorted by status for a selected purchasing agent"
+5 SET DIR(0)="SM^A:Status;B:RFQs entered by selected PA"
+6 SET DIR("?")="Enter A to select a status, B to enter a PA name"
+7 SET DIR("A")="Enter A, B, or '^' to exit"
+8 DO ^DIR
if $DATA(DIRUT)
QUIT
SET VALUE=Y
KILL DIR
+9 ;
+10 DO @VALUE
GOTO START
A ;
+1 WRITE @IOF
+2 SET DIS(0)="I $P($G(^PRC(444,D0,0)),""^"",8)'=5,$P($G(^PRC(444,D0,0)),""^"",8)'=0"
SET TITLE="STATUS"
DO PRINT
QUIT
B ;
+1 WRITE @IOF
B1 SET DIC("A")="Select purchasing agent name, or '^' to exit: "
+1 SET DIC="^VA(200,"
SET DIC(0)="AEQZ"
DO ^DIC
KILL DIC
if +Y<1
QUIT
SET VALUE=+Y
+2 IF +$PIECE($GET(^VA(200,VALUE,400)),"^")<3
WRITE !?5,$PIECE($GET(^VA(200,VALUE,0)),U)," is not a purchasing agent."
GOTO B1
+3 SET 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"
SET TITLE="PURCHASING AGENT"
+4 DO PRINT
QUIT
+5 ;
PRINT ;
+1 SET L=0
SET BY=7
SET DIC="^PRC(444,"
SET DHD="UNAWARDED RFQ REPORT BY "_TITLE
SET FLDS="[PRCHQ UNAWARDED]"
+2 SET DIOEND="I $E(IOST,1,2)=""C-"",'$D(ZTQUEUED) R !,""Press return to continue "",X:DTIME"
+3 DO EN1^DIP
+4 KILL L,FLDS,DIC,DIS,BY,DIOEND,DHD
+5 QUIT
