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

PRCPUUIP.m

Go to the documentation of this file.
  1. PRCPUUIP ;WISC/RFJ-utility update item prim to secondary ;08 Jul 92
  1. ;;5.1;IFCAP;**126**;Oct 20, 2000;Build 2
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. ITEM(INVPT,ITEMDA,TRANTYPE,ORDERNO,PRCPDATA) ; update inventory point item
  1. ;prcpdata =
  1. ; qty) = quantity to add to on-hand
  1. ; invval) = total inventory value
  1. ; selval) = total sales value
  1. ; otherpt) = other inventory point affected (for issues)
  1. ; reason) = reason (for adjustments)
  1. ; date) = date of transaction (optional)
  1. ; pkg) = packaging units on transaction register
  1. ; noduein) = do not decrement dueins if $data (optional)
  1. ; nodueout) = do not decrement dueouts if $data (optional)
  1. ;
  1. ;returns
  1. ; prcpid = transaction 445.2 da number
  1. ;
  1. N %,COSTCNTR,DATE,ITEMDATA,PRCPUUIP,X,Y
  1. D NOW^%DTC S DATE=%
  1. I '$D(^PRCP(445.1,INVPT,1,ITEMDA,1,$E(DATE,1,5),0)) D BALANCE^PRCPUBAL(INVPT,ITEMDA,$E(DATE,1,5))
  1. I $P($G(^PRCP(445,INVPT,0)),"^",6)="Y" D
  1. . K PRCPUUIP F %="DATE","QTY","INVVAL","SELVAL","PKG","REF","2237PO","ISSUE","OTHERPT","REASON" I $D(PRCPDATA(%)) S PRCPUUIP(%)=PRCPDATA(%)
  1. . K PRCPID D ADDTRAN^PRCPUTRX(INVPT,ITEMDA,TRANTYPE,ORDERNO,.PRCPUUIP) K PRCPUUIP S PRCPID=+$G(Y)
  1. I '$D(^PRCP(445,INVPT,1,ITEMDA,0))&((TRANTYPE="R")!(TRANTYPE="C")) D Q
  1. . ; update costcenter costs and quit
  1. . ; use costcenter for primary since second do not have costcneters
  1. . S COSTCNTR=$P($G(^PRCP(445,INVPT,0)),"^",7)
  1. . I COSTCNTR D COSTCNTR^PRCPUCC(PRCPDATA("OTHERPT"),INVPT,COSTCNTR,-PRCPDATA("SELVAL"))
  1. I '$D(^PRCP(445,INVPT,1,ITEMDA,0)) Q
  1. L +^PRCP(445,INVPT,1,ITEMDA)
  1. S ITEMDATA=^PRCP(445,INVPT,1,ITEMDA,0)
  1. ;
  1. ; RC=receipts
  1. I TRANTYPE="RC" D
  1. . D RECEIPTS^PRCPUSAG(INVPT,ITEMDA,PRCPDATA("QTY"))
  1. . ; do not update dueins if "noduein" defined
  1. . I '$D(PRCPDATA("NODUEIN")) D SETIN^PRCPUDUE(INVPT,ITEMDA,-PRCPDATA("QTY"))
  1. . S $P(ITEMDATA,"^",15)=$J(PRCPDATA("INVVAL")/PRCPDATA("QTY"),0,3),$P(ITEMDATA,"^",3)=$E(DATE,1,7)
  1. ;
  1. ; R or C=distribution
  1. I TRANTYPE="R"!(TRANTYPE="C") D
  1. . D ADDUSAG^PRCPUSAG(INVPT,ITEMDA,-PRCPDATA("QTY"),-PRCPDATA("INVVAL"))
  1. . ; use costcenter for primary since second do not have costcenters
  1. . S COSTCNTR=$P($G(^PRCP(445,INVPT,0)),"^",7)
  1. . I COSTCNTR D COSTCNTR^PRCPUCC(PRCPDATA("OTHERPT"),INVPT,COSTCNTR,-PRCPDATA("SELVAL"))
  1. . ; do not update dueouts if "nodueout" defined
  1. . I '$D(PRCPDATA("NODUEOUT")) D SETOUT^PRCPUDUE(INVPT,ITEMDA,PRCPDATA("QTY"))
  1. ;
  1. ; U=usage
  1. I TRANTYPE="U" D
  1. . D ADDUSAG^PRCPUSAG(INVPT,ITEMDA,-PRCPDATA("QTY"),-PRCPDATA("INVVAL"))
  1. ;
  1. ; update inventory item
  1. I '$P(ITEMDATA,"^",27) S $P(ITEMDATA,"^",27)=$J($P(ITEMDATA,"^",7)*$P(ITEMDATA,"^",22),0,2)
  1. S $P(ITEMDATA,"^",7)=$P(ITEMDATA,"^",7)+PRCPDATA("QTY")
  1. S $P(ITEMDATA,"^",27)=$P(ITEMDATA,"^",27)+PRCPDATA("INVVAL")
  1. 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
  1. I TRANTYPE="P",$P(ITEMDATA,"^",22)=0 S $P(ITEMDATA,"^",22)=$P(ITEMDATA,"^",15)
  1. S ^PRCP(445,INVPT,1,ITEMDA,0)=ITEMDATA
  1. L -^PRCP(445,INVPT,1,ITEMDA)
  1. Q