| [613] | 1 | PRCHAMY3 ;WISC/DJM-PRINT AMENDMENT, ROUTINE #3 ;8/31/95 11:24 AM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | E29 ;EST. SHIPPING Edit
|
|---|
| 6 | N CHANGE,OLD,EST,LCNT,DATA,OBOC,OBOC1,FLAG
|
|---|
| 7 | S CHANGE=0 D LCNT^PRCHPAM5(.LCNT)
|
|---|
| 8 | F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,13,CHANGE)) Q:CHANGE'>0 D
|
|---|
| 9 | .S OLD=$G(^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)),OLD=$FN(OLD,"-",2)
|
|---|
| 10 | .S EST=$P($G(^PRC(442,PRCHPO,0)),U,13),EST=$FN(EST,"-",2)
|
|---|
| 11 | .S (OBOC1,FLAG)=0 K OBOC
|
|---|
| 12 | .F S OBOC1=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,13.5,OBOC1)) Q:OBOC1'>0 D Q:FLAG=1
|
|---|
| 13 | ..S OBOC=+(^PRC(442,PRCHPO,6,PRCHAM,3,OBOC1,1,1,0)),FLAG=1
|
|---|
| 14 | .I '$D(OBOC) S OBOC=+$P($G(^PRC(442,PRCHPO,23)),U)
|
|---|
| 15 | .D LINE^PRCHPAM5(.LCNT,2)
|
|---|
| 16 | .I OLD'>0 D
|
|---|
| 17 | ..S DATA="**ADDED THROUGH AMENDMENT**" D DATA^PRCHPAM5(.LCNT,DATA)
|
|---|
| 18 | ..S DATA="Estimated Shipping and/or Handling of $"_EST_" has been added" D DATA^PRCHPAM5(.LCNT,DATA)
|
|---|
| 19 | ..S DATA="BOC: "_+$P($G(^PRC(442,PRCHPO,23)),U) D DATA^PRCHPAM5(.LCNT,DATA)
|
|---|
| 20 | ..Q
|
|---|
| 21 | .I OLD>0 D
|
|---|
| 22 | ..S DATA="Estimated Shipping and/or Handling of $"_OLD_" has been changed" D DATA^PRCHPAM5(.LCNT,DATA)
|
|---|
| 23 | ..S DATA="to $"_EST D DATA^PRCHPAM5(.LCNT,DATA)
|
|---|
| 24 | ..S DATA="BOC: "_OBOC_" has been changed to: "+$P($G(^PRC(442,PRCHPO,23)),U) D DATA^PRCHPAM5(.LCNT,DATA)
|
|---|
| 25 | ..Q
|
|---|
| 26 | .D LCNT1^PRCHPAM5(LCNT)
|
|---|
| 27 | .Q
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | OLD ;GET ALL THE OLD DESCRIPTION FROM 'CHANGES' MULTIPLE AND SET INTO
|
|---|
| 31 | ;THE DISPLAY '^TMP($J,"AMD"' ARRAY.
|
|---|
| 32 | N LINE,DATA
|
|---|
| 33 | S LINE=1
|
|---|
| 34 | F D:DES]"" Q:DES=""
|
|---|
| 35 | .S DATA=$E(DES,1,75) D DATA^PRCHPAM5(.LCNT,DATA)
|
|---|
| 36 | .S DES=$E(DES,76,255) Q:$L(DES)'<75 Q:LINE'>0
|
|---|
| 37 | .S LINE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,PRCHLN,1,LINE)) Q:LINE'>0
|
|---|
| 38 | .S DES=DES_$G(^PRC(442,PRCHPO,6,PRCHAM,3,PRCHLN,1,LINE,0))
|
|---|
| 39 | .Q
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | NEW ;GET ALL THE NEW DESCRIPTION FROM THE LINE ITEM MULTIPLE AND SET
|
|---|
| 43 | ;INTO THE DISPLAY '^TMP($J,"AMD"' ARRAY.
|
|---|
| 44 | N LINE,DATA
|
|---|
| 45 | S LINE=1
|
|---|
| 46 | F D:ITEM1]"" Q:ITEM1=""
|
|---|
| 47 | .S DATA=$E(ITEM1,1,75) D DATA^PRCHPAM5(.LCNT,DATA)
|
|---|
| 48 | .S ITEM1=$E(ITEM1,76,255) Q:$L(ITEM1)'<75 Q:LINE'>0
|
|---|
| 49 | .S LINE=$O(^PRC(442,PRCHPO,2,ITEM,1,LINE)) Q:LINE'>0
|
|---|
| 50 | .S ITEM1=ITEM1_$G(^PRC(442,PRCHPO,2,ITEM,1,LINE,0))
|
|---|
| 51 | .Q
|
|---|
| 52 | Q
|
|---|
