source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFCST.m@ 1087

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

initial load of WorldVistAEHR

File size: 947 bytes
RevLine 
[613]1PRCFCST ;WISC@ALTOONA/CLH-CHANGE P.O. STATUS ;10 Sep 89/3:08 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4EN K COUNT I '$D(PRC("SITE")) D ^PRCFSITE Q:'%
5 S DIC=442,DIC(0)="AEMNQ",DIC("A")="Select PURCHASE ORDER: " D ^DIC K DIC G:+Y<0 OUT S PRCFDA=+Y
6 I '$D(^PRC(442,PRCFDA,7)) W $C(7),!,"Current Status is undefined",! Q
7 S PRCFSTAN=$P(^PRC(442,PRCFDA,7),"^") W !,"Current status is: " S DIC=442.3,DIC(0)="MN",X=PRCFSTAN D ^DIC K DIC I +Y<0 W "??" G EN
8 S PRCFSTA=$P(Y,"^",2) W PRCFSTA
9CSTAT S:'$D(COUNT) COUNT=0 S DIC=442.3,DIC("A")="Select NEW STATUS: ",DIC(0)="AEMNQ" S COUNT=COUNT+1 D ^DIC Q:COUNT>2 G:+Y<0 CSTAT S PRCFNST=+Y
10 S %A="Are you sure you want to change the status",%B="",%=1 D ^PRCFYN I %'=1 W $C(7),!," ---- STATUS NOT CHANGED ----" G OUT
11 D WAIT^PRCFYN S X=PRCFNST,DA=PRCFDA D UPD^PRCHSTAT W !!,"Status changed",! G EN
12OUT K DIC,PRCFDA,PRCFSTAN,PRCFSTA,PRCFNST,COUNT Q
Note: See TracBrowser for help on using the repository browser.