43 lines
1.9 KiB
Mathematica
43 lines
1.9 KiB
Mathematica
PRCPPOL0 ;WISC/RFJ-receive purchase order (list manager) ;06 Jan 94
|
|
;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
;
|
|
;
|
|
DISTCOST ; item not in inventory point, cost to distribution point
|
|
; needs prcpordr,prcpinpt
|
|
D FULL^VALM1
|
|
S VALMBCK="R"
|
|
N %,C,COSTCNTR,DATA,DISTRPT,I,ITEMDA,LINEDA,X,Y
|
|
K X S X(1)="This option allows items which are not stored in the "_$$INVNAME^PRCPUX1(PRCPINPT)_" to be costed to a distribution point."
|
|
D DISPLAY^PRCPUX2(5,75,.X)
|
|
I '$O(^TMP($J,"PRCPPOLMCOS",0)) K X S X(1)="All items on the purchase order are currently stored in the inventory point." D DISPLAY^PRCPUX2(15,55,.X) D R^PRCPUREP Q
|
|
S LINEDA=$$LINEITEM^PRCPPOU1(PRCPORDR) I 'LINEDA Q
|
|
S DATA=$G(^TMP($J,"PRCPPOLMCOS",LINEDA)) Q:DATA=""
|
|
S ITEMDA=$P(DATA,"^")
|
|
K X S X(1)="This item is not stored in the inventory point. You have the option to cost this out as a distribution cost to one of your distribution inventory points."
|
|
W ! D DISPLAY^PRCPUX2(5,75,.X)
|
|
W !,"Line Number: ",LINEDA,?20,"Master Item Number: ",ITEMDA,!?2,"DESCRIPTION: "
|
|
K X S %=0 F I=1:1 S %=$O(^PRC(442,PRCPORDR,2,LINEDA,1,%)) Q:'% S X(I)=^(%,0)
|
|
D DISPLAY^PRCPUX2(13,75,.X)
|
|
S %=$$INVNAME^PRCPUX1($P(DATA,"^",2))
|
|
W !,"COST OUT TO INVPT: ",$S(%="":"<NONE>",1:%),?50,"COST CENTER: ",$S($P(DATA,"^",3)="":"<NONE>",1:$P(DATA,"^",3))
|
|
; select distribution point
|
|
F S DISTRPT=$$TO^PRCPUDPT(PRCPINPT) Q:'DISTRPT D Q:DISTRPT
|
|
. S COSTCNTR=$P($G(^PRCP(445,DISTRPT,0)),"^",7) S:'COSTCNTR COSTCNTR=$P(^PRC(442,PRCPORDR,0),"^",5) I 'COSTCNTR W !?5,"INVENTORY POINT DOES NOT CONTAIN A COST CENTER." S DISTRPT=0 Q
|
|
. W !?5,"COSTING TO COST CENTER: ",COSTCNTR
|
|
. S ^TMP($J,"PRCPPOLMCOS",LINEDA)=ITEMDA_"^"_DISTRPT_"^"_COSTCNTR
|
|
D REBUILD^PRCPPOLB
|
|
S VALMBCK="R"
|
|
Q
|
|
;
|
|
;
|
|
EEITEMS ; called from protocol file to enter/edit invpt items
|
|
D FULL^VALM1
|
|
N PRC,PRCP
|
|
S PRCP("DPTYPE")="WP"
|
|
D ^PRCPEILM
|
|
D REBUILD^PRCPPOLB
|
|
S VALMBCK="R"
|
|
Q
|