source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIXA.m@ 1800

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

initial load of WorldVistAEHR
File size: 8.6 KB
RevLine 
[613]1RMPRPIXA ;HINCIO/ODJ - FILE 661.6 API ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ; SRCH
6SRCH(RMPR,RMPRXREF,RMPRLEV,RMPRT,RMPRFIND,RMPREOF) ;
7 N RMPRRET,RMPRK1,RMPRK2,RMPRK3,RMPRK4
8 S RMPRRET=0
9 S RMPREOF=0
10 I RMPRXREF="XHDS" D G SRCHX
11 . S RMPRK1=$G(RMPR("HCPCS"))
12 . S RMPRK2=$G(RMPR("DATE&TIME"))
13 . S RMPRK3=$G(RMPR("SEQUENCE"))
14 . S RMPRK4=$G(RMPR("IEN"))
15 . S RMPRFIND=0
16 . I RMPRK1="" D
17 .. S RMPRK1=$O(^RMPR(661.6,RMPRXREF,""),RMPRT)
18 .. Q
19 . E D
20 .. I '$D(^RMPR(661.6,RMPRXREF,RMPRK1)) D Q
21 ... S RMPRK1=$O(^RMPR(661.6,RMPRXREF,RMPRK1),RMPRT)
22 ... Q
23 .. S RMPRFIND=1
24 .. Q
25 . I RMPRK1="" S RMPREOF=1 Q
26 . S RMPR("HCPCS")=RMPRK1
27 . I RMPRLEV="HCPCS" Q
28 . S RMPRFIND=0
29 . I RMPRK2="" D
30 .. S RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,""),RMPRT)
31 .. Q
32 . E D
33 .. I '$D(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2)) D Q
34 ... S RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
35 ... Q
36 .. S RMPRFIND=1
37 .. Q
38 . I RMPRK2="" S RMPREOF=1 Q
39 . S RMPR("DATE&TIME")=RMPRK2
40 . I RMPRLEV="DATE&TIME" Q
41 . S RMPRFIND=0
42 . I RMPRK3="" D
43 .. S RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,""),RMPRT)
44 .. Q
45 . E D
46 .. I '$D(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3)) D Q
47 ... S RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
48 ... Q
49 .. S RMPRFIND=1
50 .. Q
51 . I RMPRK3="" S RMPREOF=1 Q
52 . S RMPR("SEQUENCE")=RMPRK3
53 . I RMPRLEV="SEQUENCE" Q
54 . S RMPRFIND=0
55 . I RMPRK4="" D
56 .. S RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,""),RMPRT)
57 .. Q
58 . E D
59 .. I '$D(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4)) D Q
60 ... S RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT)
61 ... Q
62 .. S RMPRFIND=1
63 .. Q
64 . I RMPRK4="" S RMPREOF=1 Q
65 . S RMPR("IEN")=RMPRK4
66 . Q
67SRCHX Q RMPRRET
68 ;
69 ; NEXT
70NEXT(RMPR,RMPRXREF,RMPRLEV,RMPRT,RMPROLD,RMPREOF) ;
71 N RMPRRET,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7
72 I $G(RMPRT)'=-1 S RMPRT=1
73 S RMPRRET=0,RMPREOF=0
74 ;
75 ; HCPCS, Date&Time, Sequence X-ref
76 I RMPRXREF="XHDS" D G NEXTX
77 . S RMPRK1=$G(RMPR("HCPCS"))
78 . S RMPRK2=$G(RMPR("DATE&TIME"))
79 . S RMPRK3=$G(RMPR("SEQUENCE"))
80 . S RMPRK4=$G(RMPR("IEN"))
81 . I RMPRLEV="HCPCS" D Q:RMPREOF
82 .. S RMPRK1=$O(^RMPR(661.6,RMPRXREF,RMPRK1),RMPRT)
83 .. I RMPRK1="" S RMPREOF=1 K RMPROLD Q
84 .. S (RMPRK2,RMPRK3,RMPRK4)=""
85 .. Q
86 . I RMPRLEV="DATE&TIME",RMPRK1'="" D
87 .. S RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
88 .. I RMPRK2="" S RMPREOF=1
89 .. S (RMPRK3,RMPRK4)=""
90 .. Q
91 . I RMPRLEV="SEQUENCE",RMPRK2'="" D
92 .. S RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
93 .. I RMPRK3="" S RMPREOF=1
94 .. S RMPRK4=""
95 .. Q
96 . I RMPRLEV="",RMPRK3'="" D
97 .. S RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT)
98 .. I RMPRK4="" S RMPREOF=1
99 .. Q
100 . K RMPROLD
101 . I RMPREOF D
102 .. I RMPRK4="" S:RMPRK3'="" RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
103 .. I RMPRK3="" S:RMPRK2'="" RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
104 .. I RMPRK2="" S:RMPRK1'="" RMPRK1=$O(^RMPR(661.6,RMPRXREF,RMPRK1),RMPRT) S:RMPRK1="" RMPREOF=1
105 .. Q
106 . I RMPRK1="",RMPREOF Q
107 . S RMPREOF=0
108 . M RMPROLD=RMPR
109 . I RMPRK1="" S RMPRK1=$O(^RMPR(661.6,RMPRXREF,""),RMPRT)
110 . I RMPRK2="" S RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,""),RMPRT)
111 . I RMPRK3="" S RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,""),RMPRT)
112 . I RMPRK3="" W !,"*** HCPCS = ",RMPRK1,!,"*** DATE = ",RMPRK2,!,"*** is not in file #661.6",!,"*** Please investigate!!!!" Q
113 . I RMPRK4="" S RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,""),RMPRT)
114 . S RMPR("HCPCS")=RMPRK1
115 . S RMPR("DATE&TIME")=RMPRK2
116 . S RMPR("DATE")=$P(RMPRK2,".",1)
117 . S RMPR("TIME")=$P(RMPRK2,".",2)
118 . S RMPR("SEQUENCE")=RMPRK3
119 . S RMPR("IEN")=RMPRK4
120 . Q
121 ;
122 ; Station, Trans. Type, HCPCS, Item, Date&Time, Sequence X-ref.
123 I RMPRXREF="ASTHIDS" D G NEXTX
124 . S RMPRK1=$G(RMPR("STATION"))
125 . S RMPRK2=$G(RMPR("TRAN TYPE"))
126 . S RMPRK3=$G(RMPR("HCPCS"))
127 . S RMPRK4=$G(RMPR("ITEM"))
128 . S RMPRK5=$G(RMPR("DATE&TIME"))
129 . S RMPRK6=$G(RMPR("SEQUENCE"))
130 . S RMPRK7=$G(RMPR("IEN"))
131 . I RMPRLEV="STATION" D Q:RMPREOF
132 .. S RMPRK1=$O(^RMPR(661.6,RMPRXREF,RMPRK1),RMPRT)
133 .. I RMPRK1="" S RMPREOF=1 K RMPROLD Q
134 .. S (RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7)=""
135 .. Q
136 . I RMPRLEV="TRAN TYPE",RMPRK1'="" D
137 .. S RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
138 .. I RMPRK2="" S RMPREOF=1
139 .. S (RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7)=""
140 .. Q
141 . I RMPRLEV="HCPCS",RMPRK2'="" D
142 .. S RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
143 .. I RMPRK3="" S RMPREOF=1
144 .. S (RMPRK4,RMPRK5,RMPRK6,RMPRK7)=""
145 .. Q
146 . I RMPRLEV="ITEM",RMPRK3'="" D
147 .. S RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT)
148 .. I RMPRK4="" S RMPREOF=1
149 .. S (RMPRK5,RMPRK6,RMPRK7)=""
150 .. Q
151 . I RMPRLEV="DATE&TIME",RMPRK4'="" D
152 .. S RMPRK5=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5),RMPRT)
153 .. I RMPRK5="" S RMPREOF=1
154 .. S (RMPRK6,RMPRK7)=""
155 .. Q
156 . I RMPRLEV="SEQUENCE",RMPRK5'="" D
157 .. S RMPRK6=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6),RMPRT)
158 .. I RMPRK6="" S RMPREOF=1
159 .. S RMPRK7=""
160 .. Q
161 . I RMPRLEV="",RMPRK6'="" D
162 .. S RMPRK7=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7),RMPRT)
163 .. I RMPRK7="" S RMPREOF=1
164 .. Q
165 . K RMPROLD
166 . I RMPREOF D
167 .. I RMPRK7="" S:RMPRK6'="" RMPRK6=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6),RMPRT)
168 .. I RMPRK6="" S:RMPRK5'="" RMPRK5=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5),RMPRT)
169 .. I RMPRK5="" S:RMPRK4'="" RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT)
170 .. I RMPRK4="" S:RMPRK3'="" RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
171 .. I RMPRK3="" S:RMPRK2'="" RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
172 .. I RMPRK2="" S:RMPRK1'="" RMPRK1=$O(^RMPR(661.6,RMPRXREF,RMPRK1),RMPRT) S:RMPRK1="" RMPREOF=1
173 .. Q
174 . I RMPRK1="",RMPREOF Q
175 . M RMPROLD=RMPR
176 . I RMPRK1="" S RMPRK1=$O(^RMPR(661.6,RMPRXREF,""),RMPRT)
177 . I RMPRK2="" S RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,""),RMPRT)
178 . I RMPRK3="" S RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,""),RMPRT)
179 . I RMPRK4="" S RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,""),RMPRT)
180 . I RMPRK5="" S RMPRK5=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,""),RMPRT)
181 . I RMPRK6="" S RMPRK6=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,""),RMPRT)
182 . I RMPRK7="" S RMPRK7=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,""),RMPRT)
183 . S RMPR("STATION")=RMPRK1
184 . S RMPR("TRAN TYPE")=RMPRK2
185 . S RMPR("HCPCS")=RMPRK3
186 . S RMPR("ITEM")=RMPRK4
187 . S RMPR("DATE&TIME")=RMPRK5
188 . S RMPR("SEQUENCE")=RMPRK6
189 . S RMPR("IEN")=RMPRK7
190 . Q
191NEXTX Q RMPRRET
192 ;
193 ; CRE
194CRE(RMPR616,RMPR6111) ;
195 N RMPRRET,RMPRIENA,RMPRFDA,RMPRFME,X,Y,%
196 N %,%H,%I,X
197 S RMPRRET=0
198 ;
199 ; Get DATE&TIME for transaction and lock the file
200 S RMPR616("DATE&TIME")=""
201 F D Q:RMPR616("DATE&TIME")'=""
202 . D NOW^%DTC
203 . I $D(^RMPR(661.6,"XHDS",RMPR616("HCPCS"),%,1)) H (1+$R(3)) Q
204 . L +^RMPR(661.6,"XHDS",RMPR616("HCPCS"),%):0 E Q
205 . S RMPR616("DATE&TIME")=%
206 . Q
207 S RMPRFDA(661.6,"+1,",.01)=RMPR6111("HCPCS")
208 S RMPRFDA(661.6,"+1,",2)=RMPR616("DATE&TIME")
209 S RMPRFDA(661.6,"+1,",3)=RMPR616("SEQUENCE")
210 S RMPRFDA(661.6,"+1,",4)=RMPR616("TRAN TYPE")
211 S RMPRFDA(661.6,"+1,",5)=RMPR616("QUANTITY")
212 S RMPRFDA(661.6,"+1,",6)=RMPR616("VALUE")
213 S RMPRFDA(661.6,"+1,",8)=RMPR616("COMMENT")
214 S RMPRFDA(661.6,"+1,",9)=RMPR616("USER")
215 S RMPRFDA(661.6,"+1,",11)=RMPR6111("ITEM")
216 S RMPRFDA(661.6,"+1,",12)=RMPR616("VENDOR")
217 S RMPRFDA(661.6,"+1,",13)=RMPR6111("STATION")
218 S RMPRFDA(661.6,"+1,",14)=RMPR616("LOCATION")
219 D UPDATE^DIE("","RMPRFDA","RMPRIENA","RMPRFME")
220 L -^RMPR(661.6,"XHDS",RMPR616("HCPCS"),RMPR616("DATE&TIME"))
221 I $D(RMPRFME) S RMPRRET=1 G CREX
222 S RMPR616("IEN")=RMPRIENA(1)
223CREX Q RMPRRET
224 ;
225 ; GET
226GET(RMPR) ;
227 N RMPRRET,RMPRFME,RMPRIEN,RMPRKEY,RMPRERR,RMPROUP
228 S RMPRRET=0
229 I $G(RMPR("IEN"))="" D
230 . I $G(RMPR("HCPCS"))="" S RMPRRET=1 Q
231 . I $G(RMPR("DATE&TIME"))="" S RMPRRET=2 Q
232 . S RMPRKEY("HCPCS")=RMPR("HCPCS")
233 . S RMPRKEY("DATE&TIME")=RMPR("DATE&TIME")
234 . S RMPRERR=$$NEXT(.RMPRKEY,"XHDS","",-1,,.RMPREOF)
235 . I RMPRERR S RMPRRET=3 Q
236 . I RMPRKEY("SEQUENCE")'=1 S RMPRRET=4 Q
237 . S RMPR("IEN")=RMPRKEY("IEN")
238 . Q
239 I RMPRRET G GETX
240 S RMPRIEN=RMPR("IEN")_","
241 D GETS^DIQ(661.6,RMPRIEN,"*","","RMPROUP","RMPRFME")
242 I $D(RMPRFME) S RMPRRET=5 G GETX
243 S RMPR("HCPCS")=RMPROUP(661.6,RMPRIEN,.01)
244 S RMPR("DATE&TIME")=RMPROUP(661.6,RMPRIEN,2)
245 S RMPR("SEQUENCE")=RMPROUP(661.6,RMPRIEN,3)
246 S RMPR("TRAN TYPE")=RMPROUP(661.6,RMPRIEN,4)
247 S RMPR("QUANTITY")=RMPROUP(661.6,RMPRIEN,5)
248 S RMPR("VALUE")=RMPROUP(661.6,RMPRIEN,6)
249 S RMPR("COMMENT")=RMPROUP(661.6,RMPRIEN,8)
250 S RMPR("USER")=RMPROUP(661.6,RMPRIEN,9)
251 S RMPR("ITEM")=RMPROUP(661.6,RMPRIEN,11)
252 S RMPR("VENDOR")=RMPROUP(661.6,RMPRIEN,12)
253 S RMPR("STATION")=RMPROUP(661.6,RMPRIEN,13)
254 S RMPR("LOCATION")=RMPROUP(661.6,RMPRIEN,14)
255GETX Q RMPRRET
Note: See TracBrowser for help on using the repository browser.