source: FOIAVistA/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSUTIL1.m@ 1635

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

initial load of FOIAVistA 6/30/08 version
File size: 7.6 KB
Line 
1BPSUTIL1 ;BHAM ISC/SS - General Utility functions ;08/01/2006
2 ;;1.0;E CLAIMS MGMT ENGINE;**5**;JUN 2004;Build 45
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q
6 ;Function to return field data from DRUG file (#50)
7 ; Parameters
8 ; BPSIEN50 - IEN of DRUG FILE #50
9 ; BPSFLDN - Field Number(s) (like .01)
10 ; BPSEXIN - Specifies internal or external value of returned field
11 ; - optional, defaults to "I"
12 ; BPSARR50 - Array to return value(s). Optional. Pass by reference.
13 ; See EN^DIQ documentation for variable DIQ
14 ;
15 ; Function returns field data if one field is specified. If
16 ; multiple fields, the function will return "" and the field
17 ; values are returned in BPSARR50
18 ; Example: W $$DRUGDIE^BPSUTIL1(134,25,"E",.ARR)
19DRUGDIE(BPSIEN50,BPSFLDN,BPSEXIN,BPSARR50) ; Return field values for Drug file
20 I $G(BPSIEN50)=""!($G(BPSFLDN)="") Q ""
21 N DIQ,PSSDIY
22 N BPSDIQ
23 I $G(BPSEXIN)'="E" S BPSEXIN="I"
24 S BPSDIQ="BPSARR50",BPSDIQ(0)=BPSEXIN
25 D EN^PSSDI(50,"BPS",50,.BPSFLDN,.BPSIEN50,.BPSDIQ)
26 Q $G(BPSARR50(50,BPSIEN50,BPSFLDN,BPSEXIN))
27 ;
28 ;Function to do lookup on DRUG file (#50)
29 ; Paramters
30 ; BPSDIC - Setup per fileman documentation for call to ^DIC
31 ;
32 ; Returns variables as documented for call to ^DIC except X
33 ; will not be returned.
34DRUGDIC(BPSDIC) ; Look up on DRUG FILE (#50)
35 I '$G(BPSDIC) Q
36 N PSSDIY
37 D DIC^PSSDI(50,"BPS",.BPSDIC)
38 Q
39 ;/*
40 ;Subroutine to return values from MULTIPLE fields of file #52
41 ;DBIA 4858
42 ;input:
43 ; IEN - ien of file #52
44 ; BPSFLDN - one or more fields, for example ".01;2;5"
45 ; BPSRET - contains a name for a local array to return results,
46 ; Note: the name of the array should't be "BPSRET" otherwise it will
47 ; be "newed" since the parameter has the same name
48 ; BPFORMAT -
49 ; "E" for external format
50 ; "I" - internal
51 ; "N" - do not return nulls
52 ; default is "E"
53 ;output:
54 ; result will be put into array with the name specified by BPSRET
55 ; examples:
56 ;D RXAPI^BPSUTIL1(504733,".01;1;6","ARR","IE")
57 ;ZW ARR
58 ;ARR(52,504733,.01,"E")=100004099
59 ;ARR(52,504733,.01,"I")=100004099
60 ;ARR(52,504733,1,"E")="JUL 21, 2006"
61 ;ARR(52,504733,1,"I")=3060721
62 ;ARR(52,504733,6,"E")="ALBUMIN 25% 50ML"
63 ;ARR(52,504733,6,"I")=134
64RXAPI(BPSIEN52,BPSFLDN,BPSRET,BPFORMAT) ;*/
65 I ($G(BPSIEN52)="")!($G(BPSFLDN)="")!($G(BPSRET)="") Q
66 N DIQ,DIC,X,Y,D0,PSODIY
67 N I,J,C,DA,DRS,DIL,DI,DIQ1
68 N BPSDIQ
69 S BPSDIQ=$NA(@BPSRET)
70 S BPSDIQ(0)=$S($G(BPFORMAT)="":"E",1:BPFORMAT)
71 D DIQ^PSODI(52,52,.BPSFLDN,.BPSIEN52,.BPSDIQ) ;DBIA 4858
72 Q
73 ;
74 ;/*
75 ;Function to return a value for a SINGLE field of file #52
76 ;DBIA 4858
77 ;input:
78 ; BPSIEN52 - ien of file #52
79 ; BPSFLDN - one single field, for example ".01"
80 ; BPFORMAT - optional parameter,
81 ; "E" for external format
82 ; "I" - internal
83 ; "N" - do not return nulls
84 ; default is "E"
85 ;output:
86 ; returns a field value or null (empty string)
87 ; examples:
88 ;W $$RXAPI1^BPSUTIL1(504733,6,"E")
89 ;ALBUMIN 25% 50ML
90 ;W $$RXAPI1^BPSUTIL1(504733,6,"I")
91 ;134
92RXAPI1(BPSIEN52,BPSFLDN,BPFORMAT) ;*/
93 I ($G(BPSIEN52)="")!($G(BPSFLDN)="") Q ""
94 N DIQ,DIC,BPSARR,X,Y,D0,PSODIY
95 N I,J,C,DA,DRS,DIL,DI,DIQ1
96 N BPSDIQ
97 S BPSDIQ="BPSARR"
98 S BPSDIQ(0)=$S($G(BPFORMAT)="":"E",1:BPFORMAT)
99 D DIQ^PSODI(52,52,.BPSFLDN,.BPSIEN52,.BPSDIQ) ;DBIA 4858
100 Q $S(BPSDIQ(0)="N":$G(BPSARR(52,BPSIEN52,BPSFLDN)),1:$G(BPSARR(52,BPSIEN52,BPSFLDN,BPSDIQ(0))))
101 ;
102 ;/*
103 ;Subroutine to return values from MULTIPLE fields of a subfile of the file #52
104 ;DBIA 4858
105 ;input:
106 ; BPSIEN52 - ien of file #52
107 ; BPSFLD52 - field # that relates to this subfile
108 ; BPSUBFNO - subfile number (like 52.052311)
109 ; BPSUBIEN - ien of the subfile record you're interested in
110 ; BPSUBFLD - one or more fields, for example ".01;2;5"
111 ; BPSRET - name for a local array to return results
112 ; BPFORMAT - optional parameter.
113 ; "E" for external format
114 ; "I" - internal
115 ; "N" - do not return nulls
116 ; default is "E"
117 ;output:
118 ; returns results in array BPSRET in the form:
119 ; BPSRET (BPSUBFNO, BPSUBIEN, BPSUBFLD,BPFORMAT)=value
120 ;
121 ;example for (#52311) ICD DIAGNOSIS subfile
122 ;D RXSUBF^BPSUTIL1(504740,52311,52.052311,1,".01;1;2","ARR","I")
123 ;ZW ARR
124 ;ARR(52.052311,1,.01,"I")=816
125 ;ARR(52.052311,1,1,"I")=1
126 ;ARR(52.052311,1,2,"I")=1
127 ;
128RXSUBF(BPSIEN52,BPSFLD52,BPSUBFNO,BPSUBIEN,BPSUBFLD,BPSRET,BPFORMAT) ;
129 I ($G(BPSIEN52)="")!($G(BPSFLD52)="")!($G(BPSUBFNO)="")!($G(BPSUBIEN)="")!($G(BPSUBFLD)="")!($G(BPSRET)="") Q
130 N DIQ,DIC,DA,DR,X,Y,D0,PSODIY
131 N I,J,C,DA,DRS,DIL,DI,DIQ1
132 N BPSDIC,BPSDR,BPSDA,BPSDIQ
133 S BPSDIC=52 ;main file #52
134 S BPSDA=BPSIEN52 ;ien in main file #52
135 S BPSDA(BPSUBFNO)=BPSUBIEN ;ien in subfile
136 S BPSDR=BPSFLD52 ;field# of the subfile in the main file
137 S BPSDR(BPSUBFNO)=BPSUBFLD ;field# in the subfile that we need to get a value for
138 S BPSDIQ=$NA(@BPSRET) ;output array
139 S BPSDIQ(0)=$S($G(BPFORMAT)="":"E",1:BPFORMAT)
140 D DIQ^PSODI(52,.BPSDIC,.BPSDR,.BPSDA,.BPSDIQ) ;DBIA 4858
141 Q
142 ;
143 ;/*
144 ;Function to return a value for a SINGLE field of a subfile of the file #52
145 ;DBIA 4858
146 ;input:
147 ; BPSIEN52 - ien of file #52
148 ; BPSFLD52 - field # that relates to this subfile
149 ; BPSUBFNO - subfile number (like 52.052311)
150 ; BPSUBIEN - ien of the subfile record you're interested in
151 ; BPSUBFLD - one single field, for example ".01"
152 ; BPFORMAT - optional parameter,
153 ; "E" for external format
154 ; "I" - internal
155 ; "N" - do not return nulls
156 ; default is "E"
157 ;output:
158 ; returns a field value or null (empty string)
159 ;
160 ;example for (#52311) ICD DIAGNOSIS subfile
161 ;W $$RXSUBF1^BPSUTIL1(504740,52311,52.052311,1,1,"I")
162 ;1
163 ;W $$RXSUBF1^BPSUTIL1(504740,52311,52.052311,1,.01,"E")
164 ;239.1
165 ;
166RXSUBF1(BPSIEN52,BPSFLD52,BPSUBFNO,BPSUBIEN,BPSUBFLD,BPFORMAT) ;*/
167 I ($G(BPSIEN52)="")!($G(BPSFLD52)="")!($G(BPSUBFNO)="")!($G(BPSUBIEN)="")!($G(BPSUBFLD)="") Q ""
168 N DIQ,DIC,BPSARR,DA,DR,X,Y,D0,PSODIY
169 N I,J,C,DRS,DIL,DI,DIQ1
170 N BPSDIC,BPSDA,BPSDR
171 S BPSDIC=52 ;main file #52
172 S BPSDA=BPSIEN52 ;ien in main file #52
173 S BPSDA(BPSUBFNO)=BPSUBIEN ;ien in subfile
174 S BPSDR=BPSFLD52 ;field# of the subfile in the main file
175 S BPSDR(BPSUBFNO)=BPSUBFLD ;field# in the subfile that we need to get a value for
176 S BPSDIQ="BPSARR" ;output array
177 S BPSDIQ(0)=$S($G(BPFORMAT)="":"E",1:BPFORMAT)
178 D DIQ^PSODI(52,.BPSDIC,.BPSDR,.BPSDA,.BPSDIQ) ;DBIA 4858
179 Q $S(BPSDIQ(0)="N":$G(BPSARR(BPSUBFNO,BPSUBIEN,BPSUBFLD)),1:$G(BPSARR(BPSUBFNO,BPSUBIEN,BPSUBFLD,BPSDIQ(0))))
180 ;
181 ;
182 ;Function to return a value for a single field of subfile #52.1
183 ;DBIA 4858
184 ;input:
185 ; BPSIEN52 - ien of file #52
186 ; REFIEN - refill ien of subfile #52.1
187 ; BPSFLDN - one single field, for example ".01"
188 ; BPFORMAT - (optional)
189 ; "E" for external format
190 ; "I" - internal
191 ; "N" - do not return nulls
192 ; default is "E"
193 ;output:
194 ; returns a field value or null (empty string)
195 ; examples:
196 ;W $$REFAPI1^BPSUTIL1(401777,1,.01,"I")
197 ;3000526
198REFAPI1(BPSIEN52,REFIEN,BPSFLDN,BPFORMAT) ;
199 I ($G(BPSIEN52)="")!($G(REFIEN)="")!($G(BPSFLDN)="") Q ""
200 Q $$RXSUBF1(BPSIEN52,52,52.1,REFIEN,BPSFLDN,$G(BPFORMAT))
201 ;
202 ;
203 ;/**
204 ;DBIA 4858
205 ;prompts for RX selection
206 ;input:
207 ; BPSPROM - prompt message
208 ; BPSDFLT - default value for the prompt (optional parameter)
209 ;output:
210 ; returns selection (IEN of file #52)
211 ; OR -1 when timeout and/or uparrow
212 ; OR -2 when incorrect parameters
213 ;Example:
214 ;W $$PROMPTRX^BPSUTIL1("Select RX:",100003784)
215 ;Select RX:: 100003784// ??
216 ; Choose from:
217 ;200168 200081A MYLANTA II LIQUID 5 OZ
218 ;200291 300110B IBUPROFEN 600MG
219PROMPTRX(BPSPROM,BPSDFLT) ;*/
220 N Y,X,DUOUT,DTOUT,DIROUT,DIC,PSODIY,DILN,I
221 N BPSDIC
222 S BPSDIC=52,X=""
223 S BPSDIC(0)="AEMNQ"
224 S:$L($G(BPSDFLT))>0 BPSDIC("B")=BPSDFLT
225 S:$G(BPSPROM)]"" BPSDIC("A")=BPSPROM_": "
226 D DIC^PSODI(52,.BPSDIC,X) ;DBIA 4858
227 I (Y=-1)!$D(DUOUT)!$D(DTOUT) Q -1
228 Q $P(Y,U)
229 ;
Note: See TracBrowser for help on using the repository browser.