source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHRET.m@ 1259

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1PRCHRET ;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.
4PULL ;Return Purchase Order Amendment to Supply
5 D ^PRCFSITE Q:'%
6 D KILL
7ASKPO ;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
27READ ; 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
35NOAMEND ;No amendment to pull
36 W !! S X="NO AMENDMENT EXISTS FOR THIS ORDER . OPTION IS BEING ABORTED ." D MSG^PRCFQ W !
37 Q
38NOSIGN ; 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
41NOPROC ; Message Processing for exit
42 W !! S X="No further processing is being taken on this amendment obligation.*" D MSG^PRCFQ W !
43 Q
44KILL ;Kill local variables
45 K FLG,%,PO,PRCFA,PRCFAA,PRCFPODA,X,Y,NODE0,AMEND,AMEND1
46 Q
Note: See TracBrowser for help on using the repository browser.