RMPRPIUE ;HINCIO/ODJ - Get Current Stock Utility ;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
; STOCK - For an entered Station, Location, Vendor
; HCPCS and Item
; return total quantity on hand for that item
; and the average unit cost.
;
; Inputs:
; RMPR - an array with the following elements...
; RMPR("STATION IEN") - Station ien (ptr ^DIC(4,)
; RMPR("LOCATION IEN") - Location ien (ptr ^RMPR(661.5,)
; RMPR("HCPCS") - HCPCS code (eg E0111)
; RMPR("ITEM") - HCPCS Item number (eg 1)
; RMPR("VENDOR IEN") - Vendor ien
;
; Outputs:
; RMPR - additional elements to the input RMPR array
; RMPR("QOH") - Quantity on hand
; RMPR("UNIT COST") - Unit cost per Item
;
; RMPRERR - function return...
; 0 - no errors
; 1 - null Station ien input
; 2 - null Location ien input
; 3 - null HCPCS code input
; 4 - null Item input
; 5 - problem with 661.7 file
; 6 - problem with 661.6 file
STOCK(RMPR) ;
N RMPRERR,RMPRK,RMPROLD,RMPREOF,RMPR7,RMPR6,RMPRTCST
S RMPRERR=0
S RMPRTCST=0
S RMPR("QOH")=0
S RMPR("UNIT COST")=0
S RMPRK("STATION")=$G(RMPR("STATION IEN"))
I RMPRK("STATION")="" S RMPRERR=1 G STOCKX
S RMPRK("LOCATION")=$G(RMPR("LOCATION IEN"))
I RMPRK("LOCATION")="" S RMPRERR=2 G STOCKX
S RMPRK("HCPCS")=$G(RMPR("HCPCS"))
I RMPRK("HCPCS")="" S RMPRERR=3 G STOCKX
S RMPRK("ITEM")=$G(RMPR("ITEM"))
I RMPRK("ITEM")="" S RMPRERR=4 G STOCKX
L +^RMPR(661.7,"XSHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))
;
; Loop on all records for Stn, Loc, HCPCS and Item, and sum qty and cst
STOCKA S RMPRERR=$$NEXT^RMPRPIXE(.RMPRK,"XSLHIDS","",1,.RMPROLD,.RMPREOF)
I RMPRERR S RMPRERR=5 G STOCKU
I RMPREOF G STOCKU
I RMPRK("ITEM")'=RMPROLD("ITEM") G STOCKU
I RMPRK("HCPCS")'=RMPROLD("HCPCS") G STOCKU
I RMPRK("LOCATION")'=RMPROLD("LOCATION") G STOCKU
I RMPRK("STATION")'=RMPROLD("STATION") G STOCKU
K RMPR7 M RMPR7=RMPRK
S RMPRERR=$$GET^RMPRPIX7(.RMPR7) ;get current stock record
I RMPRERR S RMPRERR=5 G STOCKU
I RMPR("VENDOR IEN")'="" D G:RMPRERR STOCKU
. K RMPR6 M RMPR6=RMPRK S RMPR6("IEN")=""
. S RMPRERR=$$GET^RMPRPIX6(.RMPR6) ;get transaction record
. I RMPRERR S RMPRERR=6 Q
. S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6) ;get vendor ien
. I RMPRERR S RMPRERR=6 Q
. Q:RMPR("VENDOR IEN")'=RMPR6("VENDOR IEN")
. S RMPR("QOH")=RMPR7("QUANTITY")+RMPR("QOH")
. S RMPRTCST=RMPRTCST+RMPR7("VALUE")
. Q
E D
. S RMPR("QOH")=RMPR7("QUANTITY")+RMPR("QOH")
. S RMPRTCST=RMPRTCST+RMPR7("VALUE")
. Q
G STOCKA
STOCKU L -^RMPR(661.7,"XSHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))
I RMPR("QOH") S RMPR("UNIT COST")=RMPRTCST/RMPR("QOH")
STOCKX Q RMPRERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIUE 2900 printed Sep 23, 2025@20:12:34 Page 2
RMPRPIUE ;HINCIO/ODJ - Get Current Stock Utility ;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ; STOCK - For an entered Station, Location, Vendor
+4 ; HCPCS and Item
+5 ; return total quantity on hand for that item
+6 ; and the average unit cost.
+7 ;
+8 ; Inputs:
+9 ; RMPR - an array with the following elements...
+10 ; RMPR("STATION IEN") - Station ien (ptr ^DIC(4,)
+11 ; RMPR("LOCATION IEN") - Location ien (ptr ^RMPR(661.5,)
+12 ; RMPR("HCPCS") - HCPCS code (eg E0111)
+13 ; RMPR("ITEM") - HCPCS Item number (eg 1)
+14 ; RMPR("VENDOR IEN") - Vendor ien
+15 ;
+16 ; Outputs:
+17 ; RMPR - additional elements to the input RMPR array
+18 ; RMPR("QOH") - Quantity on hand
+19 ; RMPR("UNIT COST") - Unit cost per Item
+20 ;
+21 ; RMPRERR - function return...
+22 ; 0 - no errors
+23 ; 1 - null Station ien input
+24 ; 2 - null Location ien input
+25 ; 3 - null HCPCS code input
+26 ; 4 - null Item input
+27 ; 5 - problem with 661.7 file
+28 ; 6 - problem with 661.6 file
STOCK(RMPR) ;
+1 NEW RMPRERR,RMPRK,RMPROLD,RMPREOF,RMPR7,RMPR6,RMPRTCST
+2 SET RMPRERR=0
+3 SET RMPRTCST=0
+4 SET RMPR("QOH")=0
+5 SET RMPR("UNIT COST")=0
+6 SET RMPRK("STATION")=$GET(RMPR("STATION IEN"))
+7 IF RMPRK("STATION")=""
SET RMPRERR=1
GOTO STOCKX
+8 SET RMPRK("LOCATION")=$GET(RMPR("LOCATION IEN"))
+9 IF RMPRK("LOCATION")=""
SET RMPRERR=2
GOTO STOCKX
+10 SET RMPRK("HCPCS")=$GET(RMPR("HCPCS"))
+11 IF RMPRK("HCPCS")=""
SET RMPRERR=3
GOTO STOCKX
+12 SET RMPRK("ITEM")=$GET(RMPR("ITEM"))
+13 IF RMPRK("ITEM")=""
SET RMPRERR=4
GOTO STOCKX
+14 LOCK +^RMPR(661.7,"XSHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))
+15 ;
+16 ; Loop on all records for Stn, Loc, HCPCS and Item, and sum qty and cst
STOCKA SET RMPRERR=$$NEXT^RMPRPIXE(.RMPRK,"XSLHIDS","",1,.RMPROLD,.RMPREOF)
+1 IF RMPRERR
SET RMPRERR=5
GOTO STOCKU
+2 IF RMPREOF
GOTO STOCKU
+3 IF RMPRK("ITEM")'=RMPROLD("ITEM")
GOTO STOCKU
+4 IF RMPRK("HCPCS")'=RMPROLD("HCPCS")
GOTO STOCKU
+5 IF RMPRK("LOCATION")'=RMPROLD("LOCATION")
GOTO STOCKU
+6 IF RMPRK("STATION")'=RMPROLD("STATION")
GOTO STOCKU
+7 KILL RMPR7
MERGE RMPR7=RMPRK
+8 ;get current stock record
SET RMPRERR=$$GET^RMPRPIX7(.RMPR7)
+9 IF RMPRERR
SET RMPRERR=5
GOTO STOCKU
+10 IF RMPR("VENDOR IEN")'=""
Begin DoDot:1
+11 KILL RMPR6
MERGE RMPR6=RMPRK
SET RMPR6("IEN")=""
+12 ;get transaction record
SET RMPRERR=$$GET^RMPRPIX6(.RMPR6)
+13 IF RMPRERR
SET RMPRERR=6
QUIT
+14 ;get vendor ien
SET RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6)
+15 IF RMPRERR
SET RMPRERR=6
QUIT
+16 if RMPR("VENDOR IEN")'=RMPR6("VENDOR IEN")
QUIT
+17 SET RMPR("QOH")=RMPR7("QUANTITY")+RMPR("QOH")
+18 SET RMPRTCST=RMPRTCST+RMPR7("VALUE")
+19 QUIT
End DoDot:1
if RMPRERR
GOTO STOCKU
+20 IF '$TEST
Begin DoDot:1
+21 SET RMPR("QOH")=RMPR7("QUANTITY")+RMPR("QOH")
+22 SET RMPRTCST=RMPRTCST+RMPR7("VALUE")
+23 QUIT
End DoDot:1
+24 GOTO STOCKA
STOCKU LOCK -^RMPR(661.7,"XSHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))
+1 IF RMPR("QOH")
SET RMPR("UNIT COST")=RMPRTCST/RMPR("QOH")
STOCKX QUIT RMPRERR
