PRCOPHA.m

PRCOPHA ;WISC/DJM-IFCAP PHA RETRANSMIT ROUTINE ;1/14/98  17:47

V ;;5.1;IFCAP;;Oct 20, 2000

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

START ;SELECT PO FROM FILE 442 TO RETRANSMIT

 N AA,XX,YY,DIE,DR,DA,%,VAR2,PRCHPO

 S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE"))  S PRCHP("S")="$P(^(0),U,2)<10!($P(^(0),U,2)=25&("";P;S;""'[("";""_$P($G(^(23)),U,11)_"";"")))" D EN3^PRCHPAT I '$D(PRCHPO) W !!,"No P.O. selected...quitting" Q

 S AA=$G(^PRC(442,PRCHPO,12)) I $P(AA,U,10)="" W !!,"This P.O. has never been sent to Austin in a PHA transaction.  It can't be",!,"sent using this option." Q

 I $P(AA,U,16)="n" W !!,"The Purchasing Agent has specified that this order not go out EDI.",!,"This P.O. can't be sent using this option." Q

 S XX=$G(^PRC(442,PRCHPO,1))  I +XX'>0 W !!,"For some reason there is no vendor listed in this P.O.  This P.O. can't be",!,"processed in this option." Q

 S YY=$G(^PRC(440,+XX,3)) I $P(YY,U,2)'="Y" W !!,"This P.O. is not going to a vendor that can accept a P.O. electronically.",!,"This P.O. can't be sent in this option." Q

QUERY W !!,"Do you want to re-transmit PO " S AA=$G(^PRC(442,PRCHPO,0)) W $P(AA,U) S %=2 D YN^DICN Q:%<0  Q:%=2  I %=1 S DIE="^PRC(442,",DA=PRCHPO,DR="18.5///@" D ^DIE S VAR2="" D NEW^PRCOPHA1(PRCHPO,.VAR2) W !!,VAR2,! G START

 I %=0 W !!,"If you have an EDI TRANSACTION REPORT for a rejected PHA transaction",!,"and have corrected the P.O. answer YES to send a new PHA transaction." G QUERY

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCOPHA   1478     printed  Apr 09, 2024@21:12:36                                                                                                                                                                                                     Page 2

PRCOPHA   ;WISC/DJM-IFCAP PHA RETRANSMIT ROUTINE ;1/14/98  17:47

V         ;;5.1;IFCAP;;Oct 20, 2000

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

START     ;SELECT PO FROM FILE 442 TO RETRANSMIT

 +1        NEW AA,XX,YY,DIE,DR,DA,%,VAR2,PRCHPO

 +2        SET PRCF("X")="S"

           DO ^PRCFSITE

           if '$DATA(PRC("SITE"))

               QUIT 

           SET PRCHP("S")="$P(^(0),U,2)<10!($P(^(0),U,2)=25&("";P;S;""'[("";""_$P($G(^(23)),U,11)_"";"")))"

           DO EN3^PRCHPAT

           IF '$DATA(PRCHPO)

               WRITE !!,"No P.O. selected...quitting"

               QUIT 

 +3        SET AA=$GET(^PRC(442,PRCHPO,12))

           IF $PIECE(AA,U,10)=""

               WRITE !!,"This P.O. has never been sent to Austin in a PHA transaction.  It can't be",!,"sent using this option."

               QUIT 

 +4        IF $PIECE(AA,U,16)="n"

               WRITE !!,"The Purchasing Agent has specified that this order not go out EDI.",!,"This P.O. can't be sent using this option."

               QUIT 

 +5        SET XX=$GET(^PRC(442,PRCHPO,1))

           IF +XX'>0

               WRITE !!,"For some reason there is no vendor listed in this P.O.  This P.O. can't be",!,"processed in this option."

               QUIT 

 +6        SET YY=$GET(^PRC(440,+XX,3))

           IF $PIECE(YY,U,2)'="Y"

               WRITE !!,"This P.O. is not going to a vendor that can accept a P.O. electronically.",!,"This P.O. can't be sent in this option."

               QUIT 

QUERY      WRITE !!,"Do you want to re-transmit PO "

           SET AA=$GET(^PRC(442,PRCHPO,0))

           WRITE $PIECE(AA,U)

           SET %=2

           DO YN^DICN

           if %<0

               QUIT 

           if %=2

               QUIT 

           IF %=1

               SET DIE="^PRC(442,"

               SET DA=PRCHPO

               SET DR="18.5///@"

               DO ^DIE

               SET VAR2=""

               DO NEW^PRCOPHA1(PRCHPO,.VAR2)

               WRITE !!,VAR2,!

               GOTO START

 +1        IF %=0

               WRITE !!,"If you have an EDI TRANSACTION REPORT for a rejected PHA transaction",!,"and have corrected the P.O. answer YES to send a new PHA transaction."

               GOTO QUERY