- 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 Jan 18, 2025@03:11:15 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