RMPRPIUV.m

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 ---RMPRPIUV   2950     printed  Apr 09, 2024@21:34:10                                                                                                                                                                                                    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