source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIUA.m@ 1424

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

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1RMPRPIUA ;HINCIO/ODJ - APIs for file 661.7 ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ; SCAN - If scanned an item's barcode locate record from
6 ; Prosthetic Current Stock file 661.7
7 ;
8 ; Inputs:
9 ; RMPR7 - array containing...
10 ; RMPR7("STATION") - Station ien
11 ; RMPR7("HCPCS") - HCPCS code (contained in bar code)
12 ; RMPR7("DATE&TIME") - Date&Time (contained in bar code)
13 ;
14 ; Outputs:
15 ; RMPR7 - complete array for the 661.7 record read (if any)...
16 ; RMPR7("IEN")
17 ; RMPR7("STATION") - Station Name
18 ; (nb will now be in external form)
19 ; RMPR7("HCPCS") -
20 ; RMPR7("SEQUENCE") -
21 ; RMPR7("HCPCS ITEM") -
22 ; RMPR7("LOCATION") -
23 ; RMPR7("QUANTITY") -
24 ; RMPR7("VALUE") -
25 ; RMPR7("UNIT") -
26 ;
27 ; RMPREXC - exit condition
28 ; 0 - normal, everything ok
29 ; 1 - multi-instance but with station match (RMPR7 set)
30 ; 2 - single instance but with
31 ; station mis-match (RMPR7 set)
32 ; 3 - multi-instance and station mis-match (RMPR7 not set)
33 ; RMPRERR - error code returned by function
34 ; 0 - no error
35 ; 1 - null HCPCS input
36 ; 2 - null Date&Time entered
37 ; 3 - corrupt file (sequence but no ien)
38 ; 4 - corrupt file (ien but no record)
39 ; 5 - error reading 661.7
40 ; 99 - no instances found for input HCPCS and Date&Time
41SCAN(RMPR7,RMPREXC) ;
42 N RMPRERR,RMPRC,RMPRSEQ,RMPRIEN,RMPRS,RMPRIEN1,RMPRIEN2,RMPRDTTM
43 S RMPRERR=0
44 S RMPREXC=0
45 S RMPR7("STATION")=$G(RMPR7("STATION"))
46 I $G(RMPR7("HCPCS"))="" S RMPRERR=1 G SCANX
47 I $G(RMPR7("DATE&TIME"))="" S RMPRERR=2 G SCANX
48 S RMPRDTTM=RMPR7("DATE&TIME")
49 S RMPRC=0,RMPRIEN1="",RMPRIEN2="",RMPR7("IEN")=""
50 S RMPRSEQ=""
51 ;
52 ; Get ien for current stock record
53 ; Record number of instances for same HCPCS and Date&Time in
54 ; RMPRC (more than 1 should be very, very rare)
55 ; RMPRIEN1 is IEN for first instance
56 ; RMPRIEN2 is ien for any instance with station ien matching input
57 L +^RMPR(661.7,"XHDS",RMPR7("HCPCS"),RMPRDTTM)
58 F S RMPRSEQ=$O(^RMPR(661.7,"XHDS",RMPR7("HCPCS"),RMPRDTTM,RMPRSEQ)) Q:RMPRSEQ="" D Q:RMPRERR
59 . S RMPRIEN=$O(^RMPR(661.7,"XHDS",RMPR7("HCPCS"),RMPRDTTM,RMPRSEQ,""))
60 . I RMPRIEN="" S RMPRERR=3 Q
61 . I '$D(^RMPR(661.7,RMPRIEN,0)) S RMPRERR=4 Q
62 . S RMPRS=^RMPR(661.7,RMPRIEN,0)
63 . S RMPRC=RMPRC+1
64 . S RMPR7("UNIT")=$P(RMPRS,U,9)
65 . I RMPR7("STATION")=$P(RMPRS,"^",5) S RMPRIEN2=RMPRIEN
66 . I RMPRC=1 S RMPRIEN1=RMPRIEN
67 . Q
68 I RMPRERR G SCANU
69 I 'RMPRC S RMPRERR=99 G SCANU
70 ;
71 ; Set exit condition
72 I RMPRC>1 D
73 . I RMPRIEN2'="" S RMPR7("IEN")=RMPRIEN2,RMPREXC=1
74 . E S RMPREXC=3
75 . Q
76 E D
77 . I RMPRIEN2="" S RMPREXC=2
78 . S RMPR7("IEN")=RMPRIEN1
79 . Q
80 I RMPR7("IEN")'="" D
81 . S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
82 . I RMPRERR S RMPRERR=5
83 . Q
84SCANU L -^RMPR(661.7,"XHDS",RMPR7("HCPCS"),RMPRDTTM)
85SCANX Q RMPRERR
86 ;
87 ; STOCK - For an entered Station, Location, HCPCS and Item return
88 ; total quantity on hand for that item, the average unit cost
89 ; and the vendor. If more than one vendor, use the first one.
90 ;
91 ; Inputs:
92 ; RMPR - an array with the following elements...
93 ; RMPR("STATION IEN") - Station ien (ptr ^DIC(4,)
94 ; RMPR("LOCATION IEN") - Location ien (ptr ^RMPR(661.5,)
95 ; RMPR("HCPCS") - HCPCS code (eg E0111)
96 ; RMPR("ITEM") - HCPCS Item number (eg 1)
97 ;
98 ; Outputs:
99 ; RMPR - additional elements to the input RMPR array
100 ; RMPR("QOH") - Quantity on hand
101 ; RMPR("UNIT COST") - Unit cost per Item
102 ; RMPR("VENDOR") - Vendor Name
103 ; RMPR("VENDOR IEN") - Vendor ien
104 ;
105 ; RMPRERR - function return...
106 ; 0 - no errors
107 ; 1 - null Station ien input
108 ; 2 - null Location ien input
109 ; 3 - null HCPCS code input
110 ; 4 - null Item input
111 ; 5 - problem with 661.7 file
112 ; 6 - problem with 661.6 file
113STOCK(RMPR) ;
114 N RMPRERR,RMPRK,RMPROLD,RMPREOF,RMPR7,RMPR6,RMPRTCST
115 S RMPRERR=0
116 S RMPRTCST=0
117 S RMPR("QOH")=0
118 S RMPR("UNIT COST")=0
119 S RMPR("VENDOR")=""
120 S RMPR("VENDOR IEN")=""
121 S RMPRK("STATION")=$G(RMPR("STATION IEN"))
122 I RMPRK("STATION")="" S RMPRERR=1 G STOCKX
123 S RMPRK("LOCATION")=$G(RMPR("LOCATION IEN"))
124 I RMPRK("LOCATION")="" S RMPRERR=2 G STOCKX
125 S RMPRK("HCPCS")=$G(RMPR("HCPCS"))
126 I RMPRK("HCPCS")="" S RMPRERR=3 G STOCKX
127 S RMPRK("ITEM")=$G(RMPR("ITEM"))
128 I RMPRK("ITEM")="" S RMPRERR=4 G STOCKX
129 L +^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))
130 ;
131 ; Loop on all records for Stn, Loc, HCPCS and Item, and sum qty and cst
132STOCKA S RMPRERR=$$NEXT^RMPRPIXE(.RMPRK,"XSLHIDS","",1,.RMPROLD,.RMPREOF)
133 I RMPRERR S RMPRERR=5 G STOCKU
134 I RMPREOF G STOCKU
135 I RMPRK("ITEM")'=RMPROLD("ITEM") G STOCKU
136 I RMPRK("HCPCS")'=RMPROLD("HCPCS") G STOCKU
137 I RMPRK("LOCATION")'=RMPROLD("LOCATION") G STOCKU
138 I RMPRK("STATION")'=RMPROLD("STATION") G STOCKU
139 K RMPR7 M RMPR7=RMPRK
140 S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
141 I RMPRERR S RMPRERR=5 G STOCKU
142 S RMPR("QOH")=RMPR7("QUANTITY")+RMPR("QOH")
143 S RMPRTCST=RMPRTCST+RMPR7("VALUE")
144 I RMPR("VENDOR IEN")="" D G:RMPRERR STOCKU
145 . K RMPR6 M RMPR6=RMPRK S RMPR6("IEN")=""
146 . S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
147 . I RMPRERR S RMPRERR=6 Q
148 . S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6)
149 . I RMPRERR S RMPRERR=6 Q
150 . S RMPR("VENDOR")=RMPR6("VENDOR")
151 . S RMPR("VENDOR IEN")=RMPR6("VENDOR IEN")
152 . Q
153 G STOCKA
154STOCKU L -^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))
155 I RMPR("QOH") S RMPR("UNIT COST")=RMPRTCST/RMPR("QOH")
156STOCKX Q RMPRERR
Note: See TracBrowser for help on using the repository browser.