source: FOIAVistA/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUSUM2.m@ 866

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

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1PSUSUM2 ;BIR/DAM - Patient Demographics Summary for OP Extract ; 20 DEC 2001
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;
4 ;DBIA'S
5 ; Reference to File #59 supported by DBIA 1876
6 ;
7EN ;EN CALLED FROM PSUOP0
8 ;Q:$D(^XTMP("PSU_"_PSUJOB,"PSUMFLAG")) ;Do not run if auto extract
9 ;
10 D PULL^PSUCP
11 F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))=""
12 ;
13 I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","RX")) D Q ;Summary report if there is no data
14 .I '$D(PSUMOD(1))&'$D(PSUMOD(2)) D
15 ..D NODATA
16 ..I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG2")) K ^XTMP("PSU_"_PSUJOB,"PSUNONE")
17 ;
18 D DATE
19 D DIVNUM
20 D TOTAL
21 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" ---------" S I=I+1
22 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="" S I=I+1
23 D TAB1
24 I $D(PSUMOD(1))!$D(PSUMOD(2)) D
25 .M ^XTMP("PSU_"_PSUJOB,"PSURXCTA")=^XTMP("PSU_"_PSUJOB,"PSUCT")
26 .M ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")=^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
27 .S ^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE")=M-1
28 .M ^XTMP("PSU_"_PSUJOB,"PSURXSSN")=^XTMP("PSU_"_PSUJOB,"PSUSSN")
29 ;
30 I '$D(PSUMOD(1))&'$D(PSUMOD(2)) D
31 .D PDSUM^PSUDEM5 ;Mail message
32 K ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
33 K ^XTMP("PSU_"_PSUJOB,"PSUSSN")
34 K ^XTMP("PSU_"_PSUJOB,"PSUCT")
35 K ^XTMP("PSU_"_PSUJOB,"PSUDIV")
36 K ^XTMP("PSU_"_PSUJOB,"PSURX")
37 I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
38 K ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")
39 Q
40 ;
41DATE ;Convert date range of extract to external format
42 ;
43 S %H=$E($H,1,5) ;today's date
44 D YX^%DTC
45 N PSUD S PSUD=Y
46 ;
47 S Y=PSUSDT ;Start date of extract
48 D DD^%DT
49 N PSUS S PSUS=Y
50 ;
51 S Y=PSUEDT ;End date of extract
52 D DD^%DT
53 N PSUE S PSUE=Y
54 ;
55 D RXSUM
56 Q
57 ;
58RXSUM ;Summary report to be run if Rx (Outpatient) extract is run
59 ;
60 D UNIQUE
61 ;Report header
62 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY OUTPATIENT UNIQUE PATIENTS REPORT "_PSUD
63 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",2),"-",80)="" ;Separator bar
64 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)=" "_PSUS_" through "_PSUE
65 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",4),"=",80)=""
66 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",5)=" UNIQUE"
67 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",6),"-",70)=""
68 D TAB2
69 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",8),"-",70)=""
70 S I=9
71 ;
72 Q
73 ;
74TAB2 ;Tab spacing for line 7. Set line into global
75 ;
76 N PSUTB3,PSUTB4,PSUTB5
77 ;
78 S PSUTB3=" "
79 S PSUTB4="TOTAL Pharmacy patients across all divisions:"
80 S PSUTB5=(67-$L(PSUTB4))-$L($P(^XTMP("PSU_"_PSUJOB,"PSUUNIQUE"),U,1))
81 F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D
82 .S PSUTB3=PSUTB3_PSUTB(S3)
83 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",7)=PSUTB4_PSUTB3_$P(^XTMP("PSU_"_PSUJOB,"PSUUNIQUE"),U,1)
84 Q
85 ;
86UNIQUE ;Find UNIQUE patients across all divisions
87 ;
88 N PSUSIT,PSUTOTAL,PSUSOC1,PSUNIQUE,PSURX2,PSURX5
89 M ^XTMP("PSU_"_PSUJOB,"PSURX")=^XTMP(PSUOPSUB)
90 ;
91 S M=0
92 S N=1
93 S PSUSIT=0
94 S PSURX1=0
95 F S PSUSIT=$O(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT)) Q:'PSUSIT D
96 .F S PSURX1=$O(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT,PSURX1)) Q:'PSURX1 D
97 ..I $P($G(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT,PSURX1)),U,7)?9.10E D
98 ...;S PSUTOTAL=N
99 ...S PSUSOC1=$P($G(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT,PSURX1)),U,7)
100 ...I $G(PSUSOC1) S ^XTMP("PSU_"_PSUJOB,"PSUSSN",PSUSOC1)=""
101 ...S N=N+1
102 D ELIM
103 Q
104 ;
105ELIM ;Eliminate duplicate patient entries to get number of unique pts
106 ;
107 S PSUADM=0
108 F S PSUADM=$O(^XTMP("PSU_"_PSUJOB,"PSUSSN",PSUADM)) Q:'PSUADM D
109 .S $P(^XTMP("PSU_"_PSUJOB,"PSUUNIQUE"),U,1)=M
110 .S M=M+1
111 Q
112 ;
113DIVNUM ;Set number of patients per division into summary message
114 ;
115 ;Find patient SSN's in the following global and place with the division
116 ;number
117 N PSUPTID,PSUPL
118 S PSUDNUM=0
119 S C=1
120 F S PSUDNUM=$O(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUDNUM)) Q:PSUDNUM="" D
121 .S PSUPL=0
122 .F S PSUPL=$O(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUDNUM,PSUPL)) Q:PSUPL="" D
123 ..S PSUPTID=$P(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUDNUM,PSUPL),U,7)
124 ..Q:PSUPTID=""
125 ..S ^XTMP("PSU_"_PSUJOB,"PSUCT0",PSUDNUM,PSUPTID)=""
126 ;
127 ;Get patient count for each division
128 S PSUDNUM1=0
129 F S PSUDNUM1=$O(^XTMP("PSU_"_PSUJOB,"PSUCT0",PSUDNUM1)) Q:PSUDNUM1="" D
130 .S PSUID=0
131 .F S PSUID=$O(^XTMP("PSU_"_PSUJOB,"PSUCT0",PSUDNUM1,PSUID)) Q:PSUID="" D
132 ..I $D(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1)) D
133 ...S C=C+1
134 ...S ^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1)=C
135 ..I '$D(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1)) D
136 ...S C=1 S ^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1)=C
137 ;
138 ;Get division name
139 S PSUDIV=0
140 N PSUNBR
141 F S PSUDIV=$O(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDIV)) Q:PSUDIV="" D
142 .S PSUNBR=$P(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDIV),U,1)
143 .S X=PSUDIV,DIC=59,DIC(0)="XM" D ^DIC ;**1
144 .S X=+Y,PSUDIVNM=$$VAL^PSUTL(59,X,.01)
145 .I PSUDIVNM'="" S ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVNM)=PSUNBR
146 .I PSUDIVNM="" S ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIV)=PSUNBR
147 ;
148 N PSUTB1,PSUTB2
149 ;
150 N PSUCT2
151 S PSUDIVA1=0
152 F S PSUDIVA1=$O(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1)) Q:PSUDIVA1="" D
153 .S PSUCT2=$P(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1),U,1)
154 .D TAB
155 .S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSUDIVA1_" Division:"_PSUTB1_PSUCT2
156 .S I=I+1
157 Q
158 ;
159TAB ;Calculate tab spacing
160 ;
161 S PSUTB1=" "
162 S PSUTB2=(62-$L(PSUCT2))-$L(PSUDIVA1)-10
163 F S2=1:1:(PSUTB2-1) S PSUTB(S2)=" " D
164 .S PSUTB1=PSUTB1_PSUTB(S2) ;Tab position
165 Q
166 ;
167TOTAL ;Calculate Outpatient Total of all Divisions
168 ;
169 S PSUOPTOT=0
170 S PSUTOCT1=0
171 F S PSUOPTOT=$O(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUOPTOT)) Q:PSUOPTOT="" D
172 .S PSUTOCT=$P(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUOPTOT),U,1)
173 .S PSUTOCT1=PSUTOCT1+PSUTOCT
174 S $P(^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),U,1)=PSUTOCT1
175 Q
176 ;
177TAB1 ;Calculate tab spacing for 'Outpatient Total of all Divisions' line.
178 ;and set the last lines of message into the summary global.
179 ;
180 N PSUTB3,PSUTB4,PSUTB5
181 ;
182 S PSUTB3=" "
183 S PSUTB4=" Outpatient Total of all Divisions:"
184 S PSUTB5=(67-$L(PSUTB4))-$L($P(^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),U,1))
185 F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D
186 .S PSUTB3=PSUTB3_PSUTB(S3) ;Tab position
187 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1) S I=I+1
188 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="" S I=I+1
189 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="**PLEASE NOTE: Final TOTAL may not match sum of all SUBTOTALS. A patient may" S I=I+1
190 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="have been provided pharmacy services at more than one outpatient and/or" S I=I+1
191 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="inpatient division."
192 Q
193 ;
194NODATA ;Summary report line to be sent if there is no data
195 ;
196 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY OUTPATIENT UNIQUE PATIENTS REPORT"
197 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",2)=" "
198 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)="No data to report"
199 D PDSUM^PSUDEM5
200 Q
Note: See TracBrowser for help on using the repository browser.