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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPHL1 2421 printed Sep 23, 2025@19:49:55 Page 2
PRCPHL1 ;WISC/CC-update GIP files from data in 447.1 transaction ;4/01
V ;;5.1;IFCAP;**24**;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
+3 ;
+4 ;
UPDATE(PRCPSEC,PRCPITEM,PRCPLEFT,PRCPHL1,TYPE) ;
+1 ;
+2 ; PRCPSEC = the secondary inventory point ien
+3 ; PRCPITEM = the item's ien
+4 ; PRCPLEFT = the amount now remaining in the supply station
+5 ; PRCPHL1("DATE") = Date the activity occured
+6 ; ("INVVAL") = the dollar value linked with the transaction
+7 ; ("ITEM") = item information from the zero node
+8 ; ("QTY") = the amount transacted
+9 ; ("REASON") = comments supporting the transaction
+10 ; ("RECIPIENT")= patient involved in the transaction
+11 ; ("SELVAL") = the dollar value linked to the transaction
+12 ; ("TRAN") = The transaction file order number, if exists
+13 ; ("USER") = the individual responsible for the activity
+14 ; TYPE = the type of activity: A=adjust or disposal, U=usage
+15 ; or return, Q=quantity of hand adjusted to supply station
+16 ;
+17 NEW ITEMDATA,PRCPDATE,TRANORDR,%
+18 SET ITEMDATA=PRCPHL1("ITEM")
+19 ; don't update file 445 if no qty transacted
IF PRCPHL1("QTY")=0
GOTO LEFT
+20 SET PRCPHL1("INVVAL")=$JUSTIFY(PRCPHL1("QTY")*$PIECE(ITEMDATA,"^",22),0,2)
+21 ;
+22 ; set up monthly start balance, if not yet done (File 445.1)
+23 DO NOW^%DTC
SET PRCPDATE=%
+24 IF '$DATA(^PRCP(445.1,PRCPSEC,1,PRCPITEM,1,$EXTRACT(PRCPDATE,1,5),0))
DO BALANCE^PRCPUBAL(PRCPSEC,PRCPITEM,$EXTRACT(PRCPDATE,1,5))
+25 ;
+26 ; usage (File 445)
+27 DO ADDUSAG^PRCPUSAG(PRCPSEC,PRCPITEM,-PRCPHL1("QTY"),-PRCPHL1("INVVAL"))
+28 ;
+29 ; update inventory point, verify inventory value is set to qty*unitcost
+30 ; cost of quantity on hand
IF '$PIECE(ITEMDATA,"^",27)
SET $PIECE(ITEMDATA,"^",27)=$JUSTIFY($PIECE(ITEMDATA,"^",7)*$PIECE(ITEMDATA,"^",22),0,2)
+31 ; QOH+QTY in txn
SET $PIECE(ITEMDATA,"^",7)=$PIECE(ITEMDATA,"^",7)+PRCPHL1("QTY")
+32 ; cost of QOH+QTY transacted
SET $PIECE(ITEMDATA,"^",27)=$JUSTIFY($PIECE(ITEMDATA,"^",27),0,2)+PRCPHL1("INVVAL")
+33 ;
LEFT SET ^PRCP(445,PRCPSEC,1,PRCPITEM,0)=ITEMDATA
+1 SET $PIECE(^PRCP(445,PRCPSEC,1,PRCPITEM,9),"^",1)=PRCPLEFT
+2 SET $PIECE(^PRCP(445,PRCPSEC,1,PRCPITEM,9),"^",2)=PRCPHL1("DATE")
+3 ;
+4 ; transaction register
+5 ; don't log transactions of 0 qty
IF PRCPHL1("QTY")=0
GOTO Q
+6 IF $DATA(PRCPHL1("TRAN"))
SET TRANORDR=PRCPHL1("TRAN")
+7 IF '$DATA(PRCPHL1("TRAN"))
SET TRANORDR=$$ORDERNO^PRCPUTRX(PRCPSEC)
+8 DO ADDTRAN^PRCPUTRX(PRCPSEC,PRCPITEM,TYPE,TRANORDR,.PRCPHL1)
+9 ;
Q QUIT
