- PRCPUUIW ;WISC/RFJ-utility update item whse to prim ;08 Jul 92
- ;;5.1;IFCAP;**221**;4/21/95;Build 14
- ;Per VA Directive 6402, this routine should not be modified.
- ;
- ;PRC*5.1*221 If Total Inventory Value is zero DO NOT
- ; recalulate Onhand*Avg Price which cause
- ; doubling of of adjustment entered for
- ; Total Inventory Value
- Q
- ;
- ;
- ITEM(INVPT,ITEMDA,TRANTYPE,ORDERNO,PRCPDATA) ; update inventory point item
- ;prcpdata =
- ; qty) = quantity to add to on-hand
- ; invval) = total inventory value
- ; selval) = total sales value
- ; 2237po) = 2237 or purchase order number
- ; ref) = reference number
- ; otherpt) = other inventory point affected (for issues)
- ; reason) = reason (for adjustments)
- ; reasoncode)= reason code for other adjustments
- ; date) = date of transaction (optional)
- ; tranda) = transaction number for removing due-ins
- ; pkg) = packaging units on transaction register
- ; drugacct) = update drug accountability
- ;
- ;returns
- ; prcpid = transaction 445.2 da number
- ;
- N %,COSTCNTR,DATE,INVTYPE,ITEMDATA,PRCPUUIW,X,Y
- D NOW^%DTC S DATE=%
- I '$D(^PRCP(445.1,INVPT,1,ITEMDA,1,$E(DATE,1,5),0)) D BALANCE^PRCPUBAL(INVPT,ITEMDA,$E(DATE,1,5))
- I $P($G(^PRCP(445,INVPT,0)),"^",6)="Y" D
- . K PRCPUUIW F %="DATE","QTY","INVVAL","SELVAL","PKG","REF","2237PO","ISSUE","OTHERPT","REASON","REASONCODE" I $D(PRCPDATA(%)) S PRCPUUIW(%)=PRCPDATA(%)
- . K PRCPID D ADDTRAN^PRCPUTRX(INVPT,ITEMDA,TRANTYPE,ORDERNO,.PRCPUUIW) K PRCPUUIW S PRCPID=+$G(Y)
- S INVTYPE=$P(^PRCP(445,INVPT,0),"^",3)
- I '$D(^PRCP(445,INVPT,1,ITEMDA,0)) Q
- L +^PRCP(445,INVPT,1,ITEMDA):$G(DILOCKTM,5)
- S ITEMDATA=^PRCP(445,INVPT,1,ITEMDA,0)
- ; purchase order
- I PRCPDATA("2237PO")'="",$P(PRCPDATA("2237PO"),"-",3)="" D
- . I PRCPDATA("QTY") D RECEIPTS^PRCPUSAG(INVPT,ITEMDA,PRCPDATA("QTY"))
- ;
- ; 2237 issue
- I $P(PRCPDATA("2237PO"),"-",3)'="" D
- . I INVTYPE="W" D
- . . D ADDUSAG^PRCPUSAG(INVPT,ITEMDA,-PRCPDATA("QTY"),-PRCPDATA("INVVAL"))
- . . I TRANTYPE="R" D SETOUT^PRCPUDUE(INVPT,ITEMDA,PRCPDATA("QTY"))
- . I INVTYPE="P" D
- . . D RECEIPTS^PRCPUSAG(INVPT,ITEMDA,PRCPDATA("QTY"))
- . . S COSTCNTR=$P($G(^PRCP(445,INVPT,0)),"^",7) I COSTCNTR D COSTCNTR^PRCPUCC(INVPT,PRCPDATA("OTHERPT"),COSTCNTR,PRCPDATA("SELVAL"))
- ; update drug accountability
- I INVTYPE="P",$G(PRCPDATA("DRUGACCT")) S %=+$P(ITEMDATA,"^",29) S:'% %=1 D EN^PSAGIP(INVPT,ITEMDA,PRCPDATA("QTY")*%,$G(PRCPDATA("TRANDA")),PRCPDATA("2237PO"),TRANTYPE_ORDERNO,PRCPDATA("INVVAL"))
- ; update inventory item
- ;I '$P(ITEMDATA,"^",27) S $P(ITEMDATA,"^",27)=$J($P(ITEMDATA,"^",7)*$P(ITEMDATA,"^",22),0,2) ;PRC*5.1*221 comment out calc
- S $P(ITEMDATA,"^",7)=$P(ITEMDATA,"^",7)+PRCPDATA("QTY")
- I $D(PRCPDATA("ISSUE")) S $P(ITEMDATA,"^",19)=$P(ITEMDATA,"^",19)-PRCPDATA("QTY")
- S $P(ITEMDATA,"^",27)=$P(ITEMDATA,"^",27)+PRCPDATA("INVVAL")
- S $P(ITEMDATA,"^",22)=0,%=$P(ITEMDATA,"^",7)+$P(ITEMDATA,"^",19) I %>0 S $P(ITEMDATA,"^",22)=$J($P(ITEMDATA,"^",27)/%,0,3)
- I TRANTYPE="RC",$G(PRCPDATA("TRANDA")) D OUTST^PRCPUTRA(INVPT,ITEMDA,PRCPDATA("TRANDA"),-PRCPDATA("QTY"))
- I TRANTYPE="RC",PRCPDATA("QTY") S $P(ITEMDATA,"^",15)=$J(PRCPDATA("INVVAL")/PRCPDATA("QTY"),0,3),$P(ITEMDATA,"^",3)=$E(DATE,1,7)
- I PRCPDATA("2237PO")'="",$P(PRCPDATA("2237PO"),"-",3)="",INVTYPE="W",$D(^PRC(441,ITEMDA,2,+$O(^PRC(440,"AC","S",0)),0)) S $P(^(0),"^",2)=$S($P(ITEMDATA,"^",15)>$P(ITEMDATA,"^",22):$P(ITEMDATA,"^",15),1:$P(ITEMDATA,"^",22))
- S ^PRCP(445,INVPT,1,ITEMDA,0)=ITEMDATA
- L -^PRCP(445,INVPT,1,ITEMDA)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPUUIW 3611 printed Feb 18, 2025@23:42:52 Page 2
- PRCPUUIW ;WISC/RFJ-utility update item whse to prim ;08 Jul 92
- +1 ;;5.1;IFCAP;**221**;4/21/95;Build 14
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ;PRC*5.1*221 If Total Inventory Value is zero DO NOT
- +5 ; recalulate Onhand*Avg Price which cause
- +6 ; doubling of of adjustment entered for
- +7 ; Total Inventory Value
- +8 QUIT
- +9 ;
- +10 ;
- ITEM(INVPT,ITEMDA,TRANTYPE,ORDERNO,PRCPDATA) ; update inventory point item
- +1 ;prcpdata =
- +2 ; qty) = quantity to add to on-hand
- +3 ; invval) = total inventory value
- +4 ; selval) = total sales value
- +5 ; 2237po) = 2237 or purchase order number
- +6 ; ref) = reference number
- +7 ; otherpt) = other inventory point affected (for issues)
- +8 ; reason) = reason (for adjustments)
- +9 ; reasoncode)= reason code for other adjustments
- +10 ; date) = date of transaction (optional)
- +11 ; tranda) = transaction number for removing due-ins
- +12 ; pkg) = packaging units on transaction register
- +13 ; drugacct) = update drug accountability
- +14 ;
- +15 ;returns
- +16 ; prcpid = transaction 445.2 da number
- +17 ;
- +18 NEW %,COSTCNTR,DATE,INVTYPE,ITEMDATA,PRCPUUIW,X,Y
- +19 DO NOW^%DTC
- SET DATE=%
- +20 IF '$DATA(^PRCP(445.1,INVPT,1,ITEMDA,1,$EXTRACT(DATE,1,5),0))
- DO BALANCE^PRCPUBAL(INVPT,ITEMDA,$EXTRACT(DATE,1,5))
- +21 IF $PIECE($GET(^PRCP(445,INVPT,0)),"^",6)="Y"
- Begin DoDot:1
- +22 KILL PRCPUUIW
- FOR %="DATE","QTY","INVVAL","SELVAL","PKG","REF","2237PO","ISSUE","OTHERPT","REASON","REASONCODE"
- IF $DATA(PRCPDATA(%))
- SET PRCPUUIW(%)=PRCPDATA(%)
- +23 KILL PRCPID
- DO ADDTRAN^PRCPUTRX(INVPT,ITEMDA,TRANTYPE,ORDERNO,.PRCPUUIW)
- KILL PRCPUUIW
- SET PRCPID=+$GET(Y)
- End DoDot:1
- +24 SET INVTYPE=$PIECE(^PRCP(445,INVPT,0),"^",3)
- +25 IF '$DATA(^PRCP(445,INVPT,1,ITEMDA,0))
- QUIT
- +26 LOCK +^PRCP(445,INVPT,1,ITEMDA):$GET(DILOCKTM,5)
- +27 SET ITEMDATA=^PRCP(445,INVPT,1,ITEMDA,0)
- +28 ; purchase order
- +29 IF PRCPDATA("2237PO")'=""
- IF $PIECE(PRCPDATA("2237PO"),"-",3)=""
- Begin DoDot:1
- +30 IF PRCPDATA("QTY")
- DO RECEIPTS^PRCPUSAG(INVPT,ITEMDA,PRCPDATA("QTY"))
- End DoDot:1
- +31 ;
- +32 ; 2237 issue
- +33 IF $PIECE(PRCPDATA("2237PO"),"-",3)'=""
- Begin DoDot:1
- +34 IF INVTYPE="W"
- Begin DoDot:2
- +35 DO ADDUSAG^PRCPUSAG(INVPT,ITEMDA,-PRCPDATA("QTY"),-PRCPDATA("INVVAL"))
- +36 IF TRANTYPE="R"
- DO SETOUT^PRCPUDUE(INVPT,ITEMDA,PRCPDATA("QTY"))
- End DoDot:2
- +37 IF INVTYPE="P"
- Begin DoDot:2
- +38 DO RECEIPTS^PRCPUSAG(INVPT,ITEMDA,PRCPDATA("QTY"))
- +39 SET COSTCNTR=$PIECE($GET(^PRCP(445,INVPT,0)),"^",7)
- IF COSTCNTR
- DO COSTCNTR^PRCPUCC(INVPT,PRCPDATA("OTHERPT"),COSTCNTR,PRCPDATA("SELVAL"))
- End DoDot:2
- End DoDot:1
- +40 ; update drug accountability
- +41 IF INVTYPE="P"
- IF $GET(PRCPDATA("DRUGACCT"))
- SET %=+$PIECE(ITEMDATA,"^",29)
- if '%
- SET %=1
- DO EN^PSAGIP(INVPT,ITEMDA,PRCPDATA("QTY")*%,$GET(PRCPDATA("TRANDA")),PRCPDATA("2237PO"),TRANTYPE_ORDERNO,PRCPDATA("INVVAL"))
- +42 ; update inventory item
- +43 ;I '$P(ITEMDATA,"^",27) S $P(ITEMDATA,"^",27)=$J($P(ITEMDATA,"^",7)*$P(ITEMDATA,"^",22),0,2) ;PRC*5.1*221 comment out calc
- +44 SET $PIECE(ITEMDATA,"^",7)=$PIECE(ITEMDATA,"^",7)+PRCPDATA("QTY")
- +45 IF $DATA(PRCPDATA("ISSUE"))
- SET $PIECE(ITEMDATA,"^",19)=$PIECE(ITEMDATA,"^",19)-PRCPDATA("QTY")
- +46 SET $PIECE(ITEMDATA,"^",27)=$PIECE(ITEMDATA,"^",27)+PRCPDATA("INVVAL")
- +47 SET $PIECE(ITEMDATA,"^",22)=0
- SET %=$PIECE(ITEMDATA,"^",7)+$PIECE(ITEMDATA,"^",19)
- IF %>0
- SET $PIECE(ITEMDATA,"^",22)=$JUSTIFY($PIECE(ITEMDATA,"^",27)/%,0,3)
- +48 IF TRANTYPE="RC"
- IF $GET(PRCPDATA("TRANDA"))
- DO OUTST^PRCPUTRA(INVPT,ITEMDA,PRCPDATA("TRANDA"),-PRCPDATA("QTY"))
- +49 IF TRANTYPE="RC"
- IF PRCPDATA("QTY")
- SET $PIECE(ITEMDATA,"^",15)=$JUSTIFY(PRCPDATA("INVVAL")/PRCPDATA("QTY"),0,3)
- SET $PIECE(ITEMDATA,"^",3)=$EXTRACT(DATE,1,7)
- +50 IF PRCPDATA("2237PO")'=""
- IF $PIECE(PRCPDATA("2237PO"),"-",3)=""
- IF INVTYPE="W"
- IF $DATA(^PRC(441,ITEMDA,2,+$ORDER(^PRC(440,"AC","S",0)),0))
- SET $PIECE(^(0),"^",2)=$SELECT($PIECE(ITEMDATA,"^",15)>$PIECE(ITEMDATA,"^",22):$PIECE(ITEMDATA,"^",15),1:$PIECE(ITEMDATA,"^",22))
- +51 SET ^PRCP(445,INVPT,1,ITEMDA,0)=ITEMDATA
- +52 LOCK -^PRCP(445,INVPT,1,ITEMDA)
- +53 QUIT