| [613] | 1 | PRCHPOFX ;;WISC/AKS-Routine to fix Dan's PO conversion ;7/24/00 23:25
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN ;Entry Point to subtract Shipping charges from Subamount1 and Subamt2.
|
|---|
| 5 | ;
|
|---|
| 6 | N N,BOC1,BOC2,AMT1,AMT2,ENTRY1,ENTRY2,SHIP,N7,BOC,STAT,M,N0
|
|---|
| 7 | S N=0 F S N=$O(^PRC(442,N)) Q:'N D:$P($G(^(N,0)),"^",19)=2 BOC D
|
|---|
| 8 | .S N7=$G(^PRC(442,N,7)),STAT=$P(N7,"^"),STAT="/"_STAT_"/"
|
|---|
| 9 | .I "/6/7/10/15/20/25/26/30/31/35/36/40/42/43/45/71/81/82/"'[STAT Q
|
|---|
| 10 | .I $P($G(^PRC(442,N,0)),"^",19)=1!($P($G(^(0)),"^",19)=2) Q
|
|---|
| 11 | .I $P($P($G(^PRC(442,N,12)),"^",3),".")>2940731 Q
|
|---|
| 12 | .I +$P($G(^PRC(442,N,0)),"^",6)>0,+$P(^(0),"^",13)>0,$D(^PRC(442,N,22)) D
|
|---|
| 13 | ..S N0=^PRC(442,N,0),BOC1=+$P(N0,"^",6),AMT1=+$P(N0,"^",7)
|
|---|
| 14 | ..S BOC2=+$P(N0,"^",8),AMT2=+$P(N0,"^",9),SHIP=+$P(N0,"^",13)
|
|---|
| 15 | ..S ENTRY1=$O(^PRC(442,N,22,"B",BOC1,0))
|
|---|
| 16 | ..S:BOC2>0 ENTRY2=$O(^PRC(442,N,22,"B",BOC2,0))
|
|---|
| 17 | ..I BOC2>0 S SHIP=SHIP/2,SHIP=SHIP*100+.5\1/100
|
|---|
| 18 | ..S $P(^PRC(442,N,22,ENTRY1,0),"^",2)=$P(^PRC(442,N,22,ENTRY1,0),"^",2)-SHIP
|
|---|
| 19 | ..S:BOC2>0 $P(^PRC(442,N,22,ENTRY2,0),"^",2)=$P(^PRC(442,N,22,ENTRY2,0),"^",2)-SHIP
|
|---|
| 20 | QUIT
|
|---|
| 21 | BOC ;Correct BOC's for Supply Fund Purchase orders
|
|---|
| 22 | ;
|
|---|
| 23 | S M=0 F S M=$O(^PRC(442,N,2,M)) Q:'M I +$P($G(^(M,0)),"^",4)>0 D
|
|---|
| 24 | .S BOC=+$P(^PRC(442,N,2,M,0),"^",4)
|
|---|
| 25 | .S BOC=$P(^PRCD(420.2,BOC,0),"^"),$P(^PRC(442,N,2,M,0),"^",4)=BOC
|
|---|
| 26 | QUIT
|
|---|
