source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIUV.m@ 789

Last change on this file since 789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1RMPRPIUV ;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
33STOCK(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
50STOCKA 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
77STOCKU L -^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))
78STOCKX Q RMPRERR
Note: See TracBrowser for help on using the repository browser.