Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCPUCC

PRCPUCC.m

Go to the documentation of this file.
  1. PRCPUCC ;WISC/RFJ-update distr history file 446 (cost center) ;11 Dec 91
  1. ;;5.1;IFCAP;;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. COSTCNTR(TOINVPT,FROMINPT,COSTCNTR,COST) ; add/update distribution cost (446)
  1. ; toinvpt=primary and frominpt=whse and costcntr=primary
  1. ; toinvpt=secondary and frominpt=primary and costcntr=primary
  1. ; secondaries do not have costcenters -------------------^
  1. I 'COST!(COSTCNTR="")!('$D(^PRCP(445,+TOINVPT,0)))!('$D(^PRCP(445,+FROMINPT))) Q
  1. N %,%H,%I,D,D0,DA,DI,DIC,DIE,DISYS,DLAYGO,DQ,DR,I,X,Y
  1. L +^PRCP(446)
  1. S DIC="^PRCP(446,",DIC(0)="L",DLAYGO=446
  1. S DIC("S")="I +$P(^(0),U,2)=$E(DT,1,5),$P(^(0),U,3)="_FROMINPT_",+$P(^(0),U,4)="_COSTCNTR
  1. S X=$P($G(^PRCP(445,TOINVPT,0)),"^"),PRCPPRIV=1 D ^DIC K PRCPPRIV
  1. I Y<1 L -^PRCP(446) Q
  1. S DA=+Y
  1. I $P(Y,"^",3) S DIE="^PRCP(446,",DR="1////"_$E(DT,1,5)_";2////"_FROMINPT_";3///"_COSTCNTR D ^DIE
  1. S $P(^PRCP(446,DA,0),"^",7)=$P(^PRCP(446,DA,0),"^",7)+COST
  1. L -^PRCP(446)
  1. Q
  1. ;
  1. ;
  1. EDIT ; edit distribution costs
  1. D ^PRCPUSEL Q:'$G(PRCP("I"))
  1. I "WP"'[PRCP("DPTYPE") W !,"THIS OPTION CAN ONLY BE USED BY WAREHOUSE AND PRIMARY INVENTORY POINTS." Q
  1. N %,%DT,D0,DA,DI,DIE,DLAYGO,DQ,DR,I,PRCPFLAG,X,Y
  1. S X="" W ! D ESIG^PRCUESIG(DUZ,.X) I X'>0 Q
  1. F D Q:$G(PRCPFLAG)
  1. . 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
  1. . S DA=+Y,D=^PRCP(446,+Y,0),Y=$P(D,"^",2) D DD^%DT
  1. . 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)
  1. . S DIE="^PRCP(446,",DR=6 D ^DIE
  1. Q
  1. ;
  1. ;
  1. SELCOSTS(INVPT) ; select distribution cost entry for inventory point
  1. N %,DIC,I,PRCPPRIV,X,Y
  1. S DIC="^PRCP(446,",DIC(0)="QEAM",DIC("S")="I $P(^(0),U,3)="_INVPT,PRCPPRIV=1
  1. D ^DIC
  1. Q $S(Y'>1:0,1:+Y)