source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPUUIP.m@ 623

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1PRCPUUIP ;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 ;
7ITEM(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
Note: See TracBrowser for help on using the repository browser.