source: FOIAVistA/tag/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUMAPR.m

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

initial load of FOIAVistA 6/30/08 version
File size: 6.0 KB
Line 
1PSUMAPR ;BHM/PDW-REPORT OF MAP OAU,NAOU,DA LOCATION TO DIVISION/OUTPATIENT SITES ; 9SEP2003
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;**7,9**;MARCH, 2005;Build 6
3 ;
4 ;DBIA's
5 ; Reference to file (#58.1) supported by DBIA 2515
6 ; Reference to file (#58.8) supported by DBIA 2519
7 ; Reference to file (#59.7) supported by DBIA 2854
8 ;
9EN ; select Editing or Report of Mapping
10 N C
11 K PG,LINE,LINE2
12 S PSQUIT=0,HDR="",$P(LINE,"=",79)="",$P(LINE2,"-",15)=""
13 D PGH
14AOU S HDR="AR/WS AOU" D PGH1
15 S C=0
16 S PSNM="" F S PSNM=$O(^PSI(58.1,"B",PSNM)) Q:PSNM="" D Q:PSQUIT
17 . S PSDA=0 F S PSDA=$O(^PSI(58.1,"B",PSNM,PSDA)) Q:PSDA'>0 D Q:PSQUIT
18 .. D BRK Q:PSQUIT
19 .. S C=C+1
20 .. W !,PSNM
21 .. S IEN=PSDA_",1",PSDIV=$$GET1^DIQ(59.79001,IEN,.02),PSOP=$$GET1^DIQ(59.79001,IEN,.03) W:$L(PSDIV) ?30,"Div: ",PSDIV W:$L(PSOP) ?30,"Op: ",PSOP
22 .. S PSINADT=$$GET1^DIQ(58.1,PSDA,3,"I") I PSINADT W ?60,$$FMTE^XLFDT(PSINADT,"D")
23 W !
24 D PG Q:PSQUIT
25 ;
26NAOU ;CS NAOU Drug Accountability 'Primary
27 Q:PSQUIT
28 S HDR="CS NAOU" D PGH1
29 S C=0
30 S PSNM="" F S PSNM=$O(^PSD(58.8,"B",PSNM)) Q:PSNM="" D Q:PSQUIT
31 . S PSDA=0 F S PSDA=$O(^PSD(58.8,"B",PSNM,PSDA)) Q:PSDA'>0 D
32 .. S PSN0=^PSD(58.8,PSDA,0),PSTYP=$P(PSN0,U,2),PSINADT=+$G(^PSD(58.8,PSDA,"I"))
33 .. I PSTYP="P" Q
34 .. D BRK Q:PSQUIT
35 .. S C=C+1
36 .. W !,PSNM
37 .. S IEN=PSDA_",1",PSDIV=$$GET1^DIQ(59.79002,IEN,.02),PSOP=$$GET1^DIQ(59.79002,IEN,.03) W:$L(PSDIV) ?30,"Div: ",PSDIV W:$L(PSOP) ?30,"Op: ",PSOP
38 .. S PSINADT=$$GET1^DIQ(58.8,PSDA,4,"I")
39 .. I PSINADT W ?60,$$FMTE^XLFDT(PSINADT,"D")
40 W !
41 D PG Q:PSQUIT
42 ;
43DRACC ;
44 Q:PSQUIT
45 S HDR="DRUG ACCOUNTABILITY"
46 D PGH1
47 S C=0
48 S PSNM="" F S PSNM=$O(^PSD(58.8,"B",PSNM)) Q:PSNM="" D Q:PSQUIT
49 . S PSDA=0 F S PSDA=$O(^PSD(58.8,"B",PSNM,PSDA)) Q:'PSDA D
50 .. S PSN0=^PSD(58.8,PSDA,0),PSTYP=$P(PSN0,U,2)
51 .. S PSINADT=+$G(^PSD(58.8,PSDA,"I"))
52 .. I PSTYP'="P" Q
53 .. D BRK Q:PSQUIT
54 .. S C=C+1
55 .. W !,PSNM
56 .. S IEN=PSDA_",1",PSDIV=$$GET1^DIQ(59.79003,IEN,.02),PSOP=$$GET1^DIQ(59.79003,IEN,.03) W:$L(PSDIV) ?30,"Div: ",PSDIV W:$L(PSOP) ?30,"Op: ",PSOP
57 .. S PSINADT=$$GET1^DIQ(58.8,PSDA,4,"I")
58 .. I PSINADT W ?60,$$FMTE^XLFDT(PSINADT,"D")
59 ;
60 I $E(IOST)="C" W !! K DIR S DIR(0)="EA",DIR("A")="Report Finished <cr>" D ^DIR
61 Q
62EN1 ;Scan for unmapped locations
63 ;Called from PSUOP0
64 ;
65 N PSULOC,PSULOC1,PSULOC2
66 S PSQUIT=0
67 D AOU1 ;Look for AR/WS AOU's
68 D NAOU1 ;Look for CS NAOU's
69 D DRACC1 ;Look for Drug Accountability Pharmacy Locations
70 D UNMAPD
71 D MAPD
72 Q
73 ;
74AOU1 ;Find AR/WS AOU's and set unmapped locations into AOU array
75 ;
76 S PSULOC=" AR/WS AOU's "
77 ;
78 K AOU
79 S PSNM="" F S PSNM=$O(^PSI(58.1,"B",PSNM)) Q:PSNM="" D Q:PSQUIT
80 .S PSDA=0 F S PSDA=$O(^PSI(58.1,"B",PSNM,PSDA)) Q:PSDA'>0 D
81 ..S IEN=PSDA_",1",PSDIV=$$GET1^DIQ(59.79001,IEN,.02)
82 ..S PSOP=$$GET1^DIQ(59.79001,IEN,.03)
83 ..I '$L(PSDIV),'$L(PSOP) S AOU(PSNM,PSDA)=$$GET1^DIQ(58.1,PSDA,3)
84 Q
85 ;
86NAOU1 ;Find Controlled Substances AOU's and set unmapped locations
87 ;into NAOU array
88 ;
89 S PSULOC1=" CS NAOUs "
90 ;
91 K NAOU
92 S PSNM="" F S PSNM=$O(^PSD(58.8,"B",PSNM)) Q:PSNM="" D Q:PSQUIT
93 .S PSDA=0
94 .F S PSDA=$O(^PSD(58.8,"B",PSNM,PSDA)) Q:PSDA'>0 D
95 ..S PSN0=^PSD(58.8,PSDA,0)
96 ..S PSTYP=$P(PSN0,U,2)
97 ..S PSINADT=+$G(^PSD(58.8,PSDA,"I"))
98 ..I PSTYP="P" Q
99 ..S IEN=PSDA_",1"
100 ..S PSDIV=$$GET1^DIQ(59.79002,IEN,.02)
101 ..S PSOP=$$GET1^DIQ(59.79002,IEN,.03)
102 ..I '$L(PSDIV),'$L(PSOP) S NAOU(PSNM,PSDA)=$$GET1^DIQ(58.8,PSDA,4)
103 Q
104 ;
105DRACC1 ;Find DA Pharmacy Locations and set unmapped locations into DRAC array
106 ;
107 S PSULOC2=" DA Pharmacy Locations "
108 ;
109 K DRAC
110 S PSNM="" F S PSNM=$O(^PSD(58.8,"B",PSNM)) Q:PSNM="" D Q:PSQUIT
111 .S PSDA=0
112 .F S PSDA=$O(^PSD(58.8,"B",PSNM,PSDA)) Q:'PSDA D
113 ..S PSN0=^PSD(58.8,PSDA,0),PSTYP=$P(PSN0,U,2)
114 ..S PSINADT=+$G(^PSD(58.8,PSDA,"I"))
115 ..I PSTYP'="P" Q
116 ..S IEN=PSDA_",1"
117 ..S PSDIV=$$GET1^DIQ(59.79003,IEN,.02)
118 ..S PSOP=$$GET1^DIQ(59.79003,IEN,.03)
119 ..I '$L(PSDIV),'$L(PSOP) S DRAC(PSNM,PSDA)=$$GET1^DIQ(58.8,PSDA,4)
120 Q
121 ;
122MAPD ;Display this if all locations are mapped
123 ;
124 I '$D(AOU),'$D(NAOU),'$D(DRAC) D Q
125 . W !!,?3,"All pharmacy dispensing/procurement locations are mapped.",!
126 Q
127 ;
128UNMAPD ;Display this if unmapped locations exist
129 ;
130 N C
131 W !
132 I $D(AOU) S PSNM="" D ;Unmapped AR/WS AOU's
133 .S C=0
134 .W !,?5,"The following"_PSULOC_"are not mapped:"
135 .W !
136 .F S PSNM=$O(AOU(PSNM)) Q:PSNM="" D Q:PSQUIT
137 ..S PSDA=0
138 ..F S PSDA=$O(AOU(PSNM,PSDA)) Q:PSDA'>0 D Q:PSQUIT
139 ...W !,?10,PSNM
140 ...I AOU(PSNM,PSDA)'="" W ?40,"**Inactive**"
141 ...D BRK Q:PSQUIT
142 ...I C=(IOSL-5) S C=0
143 ...S C=C+1
144 W !
145 D PG Q:PSQUIT
146 ;
147 I $D(NAOU) S PSNM="" D ;Unmapped CS NAOUs
148 .S C=0
149 .W !,?5,"The following"_PSULOC1_"are not mapped:"
150 .W !
151 .F S PSNM=$O(NAOU(PSNM)) Q:PSNM="" D Q:PSQUIT
152 ..S PSDA=0
153 ..F S PSDA=$O(NAOU(PSNM,PSDA)) Q:PSDA'>0 D Q:PSQUIT
154 ...W !,?10,PSNM
155 ...I NAOU(PSNM,PSDA)'="" W ?40,"**Inactive**"
156 ...D BRK Q:PSQUIT
157 ...I C=(IOSL-5) S C=0
158 ...S C=C+1
159 W !
160 D PG Q:PSQUIT
161 ;
162 I $D(DRAC) S PSNM="" D ;Unmapped DA Pharmacy Locations
163 .S C=0
164 .W !,?5,"The following"_PSULOC2_"are not mapped:"
165 .W !
166 .F S PSNM=$O(DRAC(PSNM)) Q:PSNM="" D Q:PSQUIT
167 ..S PSDA=0
168 ..F S PSDA=$O(DRAC(PSNM,PSDA)) Q:PSDA'>0 D Q:PSQUIT
169 ...W !,?10,PSNM
170 ...I DRAC(PSNM,PSDA)'="" W ?40,"**Inactive**"
171 ...D BRK Q:PSQUIT
172 ...I C=(IOSL-5) S C=0
173 ...S C=C+1
174 W !
175 D PG Q:PSQUIT
176 Q
177 ;
178BRK ;Page break. Occurs in the middle of a list
179 ;
180 I C=(IOSL-5) D
181 .W !
182 .K DIR I $E(IOST)="C" S DIR(0)="E" D ^DIR
183 .I $D(Y),Y=0 S PSQUIT=1 Q
184 .S PG=$G(PG)+1
185 .W @IOF
186 ;Q:$E(IOST,1,2)'="C-"!($D(IO("S")))
187 ;K DIR W !
188 ;S DIR(0)="E" D ^DIR K DIR
189 ;I 'Y S PSQUIT=1 Q
190 Q
191 ;
192PG ;Page break between headers
193 ;
194 K DIR I $E(IOST)="C" S DIR(0)="E" D ^DIR I Y=0 S PSQUIT=1 Q
195 S PG=$G(PG)+1
196 W @IOF
197 Q
198 ;
199PGH W @IOF
200 W !,"MAPPED/UNMAPPED LOCATIONS"
201 W ?30,$$FMTE^XLFDT(DT)
202 S PG=$G(PG)+1 W ?60,"PAGE: ",PG,!,LINE,!,"NAME",?30,"DIVISION/OUTPATIENT SITE",?60,"INACTIVE DATE"
203PGH1 I $L(HDR) W !!,$G(HDR),!,LINE2
204 Q
205PGB I $Y<(IOSL-4) S PSQUIT=1 Q
206PGHB W @IOF
207 W !,"UNMAPPED LOCATIONS"
208 W ?30,$$FMTE^XLFDT(DT)
209 S PG=$G(PG)+1 W ?60,"PAGE: ",PG,!,LINE,!,"NAME",?40,"INACTIVE DATE"
210PGH1B I $L(HDR) W !!,$G(HDR),!,LINE2
211 Q
Note: See TracBrowser for help on using the repository browser.