PRCHAMY1 ;WISC/DJM-PRINT AMENDMENT ;9/21/95 10:42 AM
V ;;5.1;IFCAP;**21**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;
START(PRCHPO,PRCHAM) ;PRCHPO IS 442 INTERNAL ENTRY NUMBER FOR RECORD BEING AMENDED.
;PRCHAM IS IEN AMENDMENT MULTIPLE WITHIN PRCHPO BEING AMENDED.
;FIND OUT WHAT TYPES OF AMENDMENTS HAVE BEEN DONE TO BE ABLE TO
;DETERMINE WHAT TO PRINT OUT.
N AMEND,GOTO
S AMEND=0 F S AMEND=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND)) Q:AMEND'>0 S GOTO="E"_+AMEND_"^PRCHAMY1" D @GOTO
Q
;
E20 ;SHIP TO Edit
Q
E21 ;LINE ITEM Add
N FIELD,CHANGE,CHANGES,OLD,ITEM,ITEM0,ITEM1,LCNT,DATA,I,UOP
S FIELD=0 K ITEM D LCNT^PRCHPAM5(.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=$G(^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,0)),OLD=$G(^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))
..D LINE^PRCHPAM5(.LCNT,2) S DATA=" *ADDED THROUGH AMENDMENT*" D DATA^PRCHPAM5(.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^PRCHPAM5(.LCNT,DATA)
..D NEW^PRCHAMY3
..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^PRCHPAM5(.LCNT,DATA)
..I $P(ITEM0,U,6)]"" S DATA=" STK#: "_$P(ITEM0,U,6) D DATA^PRCHPAM5(.LCNT,DATA)
..S UOP=$S($P(ITEM0,U,3)>0:$P($G(^PRCD(420.5,$P(ITEM0,U,3),0)),U),1:"")
..S DATA=" "_$P(ITEM0,U,2)_" "_UOP_" at $"_$J($P(ITEM0,U,9),12,4)_" = $"_$J($P(ITEM0,U,2)*$P(ITEM0,U,9),9,2)
..D DATA^PRCHPAM5(.LCNT,DATA),LCNT1^PRCHPAM5(LCNT)
Q
;
E22 ;LINE ITEM Delete
G E22^PRCHAMY2
;
E23 ;LINE ITEM Edit
G E23^PRCHAMY2
;
E24 ;SOURCE CODE Edit
Q
;
E25 ;Edit MAIL INVOICE TO
Q
;
E26 ;Edit METHOD OF PAYMENT
Q
;
E27 ;ADMINISTRATIVE CERTIFICATION Add
Q
;
E28 ;ADMINISTRATIVE CERTIFICATION Delete
Q
;
E29 ;EST. SHIPPING Edit
G E29^PRCHAMY3
;
E30 ;F.C.P. Edit
Q
;
E31 ;Change VENDOR
G E31^PRCHAMY4
;
E32 ;REPLACE P.O. NUMBER
G E32^PRCHAMY4
;
E33 ;PROMPT PAYMENT Edit
Q
;
E34 ;AUTHORITY Edit
G E34^PRCHAMY4
;
E35 ;F.O.B. Point
Q
;
E36 ;ITEM DISCOUNT Add/Edit
G E36^PRCHAMY5
;
E37 ;ITEM DISCOUNT Delete
G E37^PRCHAMY5
;
E98 ;DELIVERY DATE PRINT
Q
E99 ;NET AMOUNT PRINT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHAMY1 2786 printed Sep 23, 2025@19:41:58 Page 2
PRCHAMY1 ;WISC/DJM-PRINT AMENDMENT ;9/21/95 10:42 AM
V ;;5.1;IFCAP;**21**;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
START(PRCHPO,PRCHAM) ;PRCHPO IS 442 INTERNAL ENTRY NUMBER FOR RECORD BEING AMENDED.
+1 ;PRCHAM IS IEN AMENDMENT MULTIPLE WITHIN PRCHPO BEING AMENDED.
+2 ;FIND OUT WHAT TYPES OF AMENDMENTS HAVE BEEN DONE TO BE ABLE TO
+3 ;DETERMINE WHAT TO PRINT OUT.
+4 NEW AMEND,GOTO
+5 SET AMEND=0
FOR
SET AMEND=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND))
if AMEND'>0
QUIT
SET GOTO="E"_+AMEND_"^PRCHAMY1"
DO @GOTO
+6 QUIT
+7 ;
E20 ;SHIP TO Edit
+1 QUIT
E21 ;LINE ITEM Add
+1 NEW FIELD,CHANGE,CHANGES,OLD,ITEM,ITEM0,ITEM1,LCNT,DATA,I,UOP
+2 SET FIELD=0
KILL ITEM
DO LCNT^PRCHPAM5(.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=$GET(^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,0))
SET OLD=$GET(^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 DO LINE^PRCHPAM5(.LCNT,2)
SET DATA=" *ADDED THROUGH AMENDMENT*"
DO DATA^PRCHPAM5(.LCNT,DATA)
+12 SET DATA="Item No. "_$PIECE(ITEM0,U)_" Item Master File No. "
+13 SET DATA=DATA_$PIECE(ITEM0,U,5)_" BOC: "_$PIECE(ITEM0,U,4)
+14 SET DATA=DATA_" CONTRACT: "_$PIECE($GET(^PRC(442,PRCHPO,2,ITEM,2)),U,2)
+15 DO DATA^PRCHPAM5(.LCNT,DATA)
+16 DO NEW^PRCHAMY3
+17 SET UOP=$SELECT($PIECE(ITEM0,U,3)>0:$PIECE($GET(^PRCD(420.5,$PIECE(ITEM0,U,3),0)),U),1:"")
+18 SET DATA=" Items per "_UOP_": "_$PIECE(ITEM0,U,12)
+19 FOR I=1:1:26-$LENGTH(DATA)
SET DATA=DATA_" "
+20 SET DATA=DATA_"NSN: "_$PIECE(ITEM0,U,13)
DO DATA^PRCHPAM5(.LCNT,DATA)
+21 IF $PIECE(ITEM0,U,6)]""
SET DATA=" STK#: "_$PIECE(ITEM0,U,6)
DO DATA^PRCHPAM5(.LCNT,DATA)
+22 SET UOP=$SELECT($PIECE(ITEM0,U,3)>0:$PIECE($GET(^PRCD(420.5,$PIECE(ITEM0,U,3),0)),U),1:"")
+23 SET DATA=" "_$PIECE(ITEM0,U,2)_" "_UOP_" at $"_$JUSTIFY($PIECE(ITEM0,U,9),12,4)_" = $"_$JUSTIFY($PIECE(ITEM0,U,2)*$PIECE(ITEM0,U,9),9,2)
+24 DO DATA^PRCHPAM5(.LCNT,DATA)
DO LCNT1^PRCHPAM5(LCNT)
End DoDot:2
End DoDot:1
+25 QUIT
+26 ;
E22 ;LINE ITEM Delete
+1 GOTO E22^PRCHAMY2
+2 ;
E23 ;LINE ITEM Edit
+1 GOTO E23^PRCHAMY2
+2 ;
E24 ;SOURCE CODE Edit
+1 QUIT
+2 ;
E25 ;Edit MAIL INVOICE TO
+1 QUIT
+2 ;
E26 ;Edit METHOD OF PAYMENT
+1 QUIT
+2 ;
E27 ;ADMINISTRATIVE CERTIFICATION Add
+1 QUIT
+2 ;
E28 ;ADMINISTRATIVE CERTIFICATION Delete
+1 QUIT
+2 ;
E29 ;EST. SHIPPING Edit
+1 GOTO E29^PRCHAMY3
+2 ;
E30 ;F.C.P. Edit
+1 QUIT
+2 ;
E31 ;Change VENDOR
+1 GOTO E31^PRCHAMY4
+2 ;
E32 ;REPLACE P.O. NUMBER
+1 GOTO E32^PRCHAMY4
+2 ;
E33 ;PROMPT PAYMENT Edit
+1 QUIT
+2 ;
E34 ;AUTHORITY Edit
+1 GOTO E34^PRCHAMY4
+2 ;
E35 ;F.O.B. Point
+1 QUIT
+2 ;
E36 ;ITEM DISCOUNT Add/Edit
+1 GOTO E36^PRCHAMY5
+2 ;
E37 ;ITEM DISCOUNT Delete
+1 GOTO E37^PRCHAMY5
+2 ;
E98 ;DELIVERY DATE PRINT
+1 QUIT
E99 ;NET AMOUNT PRINT
+1 QUIT
