- 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 Feb 18, 2025@23:32:17 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