source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPHL1.m@ 1739

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

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1PRCPHL1 ;WISC/CC-update GIP files from data in 447.1 transaction ;4/01
2V ;;5.1;IFCAP;**24**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;
6 ;
7UPDATE(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 ;
41LEFT 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 ;
51Q Q
Note: See TracBrowser for help on using the repository browser.