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

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

initial load of WorldVistAEHR

File size: 5.1 KB
Line 
1PXRRPRDP ;ISL/PKR - Provider encounter detailed print. ;2/26/98
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,18,48**;Aug 12, 1996
3 ;
4 N BMARG,C1S,C2S,C3S,C1HS,C2HS,C3HS,DONE,INDENT,MID,PAGE
5 N CLASSNAM,CLINNAM
6 N DATE,DAY,DTOTAL,GTOTAL,HLOC,HLOCMAX,IC
7 N FACILITY,FACPNAME,FTOTAL
8 N OCC,NEWPIEN,PCLASS,PNAME,PPNAME,PTOTAL
9 N SPEC,SUBSPEC,TEMP,VACODE,VIEN
10 ;
11 ;Allow the task to be cleaned up upon successful completion.
12 S ZTREQ="@"
13 ;
14 U IO
15 S DONE=0
16 ;Setup the formatting parameters.
17 S HLOCMAX=^XTMP(PXRRXTMP,"HLOCMAX")
18 S INDENT=3
19 S C1HS=INDENT+4
20 S C2HS=INDENT+15
21 S C3HS=C2HS+45
22 ;We assume that the counts will never be longer than six digits.
23 S MID=C3HS+6
24 S C1S=C2HS+HLOCMAX+1
25 S C2S=C1S+7
26 ;
27 S PAGE=1
28 S GTOTAL=0
29 I ($E(IOST)="C")&(IO=IO(0)) S BMARG=3
30 E S BMARG=2
31 D HDR^PXRRGPRT(PAGE)
32 W !!,"Criteria for Provider Encounter Detailed Report"
33 D OPRCRIT^PXRRGPRT(3)
34 ;
35SET ;Set up print fields
36 S FACILITY=0
37FAC S FACILITY=$O(^XTMP(PXRRXTMP,FACILITY))
38 I +FACILITY=0 G FINAL
39 ;Mark the facility as being found.
40 F IC=1:1:NFAC I $P(PXRRFAC(IC),U,1)=FACILITY D Q
41 . S $P(PXRRFAC(IC),U,4)="M"
42 S FTOTAL=0
43 S FACPNAME=$P(PXRRFACN(FACILITY),U,1)_" "_$P(PXRRFACN(FACILITY),U,2)
44 S HAVEPRV=0
45 D HEAD(HAVEPRV)
46 ;
47 S PNAME=0
48PRV S PNAME=$O(^XTMP(PXRRXTMP,FACILITY,PNAME))
49 I PNAME="" D G FAC
50 . S TEMP="Total facility encounters "
51 . I $Y>(IOSL-BMARG-1) D HEAD(HAVEPRV)
52 . I 'DONE D
53 .. D PTOTAL^PXRRGPRT(TEMP,FTOTAL,MID,0)
54 .. S GTOTAL=GTOTAL+FTOTAL
55 .. I $D(PXRRPECL) D CLASSNE^PXRRGPRT(INDENT)
56 I DONE G END
57 S PPNAME=$P(PNAME,U,1)
58 S NEWPIEN=$P(PNAME,U,2)
59 ;
60 ;Check for a user request to stop the task.
61 I $$S^%ZTLOAD S ZTSTOP=1 D EXIT^PXRRGUT
62 ;
63 S CLASSNAM=0
64CLASS ;
65 I DONE G END
66 S CLASSNAM=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM))
67 I CLASSNAM="" D G PRV
68 . K ^TMP(PXRRXTMP,$J,PNAME)
69 S VACODE=$P(CLASSNAM,U,2)
70 I $L(VACODE)>0 D
71 . S PCLASS=$$OCCUP^PXBGPRV("","",VACODE,1)
72 . S OCCUP=$P(PCLASS,U,2)
73 . S SPEC=$P(PCLASS,U,3)
74 . S SUBSPEC=$P(PCLASS,U,4)
75 E D
76 . S PCLASS=-3
77 . S OCCUP="Unknown"
78 . S SPEC=""
79 . S SUBSPEC=""
80 ;If we are doing selected person classes keep track of the ones we
81 ;found.
82 I $D(PXRRPECL) S TEMP=$$MATCH^PXRRPECU(PCLASS)
83 S (DATE,PTOTAL)=0
84 I DONE G END
85 D PPRINT
86 S HAVEPRV=1
87 ;
88DATE ;
89 S DATE=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE))
90 I DATE="" D G CLASS
91 .;Print the daily totals and get the total count.
92 . D DPRINT(.PTOTAL)
93 . I 'DONE D
94 .. S TEMP="Total encounters for "_PPNAME_" "
95 .. I $Y>(IOSL-BMARG-3) D HEAD(HAVEPRV)
96 .. I 'DONE D
97 ... D PTOTAL^PXRRGPRT(TEMP,PTOTAL,MID,1)
98 ... S HAVEPRV=0
99 ... S FTOTAL=FTOTAL+PTOTAL
100 I DONE G END
101 ;
102 S HLOC=0
103HLO S HLOC=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE,HLOC))
104 I HLOC="" G DATE
105 ;
106 ;Build a ^TMP array of all the visits for the current provider.
107 S DAY=$P(DATE,".",1)
108 S VIEN=0
109 F S VIEN=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE,HLOC,VIEN)) Q:+VIEN=0 D
110 . S ^TMP(PXRRXTMP,$J,PNAME,DAY,HLOC,VIEN)=""
111 G HLO
112 ;
113FINAL ;Print grand totals.
114 I DONE G END
115 I GTOTAL>0 D
116 . S TEMP="Total encounters "
117 . I $Y>(IOSL-BMARG-3) D PAGE^PXRRGPRT
118 . I 'DONE D PTOTAL^PXRRGPRT(TEMP,GTOTAL,MID,0)
119 I DONE G END
120 ;Check for facilities that were listed but had no encounters.
121 D FACNE^PXRRGPRT(INDENT)
122END ;
123 D EXIT^PXRRGUT
124 D EOR^PXRRGUT
125 Q
126 ;
127 ;=======================================================================
128DPRINT(PTOTAL) ;Print the daily totals and return the total provider count.
129 N DAY,HLOC,HLOCNAM,NVISITS,SC,SCAT,VIEN,VISITS
130 S PTOTAL=0
131 S DAY=0
132NDAY S DAY=$O(^TMP(PXRRXTMP,$J,PNAME,DAY))
133 I DAY="" Q
134 ;
135 S HLOC=""
136NHLOC S HLOC=$O(^TMP(PXRRXTMP,$J,PNAME,DAY,HLOC))
137 S HLOCNAM=$P(HLOC,U,1)
138 S SC=$P(HLOC,U,3)
139 I HLOC="" G NDAY
140 ;
141 S NVISITS=0
142 K VISITS
143 S VIEN=0
144NVIEN S VIEN=$O(^TMP(PXRRXTMP,$J,PNAME,DAY,HLOC,VIEN))
145 I VIEN="" D G NHLOC
146 . S SCAT=$$SCAT(NVISITS,.VISITS)
147 . S PTOTAL=PTOTAL+NVISITS
148 . S C3S=MID-$L(NVISITS)
149 . I $Y>(IOSL-BMARG-3) D HEAD(HAVEPRV)
150 . I 'DONE D
151 .. W !,?INDENT,$$FMTE^XLFDT(DAY,"1D"),?C2HS,HLOCNAM
152 .. W ?C1S,SC,?C2S,SCAT,?C3S,NVISITS
153 I DONE Q
154 S NVISITS=NVISITS+1
155 S VISITS(NVISITS)=VIEN
156 G NVIEN
157 Q
158 ;
159 ;=======================================================================
160HEAD(HAVEPRV) ;Write the header.
161 N LEN,TEMP,VACODE
162 I $Y>(IOSL-BMARG-7) D PAGE^PXRRGPRT
163 I DONE Q
164 W !!,"Facility: ",FACPNAME
165 W !!,"Provider - Person Class"
166 W !,?C1HS,"Date",?C2HS,"Hos. Loc. (Stop Code) Serv. Cat.",?C3HS,"Encounters"
167 W !,?INDENT,"------------",?C2HS,"------------------------------------------",?C3HS,"----------"
168 I $G(HAVEPRV) W !,PPNAME," (continued)"
169 Q
170 ;
171 ;=======================================================================
172PPRINT ;Print the provider information.
173 I $Y>(IOSL-BMARG-4) D HEAD(HAVEPRV)
174 I DONE Q
175 S TEMP=PPNAME_" - "_OCCUP
176 S LEN=$L(TEMP)
177 I LEN>C3HS D
178 . W !,PPNAME," - "
179 . W !?3,OCCUP
180 . I $L(SPEC)>0 W !,?4,SPEC
181 . I $L(SUBSPEC)>0 W !,?5,SUBSPEC
182 E D
183 . W !,TEMP
184 . I $L(SPEC)>0 W !,?4,SPEC
185 . I $L(SUBSPEC)>0 W !,?5,SUBSPEC
186 W !
187 Q
188 ;
189 ;=======================================================================
190SCAT(NVISITS,VISITS) ;Given a list of VISIT IENS return the service categories.
191 ;
192 N IC,SCATL,VISIT
193 S SCATL=""
194 F IC=1:1:NVISITS D
195 . S VISIT=^AUPNVSIT(VISITS(IC),0)
196 . S SCATL=$$USTRINS^PXRRGUT(SCATL,$P(VISIT,U,7))
197 Q SCATL
198 ;
Note: See TracBrowser for help on using the repository browser.