| 1 | RMPRPIUV ;HINCIO/ODJ - Get Current Stock for Vendors ;3/8/01 | 
|---|
| 2 | ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 | 
|---|
| 3 | Q | 
|---|
| 4 | ; STOCK - For an entered Station, Location | 
|---|
| 5 | ;         HCPCS and Item | 
|---|
| 6 | ;         return an array of Vendors | 
|---|
| 7 | ;         with quantity on hand and the unit cost for each Vendor. | 
|---|
| 8 | ; | 
|---|
| 9 | ; Inputs: | 
|---|
| 10 | ;    RMPR - an array with the following elements... | 
|---|
| 11 | ;    RMPR("STATION IEN")  - Station ien (ptr ^DIC(4,) | 
|---|
| 12 | ;    RMPR("LOCATION IEN") - Location ien (ptr ^RMPR(661.5,) | 
|---|
| 13 | ;    RMPR("HCPCS")        - HCPCS code (eg E0111) | 
|---|
| 14 | ;    RMPR("ITEM")         - HCPCS Item number (eg 1) | 
|---|
| 15 | ; | 
|---|
| 16 | ; Outputs: | 
|---|
| 17 | ;    RMPRV - array of vendors | 
|---|
| 18 | ;      piece 1 - Number of Vendors returned | 
|---|
| 19 | ;    RMPRV(VENDOR IEN) | 
|---|
| 20 | ;          piece 1        - Quantity on hand | 
|---|
| 21 | ;                2        - Unit cost | 
|---|
| 22 | ;                3        - Vendor Name | 
|---|
| 23 | ;          (^ delimiter) | 
|---|
| 24 | ; | 
|---|
| 25 | ;    RMPRERR - function return... | 
|---|
| 26 | ;               0 - no errors | 
|---|
| 27 | ;               1 - null Station ien input | 
|---|
| 28 | ;               2 - null Location ien input | 
|---|
| 29 | ;               3 - null HCPCS code input | 
|---|
| 30 | ;               4 - null Item input | 
|---|
| 31 | ;               5 - problem with 661.7 file | 
|---|
| 32 | ;               6 - problem with 661.6 file | 
|---|
| 33 | STOCK(RMPR,RMPRV) ; | 
|---|
| 34 | N RMPRERR,RMPRK,RMPROLD,RMPREOF,RMPR7,RMPR6,RMPRTCST,RMPRVS | 
|---|
| 35 | S RMPRERR=0 | 
|---|
| 36 | K RMPRV | 
|---|
| 37 | S RMPRV=0 | 
|---|
| 38 | S RMPRTCST=0 | 
|---|
| 39 | S RMPRK("STATION")=$G(RMPR("STATION IEN")) | 
|---|
| 40 | I RMPRK("STATION")="" S RMPRERR=1 G STOCKX | 
|---|
| 41 | S RMPRK("LOCATION")=$G(RMPR("LOCATION IEN")) | 
|---|
| 42 | I RMPRK("LOCATION")="" S RMPRERR=2 G STOCKX | 
|---|
| 43 | S RMPRK("HCPCS")=$G(RMPR("HCPCS")) | 
|---|
| 44 | I RMPRK("HCPCS")="" S RMPRERR=3 G STOCKX | 
|---|
| 45 | S RMPRK("ITEM")=$G(RMPR("ITEM")) | 
|---|
| 46 | I RMPRK("ITEM")="" S RMPRERR=4 G STOCKX | 
|---|
| 47 | L +^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM")) | 
|---|
| 48 | ; | 
|---|
| 49 | ; Loop on all records for Stn, Loc, HCPCS and Item | 
|---|
| 50 | STOCKA S RMPRERR=$$NEXT^RMPRPIXE(.RMPRK,"XSLHIDS","",1,.RMPROLD,.RMPREOF) | 
|---|
| 51 | I RMPRERR S RMPRERR=5 G STOCKU | 
|---|
| 52 | I RMPREOF G STOCKU | 
|---|
| 53 | I RMPRK("ITEM")'=RMPROLD("ITEM") G STOCKU | 
|---|
| 54 | I RMPRK("HCPCS")'=RMPROLD("HCPCS") G STOCKU | 
|---|
| 55 | I RMPRK("LOCATION")'=RMPROLD("LOCATION") G STOCKU | 
|---|
| 56 | I RMPRK("STATION")'=RMPROLD("STATION") G STOCKU | 
|---|
| 57 | K RMPR7 M RMPR7=RMPRK | 
|---|
| 58 | S RMPRERR=$$GET^RMPRPIX7(.RMPR7) ;get current stock record | 
|---|
| 59 | I RMPRERR S RMPRERR=5 G STOCKU | 
|---|
| 60 | S RMPR("IEN")=RMPR7("IEN") | 
|---|
| 61 | K RMPR6 M RMPR6=RMPRK S RMPR6("IEN")="" | 
|---|
| 62 | S RMPRERR=$$GET^RMPRPIX6(.RMPR6) ;get transaction record | 
|---|
| 63 | S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6) ;get vendor ien | 
|---|
| 64 | I $D(RMPRV(RMPR6("VENDOR IEN"))) D | 
|---|
| 65 | . S RMPRVS=RMPRV(RMPR6("VENDOR IEN")) | 
|---|
| 66 | . S $P(RMPRVS,"^",1)=RMPR7("QUANTITY")+$P(RMPRVS,"^",1) | 
|---|
| 67 | . S $P(RMPRVS,"^",2)=RMPR7("VALUE")+$P(RMPRVS,"^",2) | 
|---|
| 68 | . Q | 
|---|
| 69 | E  D | 
|---|
| 70 | . S RMPRV=RMPRV+1 | 
|---|
| 71 | . S RMPRVS=RMPR7("QUANTITY") | 
|---|
| 72 | . S $P(RMPRVS,"^",2)=RMPR7("VALUE") | 
|---|
| 73 | . S $P(RMPRVS,"^",3)=RMPR6("VENDOR") | 
|---|
| 74 | . Q | 
|---|
| 75 | S RMPRV(RMPR6("VENDOR IEN"))=RMPRVS | 
|---|
| 76 | G STOCKA | 
|---|
| 77 | STOCKU L -^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM")) | 
|---|
| 78 | STOCKX Q RMPRERR | 
|---|