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 ---[H[J[2J[HPRCOPHA 1478 printed Dec 13, 2024@02:12:02 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
