PRCOE2 ;WISC/DJM-IFCAP SEGMENTS IT,DE ;12/26/02 18:18
V ;;5.1;IFCAP;**63,221**;Oct 20, 2000;Build 14
;Per VA Directive 6402, this routine should not be modified.
;
;PRC*5.1*221 Modify an item description display to skip '|' logic
; if description contains a undefined display command
; like '| IN '
;
;;
;;THIS ROUTINE AT THE 'IT' ENTRY POINT CREATES ONE 'IT' SEGMENTS FOR EACH
;;ITEM IN THE P.O. TRANSACTION. IT ALSO CREATES ALL THE 'DE' SEGMENTS
;;NEEDED FOR EACH 'IT' SEGMENT. THE LAST THING DONE IN THIS ROUTINE IS
;;TO UPDATE THE 'HE' SEGMENT AT FIELD NAME 'LINE COUNT' TO REFLECT THE
;;NUMBER OF 'IT' SEGMENTS IN THIS TRANSACTION.
;;
;;THIS ROUTINE CREATES THE 'COMMENTS' SEGMENT AT THE 'CO' ENTRY POINT.
;;ADDITIONALLY, THE 'HE' SEGMENT AT THE FIELD NAME 'COMMENT COUNT' IS
;;UPDATED TO REFLECT THE NUMBER OF 'CO' SEGMENTS CREATED.
;;
IT(VAR1,VAR2,TOTAL) ;ITEMS INFORMATION SEGMENT
N AZ,B,C,CN,DC,DE,DELDT,DIS,DIWF,DIWL,DIWR,FOBPOINT,FSC,HAZM,I0,I2
N I4,INC,INN,ITEM,ITEMCNT,J,LI,LIN,LOT,LPRC,LPRC1,M,MPN,MPNO,N,N1L
N NSN,UC,UNIT,UP,UPN,VPN,X,TD,SKU,SKUF,SERNO,SEQU,SCH
N SCHX,RP,PDA,OS,OT,IT,ICNT,PURPIPE,PRCHI,PRCHJ ;PRC*5.1*221
S (ITEM,ITEMCNT)=0
S OS=$P($G(^PRC(442,VAR1,7)),"^",1)+0 ; order status
S TOTAL=$P($G(^PRC(442,VAR1,2,0)),U,4)+7
D PIPECK S ITEM=0 ;PRC*5.1*221
F S ITEM=$O(^PRC(442,VAR1,2,ITEM)) Q:ITEM'>0 S ITEMCNT=ITEMCNT+1 D Q:VAR2]""
.S I0=$G(^PRC(442,VAR1,2,ITEM,0))
.S I2=$G(^PRC(442,VAR1,2,ITEM,2))
.I I2="" S VAR2="NI2N^"_ITEM Q
.S I4=$G(^PRC(442,VAR1,2,ITEM,4))
.S NSN=$P(I0,U,13)
.S FSC=$P(I2,U,3)
.S FSC=$S(FSC]"":$P($G(^PRC(441.2,FSC,0)),U),1:"")
.S NSN=$S(NSN]"":NSN,1:FSC)
.S B="IT^"_$P(I0,U)_"^"_NSN_"^" ; FIELDS 1, 2, 3
.S RP=$P(I0,U,5)
.S INN=""
.S:RP>0 INN=$G(^PRC(441,RP,0))
.S INC=$P(INN,U,12)
.I $P(I0,U,13)="",INC="" S INC=77777
.S B=B_INC_"^" ; FIELD 4
.S VPN=$P(I0,U,6)
.S:$E(VPN,1)="#" VPN=$E(VPN,2,99)
.S B=B_VPN_"^" ; FIELD 5
.;
IT0 .S MPN=$S(RP>0:$G(^PRC(441,RP,3)),1:"")
.I MPN="" S B=B_"^" G IT1 ; FIELD 6 - CONDITION 1
.S MPNO=$P(MPN,U,5)
.S:$E(MPNO,1)="#" MPNO=$E(MPNO,2,99)
.S B=B_MPNO_"^" ; FIELD 6 - CONDITION 2
.;
IT1 .S N=$P(I0,U,15)
.I N]"" S N=$TR($P(N,"-",1,3),"-")
.S B=B_N_"^" ; FIELD 7 (NDC)
.;
.S Q=$P(I0,U,2)
.I OS=45 S Q=0 ; zero for cancelled orders
.I Q="" S VAR2="NQTY^"_$P(I0,U) Q
.S Q=Q\1+(Q#1>0)_"00"
.S B=B_Q_"^" ; FIELD 8 (quantity)
.;
.S UP=$P(I0,U,3)
.I UP="" S VAR2="NUOP^"_$P(I0,U) Q
.S UPN=$G(^PRCD(420.5,UP,0))
.I UPN="" S VAR2="NUPN^"_$P(I0,U) Q
.S UNIT=$P(UPN,U)
.I UNIT="" S VAR2="NUNI^"_$P(I0,U) Q
.S B=B_UNIT_"^" ; FIELD 9
.;
.S UC=$P(I0,U,9)
.I UC="" S VAR2="NAUC^"_$P(I0,U) Q
.I UC="N/C"!(OS=45) S UC=0 ; no charge or canceled
.S UC=$TR($J(UC,11,4)," .","0") ; pad and strip decimal point
.;
IT2 .S B=B_UC_"^^" ; FIELDS 10, 11
.S LIN=$P(I0,U)
.S (DIS,TD)=0
.F S DIS=$O(^PRC(442,VAR1,3,DIS)) G:DIS'>0 IT3 D Q:LIN=LI
. .S DC=$G(^PRC(442,VAR1,3,DIS,0))
. .S LI=$P(DC,U,6)
. .Q
.S TD=1
.S PDA=$P(DC,U,2)
.I $E(PDA,1)'="$" D G IT3
. .S N=$TR($J(PDA,5,2)," .","0")
. .S B=B_N_"^^" ; FIELDS 12, 13 - CONDITION 1
.S PDA=$E(PDA,2,99)
.S N=$TR($J(PDA,10,2)," .","0")
.S B=B_"^"_N_"^" ; FIELDS 12, 13 - CONDITION 2
.;
IT3 .S:'TD B=B_"^^" ; FIELDS 12, 13 - CONDITION 3
.I $P(I0,U,16)>0 D
. .S SKU=$P(I0,U,16)
. .S SKU=$G(^PRCD(420.5,SKU,0))
. .S SKUF=$S($P(I0,U,17)>0:$P(I0,U,17),1:1)
. .S SKU=$P(SKU,U)
. .S B=B_SKU_"^"_SKUF_"^" ; FIELDS 14, 15 - CONDITION 1
.I $P(I0,U,16)'>0 S B=B_UNIT_"^1^" ; FIELDS 14, 15 - CONDITION 2
.;
IT4 .S B=B_"^"_$S($P(I4,U,15)]"":$P(I4,U,15),1:"N")_"^"_$S($P(I4,U,16)]"":$P(I4,U,16),1:"N")_"^" ; FIELDS 16, 17, 18
.S CN=$P(I2,U,2)
.S OT=$P(^PRC(442,VAR1,1),U,7)
.S OT=","_OT_","
.S OT=$S(",1,4,6,10,"[OT:"D",1:"")
.I OT="D",CN="" S VAR2="NCNO^"_$P(I0,U) Q:VAR2]""
.S B=B_CN_"^" ; FIELD 19
.S LPRC=$P($G(^PRC(442,VAR1,1)),U,19)
.S LPRC1=""
.I LPRC>0 S LPRC1=$P($G(^PRC(443.8,LPRC,0)),U)
.I LPRC>0 S:LPRC1=10 LPRC1="A"
.S B=B_LPRC1_"^" ; FIELD 20
.;
IT5 .S (IT,ICNT)=0
.S AZ=$G(^PRC(442,VAR1,2,ITEM,1,0))
.G:$P(AZ,U,4)'>0 IT6
.S DIWR=70
.S DIWL=1
.S DIWF=""
.S DE=0
.K ^UTILITY($J,"W")
.F S DE=$O(^PRC(442,VAR1,2,ITEM,1,DE)) Q:DE="" D
. .S X=$G(^PRC(442,VAR1,2,ITEM,1,DE,0))
. .S X=$S($D(X):X,1:"") S:PURPIPE DIWF=$G(DIWF)_"|"
. .D DIWP^PRCUTL($G(DA))
.S J=$G(^UTILITY($J,"W",1))
.G:J="" IT6
.I J>900 S J=900
.S IT=1
.S ICNT=""
.F I=1:1:J D
. .S N=$G(^UTILITY($J,"W",1,I,0)) S:$L(N)=0 N=" " S N=$TR(N,"^")
. .S M="DE^"_$P(I0,U)_"^"_I_"^"_N_"^|" ; DE SEGMENT FIELDS 1, 2, 3, 4, 5
. .S ^TMP($J,"STRING",ITEMCNT+6+I)=M
. .S TOTAL=TOTAL+1
. .S ICNT=ICNT+1
.K ^UTILITY($J,"W")
.;
IT6 .S B=B_$S(IT:ICNT,1:0)_"^^" ; FIELDS 21, 22
.;
IT7 .S LOT=$P(I4,U,17)
.S SERNO=$P(I4,U,18)
.S HAZM=$P(I2,U,14)
.S B=B_LOT_"^"_SERNO_"^"_HAZM_"^^" ; FIELDS 23, 24, 25, 26
.;
IT8 .S IT=0
.S AZ=$P(^PRC(442,VAR1,0),U)
.S SCH=0
.S SEQU=0
.F S SCH=$O(^PRC(442.8,"AC",AZ,ITEM,SCH)) Q:SCH="" D
. .S SCHX=$G(^PRC(442.8,SCH,0))
. .Q:SCHX=""
. .S SEQU=SEQU+1
. .S IT=1
. .S X=$P(SCHX,U,3)
. .D JD^PRCFDLN
. .S DELDT=$E(X,1,3)+1700_$E(Y,1,3)
. .S M="SC^"_$P(I0,U)_"^"_SEQU_"^"_($P(SCHX,U,5)*100)_"^"_UNIT_"^"_DELDT_"^|"
. .S ^TMP($J,"STRING",ITEMCNT+6+ICNT+SEQU)=M
. .S TOTAL=TOTAL+1
IT9 .S B=B_$S(IT:SEQU,1:0)_"^"_$P(INN,U,15)_"^|" ;FIELDS 27, 28, 29
.S ^TMP($J,"STRING",ITEMCNT+6)=B
.S ITEMCNT=ITEMCNT+ICNT+SEQU
.S B=^TMP($J,"STRING",1) ;ADD 1 TO HE SEGMENT FIELD 12
.S $P(B,U,12)=$P(B,U,12)+1
.S ^TMP($J,"STRING",1)=B
Q
PIPECK ;check for invalid pipe '|IN ' command in item description ;PRC*5.1*221
N PRCITEM
S PURPIPE=0,PRCITEM=0
F PRCHI=1:1 S PRCITEM=$O(^PRC(442,VAR1,2,PRCITEM)),PRCHDIW=0 Q:'PRCITEM D Q:PURPIPE
. F PRCHJ=1:1 S PRCHDIW=$O(^PRC(442,VAR1,2,PRCITEM,1,PRCHDIW)) Q:PRCHDIW'>0 S X=$S($D(^(PRCHDIW,0)):^(0),1:"") D Q:PURPIPE
. . I X["| IN " S PURPIPE=1
. . Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCOE2 6044 printed Dec 13, 2024@02:11:43 Page 2
PRCOE2 ;WISC/DJM-IFCAP SEGMENTS IT,DE ;12/26/02 18:18
V ;;5.1;IFCAP;**63,221**;Oct 20, 2000;Build 14
+1 ;Per VA Directive 6402, this routine should not be modified.
+2 ;
+3 ;PRC*5.1*221 Modify an item description display to skip '|' logic
+4 ; if description contains a undefined display command
+5 ; like '| IN '
+6 ;
+7 ;;
+8 ;;THIS ROUTINE AT THE 'IT' ENTRY POINT CREATES ONE 'IT' SEGMENTS FOR EACH
+9 ;;ITEM IN THE P.O. TRANSACTION. IT ALSO CREATES ALL THE 'DE' SEGMENTS
+10 ;;NEEDED FOR EACH 'IT' SEGMENT. THE LAST THING DONE IN THIS ROUTINE IS
+11 ;;TO UPDATE THE 'HE' SEGMENT AT FIELD NAME 'LINE COUNT' TO REFLECT THE
+12 ;;NUMBER OF 'IT' SEGMENTS IN THIS TRANSACTION.
+13 ;;
+14 ;;THIS ROUTINE CREATES THE 'COMMENTS' SEGMENT AT THE 'CO' ENTRY POINT.
+15 ;;ADDITIONALLY, THE 'HE' SEGMENT AT THE FIELD NAME 'COMMENT COUNT' IS
+16 ;;UPDATED TO REFLECT THE NUMBER OF 'CO' SEGMENTS CREATED.
+17 ;;
IT(VAR1,VAR2,TOTAL) ;ITEMS INFORMATION SEGMENT
+1 NEW AZ,B,C,CN,DC,DE,DELDT,DIS,DIWF,DIWL,DIWR,FOBPOINT,FSC,HAZM,I0,I2
+2 NEW I4,INC,INN,ITEM,ITEMCNT,J,LI,LIN,LOT,LPRC,LPRC1,M,MPN,MPNO,N,N1L
+3 NEW NSN,UC,UNIT,UP,UPN,VPN,X,TD,SKU,SKUF,SERNO,SEQU,SCH
+4 ;PRC*5.1*221
NEW SCHX,RP,PDA,OS,OT,IT,ICNT,PURPIPE,PRCHI,PRCHJ
+5 SET (ITEM,ITEMCNT)=0
+6 ; order status
SET OS=$PIECE($GET(^PRC(442,VAR1,7)),"^",1)+0
+7 SET TOTAL=$PIECE($GET(^PRC(442,VAR1,2,0)),U,4)+7
+8 ;PRC*5.1*221
DO PIPECK
SET ITEM=0
+9 FOR
SET ITEM=$ORDER(^PRC(442,VAR1,2,ITEM))
if ITEM'>0
QUIT
SET ITEMCNT=ITEMCNT+1
Begin DoDot:1
+10 SET I0=$GET(^PRC(442,VAR1,2,ITEM,0))
+11 SET I2=$GET(^PRC(442,VAR1,2,ITEM,2))
+12 IF I2=""
SET VAR2="NI2N^"_ITEM
QUIT
+13 SET I4=$GET(^PRC(442,VAR1,2,ITEM,4))
+14 SET NSN=$PIECE(I0,U,13)
+15 SET FSC=$PIECE(I2,U,3)
+16 SET FSC=$SELECT(FSC]"":$PIECE($GET(^PRC(441.2,FSC,0)),U),1:"")
+17 SET NSN=$SELECT(NSN]"":NSN,1:FSC)
+18 ; FIELDS 1, 2, 3
SET B="IT^"_$PIECE(I0,U)_"^"_NSN_"^"
+19 SET RP=$PIECE(I0,U,5)
+20 SET INN=""
+21 if RP>0
SET INN=$GET(^PRC(441,RP,0))
+22 SET INC=$PIECE(INN,U,12)
+23 IF $PIECE(I0,U,13)=""
IF INC=""
SET INC=77777
+24 ; FIELD 4
SET B=B_INC_"^"
+25 SET VPN=$PIECE(I0,U,6)
+26 if $EXTRACT(VPN,1)="#"
SET VPN=$EXTRACT(VPN,2,99)
+27 ; FIELD 5
SET B=B_VPN_"^"
+28 ;
IT0 SET MPN=$SELECT(RP>0:$GET(^PRC(441,RP,3)),1:"")
+1 ; FIELD 6 - CONDITION 1
IF MPN=""
SET B=B_"^"
GOTO IT1
+2 SET MPNO=$PIECE(MPN,U,5)
+3 if $EXTRACT(MPNO,1)="#"
SET MPNO=$EXTRACT(MPNO,2,99)
+4 ; FIELD 6 - CONDITION 2
SET B=B_MPNO_"^"
+5 ;
IT1 SET N=$PIECE(I0,U,15)
+1 IF N]""
SET N=$TRANSLATE($PIECE(N,"-",1,3),"-")
+2 ; FIELD 7 (NDC)
SET B=B_N_"^"
+3 ;
+4 SET Q=$PIECE(I0,U,2)
+5 ; zero for cancelled orders
IF OS=45
SET Q=0
+6 IF Q=""
SET VAR2="NQTY^"_$PIECE(I0,U)
QUIT
+7 SET Q=Q\1+(Q#1>0)_"00"
+8 ; FIELD 8 (quantity)
SET B=B_Q_"^"
+9 ;
+10 SET UP=$PIECE(I0,U,3)
+11 IF UP=""
SET VAR2="NUOP^"_$PIECE(I0,U)
QUIT
+12 SET UPN=$GET(^PRCD(420.5,UP,0))
+13 IF UPN=""
SET VAR2="NUPN^"_$PIECE(I0,U)
QUIT
+14 SET UNIT=$PIECE(UPN,U)
+15 IF UNIT=""
SET VAR2="NUNI^"_$PIECE(I0,U)
QUIT
+16 ; FIELD 9
SET B=B_UNIT_"^"
+17 ;
+18 SET UC=$PIECE(I0,U,9)
+19 IF UC=""
SET VAR2="NAUC^"_$PIECE(I0,U)
QUIT
+20 ; no charge or canceled
IF UC="N/C"!(OS=45)
SET UC=0
+21 ; pad and strip decimal point
SET UC=$TRANSLATE($JUSTIFY(UC,11,4)," .","0")
+22 ;
IT2 ; FIELDS 10, 11
SET B=B_UC_"^^"
+1 SET LIN=$PIECE(I0,U)
+2 SET (DIS,TD)=0
+3 FOR
SET DIS=$ORDER(^PRC(442,VAR1,3,DIS))
if DIS'>0
GOTO IT3
Begin DoDot:2
+4 SET DC=$GET(^PRC(442,VAR1,3,DIS,0))
+5 SET LI=$PIECE(DC,U,6)
+6 QUIT
End DoDot:2
if LIN=LI
QUIT
+7 SET TD=1
+8 SET PDA=$PIECE(DC,U,2)
+9 IF $EXTRACT(PDA,1)'="$"
Begin DoDot:2
+10 SET N=$TRANSLATE($JUSTIFY(PDA,5,2)," .","0")
+11 ; FIELDS 12, 13 - CONDITION 1
SET B=B_N_"^^"
End DoDot:2
GOTO IT3
+12 SET PDA=$EXTRACT(PDA,2,99)
+13 SET N=$TRANSLATE($JUSTIFY(PDA,10,2)," .","0")
+14 ; FIELDS 12, 13 - CONDITION 2
SET B=B_"^"_N_"^"
+15 ;
IT3 ; FIELDS 12, 13 - CONDITION 3
if 'TD
SET B=B_"^^"
+1 IF $PIECE(I0,U,16)>0
Begin DoDot:2
+2 SET SKU=$PIECE(I0,U,16)
+3 SET SKU=$GET(^PRCD(420.5,SKU,0))
+4 SET SKUF=$SELECT($PIECE(I0,U,17)>0:$PIECE(I0,U,17),1:1)
+5 SET SKU=$PIECE(SKU,U)
+6 ; FIELDS 14, 15 - CONDITION 1
SET B=B_SKU_"^"_SKUF_"^"
End DoDot:2
+7 ; FIELDS 14, 15 - CONDITION 2
IF $PIECE(I0,U,16)'>0
SET B=B_UNIT_"^1^"
+8 ;
IT4 ; FIELDS 16, 17, 18
SET B=B_"^"_$SELECT($PIECE(I4,U,15)]"":$PIECE(I4,U,15),1:"N")_"^"_$SELECT($PIECE(I4,U,16)]"":$PIECE(I4,U,16),1:"N")_"^"
+1 SET CN=$PIECE(I2,U,2)
+2 SET OT=$PIECE(^PRC(442,VAR1,1),U,7)
+3 SET OT=","_OT_","
+4 SET OT=$SELECT(",1,4,6,10,"[OT:"D",1:"")
+5 IF OT="D"
IF CN=""
SET VAR2="NCNO^"_$PIECE(I0,U)
if VAR2]""
QUIT
+6 ; FIELD 19
SET B=B_CN_"^"
+7 SET LPRC=$PIECE($GET(^PRC(442,VAR1,1)),U,19)
+8 SET LPRC1=""
+9 IF LPRC>0
SET LPRC1=$PIECE($GET(^PRC(443.8,LPRC,0)),U)
+10 IF LPRC>0
if LPRC1=10
SET LPRC1="A"
+11 ; FIELD 20
SET B=B_LPRC1_"^"
+12 ;
IT5 SET (IT,ICNT)=0
+1 SET AZ=$GET(^PRC(442,VAR1,2,ITEM,1,0))
+2 if $PIECE(AZ,U,4)'>0
GOTO IT6
+3 SET DIWR=70
+4 SET DIWL=1
+5 SET DIWF=""
+6 SET DE=0
+7 KILL ^UTILITY($JOB,"W")
+8 FOR
SET DE=$ORDER(^PRC(442,VAR1,2,ITEM,1,DE))
if DE=""
QUIT
Begin DoDot:2
+9 SET X=$GET(^PRC(442,VAR1,2,ITEM,1,DE,0))
+10 SET X=$SELECT($DATA(X):X,1:"")
if PURPIPE
SET DIWF=$GET(DIWF)_"|"
+11 DO DIWP^PRCUTL($GET(DA))
End DoDot:2
+12 SET J=$GET(^UTILITY($JOB,"W",1))
+13 if J=""
GOTO IT6
+14 IF J>900
SET J=900
+15 SET IT=1
+16 SET ICNT=""
+17 FOR I=1:1:J
Begin DoDot:2
+18 SET N=$GET(^UTILITY($JOB,"W",1,I,0))
if $LENGTH(N)=0
SET N=" "
SET N=$TRANSLATE(N,"^")
+19 ; DE SEGMENT FIELDS 1, 2, 3, 4, 5
SET M="DE^"_$PIECE(I0,U)_"^"_I_"^"_N_"^|"
+20 SET ^TMP($JOB,"STRING",ITEMCNT+6+I)=M
+21 SET TOTAL=TOTAL+1
+22 SET ICNT=ICNT+1
End DoDot:2
+23 KILL ^UTILITY($JOB,"W")
+24 ;
IT6 ; FIELDS 21, 22
SET B=B_$SELECT(IT:ICNT,1:0)_"^^"
+1 ;
IT7 SET LOT=$PIECE(I4,U,17)
+1 SET SERNO=$PIECE(I4,U,18)
+2 SET HAZM=$PIECE(I2,U,14)
+3 ; FIELDS 23, 24, 25, 26
SET B=B_LOT_"^"_SERNO_"^"_HAZM_"^^"
+4 ;
IT8 SET IT=0
+1 SET AZ=$PIECE(^PRC(442,VAR1,0),U)
+2 SET SCH=0
+3 SET SEQU=0
+4 FOR
SET SCH=$ORDER(^PRC(442.8,"AC",AZ,ITEM,SCH))
if SCH=""
QUIT
Begin DoDot:2
+5 SET SCHX=$GET(^PRC(442.8,SCH,0))
+6 if SCHX=""
QUIT
+7 SET SEQU=SEQU+1
+8 SET IT=1
+9 SET X=$PIECE(SCHX,U,3)
+10 DO JD^PRCFDLN
+11 SET DELDT=$EXTRACT(X,1,3)+1700_$EXTRACT(Y,1,3)
+12 SET M="SC^"_$PIECE(I0,U)_"^"_SEQU_"^"_($PIECE(SCHX,U,5)*100)_"^"_UNIT_"^"_DELDT_"^|"
+13 SET ^TMP($JOB,"STRING",ITEMCNT+6+ICNT+SEQU)=M
+14 SET TOTAL=TOTAL+1
End DoDot:2
IT9 ;FIELDS 27, 28, 29
SET B=B_$SELECT(IT:SEQU,1:0)_"^"_$PIECE(INN,U,15)_"^|"
+1 SET ^TMP($JOB,"STRING",ITEMCNT+6)=B
+2 SET ITEMCNT=ITEMCNT+ICNT+SEQU
+3 ;ADD 1 TO HE SEGMENT FIELD 12
SET B=^TMP($JOB,"STRING",1)
+4 SET $PIECE(B,U,12)=$PIECE(B,U,12)+1
+5 SET ^TMP($JOB,"STRING",1)=B
End DoDot:1
if VAR2]""
QUIT
+6 QUIT
PIPECK ;check for invalid pipe '|IN ' command in item description ;PRC*5.1*221
+1 NEW PRCITEM
+2 SET PURPIPE=0
SET PRCITEM=0
+3 FOR PRCHI=1:1
SET PRCITEM=$ORDER(^PRC(442,VAR1,2,PRCITEM))
SET PRCHDIW=0
if 'PRCITEM
QUIT
Begin DoDot:1
+4 FOR PRCHJ=1:1
SET PRCHDIW=$ORDER(^PRC(442,VAR1,2,PRCITEM,1,PRCHDIW))
if PRCHDIW'>0
QUIT
SET X=$SELECT($DATA(^(PRCHDIW,0)):^(0),1:"")
Begin DoDot:2
+5 IF X["| IN "
SET PURPIPE=1
+6 QUIT
End DoDot:2
if PURPIPE
QUIT
End DoDot:1
if PURPIPE
QUIT
+7 QUIT
