| [613] | 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
 | 
|---|