PRCFCST ;WISC@ALTOONA/CLH-CHANGE P.O. STATUS ;10 Sep 89/3:08 PM
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
EN K COUNT I '$D(PRC("SITE")) D ^PRCFSITE Q:'%
S DIC=442,DIC(0)="AEMNQ",DIC("A")="Select PURCHASE ORDER: " D ^DIC K DIC G:+Y<0 OUT S PRCFDA=+Y
I '$D(^PRC(442,PRCFDA,7)) W $C(7),!,"Current Status is undefined",! Q
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
S PRCFSTA=$P(Y,"^",2) W PRCFSTA
CSTAT 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
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
D WAIT^PRCFYN S X=PRCFNST,DA=PRCFDA D UPD^PRCHSTAT W !!,"Status changed",! G EN
OUT K DIC,PRCFDA,PRCFSTAN,PRCFSTA,PRCFNST,COUNT Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFCST 959 printed Sep 23, 2025@19:38:44 Page 2
PRCFCST ;WISC@ALTOONA/CLH-CHANGE P.O. STATUS ;10 Sep 89/3:08 PM
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
EN KILL COUNT
IF '$DATA(PRC("SITE"))
DO ^PRCFSITE
if '%
QUIT
+1 SET DIC=442
SET DIC(0)="AEMNQ"
SET DIC("A")="Select PURCHASE ORDER: "
DO ^DIC
KILL DIC
if +Y<0
GOTO OUT
SET PRCFDA=+Y
+2 IF '$DATA(^PRC(442,PRCFDA,7))
WRITE $CHAR(7),!,"Current Status is undefined",!
QUIT
+3 SET PRCFSTAN=$PIECE(^PRC(442,PRCFDA,7),"^")
WRITE !,"Current status is: "
SET DIC=442.3
SET DIC(0)="MN"
SET X=PRCFSTAN
DO ^DIC
KILL DIC
IF +Y<0
WRITE "??"
GOTO EN
+4 SET PRCFSTA=$PIECE(Y,"^",2)
WRITE PRCFSTA
CSTAT if '$DATA(COUNT)
SET COUNT=0
SET DIC=442.3
SET DIC("A")="Select NEW STATUS: "
SET DIC(0)="AEMNQ"
SET COUNT=COUNT+1
DO ^DIC
if COUNT>2
QUIT
if +Y<0
GOTO CSTAT
SET PRCFNST=+Y
+1 SET %A="Are you sure you want to change the status"
SET %B=""
SET %=1
DO ^PRCFYN
IF %'=1
WRITE $CHAR(7),!," ---- STATUS NOT CHANGED ----"
GOTO OUT
+2 DO WAIT^PRCFYN
SET X=PRCFNST
SET DA=PRCFDA
DO UPD^PRCHSTAT
WRITE !!,"Status changed",!
GOTO EN
OUT KILL DIC,PRCFDA,PRCFSTAN,PRCFSTA,PRCFNST,COUNT
QUIT
