source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIXE.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 9.2 KB
Line 
1RMPRPIXE ;HINCIO/ODJ-FILE 661.7 API ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ; NEXT - is used to get the next (or previous) record keys
6 ; from an input set of keys, on file 661.7, using a
7 ; specified cross-reference and key level.
8 ; The following cross-references are currently supported...
9 ;
10 ; XHDS - HCPCS, Date&Time and Sequence
11 ; XSHIDS - Station, HCPCS, Item, Date&Time and Sequence
12 ; XSLHIDS - Station, Location, HCPCS, Item,
13 ; Date&Time and Sequence
14 ;
15 ; Inputs:
16 ; RMPR - an array of key values which define a record.
17 ; The specification of this array is dependent on which
18 ; cross-reference is entered (see below)
19 ; RMPRXREF - The cross-reference used to order on (see above)
20 ; RMPRLEV - The level of traversal. This is also dependent on
21 ; which cross-reference is used (see below)
22 ; RMPRT - Direction of traversal: 1 - Next (ascending)
23 ; -1 - Previous (descending)
24 ; RMPROLD - This is a copy of RMPR prior to changing RMPR values
25 ; RMPREOF - End Of File flag: 1 - End Of File, 0 - not end of file
26 ;
27 ; XHDS x-ref:
28 ; RMPR("HCPCS")
29 ; RMPR("DATE&TIME")
30 ; RMPR("SEQUENCE")
31 ; RMPR("IEN")
32 ; Set RMPRLEV to...
33 ; "HCPCS" - HCPCS
34 ; "DATE&TIME" - DATE&TIME
35 ; "SEQUENCE" - SEQUENCE
36 ; "" - All records
37 ;
38 ; XSHIDS x-ref:
39 ; RMPR("STATION")
40 ; RMPR("HCPCS")
41 ; RMPR("ITEM")
42 ; RMPR("DATE&TIME")
43 ; RMPR("SEQUENCE")
44 ; Set RMPRLEV to...
45 ; "STATION"
46 ; "HCPCS"
47 ; "ITEM"
48 ; "DATE&TIME"
49 ; "SEQUENCE"
50 ; ""
51NEXT(RMPR,RMPRXREF,RMPRLEV,RMPRT,RMPROLD,RMPREOF) ;
52 N RMPRRET,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7
53 I $G(RMPRT)'=-1 S RMPRT=1
54 S RMPRRET=0,RMPREOF=0
55 ;
56 ; HCPCS, Date&Time, Sequence X-ref
57 I RMPRXREF="XHDS" D G NEXTX
58 . S RMPRK1=$G(RMPR("HCPCS"))
59 . S RMPRK2=$G(RMPR("DATE&TIME"))
60 . S RMPRK3=$G(RMPR("SEQUENCE"))
61 . S RMPRK4=$G(RMPR("IEN"))
62 . I RMPRLEV="HCPCS" D Q:RMPREOF
63 .. S RMPRK1=$O(^RMPR(661.7,RMPRXREF,RMPRK1),RMPRT)
64 .. I RMPRK1="" S RMPREOF=1 K RMPROLD Q
65 .. S (RMPRK2,RMPRK3,RMPRK4)=""
66 .. Q
67 . I RMPRLEV="DATE&TIME",RMPRK1'="" D
68 .. S RMPRK2=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
69 .. I RMPRK2="" S RMPREOF=1
70 .. S (RMPRK3,RMPRK4)=""
71 .. Q
72 . I RMPRLEV="SEQUENCE",RMPRK2'="" D
73 .. S RMPRK3=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
74 .. I RMPRK3="" S RMPREOF=1
75 .. S RMPRK4=""
76 .. Q
77 . I RMPRLEV="",RMPRK3'="" D
78 .. S RMPRK4=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT)
79 .. I RMPRK4="" S RMPREOF=1
80 .. Q
81 . K RMPROLD
82 . I RMPREOF D
83 .. I RMPRK4="" S:RMPRK3'="" RMPRK3=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
84 .. I RMPRK3="" S:RMPRK2'="" RMPRK2=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
85 .. I RMPRK2="" S:RMPRK1'="" RMPRK1=$O(^RMPR(661.7,RMPRXREF,RMPRK1),RMPRT) S:RMPRK1="" RMPREOF=1
86 .. Q
87 . I RMPRK1="",RMPREOF Q
88 . S RMPREOF=0
89 . M RMPROLD=RMPR
90 . I RMPRK1="" S RMPRK1=$O(^RMPR(661.7,RMPRXREF,""),RMPRT)
91 . Q:RMPRK1=""
92 . I RMPRK2="" S RMPRK2=$O(^RMPR(661.7,RMPRXREF,RMPRK1,""),RMPRT)
93 . Q:RMPRK2=""
94 . I RMPRK3="" S RMPRK3=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,""),RMPRT)
95 . Q:RMPRK3=""
96 . I RMPRK4="" S RMPRK4=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,""),RMPRT)
97 . S RMPR("HCPCS")=RMPRK1
98 . S RMPR("DATE&TIME")=RMPRK2
99 . S RMPR("SEQUENCE")=RMPRK3
100 . S RMPR("IEN")=RMPRK4
101 . Q
102 ;
103 ; Station, HCPCS, Item, Date&Time, Sequence X-ref.
104 I RMPRXREF="XSHIDS" D G NEXTX
105 . S (RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6)=""
106 . S RMPRK1=$G(RMPR("STATION"))
107 . S:RMPRK1'="" RMPRK2=$G(RMPR("HCPCS"))
108 . S:RMPRK2'="" RMPRK3=$G(RMPR("ITEM"))
109 . S:RMPRK3'="" RMPRK4=$G(RMPR("DATE&TIME"))
110 . S:RMPRK4'="" RMPRK5=$G(RMPR("SEQUENCE"))
111 . S:RMPRK5'="" RMPRK6=$G(RMPR("IEN"))
112 . I RMPRLEV="STATION" D Q:RMPREOF
113 .. S RMPRK1=$O(^RMPR(661.7,RMPRXREF,RMPRK1),RMPRT)
114 .. I RMPRK1="" S RMPREOF=1 K RMPROLD Q
115 .. S (RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6)=""
116 .. Q
117 . I RMPRLEV="HCPCS",RMPRK1'="" D
118 .. S RMPRK2=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
119 .. I RMPRK2="" S RMPREOF=1
120 .. S (RMPRK3,RMPRK4,RMPRK5,RMPRK6)=""
121 .. Q
122 . I RMPRLEV="ITEM",RMPRK2'="" D
123 .. S RMPRK3=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
124 .. I RMPRK3="" S RMPREOF=1
125 .. S (RMPRK4,RMPRK5,RMPRK6)=""
126 .. Q
127 . I RMPRLEV="DATE&TIME",RMPRK3'="" D
128 .. S RMPRK4=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT)
129 .. I RMPRK4="" S RMPREOF=1
130 .. S (RMPRK5,RMPRK6)=""
131 .. Q
132 . I RMPRLEV="SEQUENCE",RMPRK4'="" D
133 .. S RMPRK5=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5),RMPRT)
134 .. I RMPRK5="" S RMPREOF=1
135 .. S RMPRK6=""
136 .. Q
137 . I RMPRLEV="",RMPRK5'="" D
138 .. S RMPRK6=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6),RMPRT)
139 .. I RMPRK6="" S RMPREOF=1
140 .. Q
141 . K RMPROLD
142 . I RMPREOF D
143 .. I RMPRK6="" S:RMPRK5'="" RMPRK5=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5),RMPRT)
144 .. I RMPRK5="" S:RMPRK4'="" RMPRK4=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT)
145 .. I RMPRK4="" S:RMPRK3'="" RMPRK3=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
146 .. I RMPRK3="" S:RMPRK2'="" RMPRK2=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
147 .. I RMPRK2="" S:RMPRK1'="" RMPRK1=$O(^RMPR(661.7,RMPRXREF,RMPRK1),RMPRT) S:RMPRK1="" RMPREOF=1
148 .. Q
149 . I RMPRK1="",RMPREOF Q
150 . S RMPREOF=0
151 . M RMPROLD=RMPR
152 . I RMPRK1="" S RMPRK1=$O(^RMPR(661.7,RMPRXREF,""),RMPRT) I RMPRK1="" S RMPREOF=1 Q
153 . I RMPRK2="" S RMPRK2=$O(^RMPR(661.7,RMPRXREF,RMPRK1,""),RMPRT) I RMPRK2="" S RMPREOF=1 Q
154 . I RMPRK3="" S RMPRK3=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,""),RMPRT) I RMPRK3="" S RMPREOF=1 Q
155 . I RMPRK4="" S RMPRK4=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,""),RMPRT) I RMPRK4="" S RMPREOF=1 Q
156 . I RMPRK5="" S RMPRK5=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,""),RMPRT) I RMPRK5="" S RMPREOF=1 Q
157 . I RMPRK6="" S RMPRK6=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,""),RMPRT) I RMPRK6="" S RMPREOF=1 Q
158 . S RMPR("STATION")=RMPRK1
159 . S RMPR("HCPCS")=RMPRK2
160 . S RMPR("ITEM")=RMPRK3
161 . S RMPR("DATE&TIME")=RMPRK4
162 . S RMPR("SEQUENCE")=RMPRK5
163 . S RMPR("IEN")=RMPRK6
164 . Q
165 ;
166 ; Station, Location, HCPCS, Item, Date&Time, Sequence
167 I RMPRXREF="XSLHIDS" D G NEXTX
168 . S (RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7)=""
169 . S RMPRK1=$G(RMPR("STATION"))
170 . S:RMPRK1'="" RMPRK2=$G(RMPR("LOCATION"))
171 . S:RMPRK2'="" RMPRK3=$G(RMPR("HCPCS"))
172 . S:RMPRK3'="" RMPRK4=$G(RMPR("ITEM"))
173 . S:RMPRK4'="" RMPRK5=$G(RMPR("DATE&TIME"))
174 . S:RMPRK5'="" RMPRK6=$G(RMPR("SEQUENCE"))
175 . S:RMPRK6'="" RMPRK7=$G(RMPR("IEN"))
176 . I RMPRLEV="STATION" D Q:RMPREOF
177 .. S RMPRK1=$O(^RMPR(661.7,RMPRXREF,RMPRK1),RMPRT)
178 .. I RMPRK1="" S RMPREOF=1 K RMPROLD Q
179 .. S (RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7)=""
180 .. Q
181 . I RMPRLEV="LOCATION",RMPRK1'="" D
182 .. S RMPRK2=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
183 .. I RMPRK2="" S RMPREOF=1
184 .. S (RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7)=""
185 .. Q
186 . I RMPRLEV="HCPCS",RMPRK2'="" D
187 .. S RMPRK3=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
188 .. I RMPRK3="" S RMPREOF=1
189 .. S (RMPRK4,RMPRK5,RMPRK6,RMPRK7)=""
190 .. Q
191 . I RMPRLEV="ITEM",RMPRK3'="" D
192 .. S RMPRK4=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT)
193 .. I RMPRK4="" S RMPREOF=1
194 .. S (RMPRK5,RMPRK6,RMPRK7)=""
195 .. Q
196 . I RMPRLEV="DATE&TIME",RMPRK4'="" D
197 .. S RMPRK5=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5),RMPRT)
198 .. I RMPRK5="" S RMPREOF=1
199 .. S (RMPRK6,RMPRK7)=""
200 .. Q
201 . I RMPRLEV="SEQUENCE",RMPRK5'="" D
202 .. S RMPRK6=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6),RMPRT)
203 .. I RMPRK6="" S RMPREOF=1
204 .. S RMPRK7=""
205 .. Q
206 . I RMPRLEV="",RMPRK6'="" D
207 .. S RMPRK7=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7),RMPRT)
208 .. I RMPRK7="" S RMPREOF=1
209 .. Q
210 . K RMPROLD
211 . I RMPREOF D
212 .. I RMPRK7="" S:RMPRK6'="" RMPRK6=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6),RMPRT)
213 .. I RMPRK6="" S:RMPRK5'="" RMPRK5=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5),RMPRT)
214 .. I RMPRK5="" S:RMPRK4'="" RMPRK4=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT)
215 .. I RMPRK4="" S:RMPRK3'="" RMPRK3=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
216 .. I RMPRK3="" S:RMPRK2'="" RMPRK2=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
217 .. I RMPRK2="" S:RMPRK1'="" RMPRK1=$O(^RMPR(661.7,RMPRXREF,RMPRK1),RMPRT) S:RMPRK1="" RMPREOF=1
218 .. Q
219 . I RMPRK1="",RMPREOF Q
220 . S RMPREOF=0
221 . M RMPROLD=RMPR
222 . I RMPRK1="" S RMPRK1=$O(^RMPR(661.7,RMPRXREF,""),RMPRT) I RMPRK1="" S RMPREOF=1 Q
223 . I RMPRK2="" S RMPRK2=$O(^RMPR(661.7,RMPRXREF,RMPRK1,""),RMPRT) I RMPRK2="" S RMPREOF=1 Q
224 . I RMPRK3="" S RMPRK3=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,""),RMPRT) I RMPRK3="" S RMPREOF=1 Q
225 . I RMPRK4="" S RMPRK4=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,""),RMPRT) I RMPRK4="" S RMPREOF=1 Q
226 . I RMPRK5="" S RMPRK5=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,""),RMPRT) I RMPRK5="" S RMPREOF=1 Q
227 . I RMPRK6="" S RMPRK6=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,""),RMPRT) I RMPRK6="" S RMPREOF=1 Q
228 . I RMPRK7="" S RMPRK7=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,""),RMPRT) I RMPRK7="" S RMPREOF=1 Q
229 . S RMPR("STATION")=RMPRK1
230 . S RMPR("LOCATION")=RMPRK2
231 . S RMPR("HCPCS")=RMPRK3
232 . S RMPR("ITEM")=RMPRK4
233 . S RMPR("DATE&TIME")=RMPRK5
234 . S RMPR("SEQUENCE")=RMPRK6
235 . S RMPR("IEN")=RMPRK7
236 . Q
237NEXTX Q RMPRRET
Note: See TracBrowser for help on using the repository browser.