| [613] | 1 | PRCPPOL0 ;WISC/RFJ-receive purchase order (list manager) ;06 Jan 94
|
|---|
| 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 | DISTCOST ; item not in inventory point, cost to distribution point
|
|---|
| 8 | ; needs prcpordr,prcpinpt
|
|---|
| 9 | D FULL^VALM1
|
|---|
| 10 | S VALMBCK="R"
|
|---|
| 11 | N %,C,COSTCNTR,DATA,DISTRPT,I,ITEMDA,LINEDA,X,Y
|
|---|
| 12 | 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."
|
|---|
| 13 | D DISPLAY^PRCPUX2(5,75,.X)
|
|---|
| 14 | 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
|
|---|
| 15 | S LINEDA=$$LINEITEM^PRCPPOU1(PRCPORDR) I 'LINEDA Q
|
|---|
| 16 | S DATA=$G(^TMP($J,"PRCPPOLMCOS",LINEDA)) Q:DATA=""
|
|---|
| 17 | S ITEMDA=$P(DATA,"^")
|
|---|
| 18 | 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."
|
|---|
| 19 | W ! D DISPLAY^PRCPUX2(5,75,.X)
|
|---|
| 20 | W !,"Line Number: ",LINEDA,?20,"Master Item Number: ",ITEMDA,!?2,"DESCRIPTION: "
|
|---|
| 21 | K X S %=0 F I=1:1 S %=$O(^PRC(442,PRCPORDR,2,LINEDA,1,%)) Q:'% S X(I)=^(%,0)
|
|---|
| 22 | D DISPLAY^PRCPUX2(13,75,.X)
|
|---|
| 23 | S %=$$INVNAME^PRCPUX1($P(DATA,"^",2))
|
|---|
| 24 | W !,"COST OUT TO INVPT: ",$S(%="":"<NONE>",1:%),?50,"COST CENTER: ",$S($P(DATA,"^",3)="":"<NONE>",1:$P(DATA,"^",3))
|
|---|
| 25 | ; select distribution point
|
|---|
| 26 | F S DISTRPT=$$TO^PRCPUDPT(PRCPINPT) Q:'DISTRPT D Q:DISTRPT
|
|---|
| 27 | . 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
|
|---|
| 28 | . W !?5,"COSTING TO COST CENTER: ",COSTCNTR
|
|---|
| 29 | . S ^TMP($J,"PRCPPOLMCOS",LINEDA)=ITEMDA_"^"_DISTRPT_"^"_COSTCNTR
|
|---|
| 30 | D REBUILD^PRCPPOLB
|
|---|
| 31 | S VALMBCK="R"
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | ;
|
|---|
| 35 | EEITEMS ; called from protocol file to enter/edit invpt items
|
|---|
| 36 | D FULL^VALM1
|
|---|
| 37 | N PRC,PRCP
|
|---|
| 38 | S PRCP("DPTYPE")="WP"
|
|---|
| 39 | D ^PRCPEILM
|
|---|
| 40 | D REBUILD^PRCPPOLB
|
|---|
| 41 | S VALMBCK="R"
|
|---|
| 42 | Q
|
|---|
