- 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 Mar 13, 2025@21:07:28 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
