source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIX6.m@ 1505

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

initial load of FOIAVistA 6/30/08 version
File size: 8.4 KB
Line 
1RMPRPIX6 ;HINCIO/ODJ - PIP TRANSACTION FILE 661.6 API ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ;***** CRE - create new 661.6 PIP Transaction record
6 ;
7 ; Inputs:
8 ; RMPR616 - Transaction array (661.6)
9 ; (elements mandatory unless noted)
10 ; RMPR616("DATE&TIME") - (optional) usually should not be set
11 ; but if it is RMPR616("SEQUENCE")
12 ; must also be set
13 ; RMPR616("SEQUENCE") - (optional) but see above
14 ; should normally be one
15 ; RMPR616("VENDOR") - Vendor ien
16 ; RMPR616("LOCATION") - Location ien (ptr 661.5)
17 ; RMPR616("TRAN TYPE") - Transaction Type code (see 661.6 spec)
18 ; RMPR616("QUANTITY") - Quantity
19 ; RMPR616("VALUE") - $ Value of transaction
20 ; RMPR616("COMMENT") - Coment
21 ; RMPR616("USER") - User ien (ptr VA(200,)
22 ;
23 ; RMPR6111 - HCPCS Item array (661.11) (all elements mandatory)
24 ; RMPR6111("STATION") - Station ien (ptr ^DIC(4,)
25 ; RMPR6111("HCPCS") - HCPCS code
26 ; RMPR6111("ITEM") - HCPCS Item number
27 ;
28 ; Outputs:
29 ; RMPR616("IEN") - ien of created Transaction
30 ; RMPRERR - error code returned by function
31 ; 0 - no problems
32 ; 1 - FM problems creating 661.6 rec.
33 ;
34CRE(RMPR616,RMPR6111) ;
35 N RMPRRET,RMPRIENA,RMPRFDA,RMPRFME,X,Y,DA
36 S RMPRRET=0
37 ;
38 ; Get DATE&TIME for transaction and lock the file
39 I $G(RMPR616("DATE&TIME"))="" G CRE0
40 L +^RMPR(661.6,"XHDS",RMPR6111("HCPCS"),RMPR616("DATE&TIME"))
41 I $D(^RMPR(661.6,"XHDS",RMPR6111("HCPCS"),RMPR616("DATE&TIME"),RMPR616("SEQUENCE"))) L -^RMPR(661.6,"XHDS",RMPR6111("HCPCS"),RMPR616("DATE&TIME")) G CRE0
42 G CRE1
43CRE0 S RMPR616("DATE&TIME")=""
44 F D Q:RMPR616("DATE&TIME")'=""
45 . D NOW^%DTC
46 . I $D(^RMPR(661.6,"XHDS",RMPR6111("HCPCS"),%,1)) H (1+$R(3)) Q
47 . L +^RMPR(661.6,"XHDS",RMPR6111("HCPCS"),%):0 E H (1+$R(3)) Q
48 . S RMPR616("DATE&TIME")=%
49 . S RMPR616("SEQUENCE")=1
50 . Q
51 ;
52 ; Create the transaction
53CRE1 S RMPRFDA(661.6,"+1,",.01)=RMPR6111("HCPCS")
54 S RMPRFDA(661.6,"+1,",2)=RMPR616("DATE&TIME")
55 S RMPRFDA(661.6,"+1,",3)=RMPR616("SEQUENCE")
56 S RMPRFDA(661.6,"+1,",4)=RMPR616("TRAN TYPE")
57 S RMPRFDA(661.6,"+1,",5)=RMPR616("QUANTITY")
58 S RMPRFDA(661.6,"+1,",6)=RMPR616("VALUE")
59 S RMPRFDA(661.6,"+1,",8)=RMPR616("COMMENT")
60 S RMPRFDA(661.6,"+1,",9)=RMPR616("USER")
61 S RMPRFDA(661.6,"+1,",11)=RMPR6111("ITEM")
62 S RMPRFDA(661.6,"+1,",12)=RMPR616("VENDOR")
63 S RMPRFDA(661.6,"+1,",13)=RMPR6111("STATION")
64 S RMPRFDA(661.6,"+1,",14)=RMPR616("LOCATION")
65 D UPDATE^DIE("","RMPRFDA","RMPRIENA","RMPRFME")
66 L -^RMPR(661.6,"XHDS",RMPR6111("HCPCS"),RMPR616("DATE&TIME"))
67 I $D(RMPRFME) S RMPRRET=1 G CREX
68 S RMPR616("IEN")=RMPRIENA(1)
69CREX Q RMPRRET
70 ;
71 ;***** UPD - update existing Transaction (661.6) record
72 ;
73 ; Inputs:
74 ; RMPR616 - Transaction array (see above for CRE)
75 ; RMPR616("IEN") - ien of rec to update (mandatory)
76 ; all other elements optional but DATE&TIME
77 ; and SEQUENCE cannot be changed
78 ; RMPR6111 - HCPCS array (see above for CRE)
79 ; all elements optional
80 ;
81 ; Outputs:
82 ; RMPRRET - error code returned by function
83 ; 0 - no problems
84 ; 1 - invalid RMPR616("IEN")
85 ; 2 - FM problem with update
86 ;
87UPD(RMPR616,RMPR6111) ;
88 N RMPRRET,RMPRI,RMPRFDA,RMPRFME,X,Y,DA
89 S RMPRRET=0
90 I $G(RMPR616("IEN"))="" S RMPRRET=1 G UPDX
91 S RMPRI=RMPR616("IEN")_","
92 S:$D(RMPR6111("HCPCS")) RMPRFDA(661.6,RMPRI,.01)=RMPR6111("HCPCS")
93 S:$D(RMPR616("QUANTITY")) RMPRFDA(661.6,RMPRI,5)=RMPR616("QUANTITY")
94 S:$D(RMPR616("VALUE")) RMPRFDA(661.6,RMPRI,6)=RMPR616("VALUE")
95 S:$D(RMPR616("COMMENT")) RMPRFDA(661.6,RMPRI,8)=RMPR616("COMMENT")
96 S:$D(RMPR616("USER")) RMPRFDA(661.6,RMPRI,9)=RMPR616("USER")
97 S:$D(RMPR6111("ITEM")) RMPRFDA(661.6,RMPRI,11)=RMPR6111("ITEM")
98 S:$D(RMPR616("VENDOR")) RMPRFDA(661.6,RMPRI,12)=RMPR616("VENDOR")
99 S:$D(RMPR616("LOCATION")) RMPRFDA(661.6,RMPRI,14)=RMPR616("LOCATION")
100 D:$D(RMPRFDA) FILE^DIE("","RMPRFDA","RMPRFME")
101 I $D(RMPRFME) S RMPRRET=2 G UPDX
102UPDX Q RMPRRET
103 ;
104 ;***** GET - read in 661.6 record
105GET(RMPR) ;
106 N RMPRRET,RMPRFME,RMPRIEN,RMPRKEY,RMPRERR,RMPROUP,X,Y,DA,RMPREOF
107 S RMPRRET=0
108 I $G(RMPR("IEN"))="" D
109 . I $G(RMPR("HCPCS"))="" S RMPRRET=1 Q
110 . I $G(RMPR("DATE&TIME"))="" S RMPRRET=2 Q
111 . S RMPRKEY("HCPCS")=RMPR("HCPCS")
112 . S RMPRKEY("DATE&TIME")=RMPR("DATE&TIME")
113 . S RMPRERR=$$NEXT^RMPRPIXA(.RMPRKEY,"XHDS","",-1,,.RMPREOF)
114 . I RMPRERR S RMPRRET=3 Q
115 . I '$D(RMPRKEY("SEQUENCE")) S RMPRRET=1 Q
116 . I RMPRKEY("SEQUENCE")'=1 S RMPRRET=4 Q
117 . S RMPR("IEN")=RMPRKEY("IEN")
118 . Q
119 I RMPRRET G GETX
120 S RMPRIEN=RMPR("IEN")_","
121 D GETS^DIQ(661.6,RMPRIEN,"*","","RMPROUP","RMPRFME")
122 I $D(RMPRFME) S RMPRRET=5 G GETX
123 S RMPR("HCPCS")=RMPROUP(661.6,RMPRIEN,.01)
124 S RMPR("DATE&TIME")=RMPROUP(661.6,RMPRIEN,2)
125 S RMPR("DATE")=$P(RMPR("DATE&TIME"),"@",1)
126 S RMPR("TIME")=$P(RMPR("DATE&TIME"),"@",2)
127 S RMPR("SEQUENCE")=RMPROUP(661.6,RMPRIEN,3)
128 S RMPR("TRAN TYPE")=RMPROUP(661.6,RMPRIEN,4)
129 S RMPR("QUANTITY")=RMPROUP(661.6,RMPRIEN,5)
130 S RMPR("VALUE")=RMPROUP(661.6,RMPRIEN,6)
131 S RMPR("COMMENT")=RMPROUP(661.6,RMPRIEN,8)
132 S RMPR("USER")=RMPROUP(661.6,RMPRIEN,9)
133 S RMPR("ITEM")=RMPROUP(661.6,RMPRIEN,11)
134 S RMPR("VENDOR")=RMPROUP(661.6,RMPRIEN,12)
135 S RMPR("STATION")=RMPROUP(661.6,RMPRIEN,13)
136 S RMPR("LOCATION")=RMPROUP(661.6,RMPRIEN,14)
137GETX Q RMPRRET
138 ;
139 ;***** ETOI - convert external to internal form
140ETOI(RMPRE,RMPRI) ;
141 N RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
142 S RMPRERR=0
143 S RMPRIEN=RMPRE("IEN")_","
144 D GETS^DIQ(661.6,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
145 I $D(RMPRFME) S RMPRERR=1 G ETOIX
146 S RMPRI("IEN")=RMPRE("IEN")
147 S RMPRI("HCPCS")=RMPRFDI(661.6,RMPRIEN,.01,"I")
148 S RMPRI("DATE&TIME")=RMPRFDI(661.6,RMPRIEN,2,"I")
149 S RMPRI("DATE")=$P(RMPRI("DATE&TIME"),".",1)
150 S RMPRI("TIME")=$P(RMPRI("DATE&TIME"),".",2)
151 S RMPRI("SEQUENCE")=RMPRFDI(661.6,RMPRIEN,3,"I")
152 S RMPRI("TRAN TYPE")=RMPRFDI(661.6,RMPRIEN,4,"I")
153 S RMPRI("QUANTITY")=RMPRFDI(661.6,RMPRIEN,5,"I")
154 S RMPRI("VALUE")=RMPRFDI(661.6,RMPRIEN,6,"I")
155 S RMPRI("COMMENT")=RMPRFDI(661.6,RMPRIEN,8,"I")
156 S RMPRI("USER")=RMPRFDI(661.6,RMPRIEN,9,"I")
157 S RMPRI("ITEM")=RMPRFDI(661.6,RMPRIEN,11,"I")
158 S RMPRI("VENDOR")=RMPRFDI(661.6,RMPRIEN,12,"I")
159 S RMPRI("STATION")=RMPRFDI(661.6,RMPRIEN,13,"I")
160 S RMPRI("LOCATION")=RMPRFDI(661.6,RMPRIEN,14,"I")
161ETOIX Q RMPRERR
162 ;
163 ; TFLOW - sets RMPR("TRAN FLOW")
164TFLOW(RMPR) ;
165 N RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR,RMPRTYP
166 S RMPRERR=0
167 S RMPRIEN=RMPR("IEN")_","
168 S RMPRFDA(661.6,RMPRIEN,4)=RMPR("TRAN TYPE")
169 D VALS^DIE("","RMPRFDA","RMPRFDI","RMPRFME")
170 I $D(RMPRFME) S RMPRERR=1 G TFLOWX
171 S RMPRTYP=","_RMPRFDI(661.6,RMPRIEN,4)_","
172 S RMPR("TRAN FLOW")=""
173 I ",1,8,"[RMPRTYP S RMPR("TRAN FLOW")="+"
174 I ",2,7,"[RMPRTYP S RMPR("TRAN FLOW")=""
175 I ",3,4,5,6,"[RMPRTYP S RMPR("TRAN FLOW")="-"
176 I ",9,"[RMPRTYP S RMPR("TRAN FLOW")="="
177TFLOWX Q RMPRERR
178 ;
179 ; DTIEN - sets internal form of DATE/TIME
180DTIEN(RMPR) ;
181 N RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
182 S RMPRERR=0
183 S RMPRIEN=RMPR("IEN")_","
184 D GETS^DIQ(661.6,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
185 S RMPR("DATE&TIME")=RMPRFDI(661.6,RMPRIEN,2,"I")
186 Q RMPRERR
187 ;
188 ; STNIEN - sets RMPR("STATION IEN")
189STNIEN(RMPR) ;
190 N RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
191 S RMPRERR=0
192 S RMPRIEN=RMPR("IEN")_","
193 D GETS^DIQ(661.6,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
194 I $D(RMPRFME) S RMPRERR=1 G STNIENX
195 S RMPR("STATION IEN")=RMPRFDI(661.6,RMPRIEN,13,"I")
196STNIENX Q RMPRERR
197 ;
198 ; VNDIEN - sets RMPR("VENDOR IEN")
199VNDIEN(RMPR) ;
200 N RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
201 S RMPRERR=0
202 I '$D(RMPR("IEN")) W !!,"*** MISSING POINTER TO VENDOR FILE, PLEASE CHECK FILE #661.11 !!!",! S RMPRERR=1 G VNDIENX
203 S RMPRIEN=RMPR("IEN")_","
204 D GETS^DIQ(661.6,RMPRIEN,"12","I","RMPRFDI","RMPRFME")
205 I $D(RMPRFME) S RMPRERR=1 G VNDIENX
206 S RMPR("VENDOR IEN")=RMPRFDI(661.6,RMPRIEN,12,"I")
207VNDIENX Q RMPRERR
208 ;
209 ; DEL - Delete a record
210DEL(RMPR6) ;
211 N RMPRFDA,RMPRFME,RMPRERR,RMPRIEN,X,Y,DA
212 S RMPRERR=0
213 I $G(RMPR6("IEN"))="" S RMPRERR=1 G DELX
214 S RMPRIEN=RMPR6("IEN")_","
215 S RMPRFDA(661.6,RMPRIEN,.01)="@"
216 D FILE^DIE("","RMPRFDA","RMPRFME")
217 I $D(RMPRFME) S RMPRERR=1
218DELX Q RMPRERR
219 ;
220 ; Get the ien for a 2319 patient stock issue record in file 660
221IEN60(RMPR6,RMPR60) ;
222 N RMPRERR,RMPRIEN
223 S RMPRERR=0
224 I $G(RMPR6("IEN"))="" S RMPRERR=1 G IEN60X
225 S RMPRIEN=$O(^RMPR(661.63,"B",RMPR6("IEN"),""))
226 I RMPRIEN="" S RMPRERR=2 G IEN60X
227 S RMPR60("IEN")=$P($G(^RMPR(661.63,RMPRIEN,0)),"^",2)
228IEN60X Q RMPRERR
Note: See TracBrowser for help on using the repository browser.