source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIUE.m@ 1639

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1RMPRPIUE ;HINCIO/ODJ - Get Current Stock Utility ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ; STOCK - For an entered Station, Location, Vendor
5 ; HCPCS and Item
6 ; return total quantity on hand for that item
7 ; and the average unit cost.
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 ; RMPR("VENDOR IEN") - Vendor ien
16 ;
17 ; Outputs:
18 ; RMPR - additional elements to the input RMPR array
19 ; RMPR("QOH") - Quantity on hand
20 ; RMPR("UNIT COST") - Unit cost per Item
21 ;
22 ; RMPRERR - function return...
23 ; 0 - no errors
24 ; 1 - null Station ien input
25 ; 2 - null Location ien input
26 ; 3 - null HCPCS code input
27 ; 4 - null Item input
28 ; 5 - problem with 661.7 file
29 ; 6 - problem with 661.6 file
30STOCK(RMPR) ;
31 N RMPRERR,RMPRK,RMPROLD,RMPREOF,RMPR7,RMPR6,RMPRTCST
32 S RMPRERR=0
33 S RMPRTCST=0
34 S RMPR("QOH")=0
35 S RMPR("UNIT COST")=0
36 S RMPRK("STATION")=$G(RMPR("STATION IEN"))
37 I RMPRK("STATION")="" S RMPRERR=1 G STOCKX
38 S RMPRK("LOCATION")=$G(RMPR("LOCATION IEN"))
39 I RMPRK("LOCATION")="" S RMPRERR=2 G STOCKX
40 S RMPRK("HCPCS")=$G(RMPR("HCPCS"))
41 I RMPRK("HCPCS")="" S RMPRERR=3 G STOCKX
42 S RMPRK("ITEM")=$G(RMPR("ITEM"))
43 I RMPRK("ITEM")="" S RMPRERR=4 G STOCKX
44 L +^RMPR(661.7,"XSHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))
45 ;
46 ; Loop on all records for Stn, Loc, HCPCS and Item, and sum qty and cst
47STOCKA S RMPRERR=$$NEXT^RMPRPIXE(.RMPRK,"XSLHIDS","",1,.RMPROLD,.RMPREOF)
48 I RMPRERR S RMPRERR=5 G STOCKU
49 I RMPREOF G STOCKU
50 I RMPRK("ITEM")'=RMPROLD("ITEM") G STOCKU
51 I RMPRK("HCPCS")'=RMPROLD("HCPCS") G STOCKU
52 I RMPRK("LOCATION")'=RMPROLD("LOCATION") G STOCKU
53 I RMPRK("STATION")'=RMPROLD("STATION") G STOCKU
54 K RMPR7 M RMPR7=RMPRK
55 S RMPRERR=$$GET^RMPRPIX7(.RMPR7) ;get current stock record
56 I RMPRERR S RMPRERR=5 G STOCKU
57 I RMPR("VENDOR IEN")'="" D G:RMPRERR STOCKU
58 . K RMPR6 M RMPR6=RMPRK S RMPR6("IEN")=""
59 . S RMPRERR=$$GET^RMPRPIX6(.RMPR6) ;get transaction record
60 . I RMPRERR S RMPRERR=6 Q
61 . S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6) ;get vendor ien
62 . I RMPRERR S RMPRERR=6 Q
63 . Q:RMPR("VENDOR IEN")'=RMPR6("VENDOR IEN")
64 . S RMPR("QOH")=RMPR7("QUANTITY")+RMPR("QOH")
65 . S RMPRTCST=RMPRTCST+RMPR7("VALUE")
66 . Q
67 E D
68 . S RMPR("QOH")=RMPR7("QUANTITY")+RMPR("QOH")
69 . S RMPRTCST=RMPRTCST+RMPR7("VALUE")
70 . Q
71 G STOCKA
72STOCKU L -^RMPR(661.7,"XSHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))
73 I RMPR("QOH") S RMPR("UNIT COST")=RMPRTCST/RMPR("QOH")
74STOCKX Q RMPRERR
Note: See TracBrowser for help on using the repository browser.