PRCHDP6 ;WISC/DJM-PRINT AMENDMENT, ROUTINE #2 ;9/15/95 11:41 AM
V ;;5.1;IFCAP;**21,131,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 '.
; Also, the check for an existing amendment on an
; item being displayed. This intial check will allow
; for further determination whether the LATEST amendment
; has a pricing effect on the order printed.
;
E22 ;LINE ITEM Delete PRINT
N FIELD,CHANGE,CHANGES,OLD,ITEM,ITEM0,ITEM1,ITEM2,LCNT,DATA,I,UOP
S FIELD=0 K ITEM D LCNT^PRCHDP9(.LCNT)
F S FIELD=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,FIELD)) Q:FIELD'>0 D
.S CHANGE=0 F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,FIELD,CHANGE)) Q:CHANGE'>0 D
..S CHANGES=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,0),OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)
..S ITEM=$P(CHANGES,U,4) Q:$D(ITEM(ITEM)) S ITEM(ITEM)=1
..S ITEM0=$G(^PRC(442,PRCHPO,2,ITEM,0))
..I ITEM0="" Q
..S ITEM1=$G(^PRC(442,PRCHPO,2,ITEM,1,1,0))
..D LINE^PRCHDP9(.LCNT,2) S DATA="The following line item has been cancelled:" D DATA^PRCHDP9(.LCNT,DATA)
..S DATA="Item No. "_$P(ITEM0,U)_" Item Master File No. "
..S DATA=DATA_$P(ITEM0,U,5)_" BOC: "_+$P(ITEM0,U,4)
..S DATA=DATA_" CONTRACT: "_$P($G(^PRC(442,PRCHPO,2,ITEM,2)),U,2)
..D DATA^PRCHDP9(.LCNT,DATA)
..D NEW^PRCHDP7
..S UOP=$S($P(ITEM0,U,3)>0:$P($G(^PRCD(420.5,$P(ITEM0,U,3),0)),U),1:"")
..S DATA=" Items per "_UOP_": "_$P(ITEM0,U,12)
..F I=1:1:26-$L(DATA) S DATA=DATA_" "
..S DATA=DATA_"NSN: "_$P(ITEM0,U,13) D DATA^PRCHDP9(.LCNT,DATA)
..I $P(ITEM0,U,6)]"" S DATA=" STK#: "_$P(ITEM0,U,6) D DATA^PRCHDP9(.LCNT,DATA)
..S QTY=$$FETCH(2,ITEM)
..S AUC=$$FETCH(5,ITEM)
..S UOP=$S($P(ITEM0,U,3)>0:$P($G(^PRCD(420.5,$P(ITEM0,U,3),0)),U),1:"")
..S DATA=" "_QTY_" "_UOP_" at $"_$J(AUC,12,4)_" = $"_$J(QTY*AUC,9,2) D DATA^PRCHDP9(.LCNT,DATA),LCNT1^PRCHDP9(LCNT)
Q
;
E23 ;LINE ITEM Edit PRINT
N FIELD,CHANGE,CHANGES,IMF,BOC,OLD,ITEM,ITEM0,ITEM1,ITEMZ,QTY,AUC,UOP,UOP1,NSN,UCF,LCNT,DATA,DES,VAL,PRCHLN,ABC,VSN,CONOLD,CON442
S FIELD=0 K ITEM D LCNT^PRCHDP9(.LCNT)
F S FIELD=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,FIELD)) Q:FIELD'>0 D
.S CHANGE=0 F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,FIELD,CHANGE)) Q:CHANGE'>0 D
..S CHANGES=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,0),OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)
..S ITEM=$P(CHANGES,U,4) Q:$D(ITEM(ITEM)) S ITEM(ITEM)=1
..S ITEM0=$G(^PRC(442,PRCHPO,2,ITEM,0))
..I ITEM0="" Q
..I $P(ITEM0,U,2)=0,$P(ITEM0,U,9)=0 Q
..S ITEM1=$G(^PRC(442,PRCHPO,2,ITEM,1,1,0))
..S (ABC,DES)=$$FETCH(1,ITEM) S PRCHLN=VAL
..S IMF=$$FETCH(1.5,ITEM) I IMF'>0 S IMF=$P(ITEM0,U,5)
..S BOC=+$$FETCH(3.5,ITEM) I BOC'>0 S BOC=+$P(ITEM0,U,4)
..S QTY=$$FETCH(2,ITEM) I QTY'>0 S QTY=$P(ITEM0,U,2)
..S AUC=$$FETCH(5,ITEM) I AUC="" S AUC=$P(ITEM0,U,9)
..S UOP=$$FETCH(3,ITEM) I UOP'>0 S UOP=$P(ITEM0,U,3)
..S NSN=$$FETCH(9.5,ITEM) I NSN="" S NSN=$P(ITEM0,U,13)
..S UCF=$$FETCH(3.1,ITEM) I UCF'>0 S UCF=$P(ITEM0,U,12)
..S VSN=$$FETCH(9,ITEM) I VSN="" S VSN=$P(ITEM0,U,6)
..S CONOLD=$$FETCH(4,ITEM)
..S CON442=$P($G(^PRC(442,PRCHPO,2,ITEM,2)),U,2)
..I CONOLD="",CON442'="" S CONOLD=CON442
..D LINE^PRCHDP9(.LCNT,2) S DATA="**Currently:"
..D DATA^PRCHDP9(.LCNT,DATA)
..S DATA="Item No. "_$P(ITEM0,U)_" Item Master File No. "_IMF
..S DATA=DATA_" BOC: "_BOC_" CONTRACT: "_CONOLD
..D DATA^PRCHDP9(.LCNT,DATA)
..I $L(ABC)>0 D OLD^PRCHDP7
..I $L(ABC)'>0 S ITEMZ=ITEM1 D NEW^PRCHDP7
..S UOP1=$S($L(UOP)>0:$P($G(^PRCD(420.5,UOP,0)),U),1:"")
..S DATA=" Items per "_UOP1_": "_UCF
..F I=1:1:26-$L(DATA) S DATA=DATA_" "
..S DATA=DATA_"NSN: "_NSN D DATA^PRCHDP9(.LCNT,DATA)
..I $L(VSN)>0 S DATA=" STK#: "_$P(ITEM0,U,6) D DATA^PRCHDP9(.LCNT,DATA)
..S UOP1=$S($L(UOP)>0:$P($G(^PRCD(420.5,UOP,0)),U),1:"")
..S AMDQTY=QTY,AMDVAL=AUC D NXTAMD
..S DATA=" "_AMDQTY_" "_UOP1_" at $"_$J(AMDVAL,12,2)_" = $"_$J(AMDQTY*AMDVAL,9,2) D DATA^PRCHDP9(.LCNT,DATA)
..S DATA=" "
..D DATA^PRCHDP9(.LCNT,DATA)
..S DATA=" **Will now be AMENDED to read:" D DATA^PRCHDP9(.LCNT,DATA)
..S DATA="Item No. "_$P(ITEM0,U)_" Item Master File No. "
..S DATA=DATA_$P(ITEM0,U,5)_" BOC: "_+$P(ITEM0,U,4)
..S DATA=DATA_" CONTRACT: "_CON442
..D DATA^PRCHDP9(.LCNT,DATA)
..S:$D(ITEMZ) ITEM1=ITEMZ D NEW^PRCHDP7
..S UOP1=$S($P(ITEM0,U,3)>0:$P($G(^PRCD(420.5,$P(ITEM0,U,3),0)),U),1:"")
..S DATA=" Items per "_UOP1_": "_$P(ITEM0,U,12)
..F I=1:1:26-$L(DATA) S DATA=DATA_" "
..S DATA=DATA_"NSN: "_$P(ITEM0,U,13) D DATA^PRCHDP9(.LCNT,DATA)
..I $P(ITEM0,U,6)]"" S DATA=" STK#: "_$P(ITEM0,U,6) D DATA^PRCHDP9(.LCNT,DATA)
..S UOP1=$S($P(ITEM0,U,3)>0:$P($G(^PRCD(420.5,$P(ITEM0,U,3),0)),U),1:"")
..S AMDQTY=$P(ITEM0,U,2),AMDVAL=$P(ITEM0,U,9) D NXTAMD1
..S DATA=" "_AMDQTY_" "_UOP1_" at $"_$J(AMDVAL,12,4)_" = $"_$J(AMDQTY*AMDVAL,9,2)
..K AMDQTY,AMDVAL
..D DATA^PRCHDP9(.LCNT,DATA),LCNT1^PRCHDP9(LCNT)
Q
;
FETCH(FIELD,ITEM) ;EXTRINSIC FUNCTION TO RETURN THE 'VALUE' FOR A FIELD FROM 'LINE ITEM
;AMENDMENT' OPTIONS.
N VAL1
S VAL=0 F S VAL=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",21,FIELD,VAL)) Q:VAL'>0 S VAL1=$P(^PRC(442,PRCHPO,6,PRCHAM,3,VAL,0),U,4) I VAL1=ITEM S VAL1=0 G EXIT
S VAL=0 F S VAL=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",22,FIELD,VAL)) Q:VAL'>0 S VAL1=$P(^PRC(442,PRCHPO,6,PRCHAM,3,VAL,0),U,4) I VAL1=ITEM D G EXIT
.S VAL1=^PRC(442,PRCHPO,6,PRCHAM,3,VAL,1,1,0)
.Q
S VAL=0 F S VAL=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",23,FIELD,VAL)) Q:VAL'>0 S VAL1=$P(^PRC(442,PRCHPO,6,PRCHAM,3,VAL,0),U,4) I VAL1=ITEM D G EXIT
.S VAL1=^PRC(442,PRCHPO,6,PRCHAM,3,VAL,1,1,0)
.Q
S VAL1=""
EXIT Q VAL1
NXTAMD ;FIND PREVIOUS CURRENT QTY/COST WHEN MORE THAN 1 AMENDMENT
Q:'$D(^TMP($J,"PRCHDP6"))
N TMPREC
I +$G(PRCHAMNT),$P(^PRC(442,PRCHPO,6,0),U,3)>PRCHAMCT,'$D(^TMP($J,"PRCHDP6",ITEM,PRCHAM)) S PRCHAMNT=2,AMDQTY=$P(ITEM0,U,2),AMDVAL=$P(ITEM0,U,9) Q ;PRC*5.1*221
S TMPREC=^TMP($J,"PRCHDP6",ITEM,PRCHAM)
S AMDQTY=$P(TMPREC,U) S:AMDQTY="" AMDQTY=$P(ITEM0,U,2)
S AMDVAL=$P(TMPREC,U,3) S:AMDVAL="" AMDVAL=$P(ITEM0,U,9)
Q
NXTAMD1 ;FIND PREVIOUS AMENDED TO +INFO WHEN MORE THAN 1
Q:'$D(^TMP($J,"PRCHDP6"))
N TMPREC
I +$G(PRCHAMNT),$P(^PRC(442,PRCHPO,6,0),U,3)>PRCHAMCT,'$D(^TMP($J,"PRCHDP6",ITEM,PRCHAM)) S PRCHAMNT=2,AMDQTY=$P(ITEM0,U,2),AMDVAL=$P(ITEM0,U,9) Q ;PRC*5.1*221
S TMPREC=^TMP($J,"PRCHDP6",ITEM,PRCHAM)
S AMDQTY=$P(TMPREC,U,5) S:AMDQTY="" AMDQTY=$P(ITEM0,U,2)
S AMDVAL=$P(TMPREC,U,7) S:AMDVAL="" AMDVAL=$P(ITEM0,U,9)
Q
AMENDS ;SET UP AMENDMENT HISTORY
Q:'$D(^PRC(442,D0,6))
N ITIEN,AMDQTY,AMDVAL,CURQTY,CURVAL,NXTAMD,HNXTAMD,NXTCHG,NXTFLD,ITEMNO,ITNO,AMDATA,AREC,NAMEND,J,XOLD1
K ^TMP($J,"PRCHDP6") S ITIEN=0
S NXTAMD=0 F S NXTAMD=$O(^PRC(442,D0,6,NXTAMD)) Q:'NXTAMD S HNXTAMD=NXTAMD
AM1 F S ITIEN=$O(^PRC(442,D0,2,ITIEN)) Q:'ITIEN D
. S ITEM0=$G(^PRC(442,D0,2,ITIEN,0)) S CURQTY=$P(ITEM0,U,2),CURVAL=$P(ITEM0,U,9)
. F J=1:1:HNXTAMD S ^TMP($J,"PRCHDP6",ITIEN,J)=CURQTY_U_0_U_CURVAL_U_0_U_CURQTY_U_0_U_CURVAL_U_0
AM2 S NXTAMD=0
AM3 S NXTAMD=$O(^PRC(442,D0,6,NXTAMD)),NXTFLD=0 G AMX:'NXTAMD
AM4 S NXTFLD=$O(^PRC(442,D0,6,NXTAMD,3,"AC",23,NXTFLD)),NXTCHG=0 G:'NXTFLD AM3
AM5 S NXTCHG=$O(^PRC(442,D0,6,NXTAMD,3,"AC",23,NXTFLD,NXTCHG)) G:'NXTCHG AM4
S XOLD1=$G(^PRC(442,D0,6,NXTAMD,3,NXTCHG,0)),ITEMNO=$P(XOLD1,U,4)
COST I $P(XOLD1,U,3)["5;442.01" S NAMEND=0 D
. S AMDVAL=$G(^PRC(442,D0,6,NXTAMD,3,NXTCHG,1,1,0))
. F J=1:1 S NAMEND=$O(^TMP($J,"PRCHDP6",ITEMNO,NAMEND)) Q:NAMEND="" D
.. S AMDATA=^TMP($J,"PRCHDP6",ITEMNO,NAMEND)
.. I $P(AMDATA,U,4)=0,NAMEND'>NXTAMD S $P(^TMP($J,"PRCHDP6",ITEMNO,NAMEND),U,3,4)=AMDVAL_U_NXTAMD
.. I $P(AMDATA,U,8)=0,NAMEND<NXTAMD S $P(^TMP($J,"PRCHDP6",ITEMNO,NAMEND),U,7,8)=AMDVAL_U_NXTAMD
QUANT I $P(XOLD1,U,3)["2;442.01" S NAMEND=0 D
. S AMDQTY=$G(^PRC(442,D0,6,NXTAMD,3,NXTCHG,1,1,0))
. F J=1:1 S NAMEND=$O(^TMP($J,"PRCHDP6",ITEMNO,NAMEND)) Q:NAMEND="" D
.. S AMDATA=^TMP($J,"PRCHDP6",ITEMNO,NAMEND)
.. I $P(AMDATA,U,2)=0,NAMEND'>NXTAMD S $P(^TMP($J,"PRCHDP6",ITEMNO,NAMEND),U,1,2)=AMDQTY_U_NXTAMD
.. I $P(AMDATA,U,6)=0,NAMEND<NXTAMD S $P(^TMP($J,"PRCHDP6",ITEMNO,NAMEND),U,5,6)=AMDQTY_U_NXTAMD
G AM5
AMX Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHDP6 8438 printed Sep 23, 2025@19:42:50 Page 2
PRCHDP6 ;WISC/DJM-PRINT AMENDMENT, ROUTINE #2 ;9/15/95 11:41 AM
V ;;5.1;IFCAP;**21,131,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 ; Also, the check for an existing amendment on an
+7 ; item being displayed. This intial check will allow
+8 ; for further determination whether the LATEST amendment
+9 ; has a pricing effect on the order printed.
+10 ;
E22 ;LINE ITEM Delete PRINT
+1 NEW FIELD,CHANGE,CHANGES,OLD,ITEM,ITEM0,ITEM1,ITEM2,LCNT,DATA,I,UOP
+2 SET FIELD=0
KILL ITEM
DO LCNT^PRCHDP9(.LCNT)
+3 FOR
SET FIELD=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,FIELD))
if FIELD'>0
QUIT
Begin DoDot:1
+4 SET CHANGE=0
FOR
SET CHANGE=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,FIELD,CHANGE))
if CHANGE'>0
QUIT
Begin DoDot:2
+5 SET CHANGES=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,0)
SET OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)
+6 SET ITEM=$PIECE(CHANGES,U,4)
if $DATA(ITEM(ITEM))
QUIT
SET ITEM(ITEM)=1
+7 SET ITEM0=$GET(^PRC(442,PRCHPO,2,ITEM,0))
+8 IF ITEM0=""
QUIT
+9 SET ITEM1=$GET(^PRC(442,PRCHPO,2,ITEM,1,1,0))
+10 DO LINE^PRCHDP9(.LCNT,2)
SET DATA="The following line item has been cancelled:"
DO DATA^PRCHDP9(.LCNT,DATA)
+11 SET DATA="Item No. "_$PIECE(ITEM0,U)_" Item Master File No. "
+12 SET DATA=DATA_$PIECE(ITEM0,U,5)_" BOC: "_+$PIECE(ITEM0,U,4)
+13 SET DATA=DATA_" CONTRACT: "_$PIECE($GET(^PRC(442,PRCHPO,2,ITEM,2)),U,2)
+14 DO DATA^PRCHDP9(.LCNT,DATA)
+15 DO NEW^PRCHDP7
+16 SET UOP=$SELECT($PIECE(ITEM0,U,3)>0:$PIECE($GET(^PRCD(420.5,$PIECE(ITEM0,U,3),0)),U),1:"")
+17 SET DATA=" Items per "_UOP_": "_$PIECE(ITEM0,U,12)
+18 FOR I=1:1:26-$LENGTH(DATA)
SET DATA=DATA_" "
+19 SET DATA=DATA_"NSN: "_$PIECE(ITEM0,U,13)
DO DATA^PRCHDP9(.LCNT,DATA)
+20 IF $PIECE(ITEM0,U,6)]""
SET DATA=" STK#: "_$PIECE(ITEM0,U,6)
DO DATA^PRCHDP9(.LCNT,DATA)
+21 SET QTY=$$FETCH(2,ITEM)
+22 SET AUC=$$FETCH(5,ITEM)
+23 SET UOP=$SELECT($PIECE(ITEM0,U,3)>0:$PIECE($GET(^PRCD(420.5,$PIECE(ITEM0,U,3),0)),U),1:"")
+24 SET DATA=" "_QTY_" "_UOP_" at $"_$JUSTIFY(AUC,12,4)_" = $"_$JUSTIFY(QTY*AUC,9,2)
DO DATA^PRCHDP9(.LCNT,DATA)
DO LCNT1^PRCHDP9(LCNT)
End DoDot:2
End DoDot:1
+25 QUIT
+26 ;
E23 ;LINE ITEM Edit PRINT
+1 NEW FIELD,CHANGE,CHANGES,IMF,BOC,OLD,ITEM,ITEM0,ITEM1,ITEMZ,QTY,AUC,UOP,UOP1,NSN,UCF,LCNT,DATA,DES,VAL,PRCHLN,ABC,VSN,CONOLD,CON442
+2 SET FIELD=0
KILL ITEM
DO LCNT^PRCHDP9(.LCNT)
+3 FOR
SET FIELD=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,FIELD))
if FIELD'>0
QUIT
Begin DoDot:1
+4 SET CHANGE=0
FOR
SET CHANGE=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,FIELD,CHANGE))
if CHANGE'>0
QUIT
Begin DoDot:2
+5 SET CHANGES=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,0)
SET OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)
+6 SET ITEM=$PIECE(CHANGES,U,4)
if $DATA(ITEM(ITEM))
QUIT
SET ITEM(ITEM)=1
+7 SET ITEM0=$GET(^PRC(442,PRCHPO,2,ITEM,0))
+8 IF ITEM0=""
QUIT
+9 IF $PIECE(ITEM0,U,2)=0
IF $PIECE(ITEM0,U,9)=0
QUIT
+10 SET ITEM1=$GET(^PRC(442,PRCHPO,2,ITEM,1,1,0))
+11 SET (ABC,DES)=$$FETCH(1,ITEM)
SET PRCHLN=VAL
+12 SET IMF=$$FETCH(1.5,ITEM)
IF IMF'>0
SET IMF=$PIECE(ITEM0,U,5)
+13 SET BOC=+$$FETCH(3.5,ITEM)
IF BOC'>0
SET BOC=+$PIECE(ITEM0,U,4)
+14 SET QTY=$$FETCH(2,ITEM)
IF QTY'>0
SET QTY=$PIECE(ITEM0,U,2)
+15 SET AUC=$$FETCH(5,ITEM)
IF AUC=""
SET AUC=$PIECE(ITEM0,U,9)
+16 SET UOP=$$FETCH(3,ITEM)
IF UOP'>0
SET UOP=$PIECE(ITEM0,U,3)
+17 SET NSN=$$FETCH(9.5,ITEM)
IF NSN=""
SET NSN=$PIECE(ITEM0,U,13)
+18 SET UCF=$$FETCH(3.1,ITEM)
IF UCF'>0
SET UCF=$PIECE(ITEM0,U,12)
+19 SET VSN=$$FETCH(9,ITEM)
IF VSN=""
SET VSN=$PIECE(ITEM0,U,6)
+20 SET CONOLD=$$FETCH(4,ITEM)
+21 SET CON442=$PIECE($GET(^PRC(442,PRCHPO,2,ITEM,2)),U,2)
+22 IF CONOLD=""
IF CON442'=""
SET CONOLD=CON442
+23 DO LINE^PRCHDP9(.LCNT,2)
SET DATA="**Currently:"
+24 DO DATA^PRCHDP9(.LCNT,DATA)
+25 SET DATA="Item No. "_$PIECE(ITEM0,U)_" Item Master File No. "_IMF
+26 SET DATA=DATA_" BOC: "_BOC_" CONTRACT: "_CONOLD
+27 DO DATA^PRCHDP9(.LCNT,DATA)
+28 IF $LENGTH(ABC)>0
DO OLD^PRCHDP7
+29 IF $LENGTH(ABC)'>0
SET ITEMZ=ITEM1
DO NEW^PRCHDP7
+30 SET UOP1=$SELECT($LENGTH(UOP)>0:$PIECE($GET(^PRCD(420.5,UOP,0)),U),1:"")
+31 SET DATA=" Items per "_UOP1_": "_UCF
+32 FOR I=1:1:26-$LENGTH(DATA)
SET DATA=DATA_" "
+33 SET DATA=DATA_"NSN: "_NSN
DO DATA^PRCHDP9(.LCNT,DATA)
+34 IF $LENGTH(VSN)>0
SET DATA=" STK#: "_$PIECE(ITEM0,U,6)
DO DATA^PRCHDP9(.LCNT,DATA)
+35 SET UOP1=$SELECT($LENGTH(UOP)>0:$PIECE($GET(^PRCD(420.5,UOP,0)),U),1:"")
+36 SET AMDQTY=QTY
SET AMDVAL=AUC
DO NXTAMD
+37 SET DATA=" "_AMDQTY_" "_UOP1_" at $"_$JUSTIFY(AMDVAL,12,2)_" = $"_$JUSTIFY(AMDQTY*AMDVAL,9,2)
DO DATA^PRCHDP9(.LCNT,DATA)
+38 SET DATA=" "
+39 DO DATA^PRCHDP9(.LCNT,DATA)
+40 SET DATA=" **Will now be AMENDED to read:"
DO DATA^PRCHDP9(.LCNT,DATA)
+41 SET DATA="Item No. "_$PIECE(ITEM0,U)_" Item Master File No. "
+42 SET DATA=DATA_$PIECE(ITEM0,U,5)_" BOC: "_+$PIECE(ITEM0,U,4)
+43 SET DATA=DATA_" CONTRACT: "_CON442
+44 DO DATA^PRCHDP9(.LCNT,DATA)
+45 if $DATA(ITEMZ)
SET ITEM1=ITEMZ
DO NEW^PRCHDP7
+46 SET UOP1=$SELECT($PIECE(ITEM0,U,3)>0:$PIECE($GET(^PRCD(420.5,$PIECE(ITEM0,U,3),0)),U),1:"")
+47 SET DATA=" Items per "_UOP1_": "_$PIECE(ITEM0,U,12)
+48 FOR I=1:1:26-$LENGTH(DATA)
SET DATA=DATA_" "
+49 SET DATA=DATA_"NSN: "_$PIECE(ITEM0,U,13)
DO DATA^PRCHDP9(.LCNT,DATA)
+50 IF $PIECE(ITEM0,U,6)]""
SET DATA=" STK#: "_$PIECE(ITEM0,U,6)
DO DATA^PRCHDP9(.LCNT,DATA)
+51 SET UOP1=$SELECT($PIECE(ITEM0,U,3)>0:$PIECE($GET(^PRCD(420.5,$PIECE(ITEM0,U,3),0)),U),1:"")
+52 SET AMDQTY=$PIECE(ITEM0,U,2)
SET AMDVAL=$PIECE(ITEM0,U,9)
DO NXTAMD1
+53 SET DATA=" "_AMDQTY_" "_UOP1_" at $"_$JUSTIFY(AMDVAL,12,4)_" = $"_$JUSTIFY(AMDQTY*AMDVAL,9,2)
+54 KILL AMDQTY,AMDVAL
+55 DO DATA^PRCHDP9(.LCNT,DATA)
DO LCNT1^PRCHDP9(LCNT)
End DoDot:2
End DoDot:1
+56 QUIT
+57 ;
FETCH(FIELD,ITEM) ;EXTRINSIC FUNCTION TO RETURN THE 'VALUE' FOR A FIELD FROM 'LINE ITEM
+1 ;AMENDMENT' OPTIONS.
+2 NEW VAL1
+3 SET VAL=0
FOR
SET VAL=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",21,FIELD,VAL))
if VAL'>0
QUIT
SET VAL1=$PIECE(^PRC(442,PRCHPO,6,PRCHAM,3,VAL,0),U,4)
IF VAL1=ITEM
SET VAL1=0
GOTO EXIT
+4 SET VAL=0
FOR
SET VAL=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",22,FIELD,VAL))
if VAL'>0
QUIT
SET VAL1=$PIECE(^PRC(442,PRCHPO,6,PRCHAM,3,VAL,0),U,4)
IF VAL1=ITEM
Begin DoDot:1
+5 SET VAL1=^PRC(442,PRCHPO,6,PRCHAM,3,VAL,1,1,0)
+6 QUIT
End DoDot:1
GOTO EXIT
+7 SET VAL=0
FOR
SET VAL=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",23,FIELD,VAL))
if VAL'>0
QUIT
SET VAL1=$PIECE(^PRC(442,PRCHPO,6,PRCHAM,3,VAL,0),U,4)
IF VAL1=ITEM
Begin DoDot:1
+8 SET VAL1=^PRC(442,PRCHPO,6,PRCHAM,3,VAL,1,1,0)
+9 QUIT
End DoDot:1
GOTO EXIT
+10 SET VAL1=""
EXIT QUIT VAL1
NXTAMD ;FIND PREVIOUS CURRENT QTY/COST WHEN MORE THAN 1 AMENDMENT
+1 if '$DATA(^TMP($JOB,"PRCHDP6"))
QUIT
+2 NEW TMPREC
+3 ;PRC*5.1*221
IF +$GET(PRCHAMNT)
IF $PIECE(^PRC(442,PRCHPO,6,0),U,3)>PRCHAMCT
IF '$DATA(^TMP($JOB,"PRCHDP6",ITEM,PRCHAM))
SET PRCHAMNT=2
SET AMDQTY=$PIECE(ITEM0,U,2)
SET AMDVAL=$PIECE(ITEM0,U,9)
QUIT
+4 SET TMPREC=^TMP($JOB,"PRCHDP6",ITEM,PRCHAM)
+5 SET AMDQTY=$PIECE(TMPREC,U)
if AMDQTY=""
SET AMDQTY=$PIECE(ITEM0,U,2)
+6 SET AMDVAL=$PIECE(TMPREC,U,3)
if AMDVAL=""
SET AMDVAL=$PIECE(ITEM0,U,9)
+7 QUIT
NXTAMD1 ;FIND PREVIOUS AMENDED TO +INFO WHEN MORE THAN 1
+1 if '$DATA(^TMP($JOB,"PRCHDP6"))
QUIT
+2 NEW TMPREC
+3 ;PRC*5.1*221
IF +$GET(PRCHAMNT)
IF $PIECE(^PRC(442,PRCHPO,6,0),U,3)>PRCHAMCT
IF '$DATA(^TMP($JOB,"PRCHDP6",ITEM,PRCHAM))
SET PRCHAMNT=2
SET AMDQTY=$PIECE(ITEM0,U,2)
SET AMDVAL=$PIECE(ITEM0,U,9)
QUIT
+4 SET TMPREC=^TMP($JOB,"PRCHDP6",ITEM,PRCHAM)
+5 SET AMDQTY=$PIECE(TMPREC,U,5)
if AMDQTY=""
SET AMDQTY=$PIECE(ITEM0,U,2)
+6 SET AMDVAL=$PIECE(TMPREC,U,7)
if AMDVAL=""
SET AMDVAL=$PIECE(ITEM0,U,9)
+7 QUIT
AMENDS ;SET UP AMENDMENT HISTORY
+1 if '$DATA(^PRC(442,D0,6))
QUIT
+2 NEW ITIEN,AMDQTY,AMDVAL,CURQTY,CURVAL,NXTAMD,HNXTAMD,NXTCHG,NXTFLD,ITEMNO,ITNO,AMDATA,AREC,NAMEND,J,XOLD1
+3 KILL ^TMP($JOB,"PRCHDP6")
SET ITIEN=0
+4 SET NXTAMD=0
FOR
SET NXTAMD=$ORDER(^PRC(442,D0,6,NXTAMD))
if 'NXTAMD
QUIT
SET HNXTAMD=NXTAMD
AM1 FOR
SET ITIEN=$ORDER(^PRC(442,D0,2,ITIEN))
if 'ITIEN
QUIT
Begin DoDot:1
+1 SET ITEM0=$GET(^PRC(442,D0,2,ITIEN,0))
SET CURQTY=$PIECE(ITEM0,U,2)
SET CURVAL=$PIECE(ITEM0,U,9)
+2 FOR J=1:1:HNXTAMD
SET ^TMP($JOB,"PRCHDP6",ITIEN,J)=CURQTY_U_0_U_CURVAL_U_0_U_CURQTY_U_0_U_CURVAL_U_0
End DoDot:1
AM2 SET NXTAMD=0
AM3 SET NXTAMD=$ORDER(^PRC(442,D0,6,NXTAMD))
SET NXTFLD=0
if 'NXTAMD
GOTO AMX
AM4 SET NXTFLD=$ORDER(^PRC(442,D0,6,NXTAMD,3,"AC",23,NXTFLD))
SET NXTCHG=0
if 'NXTFLD
GOTO AM3
AM5 SET NXTCHG=$ORDER(^PRC(442,D0,6,NXTAMD,3,"AC",23,NXTFLD,NXTCHG))
if 'NXTCHG
GOTO AM4
+1 SET XOLD1=$GET(^PRC(442,D0,6,NXTAMD,3,NXTCHG,0))
SET ITEMNO=$PIECE(XOLD1,U,4)
COST IF $PIECE(XOLD1,U,3)["5;442.01"
SET NAMEND=0
Begin DoDot:1
+1 SET AMDVAL=$GET(^PRC(442,D0,6,NXTAMD,3,NXTCHG,1,1,0))
+2 FOR J=1:1
SET NAMEND=$ORDER(^TMP($JOB,"PRCHDP6",ITEMNO,NAMEND))
if NAMEND=""
QUIT
Begin DoDot:2
+3 SET AMDATA=^TMP($JOB,"PRCHDP6",ITEMNO,NAMEND)
+4 IF $PIECE(AMDATA,U,4)=0
IF NAMEND'>NXTAMD
SET $PIECE(^TMP($JOB,"PRCHDP6",ITEMNO,NAMEND),U,3,4)=AMDVAL_U_NXTAMD
+5 IF $PIECE(AMDATA,U,8)=0
IF NAMEND<NXTAMD
SET $PIECE(^TMP($JOB,"PRCHDP6",ITEMNO,NAMEND),U,7,8)=AMDVAL_U_NXTAMD
End DoDot:2
End DoDot:1
QUANT IF $PIECE(XOLD1,U,3)["2;442.01"
SET NAMEND=0
Begin DoDot:1
+1 SET AMDQTY=$GET(^PRC(442,D0,6,NXTAMD,3,NXTCHG,1,1,0))
+2 FOR J=1:1
SET NAMEND=$ORDER(^TMP($JOB,"PRCHDP6",ITEMNO,NAMEND))
if NAMEND=""
QUIT
Begin DoDot:2
+3 SET AMDATA=^TMP($JOB,"PRCHDP6",ITEMNO,NAMEND)
+4 IF $PIECE(AMDATA,U,2)=0
IF NAMEND'>NXTAMD
SET $PIECE(^TMP($JOB,"PRCHDP6",ITEMNO,NAMEND),U,1,2)=AMDQTY_U_NXTAMD
+5 IF $PIECE(AMDATA,U,6)=0
IF NAMEND<NXTAMD
SET $PIECE(^TMP($JOB,"PRCHDP6",ITEMNO,NAMEND),U,5,6)=AMDQTY_U_NXTAMD
End DoDot:2
End DoDot:1
+6 GOTO AM5
AMX QUIT
