source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SD53103A.m@ 1336

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

initial load of FOIAVistA 6/30/08 version
File size: 8.1 KB
Line 
1SD53103A ;ALB/MJK - Unique Visit ID Clean Up ; March 10,1997
2 ;;5.3;Scheduling;**103**;AUG 13, 1993
3 ;
4 Q
5 ;
6ONE ; -- entry point to select a single -1 encounter and resync
7 N DIC,Y,SDOE,SDPKG,SDTALK,SDEXIT
8 IF '$$INIT^SD53103B() G ONEQ
9 S SDTALK=1,SDEXIT=0
10 D HDR^SD53103B("Single") W !
11 F D IF SDEXIT G ONEQ
12 . S DIC="^SCE(",DIC("S")="N SDOE0 S SDOE0=^(0) IF $$SCREEN^SD53103A(SDOE0)",DIC(0)="AEMQ" D ^DIC
13 . IF +Y<1 S SDEXIT=1 Q
14 . ; -- display record
15 . S SDOE=+Y D OE^SD53103B(SDOE)
16 . IF $$OK^SD53103B() D
17 . . N SDX
18 . . S SDX=$$MSG(SDOE,$$RESYNC(SDOE))
19 . . IF $P(SDX,U)["RE-LINKED" D
20 . . . W "Re-Linked successfully:"
21 . . . D OE^SD53103B(SDOE)
22 . . ELSE D
23 . . . W $C(7),"Error has occurred.",!,"Please make a note of the following: ",!?10,SDX,!
24ONEQ Q
25 ;
26SCAN ; -- entry point to scan encounter file for -1's to either
27 ; 'count only' or 'count and fix'
28 N SDBEG,SDEND,SDMODE,SDPKG,SDTALK
29 ;
30 ; -- init global locals
31 IF '$$INIT^SD53103B() G SCANQ
32 D HDR^SD53103B("Date Range")
33 ;
34 ; -- get date range
35 IF '$$RANGE^SD53103B(.SDBEG,.SDEND) G SCANQ
36 ;
37 ; -- ask which mode
38 S SDMODE=$$MODE^SD53103B() IF 'SDMODE G SCANQ
39 ;
40 ; -- ask if ok to continue
41 IF '$$OK^SD53103B() G SCANQ
42 ; -- queue process
43 D QUEUE
44SCANQ Q
45 ;
46QUEUE ; queue job
47 N I,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
48 W !
49 S ZTIO="",ZTDESC="Fix -1 Outpatient Encounters",ZTRTN="DQ^SD53103A"
50 F I="SDTALK","SDMODE","SDBEG","SDEND","SDPKG" S ZTSAVE(I)=""
51 D ^%ZTLOAD
52 I $G(ZTSK) W !!,"Task queued: #",ZTSK
53 Q
54 ;
55 ;
56DQ ; -- dequeue point...collect results and generate message.
57 N SDOE,SDOE0,SDDT,SDCNT,SDRT
58 ; -- set up and scan records
59 S SDDT=SDBEG,SDCNT=0,SDRT=$NA(^TMP("SDVISIT FIX",$J)) K @SDRT
60 F S SDDT=$O(^SCE("B",SDDT)) Q:'SDDT!(SDDT>SDEND) D Q:$$S^%ZTLOAD
61 . S SDOE=""
62 . F S SDOE=$O(^SCE("B",SDDT,SDOE)) Q:'SDOE D
63 . . S SDOE0=$G(^SCE(SDOE,0)) Q:SDOE0=""
64 . . ; -- use only -1's
65 . . IF $$SCREEN(.SDOE0) D
66 . . . S SDCNT=SDCNT+1
67 . . . IF SDMODE=1 S @SDRT@(SDCNT)=$$MSG(SDOE,"COUNT ONLY")
68 . . . IF SDMODE=2 S @SDRT@(SDCNT)=$$MSG(SDOE,$$RESYNC(SDOE))
69 ;
70 D RESULTS^SD53103B(.SDMODE,.SDBEG,.SDEND,.SDRT,.SDCNT)
71 K @SDRT
72 Q
73 ;
74SCREEN(SDOE0) ; -- process screen for -1's and null ID's
75 N SDOK
76 ; -- don't use if before 10/1/96
77 IF +SDOE0,+SDOE0<2961001 Q 0
78 ; -- use if -1 id
79 IF $P(SDOE0,U,20)=-1 Q 1
80 ; -- use if id null and (has a completion date OR action req status)
81 IF $P(SDOE0,U,20)="",$P(SDOE0,U,7)!($P(SDOE0,U,12)=14) Q 1
82 ; -- use if id nul and visit exists
83 IF $P(SDOE0,U,20)="",$P(SDOE0,U,5) Q 1
84 Q 0
85 ;
86MSG(SDOE,STATUS) ; -- build display text
87 N SDOE0,SDMSG
88 S SDOE0=$G(^SCE(+$G(SDOE),0))
89 IF SDOE0="" S SDMSG="Bad encounter entry passed"_U_+$G(SDOE)_U G MSGQ
90 S SDMSG=$S(STATUS["ERROR":">> ",1:" ")_STATUS
91 S SDMSG=SDMSG_U_SDOE_U_$P(SDOE0,U,6)_U_$P(SDOE0,U,5)
92 S SDMSG=SDMSG_U_$P($G(^DPT(+$P(SDOE0,U,2),0),"Unknown Patient"),U)
93 S SDMSG=SDMSG_U_$$FMTE^XLFDT(+SDOE0)
94 S SDMSG=SDMSG_U_$P($G(^SC(+$P(SDOE0,U,4),0),"Unknown Clinic"),U)
95MSGQ Q SDMSG
96 ;
97RESYNC(SDOE) ; -- resync sd and pce data
98 N SDOE0,SDVST,SDOK,SDOEC,SDCNT
99 S SDOK=0
100 S SDOE0=$G(^SCE(SDOE,0))
101 IF SDOE0="" G RESYNCQ
102 ;
103 ; -- get visit
104 S SDVST=$$VSIT(SDOE)
105 IF 'SDVST G RESYNCQ
106 D DOT
107 ;
108 ; -- set oe visit field
109 D OESET(SDOE,SDVST)
110 ;
111 ; -- quit if child
112 IF $P(SDOE0,U,6) D G RESYNCQ
113 . S SDOK=1
114 ;
115 ; -- set oe visit field for children of parent
116 S SDOEC=0
117 F S SDOEC=$O(^SCE("APAR",SDOE,SDOEC)) Q:'SDOEC D OESET(SDOEC,SDVST)
118 ;
119 ; -- send data to pce for parent
120 S SDOK=$$DATA2PCE(SDOE)
121 ;
122RESYNCQ Q $S(SDOK:"RE-LINKED",1:"ERROR OCCURRED")
123 ;
124OESET(SDOE,SDVST) ; -- set oe visit field
125 N DA,DR,DIE
126 ;
127 ; -- if id = -1 reset id
128 IF $P($G(^AUPNVSIT(+SDVST,150)),U)=-1 D
129 . N ID
130 . S ID=$$GETVID^VSITVID()
131 . K ^AUPNVSIT("VID",-1,+SDVST)
132 . S $P(^AUPNVSIT(+SDVST,150),U)=ID
133 . S ^AUPNVSIT("VID",ID,+SDVST)=""
134 ;
135 S DIE="^SCE(",DR=".05////"_SDVST,DA=SDOE D ^DIE
136 D DOT
137 Q
138 ;
139VSIT(SDOE) ; -- get/find visit
140 N SDOE0,SDVST,VSIT,DFN,DIE,DIC,DR,DA,X,VSITPKG,SDOEP
141 S SDVST=0
142 S SDOE0=$G(^SCE(+$G(SDOE),0))
143 IF SDOE0="" G VSITQ
144 ;
145 ; -- if entry already has visit, use it
146 IF $P(SDOE0,U,5) S SDVST=$P(SDOE0,U,5) G VSITQ
147 ;
148 ; -- if parent has pointer to visit, use it
149 S SDOEP=$P(SDOE0,U,6)
150 IF SDOEP D IF SDVST G VSITQ
151 . S SDVST=$P($G(^SCE(SDOEP,0)),U,5)
152 ;
153 ; -- call api to get visit entry
154 S VSIT(0)="ENMD1"
155 S VSIT=+SDOE0
156 S DFN=+$P(SDOE0,U,2)
157 S VSITPKG="SD"
158 S VSIT("CLN")=$P(SDOE0,U,3)
159 S VSIT("SVC")=$S($$INP^SDAM2(DFN,VSIT)="I":"I",1:"A")
160 S VSIT("INS")=$P($G(^DG(40.8,+$P(SDOE0,U,11),0)),U,7)
161 S VSIT("ELG")=$S($P(SDOE0,U,13):$P(SDOE0,U,13),1:+$G(^DPT(DFN,.36)))
162 IF $P(SDOE0,U,4) S VSIT("LOC")=$P(SDOE0,U,4)
163 IF $P(SDOE0,U,6) S X=$G(^SCE($P(SDOE0,U,6),0)) IF X]"" S VSIT=+X I $P(X,U,5) S VSIT("LNK")=$P(X,U,5)
164 IF '$P(SDOE0,U,6) D
165 . S VSIT("PRI")="P"
166 E D
167 . IF $P(SDOE0,U,8)=4 D
168 . . S VSIT("PRI")="C",VSIT("SVC")=$S($$INP^SDAM2(DFN,VSIT)="I":"D",1:"X")
169 . E D
170 . . S VSIT("PRI")="S"
171 ;
172 ; -- do checks
173 I 'VSIT,'DFN,'VSIT("ELG")!('VSIT("INS"))!('VSIT("CLN")) G VSITQ
174 ;
175 ; -- add/find visit
176 ;
177 ; -- change call if orinating process is a disposition.
178 I $P(SDOE0,U,8)=3 D
179 .; -- must be valid disposition clinic
180 . IF $O(^PX(815,1,"DHL","B",+$P(SDOE0,U,4),0)) D DISPVSIT^PXAPI Q
181 .; -- if interactive mode, ok to get visit
182 . IF SDTALK D
183 . . D DISPVSIT^PXAPI
184 . .; -- visit created and loc defined; re-set oe location field
185 . . IF +$G(VSIT("IEN"))>0,VSIT("LOC") D
186 . . . S $P(^SCE(SDOE,0),U,4)=VSIT("LOC")
187 . . .; -- re-set children oe location field
188 . . . N SDOEC S SDOEC=0
189 . . . F S SDOEC=$O(^SCE("APAR",SDOE,SDOEC)) Q:'SDOEC D
190 . . . . S $P(^SCE(SDOEC,0),U,4)=VSIT("LOC")
191 ;
192 IF $P(SDOE0,U,8)'=3 D
193 .; -- quit if parent is a disposition and bad location; parent will fix
194 . IF $P($G(^SCE(+$P(SDOE0,U,6),0)),U,8)=3,'$O(^PX(815,1,"DHL","B",+$P(SDOE0,U,4),0)) Q
195 . D ^VSIT
196 ;
197 IF +$G(VSIT("IEN"))>0 S SDVST=+VSIT("IEN")
198VSITQ Q SDVST
199 ;
200DATA2PCE(SDOE) ; -- send data to pce
201 N SDOE0,X,SDVST,SDPRV,SDIAG,SDCLS,SDPROC,SDPCE,SDOK,SDOEC
202 S SDOK=0
203 ;
204 ; -- gather needed data
205 S SDOE0=$G(^SCE(SDOE,0)) G DATAQ:SDOE0=""
206 S SDVST=$P(SDOE0,U,5) G DATAQ:'SDVST
207 ;
208 ; -- if visit has v-file data quit
209 IF $O(^AUPNVCPT("AD",SDVST,0))!($O(^AUPNVPRV("AD",SDVST,0)))!($O(^AUPNVPOV("AD",SDVST,0))) S SDOK=1 G DATAQ
210 ;
211 ; -- get data from parent
212 D SET(SDOE,"SDPRV",409.44),DOT
213 D SET(SDOE,"SDIAG",409.43),DOT
214 D SET(SDOE,"SDCLS",409.42),DOT
215 D PROC^SCDXUTL0(SDOE,"SDPROC"),DOT ; -- gets both parent & children data
216 ;
217 ; -- get data from children
218 S SDOEC=0
219 F S SDOEC=$O(^SCE("APAR",SDOE,SDOEC)) Q:'SDOEC D
220 . D SET(SDOEC,"SDPRV",409.44),DOT
221 . D SET(SDOEC,"SDIAG",409.43),DOT
222 . D SET(SDOEC,"SDCLS",409.42),DOT
223 ;
224 ; ---build pce data array
225 D BUILD("SDPRV","SDIAG","SDCLS","SDPROC","SDPCE")
226 ;
227 ; -- call pce api to file data
228 IF $$DATA2PCE^PXAPI("SDPCE",SDPKG,"SD TO PCE RESYNC",SDVST)=1 D
229 . S SDOK=1
230DATAQ Q SDOK
231 ;
232BUILD(SDPROV,SDDX,SDCLASS,SDCPT,SDATA) ; -- build pce data array
233 N X,SDI,SDIEN,SDCNT
234 S SDI=0 F S SDI=$O(@SDCLASS@(SDI)) Q:'SDI D
235 . S X=@SDCLASS@(SDI)
236 . S @SDATA@("ENCOUNTER",1,$P("AO^IR^SC^EC",U,+X))=$P(X,U,3)
237 ;
238 ; -- set provider info
239 IF $O(@SDPROV@(0)) D
240 . S (SDCNT,SDIEN)=0
241 . F S SDIEN=$O(@SDPROV@(SDIEN)) Q:'SDIEN D
242 . . S X=@SDPROV@(SDIEN)
243 . . S SDCNT=SDCNT+1
244 . . S @SDATA@("PROVIDER",SDCNT,"NAME")=+X
245 ;
246 ; -- set dx info
247 IF $O(@SDDX@(0)) D
248 . S (SDCNT,SDIEN)=0
249 . F S SDIEN=$O(@SDDX@(SDIEN)) Q:'SDIEN D
250 . . S X=@SDDX@(SDIEN)
251 . . S SDCNT=SDCNT+1
252 . . S @SDATA@("DX/PL",SDCNT,"DIAGNOSIS")=+X
253 . . S @SDATA@("DX/PL",SDCNT,"PRIMARY")=+$P(X,U,3)
254 ;
255 ; -- set cpt info
256 IF $O(@SDCPT@(0)) D
257 . ; -- count times performed
258 . N SDX
259 . S (SDCNT,SDIEN)=0
260 . F S SDIEN=$O(@SDCPT@(SDIEN)) Q:'SDIEN D
261 . . S X=@SDCPT@(SDIEN)
262 . . S SDX(+X)=$G(SDX(+X))+1
263 . ;
264 . ; -- build nodes
265 . S (SDCNT,SDIEN)=0
266 . F S SDIEN=$O(SDX(SDIEN)) Q:'SDIEN D
267 . . S X=SDX(SDIEN)
268 . . S SDCNT=SDCNT+1
269 . . S @SDATA@("PROCEDURE",SDCNT,"PROCEDURE")=SDIEN
270 . . S @SDATA@("PROCEDURE",SDCNT,"QTY")=+X
271BUILDQ Q
272 ;
273SET(SDOE,ARRAY,FILE) ;Set-up Array for Outpatient Encounter
274 ; Input -- SDOE Outpatient Encounter IEN
275 ; Output -- ARRAY Provider or dx Array Subscripted by a ien
276 ;
277 N SDIEN
278 S SDIEN=0
279 F S SDIEN=$O(^SDD(FILE,"OE",SDOE,SDIEN)) Q:'SDIEN D
280 . S X=$G(^SDD(FILE,SDIEN,0)) Q:X=""
281 . S @ARRAY@(SDIEN)=X
282SETQ Q
283 ;
284DOT ; -- write '.' if ok to talk
285 IF SDTALK D
286 . W "."
287 Q
288 ;
Note: See TracBrowser for help on using the repository browser.