source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCDXUAPI.m@ 1185

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

initial load of FOIAVistA 6/30/08 version

File size: 8.8 KB
Line 
1SCDXUAPI ;ALB/MLI - Utility API to add OOS clinic locations ; 10/8/96
2 ;;5.3;Scheduling;**63**;AUG 13, 1993
3 ;
4 ; This utility should be called only by the lab or radiology packages
5 ; or other applications designated as needing clinics which are
6 ; exempted from classification and check-out information. It will
7 ; create clinic locations which are editable only using this API.
8 ; These locations will be set up to not allow clinic patterns to be
9 ; built (no appointments may be made to the clinics).
10 ;
11RAD(IEN,PKG) ; radiology call
12 ;
13 ; Description:
14 ; This call will accept the IEN of a location currently defined.
15 ; It will check to look for clinic patterns. If none exist, it
16 ; will update the location fields for an occasion of service
17 ; location. If there are clinic patterns set up, it will convert
18 ; the existing entry to non-count and create a new entry with the
19 ; appropriate fields defined. It will return the IEN of the entry
20 ; used (either the same as the incoming IEN or the IEN of the new
21 ; entry which had to be created).
22 ;
23 ; Input: IEN of existing entry in the Hospital Location file
24 ; PKG as either name, namespace, or IEN of package file
25 ; Output: same IEN or different one if new one had to be created
26 ; - OR- -1^code^description of error encountered
27 ;
28 N ERR,I,OK,SDERR,X,Y
29 S PKG=$$PKGIEN(PKG)
30 F I="IEN","PKG" S SDERR(I)=@I
31 S ERR=$$ERRCHK(.SDERR,1)
32 I ERR]"" G RADQ ; error encountered
33 S OK=$$CHK(IEN) ; patterns?
34 I OK D UPD(IEN,PKG)
35 I 'OK D
36 . D NONCOUNT(IEN)
37 . S IEN=$$NEW(IEN,PKG)
38RADQ Q $S(ERR]"":ERR,1:IEN)
39 ;
40 ;
41LOC(NAME,INST,STOP,PKG,IEN,INACT) ; add/edit location for ancillary app
42 ;
43 ; Description:
44 ; This call will accept the name, division, and stop code (DSS ID)
45 ; of the clinic location to be add/edited. If the IEN is passed in,
46 ; the entry with that IEN will be updated. Otherwise, a new entry will
47 ; be added. If the INACT variable is set to a date, it will INACTIVATE
48 ; the location (if it exists).
49 ;
50 ; Input: NAME of clinic to be created (optional)
51 ; INST as pointer to the institution file (optional)
52 ; STOP as number of stop code (not IEN) for
53 ; occasion of service range of codes (optional)
54 ; PKG as package file IEN, name, or namespace - required!
55 ; IEN as IEN of location if you want to update an already
56 ; existing location (optional. If not defined, NAME,
57 ; INST, STOP become required)
58 ; INACT as a date if you want to inactivate the location that
59 ; has the IEN you defined (optional)
60 ;
61 ; Output: IEN of location created/inactivated - OR -
62 ; -1^error message if problem encountered
63 N ERR,I,SCERR,X
64 S PKG=$$PKGIEN(PKG)
65 F I="NAME","INST","STOP","INACT","IEN","PKG" I $G(@I) S SCERR(I)=@I
66 S ERR=$$ERRCHK(.SCERR)
67 I ERR]"" G LOCQ
68 I $D(STOP) S STOP=$O(^DIC(40.7,"C",+STOP,0)) I 'STOP S Y=$$ERR(6) G LOCQ
69 I $G(IEN)]"" D
70 . N X
71 . S X=$G(^SC(IEN,"OOS"))
72 . I X,($P(X,"^",2)=PKG) D EDIT(IEN,$G(NAME),$G(INST),$G(STOP),PKG,$G(INACT)) Q
73 . S ERR=$$ERR(7)
74 E D
75 . F I="NAME","INST","STOP" I @I']"" S ERR=$$ERR(8) Q
76 . S IEN=$$ADD(NAME,PKG) I IEN'>0 S ERR=$$ERR(9) Q
77 . D EDIT(IEN,NAME,INST,STOP,PKG)
78LOCQ Q $S(ERR]"":ERR,1:IEN)
79 ;
80 ;
81ERRCHK(SC,RAD) ; check input variables for consistency
82 ;
83 ; if RAD defined, don't check division/institution
84 ;
85 N LOC,OK,X,Y
86 S Y=""
87 I $D(SC("IEN")) D I +Y<0 G ERRCHKQ
88 . N IEN
89 . S IEN=SC("IEN")
90 . S LOC=$G(^SC(+IEN,0))
91 . I LOC']"" S Y=$$ERR(1) Q ; invalid ptr
92 . I '$G(RAD),'$D(^DIC(4,+$G(SC("INST")),0)) D I Y]"" Q
93 . . I '$P(LOC,"^",4),'$P(LOC,"^",15) S Y=$$ERR(2) Q ; bad inst/div
94 . S X=$G(^SC(IEN,"I"))
95 . I +X,('$P(X,"^",2)!($P(X,"^",2)>DT)) S Y=$$ERR(3) Q ; inactive
96 . S X=$G(^SC(IEN,"OOS"))
97 . I +X,($P(X,"^",2)'=SC("PKG")) S Y=$$ERR(5) Q ; wrong pkg
98 I PKG'>0 S Y=$$ERR(4) G ERRCHKQ ; pkg invalid
99 I $D(SC("STOP")) D I Y]"" G ERRCHKQ
100 . N STOP
101 . S STOP=SC("STOP")
102 . S STOP=$O(^DIC(40.7,"C",+STOP,0))
103 . I 'STOP S Y=$$ERR(6) Q ; bad stop code
104 . I '$$EX^SDCOU2(+STOP) S Y=$$ERR(10) Q ; not oos stop
105ERRCHKQ Q Y
106 ;
107 ;
108NONCOUNT(IEN) ; convert location to non-count
109 ;
110 ; Input: IEN of location to convert
111 ; Output: none
112 ;
113 N DA,DIE,DR
114 S DIE="^SC(",DA=IEN,DR="2502////Y"
115 D ^DIE
116 Q
117 ;
118 ;
119UPD(IEN,PKG) ; update existing entry
120 ;
121 ; Called from within routine only...not supported
122 ; Input: IEN as IEN of location to update
123 ; PKG as calling package
124 ;
125 N SC
126 D VAR(IEN,.SC)
127 D EDIT(IEN,SC("NAME"),SC("INST"),SC("STOP"),PKG)
128 Q
129 ;
130 ;
131NEW(IEN,PKG) ; create new entry given parameters from existing entry
132 ;
133 ; Called from within routine only...not supported
134 ; Input: IEN as IEN of location to update
135 ; PKG as calling package
136 ;
137 N SC
138 D VAR(IEN,.SC)
139 S IEN=$$ADD(SC("NAME"),PKG)
140 D EDIT(IEN,SC("NAME"),SC("INST"),SC("STOP"),PKG)
141 Q IEN
142 ;
143 ;
144VAR(IEN,SC) ; set up variables for ADD and EDIT calls based on existing entry
145 ;
146 ; Input: IEN as IEN of existing location
147 ; Output: SC("NAME") as name of location
148 ; SC("INST") as institution file ptr
149 ; SC("STOP") as IEN of clinic stop file
150 ;
151 N DIV,X
152 S X=$G(^SC(+$G(IEN),0))
153 S SC("NAME")=$P(X,"^",1)
154 S SC("STOP")=$P(X,"^",7)
155 I $P(X,"^",4) S SC("INST")=$P(X,"^",4) G VARQ
156 S DIV=$P(X,"^",15),SC("INST")=$P($G(^DG(40.8,+DIV,0)),"^",7)
157VARQ Q
158 ;
159 ;
160PKGIEN(PKG) ; get IEN of package file entry
161 ;
162 ; Input: PKG as IEN, name, or abbreviation of PKG
163 ; Output: IEN of package file
164 ;
165 N Y
166 S PKG=$G(PKG)
167 I PKG']"" S Y=-1 G PKGIENQ
168 I PKG S Y=PKG G PKGIENQ
169 S Y=$O(^DIC(9.4,"C",PKG,0)) I Y G PKGIENQ
170 S Y=$O(^DIC(9.4,"B",PKG,0)) I Y G PKGIENQ
171 S Y=-1
172PKGIENQ Q Y
173 ;
174 ;
175DIV(INST) ; return division associated with institution
176 Q $O(^DG(40.8,"AD",+INST,0))
177 ;
178 ;
179CHK(IEN) ; check to see if patterns exist for IEN
180 ;
181 ; Input: IEN of hospital location file
182 ; Output: 1 if ok (no patterns exist); 0 otherwise
183 ;
184 N I,OK
185 S OK=1
186 I $G(^SC(IEN,"SL"))]"" S OK=0 G CHKQ
187 I $O(^SC(IEN,"ST",0)) S OK=0 G CHKQ
188 I $O(^SC(IEN,"T",0)) S OK=0 G CHKQ
189 F I=0:1:6 I $O(^SC(IEN,"T"_I,0)) S OK=0 Q
190CHKQ Q OK
191 ;
192 ;
193ADD(SCNAME,SCPKG) ; add new entry
194 ;
195 N DD,DIC,DINUM,DO,X,Y
196 S DIC="^SC(",X=SCNAME,DIC(0)="L"
197 S DIC("DR")="50.01////1;50.02////^S X=$$PKGIEN^SCDXUAPI(SCPKG);"
198 D FILE^DICN
199 Q +Y
200 ;
201 ;
202EDIT(SCIEN,SCNAME,SCINST,SCSTOP,SCPKG,SCINACT) ; update fields
203 ;
204 N DA,DIE,DR,INST,X
205 S DIE="^SC(",DA=SCIEN,DR=""
206 I $G(SCNAME)]"" S DR=DR_".01///^S X=SCNAME;" ; name
207 S DR=DR_"2////C;" ; type = clinic
208 I $G(SCINST)]"" D
209 . S DR=DR_"3////^S X=SCINST;" ; inst ptr
210 . S DR=DR_"3.5////^S X=$$DIV^SCDXUAPI(SCINST);" ; division
211 I $G(SCSTOP)]"" S DR=DR_"8////^S X=SCSTOP;" ; stop code
212 S DR=DR_"2504////Y;" ; clinic meets here
213 S DR=DR_"9////0;" ; service=none
214 S DR=DR_"2502////N;" ; non-count=no
215 S DR=DR_"2502.5////0;" ; on fileroom list = no
216 S DR=DR_"26////1;" ; ask provider = yes
217 S DR=DR_"27////0;" ; ask diagnosis = no
218 S DR=DR_"2500////Y;" ; prohibit access=yes
219 S DR=DR_"50.01////1;" ; occasion of serv loc
220 S DR=DR_"50.02////^S X=$$PKGIEN^SCDXUAPI(SCPKG);" ; calling pkg
221 I $G(SCINACT) D
222 . S DR=DR_"2505////^S X=SCINACT;" ; inact date
223 . S DR=DR_"2506///@;" ; remove react date
224 D ^DIE
225 Q
226 ;
227 ;
228ERR(NUMBER) ; return error message corresponding to the number passed in
229 ;
230 ; Input: NUMBER of error message to return
231 ; Output: -1^NUMBER^Error Message Text
232 ;
233 Q "-1^"_NUMBER_"^"_$P($T(ERRORS+NUMBER),";;",2)
234 ;
235 ;
236ERRORS ; list of error messages
237 ;;Hospital Location IEN is Invalid
238 ;;Neither institution nor division defined properly for existing entry
239 ;;Location has an inactivation date
240 ;;Invalid PKG variable passed in
241 ;;IEN belongs to another package (PKG file entries don't match)
242 ;;Invalid stop code passed
243 ;;Invalid IEN passed to LOC call (package doesn't 'own' IEN)
244 ;;NAME, INST, and STOP not all defined before LOC call when IEN not set
245 ;;Unable to add entry to Hospital Location file
246 ;;Stop code not an occassion of service stop
247 ;
248 ;
249SCREEN(PKG) ; screen to only allow OOS locations for specified package
250 Q "I +$G(^(""OOS"")),($P(^(""OOS""),""^"",2)="_$$PKGIEN(PKG)_")"
251 ;
252EXEMPT() ; screen on clinic stop file to select only OOS stops
253 Q "I $$EX^SDCOU2(+Y)"
254 ;
255PKGNM(SCPKG) ; Return Name of Package
256 ; Input: SCPKG - Pointer to Package File (9.4)
257 ; Returned: Name of Package or 'Bad or Missing Pointer'
258 ;
259 N SCOS
260 D:$G(SCPKG) GETS^DIQ(9.4,SCPKG,.01,"E","SCOS")
261 Q $S($D(SCOS(9.4,(+$G(SCPKG))_",",.01,"E")):SCOS(9.4,(+$G(SCPKG))_",",.01,"E"),1:"Bad or Missing Pointer")
Note: See TracBrowser for help on using the repository browser.