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
|
---|