source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDPCE.m@ 635

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1SDPCE ;MJK/ALB - Process PCE Event Data ;01 APR 1993
2 ;;5.3;Scheduling;**27,91,132,150,244,325**;Aug 13, 1993
3 ;
4 ; **** See SDPCE0 for variable definitions ****
5 ;
6EN ; -- main entry pt for PCE event processing
7 ;
8 ; -- start rt monitor
9 D:$D(XRTL) T0^%ZOSV
10 ;
11 N SDVSIT,SDVSIT0,SDEVENT,SDERR,SDCLST,SDCS,SDPCNT,SDVDT,SDELAP
12 S SDVSIT0=0,SDEVENT="SDEVENT"
13 ; -- process each visit (initially will only be 1)
14 F S SDVSIT0=$O(^TMP("PXKCO",$J,SDVSIT0)) Q:'SDVSIT0 D
15 . I $$HISTORIC^VSIT(SDVSIT0) Q
16 . S SDVSIT("AFTER")=$G(^TMP("PXKCO",$J,SDVSIT0,"VST",SDVSIT0,0,"AFTER")),SDVSIT("BEFORE")=$G(^("BEFORE"))
17 .;
18 .; -- new or old visit
19 . IF SDVSIT("AFTER")]"",SDVSIT("BEFORE")]""!(SDVSIT("BEFORE")="") D ADD(.SDVSIT0,.SDEVENT,.SDERR) Q
20 .;
21 .; -- deleted visit
22 . IF SDVSIT("AFTER")="",SDVSIT("BEFORE")]"" D DEL(.SDVSIT0,.SDEVENT,.SDERR) Q
23 ;
24 ; -- stop rt monitor
25 IF $D(XRT0) S XRTN=$T(+0) D T1^%ZOSV
26 ;
27 Q
28 ;
29ADD(SDVSIT0,SDEVENT,SDERR) ; -- add/update encounter data
30 N DFN,SDT,SDCL,SDRESULT,SDTYPE,SDOE,SDDIS,SDPVSIT,SDELAP
31 ; -- get patient/encounter data
32 D PAT(SDVSIT("AFTER"),.DFN,.SDT,.SDCL)
33 S SDVSIT=$S($P(SDVSIT("AFTER"),U,12):$P(SDVSIT("AFTER"),U,12),1:SDVSIT0)
34 ; -- get encounter data
35 S SDOE=$O(^SCE("AVSIT",+SDVSIT,0)),SDDIS=$P($G(^SCE(+SDOE,0)),U,8)
36 I 'SDDIS,$G(SDOEP) S SDDIS=$P($G(^SCE(+SDOEP,0)),U,8)
37 ;
38 ; -- get elig for visit
39 S @SDEVENT@("ELIGIBILITY")=$S($P(SDVSIT("AFTER"),U,21):$P(SDVSIT("AFTER"),U,21),1:"")
40 ;
41 ; -- get appt type
42 S SDELAP=$G(^TMP("PXKCO",$J,SDVSIT0,"VST",SDVSIT0,"ELAP","AFTER"))
43 S @SDEVENT@("APPT TYPE")=$S($P(SDELAP,U,3):$P(SDELAP,U,3),1:"")
44 ;
45 ; -- get co d/t
46 S @SDEVENT@("DATE/TIME")=$S($P(SDVSIT("AFTER"),U,18):$P(SDVSIT("AFTER"),U,18),1:"")
47 ;
48 ; -- determine the type of event
49 IF SDCL,SDCL=+$G(^DPT(DFN,"S",SDT,0)) D
50 . S @SDEVENT@("EVENT")="CHECK-OUT"
51 ;
52 ELSE I SDDIS,SDDIS=3 D
53 . S @SDEVENT@("EVENT")="DISPOSITION"
54 ;
55 ELSE D Q:$$DELAE()
56 . S @SDEVENT@("EVENT")="ADD/EDIT CHECK-OUT"
57 . I SDVSIT S SDPVSIT=SDVSIT D ENCEVENT^PXKENC(SDPVSIT)
58 ;
59 ; -- get user
60 S @SDEVENT@("USER")=$S($D(^VA(200,+$G(DUZ),0)):+DUZ,1:.5)
61 D CLASS(.SDVSIT,.SDEVENT)
62 S @SDEVENT@("VISIT CHANGE FLAGS")=$$CHANGE(.SDVSIT0)
63 I $G(SDPVSIT),'$D(@SDEVENT@("CLASSIFICATION")) D CLASSAE(SDPVSIT,.SDEVENT)
64 ; -- call api
65 D API(DFN,SDT,SDCL,.SDEVENT,.SDERR,SDVSIT,"ADDITION")
66 K ^TMP("PXKENC",$J)
67 Q
68 ;
69DEL(SDVSIT0,SDEVENT,SDERR) ; -- delete co info when visit delete
70 N DFN,SDT,SDCL
71 S SDVSIT=$S($P(SDVSIT("AFTER"),U,12):$P(SDVSIT("AFTER"),U,12),1:SDVSIT0)
72 D PAT(SDVSIT("BEFORE"),.DFN,.SDT,.SDCL)
73 S @SDEVENT@("USER")=$S($P(SDVSIT("BEFORE"),U,23):$P(SDVSIT("BEFORE"),U,23),1:.5)
74 S @SDEVENT@("EVENT")="CHECK-OUT DELETE"
75 D API(DFN,SDT,SDCL,.SDEVENT,.SDERR,SDVSIT,"DELETION")
76 Q
77 ;
78DELAE() ; -- delete standalone encounter if no cpt, dx and providers
79 N SDDEL
80 S SDDEL=0
81 IF '$D(^TMP("PXKENC",$J,SDVSIT,"CPT")),'$D(^("POV")),'$D(^("PRV")) D
82 . S @SDEVENT@("USER")=$S($P(SDVSIT("BEFORE"),U,23):$P(SDVSIT("BEFORE"),U,23),1:.5)
83 . S @SDEVENT@("EVENT")="CHECK-OUT DELETE"
84 . D API(DFN,SDT,SDCL,.SDEVENT,.SDERR,SDVSIT,"DELETION")
85 . K ^TMP("PXKENC",$J)
86 . S SDDEL=1
87 Q SDDEL
88 ;
89API(DFN,SDT,SDCL,SDEVENT,SDERR,SDVSIT,SDACT) ;
90 N SDRET,SDSOR
91 S SDRET=$$EN^SDAPI(DFN,SDT,SDCL,.SDEVENT,.SDERR,SDVSIT)
92 ;
93 ; -- is it ok to send bulletin if needed
94 S SDSOR=+$O(^TMP("PXKCO",$J,SDVSIT,"SOR",0))
95 IF SDSOR,'$P($G(^TMP("PXKCO",$J,SDVSIT,"SOR",SDSOR,0,"AFTER")),U,9) D
96 . Q
97 ELSE D
98 . D BULL^SDPCE2(DFN,SDT,SDCL,.SDEVENT,.SDERR,SDVSIT,SDACT)
99 Q
100 ;
101PAT(SDVSIT0,DFN,SDT,SDCL) ; -- return patient/encounter data for visit
102 S DFN=+$P(SDVSIT0,U,5),SDT=+SDVSIT0,SDCL=+$P(SDVSIT0,U,22)
103 Q
104 ;
105CLASS(SDVSIT,SDEVENT) ; -- set-up classification data from visit data
106 N SD800A,SD800B,SDI,CLASS,SDA,SDB
107 S SD800A=$G(^TMP("PXKCO",$J,SDVSIT,"VST",SDVSIT,800,"AFTER")),SD800B=$G(^("BEFORE"))
108 ; -- process each piece
109 F SDI=1:1:7 D
110 . S CLASS=$P("SC^AO^IR^EC^MST^HNC^CV",U,SDI),SDA=$P(SD800A,U,SDI),SDB=$P(SD800B,U,SDI)
111 .; -- changed or same class data
112 . IF SDA]"",SDB]"" S @SDEVENT@("CLASSIFICATION",$S(SDA'=SDB:"CHANGE",1:"ADD"),CLASS)=$$CLASSVAL(SDA) Q
113 .; -- new class data
114 . IF SDA]"",SDB="" S @SDEVENT@("CLASSIFICATION","ADD",CLASS)=$$CLASSVAL(SDA) Q
115 .; -- deleted class data
116 . IF SDA="",SDB]"" S @SDEVENT@("CLASSIFICATION","DELETE",CLASS)="" Q
117 Q
118CLASSVAL(Y) ; -- yes/no processing
119 Q $S(Y=1:"Y",Y=0:"N",1:"??")
120 ;
121CLASSAE(SDVSIT,SDEVENT) ; -- set-up classification data from visit data
122 N SD800A,SD800B,SDI,CLASS,SDA,SDB
123 S SD800A=$G(^TMP("PXKENC",$J,SDVSIT,"VST",SDVSIT,800,"AFTER")),SD800B=$G(^("BEFORE"))
124 ; -- process each piece
125 F SDI=1:1:7 D
126 . S CLASS=$P("SC^AO^IR^EC^MST^HNC^CV",U,SDI),SDA=$P(SD800A,U,SDI),SDB=$P(SD800B,U,SDI)
127 .; -- changed or same class data
128 . IF SDA]"",SDB]"" S @SDEVENT@("CLASSIFICATION",$S(SDA'=SDB:"CHANGE",1:"ADD"),CLASS)=$$CLASSVAL(SDA) Q
129 .; -- new class data
130 . IF SDA]"",SDB="" S @SDEVENT@("CLASSIFICATION","ADD",CLASS)=$$CLASSVAL(SDA) Q
131 .; -- deleted class data
132 . IF SDA="",SDB]"" S @SDEVENT@("CLASSIFICATION","DELETE",CLASS)="" Q
133 Q
134 ;
135ELAP(DFN,SC) ; -- This function will return Elig and Appt Type data
136 ; INPUT: DFN - Patient, SC - Clinic IEN
137 ; OUTPUT: Elig ptr^ Elig text^ Appt Ptr^ Appt Text
138 ;
139 N VAEL,VADM,X,Y,SDAPTYP,SDATD,SDEMP,SDDECOD,SDEC,SDAMBAE
140 S SDAMBAE=1
141 ;-- get appt type
142 D TYPE^SDM4
143 S SDEMP=""
144 ;-- get elig if more than 1
145 I $O(VAEL(1,0))>0 S SDEMP="" D ELIG^SDM4:"369"[SDAPTYP S SDEMP=$S(SDDECOD:SDDECOD,1:SDEMP)
146 I 'SDEMP S SDEMP=VAEL(1)
147 ;
148 Q +SDEMP_U_$P($G(^DIC(8,+SDEMP,0)),U)_U_+SDAPTYP_U_$P($G(^SD(409.1,+SDAPTYP,0)),U)
149 ;
150NEW(DATE) ;-- This function will return 1 if SD is turned on for
151 ; Visit Tracking and optionally check if the date is past
152 ; the cut over date for the new PCE interface.
153 ; INPUT : DATE (Optional) Date to check for cut over.
154 ; OUTPUT: 1 Yes, 0 No
155 N SDRES,SDX,SDY
156 I '$G(DATE) S DATE=DT
157 ;-- is Scheduling on ?
158 S SDRES=0,SDY=$$PKGON^VSIT("SD")
159 ;-- if date is it pass cut over?
160 S SDX=1 I $G(DATE) S SDX=$$SWITCHCK^PXAPI(DATE)
161 ;-- And together
162 I SDX,SDY S SDRES=1
163 Q SDRES
164 ;
165STATUS(SDVSIT) ; Return status of an encounter
166 ; Input: SDOE = Visit File IEN
167 ; Output: Status of the encounter Internal IEN^External Value
168 ;
169 N SDINT,SDEXT,SDOE
170 S SDOE=$O(^SCE("AVSIT",+SDVSIT,0))
171 S SDINT=$P($G(^SCE(+SDOE,0)),U,12)
172 S SDEXT=$P($G(^SD(409.63,+SDINT,0)),U)
173STATQ Q SDINT_"^"_SDEXT
174 ;
175CHANGE(SDVST) ; -- set flags for overall visit change
176 N SDI,SDFLAGS
177 ;
178 ; -- initalize chnage flags
179 ; -- cpt changed ^ provider data changed ^ dx changed
180 S SDFLAGS="0^0^0"
181 ;
182 ; -- set cpt change flag
183 S SDI=0
184 F S SDI=$O(^TMP("PXKCO",$J,SDVST,"CPT",SDI)) Q:'SDI IF $G(^TMP("PXKCO",$J,SDVST,"CPT",SDI,0,"BEFORE"))'=$G(^("AFTER")) S $P(SDFLAGS,U,1)=1
185 ;
186 ; -- set provider change flag
187 S SDI=0
188 F S SDI=$O(^TMP("PXKCO",$J,SDVST,"PRV",SDI)) Q:'SDI IF $G(^TMP("PXKCO",$J,SDVST,"PRV",SDI,0,"BEFORE"))'=$G(^("AFTER")) S $P(SDFLAGS,U,2)=1
189 ;
190 ; -- set dx change flag
191 S SDI=0
192 F S SDI=$O(^TMP("PXKCO",$J,SDVST,"POV",SDI)) Q:'SDI IF $G(^TMP("PXKCO",$J,SDVST,"POV",SDI,0,"BEFORE"))'=$G(^("AFTER")) S $P(SDFLAGS,U,3)=1
193 ;
194 Q SDFLAGS
195 ;
Note: See TracBrowser for help on using the repository browser.