- 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 Jan 18, 2025@03:37: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