PRCPHL1.m

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 ---PRCPHL1   2421     printed  Apr 09, 2024@21:02:08                                                                                                                                                                                                     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