source: FOIAVistA/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUSUM5.m@ 738

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

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1PSUSUM5 ;BIR/DAM - Patient Demographics Summary for IV/UD ; 20 DEC 2001
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;
4EN ;EN CALLED FROM PSUUD0
5 ;
6 I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))!$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG3")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
7 I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV"))&$D(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD")) D Q ;Summary report if there is no data
8 .D NODATA
9 .I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG2")) K ^XTMP("PSU_"_PSUJOB,"PSUNONE")
10 ;
11 D DATE
12 S I=7 ;Line Counter
13 D UNIQUE
14 D DIV
15 D TOTAL
16 D TAB1^PSUSUM4
17 D PDSUM^PSUDEM5 ;Mail message
18 K ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")
19 K ^XTMP("PSU_"_PSUJOB,"PSUUDIN")
20 I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG2")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
21 K ^XTMP("PSU_"_PSUJOB,"PSUFIN")
22 K ^XTMP("PSU_"_PSUJOB,"PSUIVSSN")
23 K ^XTMP("PSU_"_PSUJOB,"PSUIVDIV")
24 K ^XTMP("PSU_"_PSUJOB,"PSUNEW")
25 K ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
26 K ^XTMP("PSU_"_PSUJOB,"PSUFLAG2")
27 K ^XTMP("PSU_"_PSUJOB,"PSUFLAG3")
28 K ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")
29 ;
30 K ^XTMP("PSU_"_PSUJOB,"PSURXCTA")
31 Q
32 ;
33DATE ;Convert date range of extract to external format
34 ;
35 D PULL^PSUCP
36 S %H=$E($H,1,5) ;today's date
37 D YX^%DTC
38 N PSUD S PSUD=Y
39 ;
40 S Y=PSUSDT
41 D DD^%DT
42 N PSUS S PSUS=Y
43 ;
44 S Y=PSUEDT
45 D DD^%DT
46 N PSUE S PSUE=Y
47 ;
48 D IVUDSUM
49 Q
50 ;
51IVUDSUM ;Summary report header
52 ;
53 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY INPATIENT (UD & IV) UNIQUE PATIENTS REPORT "_PSUD
54 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",2),"-",80)="" ;Separator bar
55 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)=" "_PSUS_" through "_PSUE
56 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",4),"=",80)=""
57 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",5)=" UNIQUE"
58 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",6),"-",70)=""
59 Q
60 ;
61UNIQUE ;Find Total unique patient number across all divisions
62 ;
63 N PSUSIT
64 S PSUSIT=PSUSNDR
65 ;
66 N PSUIPSUM,PSUOPSUM
67 I '$D(^XTMP("PSU_"_PSUJOB,"PSUIVIN")) S $P(^XTMP("PSU_"_PSUJOB,"PSUIVIN"),U,1)=0
68 I '$D(^XTMP("PSU_"_PSUJOB,"PSUUDIN")) S $P(^XTMP("PSU_"_PSUJOB,"PSUUDIN"),U,1)=0
69 I '$D(^XTMP("PSU_"_PSUJOB,"PSUIVOUT")) S $P(^XTMP("PSU_"_PSUJOB,"PSUIVOUT"),U,1)=0
70 ;
71 ;Create IP unique global. Screen out duplicates
72 M ^XTMP("PSU_"_PSUJOB,"PSUIPSUM")=^XTMP("PSU_"_PSUJOB,"PSUUDIN")
73 M ^XTMP("PSU_"_PSUJOB,"PSUIPSUM")=^XTMP("PSU_"_PSUJOB,"PSUIN")
74 ;
75 S N=1
76 S PSUSUM=0
77 F S PSUSUM=$O(^XTMP("PSU_"_PSUJOB,"PSUIPSUM",PSUSUM)) Q:PSUSUM="" D
78 .S PSUIPSUM=N S N=N+1
79 ;
80 S PSUOPSUM=$P($G(^XTMP("PSU_"_PSUJOB,"PSUIVOUT")),U,1)
81 D TAB
82 Q
83 ;
84TAB ;Calculate tab spacing
85 ;
86 N PSUTB2,PSUTB3,PSUTB4,PSUTB5
87 ;
88 S PSUTB1=" "
89 S PSUTB2="Total Inpatients across all divisions:"
90 S PSUTB3=(64-$L(PSUIPSUM))-$L(PSUTB2)
91 F S2=1:1:(PSUTB3-1) S PSUTB(S2)=" " D
92 .S PSUTB1=PSUTB1_PSUTB(S2)
93 ;
94 S PSUTB6=" "
95 S PSUTB4="Total Outpatients across all divisions:"
96 S PSUTB5=(64-$L(PSUOPSUM))-$L(PSUTB4)
97 F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D
98 .S PSUTB6=PSUTB6_PSUTB(S3)
99 D TOT
100 Q
101 ;
102TOT ;Set total number of unique in-patients and out-patients into
103 ;summary message
104 ;
105 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB2_PSUTB1_(PSUIPSUM) S I=I+1
106 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB6_(PSUOPSUM) S I=I+1
107 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+1
108 Q
109 ;
110DIV ;Set all divisions from both IV and UD extracts into one global
111 ;
112 M ^XTMP("PSU_"_PSUJOB,"PSUFIN")=^XTMP("PSU_"_PSUJOB,"PSUDIV1") ;IP division name/SSN
113 M ^XTMP("PSU_"_PSUJOB,"PSUFIN")=^XTMP("PSU_"_PSUJOB,"PSUDIVUD") ;UD division name/SSN
114 Q
115 S E=1 ;Counter for new global
116 S PSUZ=0
117 F S PSUZ=$O(^XTMP("PSU_"_PSUJOB,"PSUIVINDIV",PSUZ)) Q:PSUZ="" D
118 .S ^XTMP("PSU_"_PSUJOB,"PSUNEW",PSUZ,E)=$P($G(^XTMP("PSU_"_PSUJOB,"PSUIVINDIV",PSUZ)),U,1) ;IV
119 .S E=E+1
120 ;
121 S PSUZ1=0
122 F S PSUZ1=$O(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSUZ1)) Q:PSUZ1="" D
123 .S ^XTMP("PSU_"_PSUJOB,"PSUNEW",PSUZ1,E)=$P($G(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSUZ1)),U,1)
124 .S E=E+1
125 Q
126 ;
127 ;
128TOTAL ;Calculate sum of all divisions and set individual division lines
129 ;into summary message
130 ;
131 S T=1
132 S PSUDNAM=0
133 F S PSUDNAM=$O(^XTMP("PSU_"_PSUJOB,"PSUFIN",PSUDNAM)) Q:PSUDNAM="" D
134 .S PSUNUM1=0
135 .F S PSUNUM1=$O(^XTMP("PSU_"_PSUJOB,"PSUFIN",PSUDNAM,PSUNUM1)) Q:PSUNUM1="" D
136 ..S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=T S T=T+1 ;Set total count
137 ..I $D(^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM)) D
138 ...S C=C+1
139 ...S ^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM)=C
140 ..I '$D(^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM)) D
141 ...S C=1
142 ...S ^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM)=C
143 ;
144 S PSUDNAM1=0
145 N PSUSNUM
146 F S PSUDNAM1=$O(^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM1)) Q:PSUDNAM1="" D
147 .S PSUNUM=$P($G(^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM1)),U,1)
148 .D TAB1
149 .S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSUDNAM1_" Division:"_PSUTB6_PSUNUM
150 .S I=I+1
151 ;
152 Q
153 ;
154TAB1 ;Calculate tab spacing
155 ;
156 S PSUTB6=" "
157 S PSUTB7=(59-$L(PSUNUM))-$L(PSUDNAM1)-10
158 F S2=1:1:(PSUTB7-1) S PSUTB(S2)=" " D
159 .S PSUTB6=PSUTB6_PSUTB(S2) ;Tab position
160 Q
161 ;
162NODATA ;Summary report line to be sent if there is no data
163 ;
164 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY INPATIENT (UD & IV) UNIQUE PATIENTS REPORT"
165 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",2)=" "
166 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)="No data to report"
167 D PDSUM^PSUDEM5
168 Q
Note: See TracBrowser for help on using the repository browser.