| 1 | PRCHRET ;WISC/AKS-PULL AMENDMENTS BACK TO SUPPLY ;7/19/95 13:56
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | PULL ;Return Purchase Order Amendment to Supply
|
|---|
| 5 | D ^PRCFSITE Q:'%
|
|---|
| 6 | D KILL
|
|---|
| 7 | ASKPO ;Ask for purchase order and validate it.
|
|---|
| 8 | K DIC("A") S D="E"
|
|---|
| 9 | S DIC("S")="I +^(0)=PRC(""SITE"") S FSTAT=$O(^PRC(443.6,""D"",+Y,0)) I FSTAT=26!(FSTAT=31)!(FSTAT=36)!(FSTAT=45)!(FSTAT=71)"
|
|---|
| 10 | S DIC("A")="Select Purchase Order Number: ",DIC=443.6,DIC(0)="AEQZ"
|
|---|
| 11 | D IX^DIC K DIC,FSTAT,D G:+Y<0 KILL
|
|---|
| 12 | S FLG=0,NODE0=Y(0),PO=Y,PRCFPODA=+Y,PRCFA("PODA")=+Y
|
|---|
| 13 | I '$D(^PRC(443.6,+PO,6)) D G ASKPO
|
|---|
| 14 | .W !! S X="NO AMENDMENT EXISTS FOR THIS ORDER . OPTION IS BEING ABORTED." D MSG^PRCFQ W !
|
|---|
| 15 | I '$$VERIFY^PRCHES5(PRCFPODA) D G KILL
|
|---|
| 16 | .W !!,"This Purchase Order has been tampered with. Please notify IFCAP APPLICATION COORDINATOR."
|
|---|
| 17 | S AMEND=$O(^PRC(443.6,+PO,6,0)) I +AMEND'>0 D NOSIGN G ASKPO
|
|---|
| 18 | S AMEND1=$G(^PRC(443.6,+PO,6,+AMEND,1)) I $P(AMEND1,U,2)="" D NOSIGN G ASKPO
|
|---|
| 19 | S PRCFA("AMEND#")=+AMEND,PRCFAA=+AMEND
|
|---|
| 20 | W ! D READ I 'Y!($D(DIRUT)) D NOPROC K DIRUT G ASKPO
|
|---|
| 21 | I Y D
|
|---|
| 22 | .D REMOVE^PRCHES10(+PO,PRCFAA) I Y=-1 W !,"INCOMPLETE RECORD" G KILL
|
|---|
| 23 | .N DA,DIE,DR
|
|---|
| 24 | .S DIE="^PRC(443.6,"_+PO_",6,",DA=PRCFAA,DR="15///TODAY+7" D ^DIE
|
|---|
| 25 | .Q
|
|---|
| 26 | W !! G ASKPO
|
|---|
| 27 | READ ; Reader
|
|---|
| 28 | S DIR(0)="Y",DIR("A")="Amendment",DIR("B")="YES"
|
|---|
| 29 | S DIR("A",1)="Are you sure you want to pull back this Purchase Order"
|
|---|
| 30 | S DIR("?")="Enter 'NO' or 'N' or '^' to exit this option."
|
|---|
| 31 | S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to pull back this Purchase Order to"
|
|---|
| 32 | S DIR("?",2)="Supply.",DIR("?",3)=" "
|
|---|
| 33 | D ^DIR K DIR
|
|---|
| 34 | Q
|
|---|
| 35 | NOAMEND ;No amendment to pull
|
|---|
| 36 | W !! S X="NO AMENDMENT EXISTS FOR THIS ORDER . OPTION IS BEING ABORTED ." D MSG^PRCFQ W !
|
|---|
| 37 | Q
|
|---|
| 38 | NOSIGN ; Message Processing for amendments still in Supply
|
|---|
| 39 | W !! S X="This Purchase Order Amendment is already in Supply.*" D MSG^PRCFQ W !
|
|---|
| 40 | Q
|
|---|
| 41 | NOPROC ; Message Processing for exit
|
|---|
| 42 | W !! S X="No further processing is being taken on this amendment obligation.*" D MSG^PRCFQ W !
|
|---|
| 43 | Q
|
|---|
| 44 | KILL ;Kill local variables
|
|---|
| 45 | K FLG,%,PO,PRCFA,PRCFAA,PRCFPODA,X,Y,NODE0,AMEND,AMEND1
|
|---|
| 46 | Q
|
|---|
