47 lines
2.0 KiB
Mathematica
47 lines
2.0 KiB
Mathematica
PRCHRET ;WISC/AKS-PULL AMENDMENTS BACK TO SUPPLY ;7/19/95 13:56
|
|
;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
PULL ;Return Purchase Order Amendment to Supply
|
|
D ^PRCFSITE Q:'%
|
|
D KILL
|
|
ASKPO ;Ask for purchase order and validate it.
|
|
K DIC("A") S D="E"
|
|
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)"
|
|
S DIC("A")="Select Purchase Order Number: ",DIC=443.6,DIC(0)="AEQZ"
|
|
D IX^DIC K DIC,FSTAT,D G:+Y<0 KILL
|
|
S FLG=0,NODE0=Y(0),PO=Y,PRCFPODA=+Y,PRCFA("PODA")=+Y
|
|
I '$D(^PRC(443.6,+PO,6)) D G ASKPO
|
|
.W !! S X="NO AMENDMENT EXISTS FOR THIS ORDER . OPTION IS BEING ABORTED." D MSG^PRCFQ W !
|
|
I '$$VERIFY^PRCHES5(PRCFPODA) D G KILL
|
|
.W !!,"This Purchase Order has been tampered with. Please notify IFCAP APPLICATION COORDINATOR."
|
|
S AMEND=$O(^PRC(443.6,+PO,6,0)) I +AMEND'>0 D NOSIGN G ASKPO
|
|
S AMEND1=$G(^PRC(443.6,+PO,6,+AMEND,1)) I $P(AMEND1,U,2)="" D NOSIGN G ASKPO
|
|
S PRCFA("AMEND#")=+AMEND,PRCFAA=+AMEND
|
|
W ! D READ I 'Y!($D(DIRUT)) D NOPROC K DIRUT G ASKPO
|
|
I Y D
|
|
.D REMOVE^PRCHES10(+PO,PRCFAA) I Y=-1 W !,"INCOMPLETE RECORD" G KILL
|
|
.N DA,DIE,DR
|
|
.S DIE="^PRC(443.6,"_+PO_",6,",DA=PRCFAA,DR="15///TODAY+7" D ^DIE
|
|
.Q
|
|
W !! G ASKPO
|
|
READ ; Reader
|
|
S DIR(0)="Y",DIR("A")="Amendment",DIR("B")="YES"
|
|
S DIR("A",1)="Are you sure you want to pull back this Purchase Order"
|
|
S DIR("?")="Enter 'NO' or 'N' or '^' to exit this option."
|
|
S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to pull back this Purchase Order to"
|
|
S DIR("?",2)="Supply.",DIR("?",3)=" "
|
|
D ^DIR K DIR
|
|
Q
|
|
NOAMEND ;No amendment to pull
|
|
W !! S X="NO AMENDMENT EXISTS FOR THIS ORDER . OPTION IS BEING ABORTED ." D MSG^PRCFQ W !
|
|
Q
|
|
NOSIGN ; Message Processing for amendments still in Supply
|
|
W !! S X="This Purchase Order Amendment is already in Supply.*" D MSG^PRCFQ W !
|
|
Q
|
|
NOPROC ; Message Processing for exit
|
|
W !! S X="No further processing is being taken on this amendment obligation.*" D MSG^PRCFQ W !
|
|
Q
|
|
KILL ;Kill local variables
|
|
K FLG,%,PO,PRCFA,PRCFAA,PRCFPODA,X,Y,NODE0,AMEND,AMEND1
|
|
Q
|