PRCPSMB1 ;WISC/RFJ-isms transaction: balance update (create cs) ;21 Oct 91
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
BALANCE(V1,V2) ; balance transaction
; v1=invptda, v2=itemda
; returns code sheet or 'error'
N AVG,COST,D,DUEOUT,NSN,ONHAND,SALE,UNIT,VALUE,WHSE
I 'V1!('V2) Q "ERROR: invalid inventory point and item"
S D=$G(^PRCP(445,+V1,1,+V2,0)) I D="" Q "ERROR: item not stored in inventory point"
S NSN=$TR($$NSN^PRCPUX1(V2),"-") I NSN="" Q "ERROR: NSN is missing"
S UNIT=$$UNITCODE^PRCPUX1($P(D,"^",5)) I UNIT["?" Q "ERROR: UNIT OF ISSUE is missing"
S ONHAND=+$P(D,"^",7),ONHAND=$S(ONHAND:$P(ONHAND,".")_$P($J(ONHAND,0,2),".",2),1:0)
S VALUE=+$P(D,"^",27),VALUE=$S(VALUE:$P(VALUE,".")_$P($J(VALUE,0,2),".",2),1:0)
S DUEOUT=$$GETOUT^PRCPUDUE(+V1,+V2),DUEOUT=$S(DUEOUT:$P(DUEOUT,".")_$P($J(DUEOUT,0,2),".",2),1:0)
S AVG=+$P(D,"^",22),AVG=$S(AVG:$P(AVG,".")_$P($J(AVG,0,4),".",2),1:0)
S COST=+$P(D,"^",15),COST=$S(COST:$P(COST,".")_$P($J(COST,0,4),".",2),1:0)
S WHSE=+$O(^PRC(440,"AC","S",0)),SALE=+$P($G(^PRC(441,V2,2,WHSE,0)),"^",2),SALE=$S(SALE:$P(SALE,".")_$P($J(SALE,0,4),".",2),1:0)
Q "BU^"_NSN_"^"_UNIT_"^"_ONHAND_"^"_VALUE_"^"_DUEOUT_"^"_AVG_"^"_COST_"^"_SALE_"^|"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPSMB1 1280 printed Dec 13, 2024@02:15:52 Page 2
PRCPSMB1 ;WISC/RFJ-isms transaction: balance update (create cs) ;21 Oct 91
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
BALANCE(V1,V2) ; balance transaction
+1 ; v1=invptda, v2=itemda
+2 ; returns code sheet or 'error'
+3 NEW AVG,COST,D,DUEOUT,NSN,ONHAND,SALE,UNIT,VALUE,WHSE
+4 IF 'V1!('V2)
QUIT "ERROR: invalid inventory point and item"
+5 SET D=$GET(^PRCP(445,+V1,1,+V2,0))
IF D=""
QUIT "ERROR: item not stored in inventory point"
+6 SET NSN=$TRANSLATE($$NSN^PRCPUX1(V2),"-")
IF NSN=""
QUIT "ERROR: NSN is missing"
+7 SET UNIT=$$UNITCODE^PRCPUX1($PIECE(D,"^",5))
IF UNIT["?"
QUIT "ERROR: UNIT OF ISSUE is missing"
+8 SET ONHAND=+$PIECE(D,"^",7)
SET ONHAND=$SELECT(ONHAND:$PIECE(ONHAND,".")_$PIECE($JUSTIFY(ONHAND,0,2),".",2),1:0)
+9 SET VALUE=+$PIECE(D,"^",27)
SET VALUE=$SELECT(VALUE:$PIECE(VALUE,".")_$PIECE($JUSTIFY(VALUE,0,2),".",2),1:0)
+10 SET DUEOUT=$$GETOUT^PRCPUDUE(+V1,+V2)
SET DUEOUT=$SELECT(DUEOUT:$PIECE(DUEOUT,".")_$PIECE($JUSTIFY(DUEOUT,0,2),".",2),1:0)
+11 SET AVG=+$PIECE(D,"^",22)
SET AVG=$SELECT(AVG:$PIECE(AVG,".")_$PIECE($JUSTIFY(AVG,0,4),".",2),1:0)
+12 SET COST=+$PIECE(D,"^",15)
SET COST=$SELECT(COST:$PIECE(COST,".")_$PIECE($JUSTIFY(COST,0,4),".",2),1:0)
+13 SET WHSE=+$ORDER(^PRC(440,"AC","S",0))
SET SALE=+$PIECE($GET(^PRC(441,V2,2,WHSE,0)),"^",2)
SET SALE=$SELECT(SALE:$PIECE(SALE,".")_$PIECE($JUSTIFY(SALE,0,4),".",2),1:0)
+14 QUIT "BU^"_NSN_"^"_UNIT_"^"_ONHAND_"^"_VALUE_"^"_DUEOUT_"^"_AVG_"^"_COST_"^"_SALE_"^|"
