| 1 | PRCPUUIP ;WISC/RFJ-utility update item prim to secondary ;08 Jul 92
|
|---|
| 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 | ITEM(INVPT,ITEMDA,TRANTYPE,ORDERNO,PRCPDATA) ; update inventory point item
|
|---|
| 8 | ;prcpdata =
|
|---|
| 9 | ; qty) = quantity to add to on-hand
|
|---|
| 10 | ; invval) = total inventory value
|
|---|
| 11 | ; selval) = total sales value
|
|---|
| 12 | ; otherpt) = other inventory point affected (for issues)
|
|---|
| 13 | ; reason) = reason (for adjustments)
|
|---|
| 14 | ; date) = date of transaction (optional)
|
|---|
| 15 | ; pkg) = packaging units on transaction register
|
|---|
| 16 | ; noduein) = do not decrement dueins if $data (optional)
|
|---|
| 17 | ; nodueout) = do not decrement dueouts if $data (optional)
|
|---|
| 18 | ;
|
|---|
| 19 | ;returns
|
|---|
| 20 | ; prcpid = transaction 445.2 da number
|
|---|
| 21 | ;
|
|---|
| 22 | N %,COSTCNTR,DATE,ITEMDATA,PRCPUUIP,X,Y
|
|---|
| 23 | D NOW^%DTC S DATE=%
|
|---|
| 24 | I '$D(^PRCP(445.1,INVPT,1,ITEMDA,1,$E(DATE,1,5),0)) D BALANCE^PRCPUBAL(INVPT,ITEMDA,$E(DATE,1,5))
|
|---|
| 25 | I $P($G(^PRCP(445,INVPT,0)),"^",6)="Y" D
|
|---|
| 26 | . K PRCPUUIP F %="DATE","QTY","INVVAL","SELVAL","PKG","REF","2237PO","ISSUE","OTHERPT","REASON" I $D(PRCPDATA(%)) S PRCPUUIP(%)=PRCPDATA(%)
|
|---|
| 27 | . K PRCPID D ADDTRAN^PRCPUTRX(INVPT,ITEMDA,TRANTYPE,ORDERNO,.PRCPUUIP) K PRCPUUIP S PRCPID=+$G(Y)
|
|---|
| 28 | I '$D(^PRCP(445,INVPT,1,ITEMDA,0))&((TRANTYPE="R")!(TRANTYPE="C")) D Q
|
|---|
| 29 | . ; update costcenter costs and quit
|
|---|
| 30 | . ; use costcenter for primary since second do not have costcneters
|
|---|
| 31 | . S COSTCNTR=$P($G(^PRCP(445,INVPT,0)),"^",7)
|
|---|
| 32 | . I COSTCNTR D COSTCNTR^PRCPUCC(PRCPDATA("OTHERPT"),INVPT,COSTCNTR,-PRCPDATA("SELVAL"))
|
|---|
| 33 | I '$D(^PRCP(445,INVPT,1,ITEMDA,0)) Q
|
|---|
| 34 | L +^PRCP(445,INVPT,1,ITEMDA)
|
|---|
| 35 | S ITEMDATA=^PRCP(445,INVPT,1,ITEMDA,0)
|
|---|
| 36 | ;
|
|---|
| 37 | ; RC=receipts
|
|---|
| 38 | I TRANTYPE="RC" D
|
|---|
| 39 | . D RECEIPTS^PRCPUSAG(INVPT,ITEMDA,PRCPDATA("QTY"))
|
|---|
| 40 | . ; do not update dueins if "noduein" defined
|
|---|
| 41 | . I '$D(PRCPDATA("NODUEIN")) D SETIN^PRCPUDUE(INVPT,ITEMDA,-PRCPDATA("QTY"))
|
|---|
| 42 | . S $P(ITEMDATA,"^",15)=$J(PRCPDATA("INVVAL")/PRCPDATA("QTY"),0,3),$P(ITEMDATA,"^",3)=$E(DATE,1,7)
|
|---|
| 43 | ;
|
|---|
| 44 | ; R or C=distribution
|
|---|
| 45 | I TRANTYPE="R"!(TRANTYPE="C") D
|
|---|
| 46 | . D ADDUSAG^PRCPUSAG(INVPT,ITEMDA,-PRCPDATA("QTY"),-PRCPDATA("INVVAL"))
|
|---|
| 47 | . ; use costcenter for primary since second do not have costcenters
|
|---|
| 48 | . S COSTCNTR=$P($G(^PRCP(445,INVPT,0)),"^",7)
|
|---|
| 49 | . I COSTCNTR D COSTCNTR^PRCPUCC(PRCPDATA("OTHERPT"),INVPT,COSTCNTR,-PRCPDATA("SELVAL"))
|
|---|
| 50 | . ; do not update dueouts if "nodueout" defined
|
|---|
| 51 | . I '$D(PRCPDATA("NODUEOUT")) D SETOUT^PRCPUDUE(INVPT,ITEMDA,PRCPDATA("QTY"))
|
|---|
| 52 | ;
|
|---|
| 53 | ; U=usage
|
|---|
| 54 | I TRANTYPE="U" D
|
|---|
| 55 | . D ADDUSAG^PRCPUSAG(INVPT,ITEMDA,-PRCPDATA("QTY"),-PRCPDATA("INVVAL"))
|
|---|
| 56 | ;
|
|---|
| 57 | ; update inventory item
|
|---|
| 58 | I '$P(ITEMDATA,"^",27) S $P(ITEMDATA,"^",27)=$J($P(ITEMDATA,"^",7)*$P(ITEMDATA,"^",22),0,2)
|
|---|
| 59 | S $P(ITEMDATA,"^",7)=$P(ITEMDATA,"^",7)+PRCPDATA("QTY")
|
|---|
| 60 | S $P(ITEMDATA,"^",27)=$P(ITEMDATA,"^",27)+PRCPDATA("INVVAL")
|
|---|
| 61 | S $P(ITEMDATA,"^",22)=0,%=$P(ITEMDATA,"^",7)+$P(ITEMDATA,"^",19) I %>0 S $P(ITEMDATA,"^",22)=$J($P(ITEMDATA,"^",27)/%,0,3) I $P(ITEMDATA,"^",22)'>0 S $P(ITEMDATA,"^",22)=0
|
|---|
| 62 | S ^PRCP(445,INVPT,1,ITEMDA,0)=ITEMDATA
|
|---|
| 63 | L -^PRCP(445,INVPT,1,ITEMDA)
|
|---|
| 64 | Q
|
|---|
