| 1 | PRCPUCC ;WISC/RFJ-update distr history file 446 (cost center) ;11 Dec 91
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | COSTCNTR(TOINVPT,FROMINPT,COSTCNTR,COST) ; add/update distribution cost (446)
|
|---|
| 8 | ; toinvpt=primary and frominpt=whse and costcntr=primary
|
|---|
| 9 | ; toinvpt=secondary and frominpt=primary and costcntr=primary
|
|---|
| 10 | ; secondaries do not have costcenters -------------------^
|
|---|
| 11 | I 'COST!(COSTCNTR="")!('$D(^PRCP(445,+TOINVPT,0)))!('$D(^PRCP(445,+FROMINPT))) Q
|
|---|
| 12 | N %,%H,%I,D,D0,DA,DI,DIC,DIE,DISYS,DLAYGO,DQ,DR,I,X,Y
|
|---|
| 13 | L +^PRCP(446)
|
|---|
| 14 | S DIC="^PRCP(446,",DIC(0)="L",DLAYGO=446
|
|---|
| 15 | S DIC("S")="I +$P(^(0),U,2)=$E(DT,1,5),$P(^(0),U,3)="_FROMINPT_",+$P(^(0),U,4)="_COSTCNTR
|
|---|
| 16 | S X=$P($G(^PRCP(445,TOINVPT,0)),"^"),PRCPPRIV=1 D ^DIC K PRCPPRIV
|
|---|
| 17 | I Y<1 L -^PRCP(446) Q
|
|---|
| 18 | S DA=+Y
|
|---|
| 19 | I $P(Y,"^",3) S DIE="^PRCP(446,",DR="1////"_$E(DT,1,5)_";2////"_FROMINPT_";3///"_COSTCNTR D ^DIE
|
|---|
| 20 | S $P(^PRCP(446,DA,0),"^",7)=$P(^PRCP(446,DA,0),"^",7)+COST
|
|---|
| 21 | L -^PRCP(446)
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | ;
|
|---|
| 25 | EDIT ; edit distribution costs
|
|---|
| 26 | D ^PRCPUSEL Q:'$G(PRCP("I"))
|
|---|
| 27 | I "WP"'[PRCP("DPTYPE") W !,"THIS OPTION CAN ONLY BE USED BY WAREHOUSE AND PRIMARY INVENTORY POINTS." Q
|
|---|
| 28 | N %,%DT,D0,DA,DI,DIE,DLAYGO,DQ,DR,I,PRCPFLAG,X,Y
|
|---|
| 29 | S X="" W ! D ESIG^PRCUESIG(DUZ,.X) I X'>0 Q
|
|---|
| 30 | F D Q:$G(PRCPFLAG)
|
|---|
| 31 | . S DIC="^PRCP(446,",DLAYGO=446,DIC(0)="QEALM",DIC("A")="Select DISTRIBUTION INVENTORY POINT: ",DIC("S")="I $P(^(0),U,3)=PRCP(""I"")",DIC("DR")="1;3;2////"_PRCP("I"),PRCPPRIV=1 W ! D ^DIC K PRCPPRIV,DIC I +Y<0 S PRCPFLAG=1 Q
|
|---|
| 32 | . S DA=+Y,D=^PRCP(446,+Y,0),Y=$P(D,"^",2) D DD^%DT
|
|---|
| 33 | . W !!?5,"Distribution TO : ",$$INVNAME^PRCPUX1(+$P(D,"^")),!?5,"Distribution DATE: ",Y,!?5,"Distribution CC : ",$E($P(D,"^",4),1,55),!?24,$E($P(D,"^",4),56,100)
|
|---|
| 34 | . S DIE="^PRCP(446,",DR=6 D ^DIE
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | ;
|
|---|
| 38 | SELCOSTS(INVPT) ; select distribution cost entry for inventory point
|
|---|
| 39 | N %,DIC,I,PRCPPRIV,X,Y
|
|---|
| 40 | S DIC="^PRCP(446,",DIC(0)="QEAM",DIC("S")="I $P(^(0),U,3)="_INVPT,PRCPPRIV=1
|
|---|
| 41 | D ^DIC
|
|---|
| 42 | Q $S(Y'>1:0,1:+Y)
|
|---|
