52 lines
2.3 KiB
Mathematica
52 lines
2.3 KiB
Mathematica
PRCPHL1 ;WISC/CC-update GIP files from data in 447.1 transaction ;4/01
|
|
V ;;5.1;IFCAP;**24**;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
;
|
|
;
|
|
UPDATE(PRCPSEC,PRCPITEM,PRCPLEFT,PRCPHL1,TYPE) ;
|
|
;
|
|
; PRCPSEC = the secondary inventory point ien
|
|
; PRCPITEM = the item's ien
|
|
; PRCPLEFT = the amount now remaining in the supply station
|
|
; PRCPHL1("DATE") = Date the activity occured
|
|
; ("INVVAL") = the dollar value linked with the transaction
|
|
; ("ITEM") = item information from the zero node
|
|
; ("QTY") = the amount transacted
|
|
; ("REASON") = comments supporting the transaction
|
|
; ("RECIPIENT")= patient involved in the transaction
|
|
; ("SELVAL") = the dollar value linked to the transaction
|
|
; ("TRAN") = The transaction file order number, if exists
|
|
; ("USER") = the individual responsible for the activity
|
|
; TYPE = the type of activity: A=adjust or disposal, U=usage
|
|
; or return, Q=quantity of hand adjusted to supply station
|
|
;
|
|
N ITEMDATA,PRCPDATE,TRANORDR,%
|
|
S ITEMDATA=PRCPHL1("ITEM")
|
|
I PRCPHL1("QTY")=0 G LEFT ; don't update file 445 if no qty transacted
|
|
S PRCPHL1("INVVAL")=$J(PRCPHL1("QTY")*$P(ITEMDATA,"^",22),0,2)
|
|
;
|
|
; set up monthly start balance, if not yet done (File 445.1)
|
|
D NOW^%DTC S PRCPDATE=%
|
|
I '$D(^PRCP(445.1,PRCPSEC,1,PRCPITEM,1,$E(PRCPDATE,1,5),0)) D BALANCE^PRCPUBAL(PRCPSEC,PRCPITEM,$E(PRCPDATE,1,5))
|
|
;
|
|
; usage (File 445)
|
|
D ADDUSAG^PRCPUSAG(PRCPSEC,PRCPITEM,-PRCPHL1("QTY"),-PRCPHL1("INVVAL"))
|
|
;
|
|
; update inventory point, verify inventory value is set to qty*unitcost
|
|
I '$P(ITEMDATA,"^",27) S $P(ITEMDATA,"^",27)=$J($P(ITEMDATA,"^",7)*$P(ITEMDATA,"^",22),0,2) ; cost of quantity on hand
|
|
S $P(ITEMDATA,"^",7)=$P(ITEMDATA,"^",7)+PRCPHL1("QTY") ; QOH+QTY in txn
|
|
S $P(ITEMDATA,"^",27)=$J($P(ITEMDATA,"^",27),0,2)+PRCPHL1("INVVAL") ; cost of QOH+QTY transacted
|
|
;
|
|
LEFT S ^PRCP(445,PRCPSEC,1,PRCPITEM,0)=ITEMDATA
|
|
S $P(^PRCP(445,PRCPSEC,1,PRCPITEM,9),"^",1)=PRCPLEFT
|
|
S $P(^PRCP(445,PRCPSEC,1,PRCPITEM,9),"^",2)=PRCPHL1("DATE")
|
|
;
|
|
; transaction register
|
|
I PRCPHL1("QTY")=0 G Q ; don't log transactions of 0 qty
|
|
I $D(PRCPHL1("TRAN")) S TRANORDR=PRCPHL1("TRAN")
|
|
I '$D(PRCPHL1("TRAN")) S TRANORDR=$$ORDERNO^PRCPUTRX(PRCPSEC)
|
|
D ADDTRAN^PRCPUTRX(PRCPSEC,PRCPITEM,TYPE,TRANORDR,.PRCPHL1)
|
|
;
|
|
Q Q
|