source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXRRPRSP.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.0 KB
RevLine 
[613]1PXRRPRSP ;ISL/PKR - Provider encounter summary print. ;6/03/97
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,18**;Aug 12, 1996
3 ;
4 N BMARG,C1S,C3S,C1HS,C2HS,C3HS,C3HSMAX,DONE,HEAD
5 N INDENT,MID,MEWPAGE,PAGE,PCLMAX,PNMAX
6 N CLASSNAM,DATE,DAY,DTOTAL,GTOTAL,HLOC
7 N FACILITY,FACPNAME,FTOTAL
8 N PCLASS,PNAME,PPNAME,PTOTAL
9 N 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 PCLMAX=^XTMP(PXRRXTMP,"PCLMAX")
18 S PNMAX=^XTMP(PXRRXTMP,"PNMAX")
19 S INDENT=3
20 S C1HS=INDENT
21 S C1S=INDENT
22 S C2HS=C1S+PNMAX+1
23 S C3HS=C2HS+PCLMAX+3
24 S C3HS=$$MAX^XLFMTH((C1HS+45),C3HS)
25 S C3HSMAX=C2HS+38
26 ;If C3HS>C3HSMAX set it to C3HSMAX+2 and wrap the Person Class entries.
27 I C3HS>C3HSMAX S C3HS=C3HSMAX+2
28 ;We assume that the counts will never be longer than six digits.
29 S MID=C3HS+6
30 ;
31 S (HEAD,PAGE)=1
32 S BMARG=2
33 S GTOTAL=0
34 D HDR^PXRRGPRT(PAGE)
35 W !!,"Criteria for Provider Encounter Summary Report"
36 D OPRCRIT^PXRRGPRT(3)
37 ;
38SET ;Set up print fields
39 S FACILITY=0
40FAC S FACILITY=$O(^XTMP(PXRRXTMP,FACILITY))
41 I +FACILITY=0 G FINAL
42 S FTOTAL=0
43 ;Mark the facility as being found.
44 F IC=1:1:NFAC I $P(PXRRFAC(IC),U,1)=FACILITY D Q
45 . S $P(PXRRFAC(IC),U,4)="M"
46 S FACPNAME=$P(PXRRFACN(FACILITY),U,1)_" "_$P(PXRRFACN(FACILITY),U,2)
47 S HEAD=1
48 D HEAD
49 ;
50 S PNAME=0
51PRV S PNAME=$O(^XTMP(PXRRXTMP,FACILITY,PNAME))
52 I PNAME="" D G FAC
53 . I $Y>(IOSL-BMARG-3) D
54 .. D PAGE^PXRRGPRT
55 .. I 'DONE W !!,"Facility: ",FACPNAME
56 . I 'DONE D
57 .. S TEMP="Total facility encounters "
58 .. D PTOTAL^PXRRGPRT(TEMP,FTOTAL,MID,1)
59 .. S GTOTAL=GTOTAL+FTOTAL
60 .. I $D(PXRRPECL) D CLASSNE^PXRRGPRT(INDENT)
61 I DONE G END
62 S PPNAME=$P(PNAME,U,1)
63 ;
64 ;Check for a user request to stop the task.
65 I $$S^%ZTLOAD S ZTSTOP=1 D EXIT^PXRRGUT
66 ;
67 S CLASSNAM=0
68CLASS ;
69 I DONE G END
70 S CLASSNAM=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM))
71 I CLASSNAM="" D G PRV
72 . K ^TMP(PXRRXTMP,$J,PNAME)
73 S VACODE=$P(CLASSNAM,U,2)
74 I $L(VACODE)>0 S PCLASS=$$OCCUP^PXBGPRV("","",VACODE,1)
75 E S PCLASS=-3
76 ;If were are doing selected person classes keep track of the ones we
77 ;found.
78 I $D(PXRRPECL) S TEMP=$$MATCH^PXRRPECU(PCLASS)
79 S DATE=0
80 ;
81DATE ;
82 S DTOTAL=0
83 S DATE=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE))
84 I DATE="" D G CLASS
85 .;Print the provider totals.
86 . D SPRINT(.PTOTAL)
87 . S FTOTAL=FTOTAL+PTOTAL
88 I DONE G END
89 ;
90 S HLOC=0
91HLO S HLOC=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE,HLOC))
92 I HLOC="" G DATE
93 ;
94 ;Build a ^TMP array of all the visits for the current provider.
95 S DAY=$P(DATE,".",1)
96 S VIEN=0
97 F S VIEN=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE,HLOC,VIEN)) Q:+VIEN=0 D
98 . S ^TMP(PXRRXTMP,$J,PNAME,DAY,HLOC,VIEN)=""
99 ;
100 G HLO
101 ;
102FINAL ;Print grand totals
103 S TEMP="Total encounters "
104 I $Y>(IOSL-BMARG-3) D
105 . D PAGE^PXRRGPRT
106 . I 'DONE W !
107 I 'DONE D
108 . D PTOTAL^PXRRGPRT(TEMP,GTOTAL,MID,0)
109 . D FACNE^PXRRGPRT(INDENT)
110END ;
111 D EXIT^PXRRGUT
112 D EOR^PXRRGUT
113 Q
114 ;
115 ;=======================================================================
116FMTPCL(PCL,START,END,PCL1,PCL2) ;Format the abbreviated Person Class, PCL so
117 ;that it fits between START and END. If it is too long break it into
118 ;two lines, PCL1 and PCL2.
119 N LBC,LEN,LPLUS,LSPACE,MAXLEN
120 S MAXLEN=END-START
121 S LEN=$L(PCL)
122 I LEN'>MAXLEN D Q
123 . S PCL1="("_PCL_")"
124 ;PCL is too long to fit on one line find a plus or a space to make the
125 ;break.
126 S LSPACE=$$LASTCHAR(PCL," ",MAXLEN)
127 S LPLUS=$$LASTCHAR(PCL,"+",MAXLEN)
128 S LBC=$$MAX^XLFMTH(LPLUS,LSPACE)
129 S PCL1="("_$E(PCL,1,LBC)
130 S PCL2=" "_$E(PCL,LBC+1,LEN)_")"
131 Q
132 ;
133 ;=======================================================================
134HEAD ;If necessary, write the header.
135 I HEAD D
136 . I $Y>(IOSL-BMARG-7) D PAGE^PXRRGPRT
137 . I DONE Q
138 . W !!,"Facility: ",FACPNAME
139 . W !!,?(C1HS+20),"Person Class"
140 . W !,?C1HS,"Provider (Occupation+Specialty+Subspecialty)",?C3HS,"Encounters"
141 . W !,?C1HS,"--------------------------------------------",?C3HS,"----------"
142 . S HEAD=0
143 Q
144 ;
145 ;=======================================================================
146LASTCHAR(STRING,CHAR,MAX) ;Return the position of the last character, CHAR, in
147 ;STRING ensuring that it is less than MAX.
148 ;Return 0 if there are none.
149 N IC0,IC1
150 S IC0=$F(STRING,CHAR)
151 I IC0=0 Q 0
152 F S IC1=$F(STRING,CHAR,IC0) Q:(IC1=0)!(IC1>MAX) D
153 . S IC0=IC1
154 Q IC0-1
155 ;
156 ;=======================================================================
157SPRINT(PTOTAL) ;Print the provider total and return the total.
158 N DAY,END,HLOC,PCL1,PCL2,TEMP,VACODE,VIEN
159 S PTOTAL=0
160 S DAY=0
161NDAY S DAY=$O(^TMP(PXRRXTMP,$J,PNAME,DAY))
162 I DAY="" D Q
163 .;No more DAYs to sum over print the total.
164 . I $Y>(IOSL-BMARG-1) D
165 .. D PAGE^PXRRGPRT
166 .. D HEAD
167 . I 'DONE D
168 .. S C3S=MID-$L(PTOTAL)
169 .. S VACODE=$P(CLASSNAM,U,2)
170 .. S TEMP=$$ABBRV^PXRRPECU(VACODE)
171 .. D FMTPCL(TEMP,C2HS,C3HSMAX,.PCL1,.PCL2)
172 .. W !,?C1S,PPNAME,?C2HS,PCL1,?C3S,PTOTAL
173 .. I $D(PCL2) W !,?C2HS,PCL2
174 I DONE Q
175 ;
176 S HLOC=""
177NHLOC S HLOC=$O(^TMP(PXRRXTMP,$J,PNAME,DAY,HLOC))
178 I HLOC="" G NDAY
179 ;
180 S VIEN=0
181NVIEN S VIEN=$O(^TMP(PXRRXTMP,$J,PNAME,DAY,HLOC,VIEN))
182 I VIEN="" G NHLOC
183 S PTOTAL=PTOTAL+1
184 G NVIEN
185 ;
Note: See TracBrowser for help on using the repository browser.