PRCHAMY3 ;WISC/DJM-PRINT AMENDMENT, ROUTINE #3 ;8/31/95 11:24 AM
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;
E29 ;EST. SHIPPING Edit
N CHANGE,OLD,EST,LCNT,DATA,OBOC,OBOC1,FLAG
S CHANGE=0 D LCNT^PRCHPAM5(.LCNT)
F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,13,CHANGE)) Q:CHANGE'>0 D
.S OLD=$G(^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)),OLD=$FN(OLD,"-",2)
.S EST=$P($G(^PRC(442,PRCHPO,0)),U,13),EST=$FN(EST,"-",2)
.S (OBOC1,FLAG)=0 K OBOC
.F S OBOC1=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,13.5,OBOC1)) Q:OBOC1'>0 D Q:FLAG=1
..S OBOC=+(^PRC(442,PRCHPO,6,PRCHAM,3,OBOC1,1,1,0)),FLAG=1
.I '$D(OBOC) S OBOC=+$P($G(^PRC(442,PRCHPO,23)),U)
.D LINE^PRCHPAM5(.LCNT,2)
.I OLD'>0 D
..S DATA="**ADDED THROUGH AMENDMENT**" D DATA^PRCHPAM5(.LCNT,DATA)
..S DATA="Estimated Shipping and/or Handling of $"_EST_" has been added" D DATA^PRCHPAM5(.LCNT,DATA)
..S DATA="BOC: "_+$P($G(^PRC(442,PRCHPO,23)),U) D DATA^PRCHPAM5(.LCNT,DATA)
..Q
.I OLD>0 D
..S DATA="Estimated Shipping and/or Handling of $"_OLD_" has been changed" D DATA^PRCHPAM5(.LCNT,DATA)
..S DATA="to $"_EST D DATA^PRCHPAM5(.LCNT,DATA)
..S DATA="BOC: "_OBOC_" has been changed to: "+$P($G(^PRC(442,PRCHPO,23)),U) D DATA^PRCHPAM5(.LCNT,DATA)
..Q
.D LCNT1^PRCHPAM5(LCNT)
.Q
Q
;
OLD ;GET ALL THE OLD DESCRIPTION FROM 'CHANGES' MULTIPLE AND SET INTO
;THE DISPLAY '^TMP($J,"AMD"' ARRAY.
N LINE,DATA
S LINE=1
F D:DES]"" Q:DES=""
.S DATA=$E(DES,1,75) D DATA^PRCHPAM5(.LCNT,DATA)
.S DES=$E(DES,76,255) Q:$L(DES)'<75 Q:LINE'>0
.S LINE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,PRCHLN,1,LINE)) Q:LINE'>0
.S DES=DES_$G(^PRC(442,PRCHPO,6,PRCHAM,3,PRCHLN,1,LINE,0))
.Q
Q
;
NEW ;GET ALL THE NEW DESCRIPTION FROM THE LINE ITEM MULTIPLE AND SET
;INTO THE DISPLAY '^TMP($J,"AMD"' ARRAY.
N LINE,DATA
S LINE=1
F D:ITEM1]"" Q:ITEM1=""
.S DATA=$E(ITEM1,1,75) D DATA^PRCHPAM5(.LCNT,DATA)
.S ITEM1=$E(ITEM1,76,255) Q:$L(ITEM1)'<75 Q:LINE'>0
.S LINE=$O(^PRC(442,PRCHPO,2,ITEM,1,LINE)) Q:LINE'>0
.S ITEM1=ITEM1_$G(^PRC(442,PRCHPO,2,ITEM,1,LINE,0))
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHAMY3 2131 printed Oct 16, 2024@18:06:41 Page 2
PRCHAMY3 ;WISC/DJM-PRINT AMENDMENT, ROUTINE #3 ;8/31/95 11:24 AM
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
E29 ;EST. SHIPPING Edit
+1 NEW CHANGE,OLD,EST,LCNT,DATA,OBOC,OBOC1,FLAG
+2 SET CHANGE=0
DO LCNT^PRCHPAM5(.LCNT)
+3 FOR
SET CHANGE=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,13,CHANGE))
if CHANGE'>0
QUIT
Begin DoDot:1
+4 SET OLD=$GET(^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0))
SET OLD=$FNUMBER(OLD,"-",2)
+5 SET EST=$PIECE($GET(^PRC(442,PRCHPO,0)),U,13)
SET EST=$FNUMBER(EST,"-",2)
+6 SET (OBOC1,FLAG)=0
KILL OBOC
+7 FOR
SET OBOC1=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,13.5,OBOC1))
if OBOC1'>0
QUIT
Begin DoDot:2
+8 SET OBOC=+(^PRC(442,PRCHPO,6,PRCHAM,3,OBOC1,1,1,0))
SET FLAG=1
End DoDot:2
if FLAG=1
QUIT
+9 IF '$DATA(OBOC)
SET OBOC=+$PIECE($GET(^PRC(442,PRCHPO,23)),U)
+10 DO LINE^PRCHPAM5(.LCNT,2)
+11 IF OLD'>0
Begin DoDot:2
+12 SET DATA="**ADDED THROUGH AMENDMENT**"
DO DATA^PRCHPAM5(.LCNT,DATA)
+13 SET DATA="Estimated Shipping and/or Handling of $"_EST_" has been added"
DO DATA^PRCHPAM5(.LCNT,DATA)
+14 SET DATA="BOC: "_+$PIECE($GET(^PRC(442,PRCHPO,23)),U)
DO DATA^PRCHPAM5(.LCNT,DATA)
+15 QUIT
End DoDot:2
+16 IF OLD>0
Begin DoDot:2
+17 SET DATA="Estimated Shipping and/or Handling of $"_OLD_" has been changed"
DO DATA^PRCHPAM5(.LCNT,DATA)
+18 SET DATA="to $"_EST
DO DATA^PRCHPAM5(.LCNT,DATA)
+19 SET DATA="BOC: "_OBOC_" has been changed to: "+$PIECE($GET(^PRC(442,PRCHPO,23)),U)
DO DATA^PRCHPAM5(.LCNT,DATA)
+20 QUIT
End DoDot:2
+21 DO LCNT1^PRCHPAM5(LCNT)
+22 QUIT
End DoDot:1
+23 QUIT
+24 ;
OLD ;GET ALL THE OLD DESCRIPTION FROM 'CHANGES' MULTIPLE AND SET INTO
+1 ;THE DISPLAY '^TMP($J,"AMD"' ARRAY.
+2 NEW LINE,DATA
+3 SET LINE=1
+4 FOR
if DES]""
Begin DoDot:1
+5 SET DATA=$EXTRACT(DES,1,75)
DO DATA^PRCHPAM5(.LCNT,DATA)
+6 SET DES=$EXTRACT(DES,76,255)
if $LENGTH(DES)'<75
QUIT
if LINE'>0
QUIT
+7 SET LINE=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,PRCHLN,1,LINE))
if LINE'>0
QUIT
+8 SET DES=DES_$GET(^PRC(442,PRCHPO,6,PRCHAM,3,PRCHLN,1,LINE,0))
+9 QUIT
End DoDot:1
if DES=""
QUIT
+10 QUIT
+11 ;
NEW ;GET ALL THE NEW DESCRIPTION FROM THE LINE ITEM MULTIPLE AND SET
+1 ;INTO THE DISPLAY '^TMP($J,"AMD"' ARRAY.
+2 NEW LINE,DATA
+3 SET LINE=1
+4 FOR
if ITEM1]""
Begin DoDot:1
+5 SET DATA=$EXTRACT(ITEM1,1,75)
DO DATA^PRCHPAM5(.LCNT,DATA)
+6 SET ITEM1=$EXTRACT(ITEM1,76,255)
if $LENGTH(ITEM1)'<75
QUIT
if LINE'>0
QUIT
+7 SET LINE=$ORDER(^PRC(442,PRCHPO,2,ITEM,1,LINE))
if LINE'>0
QUIT
+8 SET ITEM1=ITEM1_$GET(^PRC(442,PRCHPO,2,ITEM,1,LINE,0))
+9 QUIT
End DoDot:1
if ITEM1=""
QUIT
+10 QUIT
