PRCHRET.m

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCHRET   2138     printed  Mar 13, 2025@21:15:02                                                                                                                                                                                                     Page 2

PRCHRET   ;WISC/AKS-PULL AMENDMENTS BACK TO SUPPLY ;7/19/95  13:56

 +1       ;;5.1;IFCAP;;Oct 20, 2000

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

PULL      ;Return Purchase Order Amendment to Supply

 +1        DO ^PRCFSITE

           if '%

               QUIT 

 +2        DO KILL

ASKPO     ;Ask for purchase order and validate it.

 +1        KILL DIC("A")

           SET D="E"

 +2        SET 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)"

 +3        SET DIC("A")="Select Purchase Order Number: "

           SET DIC=443.6

           SET DIC(0)="AEQZ"

 +4        DO IX^DIC

           KILL DIC,FSTAT,D

           if +Y<0

               GOTO KILL

 +5        SET FLG=0

           SET NODE0=Y(0)

           SET PO=Y

           SET PRCFPODA=+Y

           SET PRCFA("PODA")=+Y

 +6        IF '$DATA(^PRC(443.6,+PO,6))

               Begin DoDot:1

 +7                WRITE !!

                   SET X="NO AMENDMENT EXISTS FOR THIS ORDER .  OPTION IS BEING ABORTED."

                   DO MSG^PRCFQ

                   WRITE !

               End DoDot:1

               GOTO ASKPO

 +8        IF '$$VERIFY^PRCHES5(PRCFPODA)

               Begin DoDot:1

 +9                WRITE !!,"This Purchase Order has been tampered with.  Please notify IFCAP APPLICATION COORDINATOR."

               End DoDot:1

               GOTO KILL

 +10       SET AMEND=$ORDER(^PRC(443.6,+PO,6,0))

           IF +AMEND'>0

               DO NOSIGN

               GOTO ASKPO

 +11       SET AMEND1=$GET(^PRC(443.6,+PO,6,+AMEND,1))

           IF $PIECE(AMEND1,U,2)=""

               DO NOSIGN

               GOTO ASKPO

 +12       SET PRCFA("AMEND#")=+AMEND

           SET PRCFAA=+AMEND

 +13       WRITE !

           DO READ

           IF 'Y!($DATA(DIRUT))

               DO NOPROC

               KILL DIRUT

               GOTO ASKPO

 +14       IF Y

               Begin DoDot:1

 +15               DO REMOVE^PRCHES10(+PO,PRCFAA)

                   IF Y=-1

                       WRITE !,"INCOMPLETE RECORD"

                       GOTO KILL

 +16               NEW DA,DIE,DR

 +17               SET DIE="^PRC(443.6,"_+PO_",6,"

                   SET DA=PRCFAA

                   SET DR="15///TODAY+7"

                   DO ^DIE

 +18               QUIT 

               End DoDot:1

 +19       WRITE !!

           GOTO ASKPO

READ      ; Reader 

 +1        SET DIR(0)="Y"

           SET DIR("A")="Amendment"

           SET DIR("B")="YES"

 +2        SET DIR("A",1)="Are you sure you want to pull back this Purchase Order"

 +3        SET DIR("?")="Enter 'NO' or 'N' or '^' to exit this option."

 +4        SET DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to pull back this Purchase Order to"

 +5        SET DIR("?",2)="Supply."

           SET DIR("?",3)=" "

 +6        DO ^DIR

           KILL DIR

 +7        QUIT 

NOAMEND   ;No amendment to pull

 +1        WRITE !!

           SET X="NO AMENDMENT EXISTS FOR THIS ORDER .  OPTION IS BEING ABORTED ."

           DO MSG^PRCFQ

           WRITE !

 +2        QUIT 

NOSIGN    ; Message Processing for amendments still in Supply

 +1        WRITE !!

           SET X="This Purchase Order Amendment is already in Supply.*"

           DO MSG^PRCFQ

           WRITE !

 +2        QUIT 

NOPROC    ; Message Processing for exit

 +1        WRITE !!

           SET X="No further processing is being taken on this amendment obligation.*"

           DO MSG^PRCFQ

           WRITE !

 +2        QUIT 

KILL      ;Kill local variables

 +1        KILL FLG,%,PO,PRCFA,PRCFAA,PRCFPODA,X,Y,NODE0,AMEND,AMEND1

 +2        QUIT