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

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

initial load of WorldVistAEHR

File size: 5.4 KB
Line 
1PXRRWLSE ;ISL/PKR,ISA/Zoltan - Sort encounters for encounter summary report. ;12/1/1998
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**20,58,61**;Aug 12, 1996
3 ;
4 ;Sort the encounters according to the selection criteria.
5SORT ;
6 N BYCLOC,BD,BUSY,CLINIC,CLINIEN,CPT,CSSCR
7 N DATE,DAY,DFN,ED,EM,EMLIST,FAC,FACILITY,FOUND
8 N HLOCIEN,HLOCNAM,HSSCR,IC,INOUT,LOCATION,NEWPIEN
9 N PCLASS,PPNAME
10 N PROVIDER,PRVCNT,PRVIEN,PRVSCR
11 N STOIND,TEMP,TOTUNIQ,TOTVIS,UPAT,VIEN,VISIT,VISIT150,VISITS
12 N MULTPR
13 ;
14 D SORT2^PXRRWLS2
15 ;
16 S BD=PXRRBDT-.0001
17 S ED=PXRREDT+.2359
18NDATE S BD=$O(^AUPNVSIT("B",BD))
19 ;If we have passed the ending date we are done.
20 I (BD>ED)!(BD="") G DONE
21 ;
22 ;If this is an interactive session let the user know that something
23 ;is happening.
24 I '(PXRRQUE!$D(IO("S"))) D SPIN^PXRRBUSY("Sorting encounters",.BUSY)
25 ;
26 ;Check for a user request to stop the task.
27 I $$S^%ZTLOAD S ZTSTOP=1 D EXIT^PXRRGUT
28 ;
29 ;Get the VISIT IEN
30 S VIEN=0
31VISIT S VIEN=$O(^AUPNVSIT("B",BD,VIEN))
32 I VIEN="" G NDATE
33 S VISIT=^AUPNVSIT(VIEN,0)
34 ;
35 ;Screen out inappropriate vists.
36 ;Service categories.
37 I PXRRSCAT'[$P(VISIT,U,7) G VISIT
38 ;Encounter types.
39 S VISIT150=$G(^AUPNVSIT(VIEN,150))
40 I PXRRENTY'[$P(VISIT150,U,3) G VISIT
41 ;
42 ;Make sure that the facility is on the list.
43 S FOUND=0
44 S FAC=$P(VISIT,U,6)
45 F IC=1:1:NFAC I $P(PXRRFAC(IC),U,1)=FAC D Q
46 . S FACILITY=FAC
47 . S FOUND=1
48 I 'FOUND G VISIT
49 ;
50 S HLOCNAM=""
51 ;
52 D VISIT2^PXRRWLS2
53 ;
54 I 'FOUND G VISIT
55 ;
56 ;Get the Provider
57 S PRVCNT=0
58 S PRVIEN=0
59 S MULTPR=""
60PRV ;
61 S PRVIEN=$O(^AUPNVPRV("AD",VIEN,PRVIEN))
62 I (PRVIEN="")&(PRVCNT>0) G VISIT
63 I (PRVIEN="") S NEWPIEN=0
64 E S NEWPIEN=+$P(^AUPNVPRV(PRVIEN,0),U,1)
65 S PRVCNT=PRVCNT+1
66 I NEWPIEN>0 S PPNAME=$P(^VA(200,NEWPIEN,0),U,1)_U_NEWPIEN
67 E S PPNAME="Unknown"_U_NEWPIEN
68 ;
69 ;Apply any Provider screens.
70 ;List of providers.
71 I $D(PXRRPRPL) D G:'FOUND PRV
72 . S FOUND=0
73 . F IC=1:1:NPL I $P(PXRRPRPL(IC),U,2)=NEWPIEN D Q
74 ..;Mark this provider as being matched.
75 .. S $P(PXRRPRPL(IC),U,4)="M"
76 .. S FOUND=1
77 ;
78 ;Person class screen.
79 I $D(PXRRPECL) D G:'FOUND PRV
80 . S PCLASS=$$OCCUP^PXBGPRV(NEWPIEN,BD,"",1,"")
81 . S FOUND=$$MATCH^PXRRPECU(PCLASS)
82 . S PPNAME=PPNAME_U_$P(PCLASS,U,7)
83 ;
84 D PRV2^PXRRWLS2
85 ;
86CLOC ;
87 D CLOC2^PXRRWLS2
88 ;
89 ;Find the CPT code(s) and associated E&M codes for this encounter.
90 S IC=$O(^AUPNVCPT("AD",VIEN,""))
91 I +IC=0 D G BYCLOC
92 . S ^XTMP(PXRRXTMP,FACILITY,STOIND,"NOCPT")=$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"NOCPT"))+1
93 .;Total for multiple provider encounters.
94 . I MULTPR S ^XTMP(PXRRXTMP,FACILITY,"&&","NOCPT")=$G(^XTMP(PXRRXTMP,FACILITY,"&&","NOCPT"))+1
95 ;
96 S IC=""
97GETCPT S IC=$O(^AUPNVCPT("AD",VIEN,IC))
98 I +IC>0 D GC2^PXRRWLS2 G GETCPT
99 ;
100BYCLOC ;If necessary accumulate the information about each clinic stop
101 ;location.
102 I BYCLOC,$L(STOIND,U)=3 D G CLOC
103 . S HLOCIEN=$P(VISIT,U,22)
104 . ;Null Subscript: Visit is missing hospital location.
105 . ;Undefined: Hospital Location may have been deleted.
106 . S STOIND=STOIND_U_$P(^SC(HLOCIEN,0),U,1)
107 ;Pass flag to report for header message.
108 I MULTPR=1 S ^XTMP(PXRRXTMP,"PXRRMPR")=1
109 ; Get the next provider for the encounter...
110 S PXRRPRSC=$G(PXRRPRSC) ; Ensure it exists.
111 I $E(PXRRPRSC)="S",$G(NPL)>1 S MULTPR=1 G PRV
112 I $E(PXRRPRSC)="C"!($E(PXRRPRSC)="A") S MULTPR=1 G PRV
113 ; ...or get the next encounter.
114 G VISIT
115 ;
116DONE ;
117 ;Process the patient list, get the number of unique patients, and the
118 ;number of visits. A visit is defined to be any activity for a patient
119 ;within a 24 hour period.
120 ;
121 S FACILITY=0
122NFAC S FACILITY=$O(^TMP(PXRRXTMP,$J,FACILITY))
123 I +FACILITY=0 G SDONE
124 ;
125 D NF2^PXRRWLS2
126 ;
127 S STOIND="&"
128NSTO S STOIND=$O(^TMP(PXRRXTMP,$J,FACILITY,STOIND))
129 I STOIND="" G NFAC
130 ;
131 S TOTVIS=0
132 S UPAT=0
133 S VISITS(0)=0
134 S VISITS(1)=0
135 ;
136 ;If this is an interactive session let the user know that something
137 ;is happening.
138 I '(PXRRQUE!$D(IO("S"))) D SPIN^PXRRBUSY("Sorting encounters",.BUSY)
139 ;
140 S DFN=0
141NDFN S DFN=$O(^TMP(PXRRXTMP,$J,FACILITY,STOIND,"PATIENT",DFN))
142 I +DFN=0 D G NSTO
143 . S ^XTMP(PXRRXTMP,FACILITY,STOIND,"TOTVIS")=TOTVIS
144 . S ^XTMP(PXRRXTMP,FACILITY,STOIND,"UPAT")=UPAT
145 . S ^XTMP(PXRRXTMP,FACILITY,STOIND,"VISITS",0)=VISITS(0)
146 . S ^XTMP(PXRRXTMP,FACILITY,STOIND,"VISITS",1)=VISITS(1)
147 S UPAT=UPAT+1
148 ;
149 S DAY=""
150NDAY S DAY=$O(^TMP(PXRRXTMP,$J,FACILITY,STOIND,"PATIENT",DFN,DAY))
151 I DAY="" G NDFN
152 S TOTVIS=TOTVIS+1
153 ;
154 S INOUT=-1
155NINOUT S INOUT=$O(^TMP(PXRRXTMP,$J,FACILITY,STOIND,"PATIENT",DFN,DAY,INOUT))
156 I INOUT="" G NDAY
157 S VISITS(INOUT)=VISITS(INOUT)+1
158 G NINOUT
159 ;
160SDONE ;Sorting is done.
161 I '(PXRRQUE!$D(IO("S"))) D DONE^PXRRBUSY("done")
162 K ^TMP(PXRRXTMP)
163 ;
164 ;If there were selected clinic stops build dummy entries for all
165 ;those without entries.
166 I $D(PXRRCS) D
167 . F FAC=1:1:NFAC D
168 .. S FACILITY=$P(PXRRFAC(FAC),U,1)
169 .. F IC=1:1:NCS D
170 ... I $P(PXRRCS(IC),U,4)'="M" D
171 .... S HLOCNAM=PXRRCS(IC)
172 .... S ^XTMP(PXRRXTMP,FACILITY,HLOCNAM,0,0)=""
173 ;
174 ;If there were selected hospital locations build dummy entries for all
175 ;those without entries.
176 I $D(PXRRLCHL) D
177 . F FAC=1:1:NFAC D
178 .. S FACILITY=$P(PXRRFAC(FAC),U,1)
179 .. F IC=1:1:NHL D
180 ... I $P(PXRRLCHL(IC),U,4)'="M" D
181 .... S HLOCNAM=PXRRLCHL(IC)
182 .... S ^XTMP(PXRRXTMP,FACILITY,HLOCNAM,0,0)=""
183 ;
184EXIT ;
185 ;Sort the appointment information.
186 I PXRRQUE D
187 .;Start the appointment sorting that was queued but not scheduled.
188 . N DESC,ROUTINE,TASK
189 . S ROUTINE="PXRRWLSA"
190 . S DESC="Encounter Summary Report - sort appointments"
191 . S ZTDTH=$$NOW^XLFDT
192 . S TASK=^XTMP(PXRRXTMP,"SAZTSK")
193 . D REQUE^PXRRQUE(DESC,ROUTINE,TASK)
194 E D SORT^PXRRWLSA
195 Q
Note: See TracBrowser for help on using the repository browser.