source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHAMY3.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1PRCHAMY3 ;WISC/DJM-PRINT AMENDMENT, ROUTINE #3 ;8/31/95 11:24 AM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5E29 ;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 ;
30OLD ;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 ;
42NEW ;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
Note: See TracBrowser for help on using the repository browser.