RMPRPIUV ;HINCIO/ODJ - Get Current Stock for Vendors ;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
; STOCK - For an entered Station, Location
; HCPCS and Item
; return an array of Vendors
; with quantity on hand and the unit cost for each Vendor.
;
; 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)
;
; Outputs:
; RMPRV - array of vendors
; piece 1 - Number of Vendors returned
; RMPRV(VENDOR IEN)
; piece 1 - Quantity on hand
; 2 - Unit cost
; 3 - Vendor Name
; (^ delimiter)
;
; 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,RMPRV) ;
N RMPRERR,RMPRK,RMPROLD,RMPREOF,RMPR7,RMPR6,RMPRTCST,RMPRVS
S RMPRERR=0
K RMPRV
S RMPRV=0
S RMPRTCST=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,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))
;
; Loop on all records for Stn, Loc, HCPCS and Item
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
S RMPR("IEN")=RMPR7("IEN")
K RMPR6 M RMPR6=RMPRK S RMPR6("IEN")=""
S RMPRERR=$$GET^RMPRPIX6(.RMPR6) ;get transaction record
S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6) ;get vendor ien
I $D(RMPRV(RMPR6("VENDOR IEN"))) D
. S RMPRVS=RMPRV(RMPR6("VENDOR IEN"))
. S $P(RMPRVS,"^",1)=RMPR7("QUANTITY")+$P(RMPRVS,"^",1)
. S $P(RMPRVS,"^",2)=RMPR7("VALUE")+$P(RMPRVS,"^",2)
. Q
E D
. S RMPRV=RMPRV+1
. S RMPRVS=RMPR7("QUANTITY")
. S $P(RMPRVS,"^",2)=RMPR7("VALUE")
. S $P(RMPRVS,"^",3)=RMPR6("VENDOR")
. Q
S RMPRV(RMPR6("VENDOR IEN"))=RMPRVS
G STOCKA
STOCKU L -^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))
STOCKX Q RMPRERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIUV 2950 printed Sep 23, 2025@20:12:41 Page 2
RMPRPIUV ;HINCIO/ODJ - Get Current Stock for Vendors ;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ; STOCK - For an entered Station, Location
+4 ; HCPCS and Item
+5 ; return an array of Vendors
+6 ; with quantity on hand and the unit cost for each Vendor.
+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 ;
+15 ; Outputs:
+16 ; RMPRV - array of vendors
+17 ; piece 1 - Number of Vendors returned
+18 ; RMPRV(VENDOR IEN)
+19 ; piece 1 - Quantity on hand
+20 ; 2 - Unit cost
+21 ; 3 - Vendor Name
+22 ; (^ delimiter)
+23 ;
+24 ; RMPRERR - function return...
+25 ; 0 - no errors
+26 ; 1 - null Station ien input
+27 ; 2 - null Location ien input
+28 ; 3 - null HCPCS code input
+29 ; 4 - null Item input
+30 ; 5 - problem with 661.7 file
+31 ; 6 - problem with 661.6 file
STOCK(RMPR,RMPRV) ;
+1 NEW RMPRERR,RMPRK,RMPROLD,RMPREOF,RMPR7,RMPR6,RMPRTCST,RMPRVS
+2 SET RMPRERR=0
+3 KILL RMPRV
+4 SET RMPRV=0
+5 SET RMPRTCST=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,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))
+15 ;
+16 ; Loop on all records for Stn, Loc, HCPCS and Item
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 SET RMPR("IEN")=RMPR7("IEN")
+11 KILL RMPR6
MERGE RMPR6=RMPRK
SET RMPR6("IEN")=""
+12 ;get transaction record
SET RMPRERR=$$GET^RMPRPIX6(.RMPR6)
+13 ;get vendor ien
SET RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6)
+14 IF $DATA(RMPRV(RMPR6("VENDOR IEN")))
Begin DoDot:1
+15 SET RMPRVS=RMPRV(RMPR6("VENDOR IEN"))
+16 SET $PIECE(RMPRVS,"^",1)=RMPR7("QUANTITY")+$PIECE(RMPRVS,"^",1)
+17 SET $PIECE(RMPRVS,"^",2)=RMPR7("VALUE")+$PIECE(RMPRVS,"^",2)
+18 QUIT
End DoDot:1
+19 IF '$TEST
Begin DoDot:1
+20 SET RMPRV=RMPRV+1
+21 SET RMPRVS=RMPR7("QUANTITY")
+22 SET $PIECE(RMPRVS,"^",2)=RMPR7("VALUE")
+23 SET $PIECE(RMPRVS,"^",3)=RMPR6("VENDOR")
+24 QUIT
End DoDot:1
+25 SET RMPRV(RMPR6("VENDOR IEN"))=RMPRVS
+26 GOTO STOCKA
STOCKU LOCK -^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))
STOCKX QUIT RMPRERR
