source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPUCC.m@ 1211

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1PRCPUCC ;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 ;
7COSTCNTR(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 ;
25EDIT ; 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 ;
38SELCOSTS(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)
Note: See TracBrowser for help on using the repository browser.