source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXRRWLS2.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1PXRRWLS2 ;ISA/Zoltan - Sort encounters for encounter summary report.;12/1/1998
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**58,61,133**;Aug 12, 1996
3 ;
4 ; Code migrated from PXRRWLSE.
5 ;
6 ; Part 1: migrated code.
7SORT2 ; Migrated from PXRRWLSE
8 I '(PXRRQUE!$D(IO("S"))) D INIT^PXRRBUSY(.BUSY)
9 ;
10 ;Location is true if we are screening by location.
11 I $P(PXRRWLSC,U,1)="L" D
12 . S LOCATION=1
13 . S ^XTMP(PXRRXTMP,"STOIND","LOCATION")=""
14 E S LOCATION=0
15 ;
16 ;CSSCR is true if we want selected clinics.
17 I $P($G(PXRRLCSC),U,1)="CS" S CSSCR=1
18 E S CSSCR=0
19 ;
20 ;CLINIC is true if we want clinics instead of hospital locations.
21 I $P($G(PXRRLCSC),U,1)["C" D
22 . S CLINIC=1
23 . S BYCLOC=$S($P(PXRRLCSC,U,3):1,1:0)
24 E D
25 . S CLINIC=0
26 . S BYCLOC=0
27 ;
28 ;HSSCR is true if we want selected hospital locations.
29 I $P($G(PXRRLCSC),U,1)="HS" S HSSCR=1
30 E S HSSCR=0
31 ;
32 ;PROVIDER is true if we select by provider.
33 I $P($G(PXRRWLSC),U,1)="P" D
34 . S PROVIDER=1
35 . S ^XTMP(PXRRXTMP,"STOIND","PROVIDER")=""
36 E S PROVIDER=0
37 ;
38 ;PRVSCR is true if we have selected providers.
39 I $D(NPL) S PRVSCR=1
40 E S PRVSCR=0
41 ;
42 ;Allow the task to be cleaned up upon successful completion.
43 S ZTREQ="@"
44 Q
45 ;
46VISIT2 ; Migrated from PXRRWLSE
47 ;Clinic screen.
48 I CSSCR D
49 . S FOUND=0
50 . S CLINIEN=$P(VISIT,U,8)
51 . F IC=1:1:NCS I $P(PXRRCS(IC),U,2)=CLINIEN D Q
52 ..;Mark the clinic as being matched.
53 .. S $P(PXRRCS(IC),U,4)="M"
54 .. S HLOCNAM=$P(^DIC(40.7,CLINIEN,0),U,1)_U_CLINIEN
55 .. S FOUND=1
56 ;
57 ;Hospital location screen.
58 I HSSCR D
59 . S FOUND=0
60 . S HLOCIEN=$P(VISIT,U,22)
61 . F IC=1:1:NHL I $P(PXRRLCHL(IC),U,2)=HLOCIEN D Q
62 ..;Mark the hospital location as being matched.
63 .. S $P(PXRRLCHL(IC),U,4)="M"
64 .. S CLINIEN=$P(^SC(HLOCIEN,0),U,7)
65 .. S HLOCNAM=$P(^SC(HLOCIEN,0),U,1)_U_HLOCIEN
66 .. S FOUND=1
67 Q
68 ;
69PRV2 ; Migrated from PXRRWLSE
70 ;At this point we have an encounter that can be added to the list.
71 ;
72 ;Get the hospital location or clinic and stop code.
73 I $L(HLOCNAM)'>0 D
74 . I 'CLINIC D
75 .. ;Get the hospital location.
76 .. S HLOCIEN=$P(VISIT,U,22)
77 .. I HLOCIEN>0 D
78 ... S HLOCNAM=$P(^SC(HLOCIEN,0),U,1)_U_HLOCIEN
79 ... S CLINIEN=$P(^SC(HLOCIEN,0),U,7)
80 .. E D
81 ...;No hospital location, see if we can at least find the clinic.
82 ... S HLOCNAM="Unknown"
83 ... S CLINIEN=$P(VISIT,U,8)
84 . E D
85 .. ;Get the clinic.
86 .. S CLINIEN=$P(VISIT,U,8)
87 .. I CLINIEN="" S CLINIEN=0
88 .. I CLINIEN,$D(^DIC(40.7,CLINIEN,0))[0 S CLINIEN=0
89 .. I CLINIEN>0 S HLOCNAM=$P(^DIC(40.7,CLINIEN,0),U,1)_U_CLINIEN
90 .. E S HLOCNAM="Unknown"
91 ;
92 ;Append the clinic stop code.
93 I CLINIEN>0 S HLOCNAM=HLOCNAM_U_$P(^DIC(40.7,CLINIEN,0),U,2)
94 ;
95 I LOCATION S STOIND=HLOCNAM
96 ;Make sure that all providers are stored with the person class.
97 I PROVIDER D
98 . I $P(PPNAME,U,3)="" D
99 .. S PCLASS=$$OCCUP^PXBGPRV(NEWPIEN,BD,"",1,"")
100 .. S PPNAME=PPNAME_U_$P(PCLASS,U,7)
101 . S STOIND=PPNAME_U
102 . I PXRRPRLL S STOIND=STOIND_HLOCNAM
103 ;
104 ;Save the patient information.
105 S TEMP=^AUPNVSIT(VIEN,0)
106 S DATE=$P(TEMP,U,1)
107 S DAY=$P(DATE,".",1)
108 S DFN=$P(TEMP,U,5)
109 ;Get the patient status, 1 is in, 0 is out.
110 S INOUT=$P(VISIT150,U,2)
111 I $L(INOUT)=0 S INOUT=-1
112 Q
113 ;
114GC2 ; Migrated from PXRRWLSE
115 S CPT=$P(^AUPNVCPT(IC,0),U,1)
116 I +CPT'>0 D
117 . W !,"WARNING AUPNVCPT IS CORRUPTED! ENTRY ",IC," does not have a CPT code."
118 . S CPT=0
119 E D
120 . S EM=$P($G(^IBE(357.69,CPT,0)),U,5)
121 . I EM="" S EM=0
122 ;
123 ;Increment the CPT and E&M counts.
124 S ^XTMP(PXRRXTMP,FACILITY,STOIND,"CPT")=$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"CPT"))+1
125 S ^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EM)=$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EM))+1
126 ;Calculate totals by facility for multiple provider encounters.
127 I MULTPR=1 D
128 . D FTOT(FACILITY,"&&","CPT")
129 . D FTOT1(FACILITY,"&&","EM",EM)
130 Q
131 ;
132 ;Totals for multiple provider encounters - used in PXRRWLPR.
133FTOT(FL,FLD,FL1) ;
134 S ^XTMP(PXRRXTMP,FL,FLD,FL1)=$G(^XTMP(PXRRXTMP,FL,FLD,FL1))+1
135 Q
136FTOT1(FL,FLD,FL1,FL2) ;
137 S ^XTMP(PXRRXTMP,FL,FLD,FL1,FL2)=$G(^XTMP(PXRRXTMP,FL,FLD,FL1,FL2))+1
138 Q
139 ;
140NF2 ; Migrated from PXRRWLSE
141 ;Count the total unique patients and visits at the facility.
142 S TOTUNIQ=0
143 S TOTVIS=0
144 S VISITS(0)=0
145 S VISITS(1)=0
146 S DFN=0
147 F S DFN=$O(^TMP(PXRRXTMP,$J,FACILITY,"&","PATIENT",DFN)) Q:DFN="" D
148 . S TOTUNIQ=TOTUNIQ+1
149 . S DAY=""
150 . F S DAY=$O(^TMP(PXRRXTMP,$J,FACILITY,"&","PATIENT",DFN,DAY)) Q:DAY="" D
151 .. S TOTVIS=TOTVIS+1
152 .. S INOUT=-1
153 .. F S INOUT=$O(^TMP(PXRRXTMP,$J,FACILITY,"&","PATIENT",DFN,DAY,INOUT)) Q:INOUT="" D
154 ... S VISITS(INOUT)=VISITS(INOUT)+1
155 S ^XTMP(PXRRXTMP,FACILITY,"&","TOTUNIQ")=TOTUNIQ
156 S ^XTMP(PXRRXTMP,FACILITY,"&","TOTVIS")=TOTVIS
157 S ^XTMP(PXRRXTMP,FACILITY,"&","TOTINOUT",0)=VISITS(0)
158 S ^XTMP(PXRRXTMP,FACILITY,"&","TOTINOUT",1)=VISITS(1)
159 Q
160 ;
161CLOC2 ; Migrated from PXRRWLSE
162 ;Save this to count the total number of unique patients and
163 ;the total unique in/out patient encounters.
164 S ^TMP(PXRRXTMP,$J,FACILITY,"&","PATIENT",DFN,DAY,INOUT)=""
165 ;
166 ;Save this to count the unique in/out patient encounters.
167 S ^TMP(PXRRXTMP,$J,FACILITY,STOIND,"PATIENT",DFN,DAY,INOUT)=""
168 ;
169 ;Save this information so we can search for appointments in PXRRWLSA.
170 S ^XTMP(PXRRXTMP,FACILITY,STOIND,"PATIENT",DFN,DATE,VIEN)=MULTPR
171 ;
172 ;Increment the encounter count.
173 S ^XTMP(PXRRXTMP,FACILITY,STOIND,"TOTENC")=$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"TOTENC"))+1
174 ;
175 ;Calculate totals by facility for multiple provider encounters.
176 I MULTPR=1 D FTOT(FACILITY,"&&","TOTENC")
177 Q
Note: See TracBrowser for help on using the repository browser.