source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXBAPI1.m@ 975

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

initial load of WorldVistAEHR

File size: 7.8 KB
Line 
1PXBAPI1 ;ISL/JVS,dee - PCE's API - interview questions ;5/6/05 2:59pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,9,23,56,104,111,113,122,116,130,147,151,124,164,182**;Aug 12, 1996;Build 3
3 ;;
4 Q
5 ;
6PROCESS(PXBEXIT) ;
7 N PXBREQ
8 I WHAT="INTV" D
9 . ;-- Interview is all of the questions
10 . D ADQ(.PXBEXIT) I PXBEXIT<1 Q
111 . D PRV(.PXBEXIT) I PXBEXIT<1 Q
123 . D POV(.PXBEXIT) I PXBEXIT<1 Q
132 . D CPT(.PXBEXIT) I PXBEXIT<1 Q
14 . I $P($G(^AUPNVSIT($G(PXBVST),150)),"^",3)="O" S PXBEXIT=0 Q
15 . I '$$DISPOSIT^PXUTL1($G(PXBPAT),$P($G(^AUPNVSIT(PXBVST,0)),"^",1),$G(PXBVST)) D STP(.PXBEXIT) I PXBEXIT<1 Q
16 E I WHAT="ADDEDIT" D
17 . D ADDEDIT
18 E I WHAT="ADQ" D
19 . ;-- Adminstrative questions
20 . D ADQ(.PXBEXIT)
21 E I WHAT="CODT" D
22 . ;-- Check out Date/Time
23 . D CODT(.PXBEXIT)
24 . Q:PXBEXIT<1
25 . D VISIT(.PXBEXIT)
26 . I PXBVST'>0 S PXBEXIT=-2 Q
27 E I WHAT="SCC" D
28 . ;-- Service connected conditions
29 . S PXCECAT="VST" D SCC(.PXBEXIT) K PXCECAT
30 . Q:PXBEXIT<1
31 . D VISIT(.PXBEXIT)
32 . I PXBVST'>0 S PXBEXIT=-2 Q
33 E I WHAT="PRV" D
34 . ;-- Providers
35 . D PRV(.PXBEXIT)
36 E I WHAT="CPT" D
37 . ;-- Providers and CPT codes
38 . D CPT(.PXBEXIT)
39 E I WHAT="POV" D
40 . ;-- Diagnoses
41 . D POV(.PXBEXIT)
42 E I WHAT="STP" D
43 . ;-- Stop Codes
44 . D STP(.PXBEXIT)
45 E S PXBEXIT=-3 W !,"Procedure ""INTV^PXAPI"" was called incorrectly, contact IRM."
46 Q
47 ;
48ADDEDIT ;
49 N PXANS
50ADDEDIT1 ;
51 D ADQ(.PXBEXIT)
52 G:PXBEXIT<1 ADDEDIT2
53 D PRV(.PXBEXIT)
54 G:PXBEXIT<1 ADDEDIT2
55 D POV(.PXBEXIT)
56 G:PXBEXIT<1 ADDEDIT2
57 ;
58 ;Call to CPT is not determined by a credit stop code any more
59 ;
60 D CPT(.PXBEXIT)
61 G:PXBEXIT<1 ADDEDIT2
62 I PXBVST>0,'$D(^AUPNVCPT("AD",PXBVST)) D ADDEDIT3 ;PX*1.0*182
63 Q ; PX*1.0*182 added quit, otherwise user is forced to delete enc.
64 ;
65ADDEDIT2 ;
66 I PXBVST>0,'$D(^AUPNVCPT("AD",PXBVST)),'$D(^AUPNVSIT("AD",PXBVST)) D I PXANS'=1 S PXBEXIT=1 G ADDEDIT1
67 . N DIR,X,Y
68 . W !!
69 . S DIR(0)="Y"
70 . S DIR("A",1)="Must have a STOP CODE or a PROCEDURE to complete this action."
71 . S DIR("A")="Do you want to delete this encounter"
72 . S DIR("B")="NO"
73 . D ^DIR
74 . S PXANS=Y
75 . Q:PXANS'=1
76 . I $$DELVFILE^PXAPIDEL("ALL",PXBVST,"","","","","")=1 S PXBEXIT=-1
77 I PXBVST>0,'$D(^AUPNVSIT(PXBVST,0)) S PXBVST=""
78 Q
79 ;
80ADDEDIT3 ;added PX*1.0*182
81 N DIR,X,Y
82 W !!
83 S DIR(0)="Y"
84 S DIR("A",1)="Must have a STOP CODE or a PROCEDURE to complete this action."
85 S DIR("A")="Do you want to delete this encounter"
86 S DIR("B")="NO"
87 D ^DIR
88 Q:Y'=1
89 I $$DELVFILE^PXAPIDEL("ALL",PXBVST,"","","","","")=1 S PXBVST=""
90 Q
91 ;
92ADQ(PXBEXIT) ;Ask the Administration questions
93 I PXBVST'>0 D
94 . ;This is only done for new visits
95 . I PXBPAT'>0 S PXBPAT=$$ASKPAT I PXBPAT'>0 S PXBEXIT=-1 Q
96 . S DFN=PXBPAT
97 . I PXBHLOC'>0 S PXBHLOC=$$ASKHL I PXBHLOC'>0 S PXBEXIT=-1 Q
98 . S PXBVSTDT=$S(PXBAPPT>0:PXBAPPT,1:$$ASKDT) I PXBVSTDT'>0 S PXBEXIT=-1 Q
99 . I PXBAPPT'>0&PXBHLOC'=+$G(^DPT(PXBPAT,"S",PXBVSTDT,0)) D
100 .. ;This is only done if there is no appointment.
101 .. S PXELAP=$$ELAP^SDPCE(PXBPAT,PXBHLOC)
102 I PXBEXIT'<1,PXBHLOC'>0 S PXBHLOC=$$ASKHL I PXBHLOC'>0 S PXBEXIT=-1 Q
103 I PXBEXIT'<1 D CODT(.PXBEXIT)
104 I PXBEXIT'<1,WHAT'="INTV" S PXCECAT="VST" D SCC(.PXBEXIT) K PXCECAT
105 I PXBEXIT'<1 D
106 . D VISIT(.PXBEXIT)
107 . I PXBVST'>0 S PXBEXIT=-2 Q
108 Q
109 ;
110ASKPAT() ;Ask user for a patient
111 ;DIC on file 9000001
112 N DIR,DIC,Y,X,DA
113 S DIR(0)="P^9000001:AEMQ"
114 S DIR("A")="Patient Name"
115 D ^DIR
116 Q $S(+Y>0:+Y,1:-1)
117 ;
118ASKHL() ;Ask user for a Hospital Location
119ASKHL2 ;DIC on file 44
120 N DIR,DIC,Y,X,DA,PXRES
121 S DIR(0)="PA^44:AEMQ"
122 S DIR("A")="Clinic: "
123 ; not occasion of service and not dispositioning
124 ;I PXALHLOC S DIR("S")="I '+$G(^(""OOS""))&'$O(^PX(815,1,""DHL"",""B"",Y,0))"
125 ; not occasion of service only ;PX*1.0*116
126 I PXALHLOC S DIR("S")="I '+$G(^(""OOS""))" ;PX*1.0*116
127 ; only clinic that are not occasion of service and not dispositioning
128 ;E S DIR("S")="I $P(^(0),U,3)=""C""&'+$G(^(""OOS""))&'$O(^PX(815,1,""DHL"",""B"",Y,0))"
129 E S DIR("S")="I $P(^(0),U,3)=""C""&'+$G(^(""OOS""))" ;PX*1.0*116
130 D ^DIR
131 ;enable to select a disposition clinic ;PX*1.0*116
132 ;I $D(^PX(815,1,"DHL","B",+Y)) D HELPDISP^PXCEVSIT W !,$C(7) G ASKHL2
133 ; disallow selection of clinics with non conforming stop codes
134 I +Y>0 S PXRES=$$CLNCK^SDUTL2(+Y,1) I 'PXRES D G ASKHL2
135 .W !,?5,"Clinic MUST be corrected before continuing."
136 Q $S(+Y>0:+Y,1:-1)
137 ;
138ASKDT() ;Ask user for the encounter Date/Time
139 N DIR,Y,X,DA
140 S DIR(0)="D^"_$S(PXLIMDT>2960000:PXLIMDT,1:"")_":"_(DT+.24)_":AEPRSX"
141 S DIR("A")="Encounter Date and Time"
142 S DIR("?")="Enter the Date and Time of this encounter"
143 D ^DIR
144 Q $S(+Y>0:+Y,1:-1)
145 ;
146CODT(PXBEXIT) ;Ask the user the Check out Date/Time
147 N PXCHKOUT
148 D CHIKOUT^PXBAPI2("",PXBPAT,PXBHLOC,PXBVSTDT)
149 S PXBCODT=PXCHKOUT
150 S:PXCHKOUT=-1 PXBCODT=""
151 ;; PX*1*113 - Change for EAS*1*3 Appointment processing removed
152 ;S X="EASMTCHK" X ^%ZOSF("TEST") I $T D Q:PXBEXIT<1
153 ;. S:$G(EASACT)'="W" EASACT="C"
154 ;. I $$MT^EASMTCHK(PXBPAT,"",EASACT,PXBVSTDT) D S PXBEXIT=-1
155 ;. . D PAUSE^VALM1
156 I WHAT'["ADDEDIT",PXCHKOUT=-1 S PXBEXIT=-1
157 I $G(PXBVST),$$DISPOSIT^PXUTL1(DFN,$P($G(^AUPNVSIT(PXBVST,0)),"^",1),PXBVST) S PXBEXIT=1
158 Q
159 ;
160SCC(PXBEXIT) ;Ask the user the Service connected conditions
161 N PXBDATA,PXBCLASS,PXBOUTEN,PXDOD
162 S (PXBOUTEN,PXDOD)=""
163 ;I $$APPOINT^PXUTL1(PXBPAT,PXBVSTDT,PXBHLOC) D
164 ;. S PXBOUTEN=$P($G(^DPT(+PXBPAT,"S",+PXBVSTDT,0)),"^",20)
165 ;E I $$DISPOSIT^PXUTL1(PXBPAT,PXBVSTDT,PXBVST) D
166 ;. S PXBOUTEN=+$P($G(^DPT(+PXBPAT,"DIS",9999999-PXBVSTDT,0)),"^",18)
167 ;I 'PXBOUTEN,$G(PXBVST)>0 S PXBOUTEN=$O(^SCE("AVSIT",PXBVST,0))
168 ;D CLASS^PXBAPI21(PXBOUTEN,PXBPAT,PXBVSTDT,PXBHLOC)
169 D CLASS^PXBAPI21(PXBOUTEN,PXBPAT,PXBVSTDT,PXBHLOC,PXBVST)
170 ;PX*1*111 - Add HNC
171 F PXBCLASS=1:1:7 I $G(PXBDATA("ERR",PXBCLASS))=4 S PXBEXIT=-1 Q ; changed 6/17/98 for MST enhancement
172 Q:PXBEXIT<1
173 I $G(PXDOD) S PXBEXIT=-1 Q
174 S PXB800(1)=$P($G(PXBDATA(3)),"^",2)
175 S PXB800(2)=$P($G(PXBDATA(1)),"^",2)
176 S PXB800(3)=$P($G(PXBDATA(2)),"^",2)
177 S PXB800(4)=$P($G(PXBDATA(4)),"^",2)
178 S PXB800(5)=$P($G(PXBDATA(5)),"^",2) ;added 6/17/98 for MST enhancement
179 ;PX*1*111 - Add HNC
180 S PXB800(6)=$P($G(PXBDATA(6)),"^",2)
181 S PXB800(7)=$P($G(PXBDATA(7)),"^",2)
182 Q
183 ;
184VISIT(PXBEXIT) ;Creat or edit the Visit
185 ;Set up ^TMP("PXK",$J and call PXK
186 I PXBVST>0 L +^AUPNVSIT(PXBVST):10 E W !!,$C(7),"Cannot edit at this time, try again later." D WAIT^PXCEHELP S PXBEXIT=-2 Q
187 K ^TMP("PXK",$J)
188 N PXBNODE,PXBAFTER,PXKERROR
189 F PXBNODE=0,21,150,800,811,812 D
190 . S PXBAFTER(PXBNODE)=$S(PXBVST>0:$G(^AUPNVSIT(PXBVST,PXBNODE)),1:"")
191 . S ^TMP("PXK",$J,"VST",1,PXBNODE,"BEFORE")=PXBAFTER(PXBNODE)
192 I PXBVST'>0 D
193 . S $P(PXBAFTER(0),"^",1)=PXBVSTDT
194 . S $P(PXBAFTER(0),"^",5)=PXBPAT
195 . S $P(PXBAFTER(0),"^",8)=$P(^SC(PXBHLOC,0),"^",7)
196 . S:PXBAPPT>0 $P(PXBAFTER(0),"^",7)="A" ;PX*1*124
197 . S $P(PXBAFTER(150),"^",3)="P"
198 . S $P(PXBAFTER(812),"^",2)=PXBPKG
199 . S $P(PXBAFTER(812),"^",3)=PXBSOURC
200 S $P(PXBAFTER(0),"^",18)=$G(PXBCODT)
201 S:$P(PXBAFTER(0),"^",22)="" $P(PXBAFTER(0),"^",22)=PXBHLOC
202 S $P(PXBAFTER(800),"^",1)=$G(PXB800(1))
203 S $P(PXBAFTER(800),"^",2)=$G(PXB800(2))
204 S $P(PXBAFTER(800),"^",3)=$G(PXB800(3))
205 S $P(PXBAFTER(800),"^",4)=$G(PXB800(4))
206 S $P(PXBAFTER(800),"^",5)=$G(PXB800(5)) ;added 6/17/98 for MST emhancement
207 ;PX*1*111 - Add HNC
208 S $P(PXBAFTER(800),"^",6)=$G(PXB800(6))
209 S $P(PXBAFTER(800),"^",7)=$G(PXB800(7))
210 I $D(PXELAP)#2 D
211 . S $P(PXBAFTER(0),"^",21)=+PXELAP
212 F PXBNODE=0,21,150,800,811,812 D
213 . S ^TMP("PXK",$J,"VST",1,PXBNODE,"AFTER")=PXBAFTER(PXBNODE)
214 S ^TMP("PXK",$J,"VST",1,"IEN")=$S(PXBVST>0:PXBVST,1:"")
215 S ^TMP("PXK",$J,"SOR")=PXBSOURC
216 D EN1^PXKMAIN
217 I PXBVST>0 L -^AUPNVSIT(PXBVST):5
218 S PXBVST=$G(^TMP("PXK",$J,"VST",1,"IEN"))
219 Q
220 ;
221CPT(PXBEXIT) ;Ask the user Providers and CTPs
222 D CPT^PXBMCPT(PXBVST) K PRVDR
223 Q
224 ;
225POV(PXBEXIT) ;Ask the user Diagnoses
226 D POV^PXBMPOV(PXBVST) K PRVDR
227 Q
228 ;
229PRV(PXBEXIT) ;Ask the user Providers
230 D PRV^PXBMPRV(PXBVST,"PRV") K PRVDR
231 Q
232 ;
233STP(PXBEXIT) ;Ask the user Stop Codes
234 I $L($T(DATE^SCDXUTL)),$$DATE^SCDXUTL(+$G(^AUPNVSIT(PXBVST,0))) Q
235 D STP^PXBMSTP(PXBVST) K PRVDR
236 Q
237 ;
Note: See TracBrowser for help on using the repository browser.