| 1 | PRCPHL1 ;WISC/CC-update GIP files from data in 447.1 transaction ;4/01
|
|---|
| 2 | V ;;5.1;IFCAP;**24**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | UPDATE(PRCPSEC,PRCPITEM,PRCPLEFT,PRCPHL1,TYPE) ;
|
|---|
| 8 | ;
|
|---|
| 9 | ; PRCPSEC = the secondary inventory point ien
|
|---|
| 10 | ; PRCPITEM = the item's ien
|
|---|
| 11 | ; PRCPLEFT = the amount now remaining in the supply station
|
|---|
| 12 | ; PRCPHL1("DATE") = Date the activity occured
|
|---|
| 13 | ; ("INVVAL") = the dollar value linked with the transaction
|
|---|
| 14 | ; ("ITEM") = item information from the zero node
|
|---|
| 15 | ; ("QTY") = the amount transacted
|
|---|
| 16 | ; ("REASON") = comments supporting the transaction
|
|---|
| 17 | ; ("RECIPIENT")= patient involved in the transaction
|
|---|
| 18 | ; ("SELVAL") = the dollar value linked to the transaction
|
|---|
| 19 | ; ("TRAN") = The transaction file order number, if exists
|
|---|
| 20 | ; ("USER") = the individual responsible for the activity
|
|---|
| 21 | ; TYPE = the type of activity: A=adjust or disposal, U=usage
|
|---|
| 22 | ; or return, Q=quantity of hand adjusted to supply station
|
|---|
| 23 | ;
|
|---|
| 24 | N ITEMDATA,PRCPDATE,TRANORDR,%
|
|---|
| 25 | S ITEMDATA=PRCPHL1("ITEM")
|
|---|
| 26 | I PRCPHL1("QTY")=0 G LEFT ; don't update file 445 if no qty transacted
|
|---|
| 27 | S PRCPHL1("INVVAL")=$J(PRCPHL1("QTY")*$P(ITEMDATA,"^",22),0,2)
|
|---|
| 28 | ;
|
|---|
| 29 | ; set up monthly start balance, if not yet done (File 445.1)
|
|---|
| 30 | D NOW^%DTC S PRCPDATE=%
|
|---|
| 31 | I '$D(^PRCP(445.1,PRCPSEC,1,PRCPITEM,1,$E(PRCPDATE,1,5),0)) D BALANCE^PRCPUBAL(PRCPSEC,PRCPITEM,$E(PRCPDATE,1,5))
|
|---|
| 32 | ;
|
|---|
| 33 | ; usage (File 445)
|
|---|
| 34 | D ADDUSAG^PRCPUSAG(PRCPSEC,PRCPITEM,-PRCPHL1("QTY"),-PRCPHL1("INVVAL"))
|
|---|
| 35 | ;
|
|---|
| 36 | ; update inventory point, verify inventory value is set to qty*unitcost
|
|---|
| 37 | I '$P(ITEMDATA,"^",27) S $P(ITEMDATA,"^",27)=$J($P(ITEMDATA,"^",7)*$P(ITEMDATA,"^",22),0,2) ; cost of quantity on hand
|
|---|
| 38 | S $P(ITEMDATA,"^",7)=$P(ITEMDATA,"^",7)+PRCPHL1("QTY") ; QOH+QTY in txn
|
|---|
| 39 | S $P(ITEMDATA,"^",27)=$J($P(ITEMDATA,"^",27),0,2)+PRCPHL1("INVVAL") ; cost of QOH+QTY transacted
|
|---|
| 40 | ;
|
|---|
| 41 | LEFT S ^PRCP(445,PRCPSEC,1,PRCPITEM,0)=ITEMDATA
|
|---|
| 42 | S $P(^PRCP(445,PRCPSEC,1,PRCPITEM,9),"^",1)=PRCPLEFT
|
|---|
| 43 | S $P(^PRCP(445,PRCPSEC,1,PRCPITEM,9),"^",2)=PRCPHL1("DATE")
|
|---|
| 44 | ;
|
|---|
| 45 | ; transaction register
|
|---|
| 46 | I PRCPHL1("QTY")=0 G Q ; don't log transactions of 0 qty
|
|---|
| 47 | I $D(PRCPHL1("TRAN")) S TRANORDR=PRCPHL1("TRAN")
|
|---|
| 48 | I '$D(PRCPHL1("TRAN")) S TRANORDR=$$ORDERNO^PRCPUTRX(PRCPSEC)
|
|---|
| 49 | D ADDTRAN^PRCPUTRX(PRCPSEC,PRCPITEM,TYPE,TRANORDR,.PRCPHL1)
|
|---|
| 50 | ;
|
|---|
| 51 | Q Q
|
|---|
