source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBRXUTL.m@ 1426

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

initial load of FOIAVistA 6/30/08 version
File size: 9.0 KB
Line 
1IBRXUTL ;ALB/MAF - PHARMACY API CALLS ; MAY 25, 2005
2 ;;2.0;INTEGRATED BILLING;**309,347**;21-MAR-94;Build 24
3 ;
4ZERO(IBDRV) ;
5 N X
6 K ^TMP($J,"IBDRUG")
7 S X="IBDRUG" D ZERO^PSS50(IBDRV,,,,,X)
8 Q
9DATA(IBDRV) ;
10 N X
11 K ^TMP($J,"IBDRUG")
12 S X="IBDRUG" D DATA^PSS50(IBDRV,,,,,X)
13 Q
14FILE(DA,DR,INTEXT) ;Returns single field from file 52
15 N RETURN,PSOFILE
16 I '$G(DA) S RETURN="" Q RETURN
17 I '$G(DR) S RETURN="" Q RETURN
18 S PSOFILE=52
19 S DA=+DA
20 I $G(INTEXT)="" S INTEXT="I"
21 S RETURN=$$GET1^PSODI(PSOFILE,DA,DR,INTEXT)
22 I $P($G(RETURN),"^",1)=0 S RETURN="" Q RETURN
23 Q $P(RETURN,"^",2)
24SUBFILE(DA,DASUB,DR,DRSUB,INTEXT) ;Returns single field from subfile 52.1
25 ;The DR variable isn't being used because Pharmacy API changed after IB*2.0*347 went
26 ;to test site. Rather than changing all the routines that call this API this
27 ;input variable is now not used.
28 N RETSUB,PSOFILE,IENS
29 I '$G(DA) S RETSUB="" Q RETSUB
30 I '$G(DASUB) S RETSUB="" Q RETSUB
31 I '$G(DRSUB) S RETSUB="" Q RETSUB
32 S PSOFILE=52.1
33 S IENS=+DASUB_","_+DA
34 I $G(INTEXT)="" S INTEXT="I"
35 S RETSUB=$$GET1^PSODI(PSOFILE,IENS,DRSUB,INTEXT)
36 I $P($G(RETSUB),"^",1)=0 S RETSUB="" Q RETSUB
37 Q $P(RETSUB,"^",2)
38RXZERO(PDFN,RXIEN) ;Returns zero node of file 52
39 N ZEROOUT,LIST,IBTMPARR,NODE
40 I '$G(PDFN) S ZEROOUT="" Q ZEROOUT
41 I '$G(RXIEN) S ZEROOUT="" Q ZEROOUT
42 S NODE=0
43 S LIST="IBZEROARR"
44 S IBTMPARR="IBTMPZERO"
45 D RX^PSO52API(PDFN,LIST,RXIEN,,NODE,,)
46 I $P(^TMP($J,LIST,PDFN,0),"^",1)>0 D
47 .S $P(^TMP($J,IBTMPARR),"^",1)=$G(^TMP($J,LIST,PDFN,RXIEN,.01))
48 .S $P(^TMP($J,IBTMPARR),"^",2)=$P($G(^TMP($J,LIST,PDFN,RXIEN,2)),"^",1)
49 .S $P(^TMP($J,IBTMPARR),"^",3)=$P($G(^TMP($J,LIST,PDFN,RXIEN,3)),"^",1)
50 .S $P(^TMP($J,IBTMPARR),"^",4)=$P($G(^TMP($J,LIST,PDFN,RXIEN,4)),"^",1)
51 .S $P(^TMP($J,IBTMPARR),"^",5)=$P($G(^TMP($J,LIST,PDFN,RXIEN,5)),"^",1)
52 .S $P(^TMP($J,IBTMPARR),"^",6)=$P($G(^TMP($J,LIST,PDFN,RXIEN,6)),"^",1)
53 .S $P(^TMP($J,IBTMPARR),"^",7)=$G(^TMP($J,LIST,PDFN,RXIEN,7))
54 .S $P(^TMP($J,IBTMPARR),"^",8)=$G(^TMP($J,LIST,PDFN,RXIEN,8))
55 .S $P(^TMP($J,IBTMPARR),"^",9)=$G(^TMP($J,LIST,PDFN,RXIEN,9))
56 .S $P(^TMP($J,IBTMPARR),"^",10)=""
57 .S $P(^TMP($J,IBTMPARR),"^",11)=$P($G(^TMP($J,LIST,PDFN,RXIEN,11)),"^",1)
58 .S $P(^TMP($J,IBTMPARR),"^",12)=""
59 .S $P(^TMP($J,IBTMPARR),"^",13)=$P($G(^TMP($J,LIST,PDFN,RXIEN,1)),"^",1)
60 .S $P(^TMP($J,IBTMPARR),"^",14)=""
61 .S $P(^TMP($J,IBTMPARR),"^",15)=""
62 .S $P(^TMP($J,IBTMPARR),"^",16)=$P($G(^TMP($J,LIST,PDFN,RXIEN,16)),"^",1)
63 .S $P(^TMP($J,IBTMPARR),"^",17)=$G(^TMP($J,LIST,PDFN,RXIEN,17))
64 .S $P(^TMP($J,IBTMPARR),"^",18)=$G(^TMP($J,LIST,PDFN,RXIEN,10.6))
65 .S $P(^TMP($J,IBTMPARR),"^",19)=$P($G(^TMP($J,LIST,PDFN,RXIEN,10.3)),"^",1)
66 .S ZEROOUT=^TMP($J,IBTMPARR)
67 .K ^TMP($J,IBTMPARR)
68 E S ZEROOUT=""
69 K ^TMP($J,LIST)
70 Q ZEROOUT
71RXSEC(PDFN,RXIEN) ;Returns second node of file 52
72 N SECOUT,LIST,IBTMPARR,NODE
73 I '$G(PDFN) S SECOUT="" Q SECOUT
74 I '$G(RXIEN) S SECOUT="" Q SECOUT
75 S NODE=2
76 S LIST="IBSECARR"
77 S IBTMPARR="IBTMPSEC"
78 D RX^PSO52API(PDFN,LIST,RXIEN,,NODE,,)
79 I $P(^TMP($J,LIST,PDFN,0),"^",1)>0 D
80 .S $P(^TMP($J,IBTMPARR),"^",1)=$P($G(^TMP($J,LIST,PDFN,RXIEN,21)),"^",1)
81 .S $P(^TMP($J,IBTMPARR),"^",2)=$P($G(^TMP($J,LIST,PDFN,RXIEN,22)),"^",1)
82 .S $P(^TMP($J,IBTMPARR),"^",3)=$P($G(^TMP($J,LIST,PDFN,RXIEN,23)),"^",1)
83 .S $P(^TMP($J,IBTMPARR),"^",4)=$G(^TMP($J,LIST,PDFN,RXIEN,24))
84 .S $P(^TMP($J,IBTMPARR),"^",5)=$P($G(^TMP($J,LIST,PDFN,RXIEN,25)),"^",1)
85 .S $P(^TMP($J,IBTMPARR),"^",6)=$P($G(^TMP($J,LIST,PDFN,RXIEN,26)),"^",1)
86 .S $P(^TMP($J,IBTMPARR),"^",7)=$G(^TMP($J,LIST,PDFN,RXIEN,27))
87 .S $P(^TMP($J,IBTMPARR),"^",8)=$G(^TMP($J,LIST,PDFN,RXIEN,28))
88 .S $P(^TMP($J,IBTMPARR),"^",9)=$P($G(^TMP($J,LIST,PDFN,RXIEN,20)),"^",1)
89 .S $P(^TMP($J,IBTMPARR),"^",10)=$P($G(^TMP($J,LIST,PDFN,RXIEN,104)),"^",1)
90 .S $P(^TMP($J,IBTMPARR),"^",11)=$P($G(^TMP($J,LIST,PDFN,RXIEN,29)),"^",1)
91 .S $P(^TMP($J,IBTMPARR),"^",12)=$G(^TMP($J,LIST,PDFN,RXIEN,30))
92 .S $P(^TMP($J,IBTMPARR),"^",13)=$P($G(^TMP($J,LIST,PDFN,RXIEN,31)),"^",1)
93 .S $P(^TMP($J,IBTMPARR),"^",14)=$P($G(^TMP($J,LIST,PDFN,RXIEN,32.2)),"^",1)
94 .S $P(^TMP($J,IBTMPARR),"^",15)=$P($G(^TMP($J,LIST,PDFN,RXIEN,32.1)),"^",1)
95 .S $P(^TMP($J,IBTMPARR),"^",16)=$G(^TMP($J,LIST,PDFN,RXIEN,32.3))
96 .S SECOUT=^TMP($J,IBTMPARR)
97 .K ^TMP($J,IBTMPARR)
98 E S SECOUT=""
99 K ^TMP($J,LIST)
100 Q SECOUT
101RX3(PDFN,RXIEN) ;Returns third node of file 52
102 N THRDOUT,LIST,IBTMPARR,NODE
103 I '$G(PDFN) S THRDOUT="" Q THRDOUT
104 I '$G(RXIEN) S THRDOUT="" Q THRDOUT
105 S NODE=3
106 S LIST="IBARRTHRD"
107 S IBTMPARR="IBTMP3"
108 D RX^PSO52API(PDFN,LIST,RXIEN,,NODE,,)
109 I $P(^TMP($J,LIST,PDFN,0),"^",1)>0 D
110 .S $P(^TMP($J,IBTMPARR),"^",1)=$P($G(^TMP($J,LIST,PDFN,RXIEN,101)),"^",1)
111 .S $P(^TMP($J,IBTMPARR),"^",2)=$P($G(^TMP($J,LIST,PDFN,RXIEN,102)),"^",1)
112 .S $P(^TMP($J,IBTMPARR),"^",3)=$P($G(^TMP($J,LIST,PDFN,RXIEN,109)),"^",1)
113 .S $P(^TMP($J,IBTMPARR),"^",4)=$P($G(^TMP($J,LIST,PDFN,RXIEN,102.1)),"^",1)
114 .S $P(^TMP($J,IBTMPARR),"^",5)=$P($G(^TMP($J,LIST,PDFN,RXIEN,26.1)),"^",1)
115 .S $P(^TMP($J,IBTMPARR),"^",6)=$P($G(^TMP($J,LIST,PDFN,RXIEN,34.1)),"^",1)
116 .S $P(^TMP($J,IBTMPARR),"^",7)=$G(^TMP($J,LIST,PDFN,RXIEN,12))
117 .S $P(^TMP($J,IBTMPARR),"^",8)=$G(^TMP($J,LIST,PDFN,RXIEN,102.2))
118 .S $P(^TMP($J,IBTMPARR),"^",9)=$G(^TMP($J,LIST,PDFN,RXIEN,112))
119 .S THRDOUT=^TMP($J,IBTMPARR)
120 .K ^TMP($J,IBTMPARR)
121 E S THRDOUT=""
122 K ^TMP($J,LIST)
123 Q THRDOUT
124ZEROSUB(PDFN,RXIEN,RXSUB) ;Returns zero node of subfile 52.1
125 N ZSUBOUT,LIST,IBTMPARR,NODE
126 I '$G(PDFN) S ZSUBOUT="" Q ZSUBOUT
127 I '$G(RXIEN) S ZSUBOUT="" Q ZSUBOUT
128 I '$G(RXSUB) S ZSUBOUT="" Q ZSUBOUT
129 S NODE="R^^"_RXSUB
130 S LIST="IBSUBARR"
131 S IBTMPARR="IBTMPSUB"
132 D RX^PSO52API(PDFN,LIST,RXIEN,,NODE,,)
133 I $P(^TMP($J,LIST,PDFN,RXIEN,"RF",0),"^",1)>0 D
134 .S $P(^TMP($J,IBTMPARR),"^",1)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,.01)),"^",1)
135 .S $P(^TMP($J,IBTMPARR),"^",2)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,2)),"^",1)
136 .S $P(^TMP($J,IBTMPARR),"^",3)=$G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,3))
137 .S $P(^TMP($J,IBTMPARR),"^",4)=$G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,1))
138 .S $P(^TMP($J,IBTMPARR),"^",5)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,4)),"^",1)
139 .S $P(^TMP($J,IBTMPARR),"^",6)=$G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,5))
140 .S $P(^TMP($J,IBTMPARR),"^",7)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,6)),"^",1)
141 .S $P(^TMP($J,IBTMPARR),"^",8)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,7)),"^",1)
142 .S $P(^TMP($J,IBTMPARR),"^",9)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,8)),"^",1)
143 .S $P(^TMP($J,IBTMPARR),"^",10)=$G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,1.1))
144 .S $P(^TMP($J,IBTMPARR),"^",11)=$G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,1.2))
145 .S $P(^TMP($J,IBTMPARR),"^",12)=""
146 .S $P(^TMP($J,IBTMPARR),"^",13)=""
147 .S $P(^TMP($J,IBTMPARR),"^",14)=$G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,12))
148 .S $P(^TMP($J,IBTMPARR),"^",15)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,13)),"^",1)
149 .S $P(^TMP($J,IBTMPARR),"^",16)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,14)),"^",1)
150 .S $P(^TMP($J,IBTMPARR),"^",17)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,15)),"^",1)
151 .S $P(^TMP($J,IBTMPARR),"^",18)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,17)),"^",1)
152 .S $P(^TMP($J,IBTMPARR),"^",19)=$P($G(^TMP($J,LIST,PDFN,RXIEN,"RF",RXSUB,10.1)),"^",1)
153 .S ZSUBOUT=^TMP($J,IBTMPARR)
154 .K ^TMP($J,IBTMPARR)
155 E S ZSUBOUT=""
156 K ^TMP($J,LIST)
157 Q ZSUBOUT
158RFNUM(RXIEN) ;
159 N PDFN,RXSUB,LIST,IBTMPARR,NODE
160 I '$G(RXIEN) S RXSUB="" Q RXSUB
161 S PDFN=$$FILE^IBRXUTL(RXIEN,2)
162 S LIST="IBRFNARR"
163 S IBTMPARR="IBTMPRFN"
164 S NODE="R"
165 D RX^PSO52API(PDFN,LIST,RXIEN,,NODE,,)
166 I $P(^TMP($J,LIST,PDFN,RXIEN,"RF",0),"^",1)>0 D
167 .S RXSUB=^TMP($J,LIST,PDFN,RXIEN,"RF",0)
168 E S RXSUB=""
169 K ^TMP($J,LIST)
170 Q RXSUB
171IBND(DFN,RXIEN) ;Returns IB node
172 N IBNDOUT,LIST,NODE,IBTMPARR
173 I '$G(DFN) S IBNDOUT="" Q IBNDOUT
174 I '$G(RXIEN) S IBNDOUT="" Q IBNDOUT
175 S LIST="IBIBNDARR"
176 S NODE="I^O"
177 S IBTMPARR="IBTMPIBND"
178 D RX^PSO52API(DFN,LIST,RXIEN,,NODE,,)
179 I $P(^TMP($J,LIST,DFN,0),"^",1)>0 D
180 .S $P(^TMP($J,IBTMPARR),"^",1)=$P($G(^TMP($J,LIST,DFN,RXIEN,105)),"^",1)
181 .S $P(^TMP($J,IBTMPARR),"^",2)=$P($G(^TMP($J,LIST,DFN,RXIEN,106)),"^",1)
182 .S $P(^TMP($J,IBTMPARR),"^",3)=$G(^TMP($J,LIST,DFN,RXIEN,106.5))
183 .S $P(^TMP($J,IBTMPARR),"^",4)=$G(^TMP($J,LIST,DFN,RXIEN,106.6))
184 .S IBNDOUT=^TMP($J,IBTMPARR)
185 .S:IBNDOUT="^^^" IBNDOUT=""
186 .K ^TMP($J,IBTMPARR)
187 E S IBNDOUT=""
188 K ^TMP($J,LIST)
189 Q IBNDOUT
190IBNDFL(DFN,RXIEN,RXRFL) ;
191 N IBNDFL,LIST,NODE,IBTMPARR
192 I '$G(DFN) S IBNDFL="" Q IBNDFL
193 I '$G(RXIEN) S IBNDFL="" Q IBNDFL
194 I '$G(RXRFL) S IBNDFL="" Q IBNDFL
195 S LIST="IBIBNDFLARR"
196 S NODE="I^R^"_RXRFL
197 S IBTMPARR="IBTMPIBNDFL"
198 D RX^PSO52API(DFN,LIST,RXIEN,,NODE,,)
199 I ^TMP($J,LIST,DFN,RXIEN,"IB",0)>0 D
200 .S $P(^TMP($J,IBTMPARR),"^",1)=$G(^TMP($J,LIST,DFN,RXIEN,"IB",RXRFL,9))
201 .S $P(^TMP($J,IBTMPARR),"^",2)=$G(^TMP($J,LIST,DFN,RXIEN,"IB",RXRFL,9.1))
202 .S IBNDFL=^TMP($J,IBTMPARR)
203 .K ^TMP($J,IBTMPARR)
204 E S IBNDFL=""
205 K ^TMP($J,LIST)
206 Q IBNDFL
207RFLNUM(IBRXN,FLDT,IBFLG) ;
208 N NUMOUT,NUM,DFN,LIST,NODE
209 I '$G(IBRXN) S NUMOUT="" Q NUMOUT
210 I '$G(FLDT) S NUMOUT="" Q NUMOUT
211 K ^TMP($J),NUM
212 S NUM=0
213 S DFN=$$FILE^IBRXUTL(IBRXN,2)
214 S LIST="IBRTMP"
215 S NODE="R^^"
216 D RX^PSO52API(DFN,LIST,IBRXN,,NODE,,)
217 F S NUM=$O(^TMP($J,LIST,DFN,IBRXN,"RF",NUM)) Q:'NUM D
218 .I $P(^TMP($J,LIST,DFN,IBRXN,"RF",NUM,.01),"^",1)=FLDT S NUMOUT=NUM
219 K ^TMP($J,LIST)
220 S:'$G(NUMOUT) NUMOUT=""
221 Q NUMOUT
Note: See TracBrowser for help on using the repository browser.