source: FOIAVistA/trunk/r/DSS_EXTRACTS-ECX/ECXDVSN2.m@ 1328

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

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1ECXDVSN2 ;ALB/JAP - Division selection utility (cont.) ; 5/11/04 3:29pm
2 ;;3.0;DSS EXTRACTS;**14,24,68**;Dec 22, 1997
3 ;
4RAD(ECXDIV,ECXALL,ECXERR) ;setup division/site information for RAD extract audit report
5 ; input
6 ; ECXDIV = passed by reference array variable (required)
7 ; ECXALL = 0/1 (optional)
8 ; '0' indicates user to select radiology division;
9 ; '1' indicates 'all' radiology divisions selected or only one division
10 ; exists in file #79; default is '1'
11 ; output
12 ; ECXDIV = data for radiology division/site;
13 ; ECXDIV(ien in file #79)=ien in file #4^name^station number
14 ; ECXERR = 0/1
15 ; if input problem, then '1' returned
16 N X,Y,DIC,DA,DUOUT,DTOUT,DR,DIQ,OUT,ECXARR,ECXD,ECXIEN
17 S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1
18 S ECXERR=0,ECXD=""
19 ;if ecxall=1, then all radiology divisions/sites are selected
20 I ECXALL=1 D
21 .;ecxd=ecxien; both are iens in file #4
22 .F S ECXD=$O(^RA(79,"B",ECXD)) Q:ECXD="" S ECXIEN=$O(^(ECXD,"")) D
23 ..K ECXARR S DA=ECXIEN,DIC="^DIC(4,",DR=".01;99",DIQ="ECXARR" D EN^DIQ1
24 ..I $D(ECXARR) S ECXDIV(ECXIEN)=ECXIEN_U_ECXARR(4,ECXIEN,.01)_U_ECXARR(4,ECXIEN,99)
25 ;if ecxall=0, user selects radiology divisions/sites
26 I ECXALL=0 S OUT=0 D
27 .F Q:OUT!ECXERR D
28 ..S DIC="^RA(79,",DIC(0)="AEMQ" K X,Y D ^DIC
29 ..I $G(DUOUT)!($G(DTOUT)) S OUT=1,ECXERR=1 Q
30 ..I Y=-1,X="" S OUT=1 Q
31 ..S (ECXIEN,DA)=+Y K ECXARR S DIC="^DIC(4,",DR=".01;99",DIQ="ECXARR" D EN^DIQ1
32 ..I $D(ECXARR) S ECXDIV(ECXIEN)=ECXIEN_U_ECXARR(4,ECXIEN,.01)_U_ECXARR(4,ECXIEN,99)
33 I ECXERR=1 K ECXDIV
34 I '$D(ECXDIV) S ECXERR=1
35 Q
36 ;
37MTL(ECXDIV,ECXALL,ECXERR) ;setup division/site information for MTL extract audit report
38 ; input
39 ; ECXDIV = passed by reference array variable (required)
40 ; ECXALL = 0/1 (optional)
41 ; '0' not valid; mental health is non-divisional
42 ; '1' indicates 'all' divisions selected or only one
43 ; exists in file #602; default is '1'
44 ; output
45 ; ECXDIV = data for site;
46 ; ECXDIV(ien in file #602)=name in file #602^ien in file #4^name in file #4^station number
47 ; ECXERR = 0/1
48 ; if error, then '1' returned; otherwise 0
49 N X,Y,DIC,DA,DR,DIQ,DATE,ECXARR,ECXIEN,SITE,DSITE,YSITE
50 S ECXALL=1
51 S ECXERR=0,ECXD=""
52 ;ecxall=0 is not valid; mental health application is non-divisional
53 ;ecxall=1; get mh site name from file #602
54 ;because mh site is free text, use dss site pointer to file #4
55 I ECXALL=1 D
56 .S X=$O(^YSA(602,"B",ECXD))
57 .I X="" S ECXERR=1 Q
58 .S ECXIEN=$O(^(X,""))
59 .K ECXARR S DA=ECXIEN,DIC="^YSA(602,",DR=".01",DIQ="ECXARR" D EN^DIQ1
60 .I '$D(ECXARR) S ECXERR=1 Q
61 .S YSITE=ECXARR(602,ECXIEN,.01)
62 .S DSSITE=$P($G(^ECX(728,1,0)),U)
63 .I 'DSSITE S ECXERR=1 Q
64 .K ECXARR S DA=DSSITE,DIC="^DIC(4,",DR=".01;99",DIQ="ECXARR" D EN^DIQ1
65 .S DATA=DSSITE_U_ECXARR(4,DSSITE,.01)_U_ECXARR(4,DSSITE,99)
66 .;name in file#602^file#4 pointer^name in file #4^station number with suffix
67 .S ECXDIV(ECXIEN)=YSITE_U_DATA
68 I ECXERR=1 K ECXDIV
69 I '$D(ECXDIV) S ECXERR=1
70 Q
71 ;
72SUR(ECXDIV,ECXALL,ECXERR) ;setup division/site information for SUR extract audit report
73 ; input
74 ; ECXDIV = passed by reference array variable (required)
75 ; ECXALL = 0/1 (optional)
76 ; '0' indicates user to select surgery division;
77 ; '1' indicates 'all' surgery divisions selected or only one division
78 ; exists in file #133; default is '1'
79 ; output
80 ; ECXDIV = data for surgery division/site;
81 ; ECXDIV(ien in file #133)=ien in file #4^name^station number
82 ; ECXERR = 0/1
83 ; if input problem, then '1' returned
84 N X,Y,DIC,DA,DUOUT,DTOUT,DR,DIQ,OUT,ECXARR,ECXD,ECXIEN
85 S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1
86 S ECXERR=0,ECXD=""
87 ;if ecxall=1, then all surgery divisions/sites are selected
88 I ECXALL=1 D
89 .F S ECXD=$O(^SRO(133,"B",ECXD)) Q:ECXD="" S ECXIEN=$O(^(ECXD,"")) D
90 ..K ECXARR S DA=ECXD,DIC="^DIC(4,",DR=".01;99",DIQ="ECXARR" D EN^DIQ1
91 ..I $D(ECXARR) S ECXDIV(ECXD)=ECXIEN_U_ECXARR(4,ECXD,.01)_U_ECXARR(4,ECXD,99)
92 ;if ecxall=0, user selects surgery divisions/sites
93 I ECXALL=0 S OUT=0 D
94 .F Q:OUT!ECXERR D
95 ..S DIC="^SRO(133,",DIC(0)="AEMQ",DIC("W")="I $P(^(0),U,21)=1 W ""**INACTIVE**""" K X,Y D ^DIC
96 ..I $G(DUOUT)!($G(DTOUT)) S OUT=1,ECXERR=1 Q
97 ..I Y=-1,X="" S OUT=1 Q
98 ..S ECXIEN=+Y,(ECXD,DA)=$P(Y,U,2) K ECXARR S DIC="^DIC(4,",DR=".01;99",DIQ="ECXARR" D EN^DIQ1
99 ..I $D(ECXARR) S ECXDIV(ECXD)=ECXIEN_U_ECXARR(4,ECXD,.01)_U_ECXARR(4,ECXD,99)
100 I ECXERR=1 K ECXDIV
101 I '$D(ECXDIV) S ECXERR=1
102 Q
103 ;
104PRO(ECXDUZ,ECXPRIME,ECXDIV,ECXALL,ECXERR) ;setup division/site information for PRO extract reports
105 ; input
106 ; ECXDUX = ien in file#200 for user
107 ; ECXPRIME = primary division ien in file #4 (required)
108 ; all other variables passed by reference
109 ; output
110 ; ECXALL = 0 (one subdivision)
111 ; 1 (all divisions related to primary division)
112 ; ECXDIV = data array for prosthetics division/site;
113 ; ECXDIV(n)=ien in file #4^name^station number
114 ; ECXERR = 0/1
115 ; if input problem, then '1' returned
116 N X,Y,DA,DR,DUOUT,DTOUT,DIRUT,DIC,DIQ,DIR,OUT,ECXARR
117 S ECXERR=0
118 I +ECXPRIME=0 S ECXERR=1
119 I '$D(^DIC(4,+ECXPRIME)) S ECXERR=1
120 D PDIV3^ECXPUTL(ECXDUZ,ECXPRIME,.ECXDIV)
121 I ECXDIV(1)=0 S ECXERR=1 Q
122 S ECXALL=1
123 S LAST=$O(ECXDIV(99),-1) I LAST>1 D
124 .W !!,"You may select ONE or ALL of the following:",!
125 .F DIV=1:1:LAST D
126 ..W !,"("_DIV_")",?6,$P(ECXDIV(DIV),U,2),?14,$P(ECXDIV(DIV),U,3)
127 .S DIR(0)="SMBA^A:ALL;O:ONE",DIR("A")="Select O(ne) or A(ll): ",DIR("B")="ALL"
128 .W ! K X,Y D ^DIR K DIR
129 .I $D(DUOUT)!($D(DTOUT)) K ECXDIV S OUT=1 Q
130 .Q:Y="A"
131 .S OUT=0 F D Q:OUT
132 ..S DIR(0)="NA^1:99:0",DIR("A")="Which one?: ",DIR("?")="^D HELP^ECXDVSN2"
133 ..W ! K X,Y D ^DIR K DIR
134 ..I $D(ECXDIV(+Y)) S DIV=+Y,OUT=1,ECXALL=0 Q
135 ..I $D(DUOUT)!($D(DTOUT)) K ECXDIV S OUT=1 Q
136 .Q:'$D(ECXDIV)
137 .F X=1:1:LAST I X'=DIV K ECXDIV(X)
138 I '$D(ECXDIV) S ECXERR=1
139 Q
140 ;
141HELP ;help for dir in pro
142 W !,"A response is required from the following:",!
143 F DIV=1:1:LAST D
144 .W !,"("_DIV_")",?6,$P(ECXDIV(DIV),U,2),?14,$P(ECXDIV(DIV),U,3)
145 W !,"Or ""^"" to exit."
146 Q
147 ;
148ALL(ECXDIV,ECXALL,ECXSTART,ECXEND,ECXERR) ;general purpose division information
149 ; input
150 ; ECXDIV = array of divisions selected (required)
151 ; passed by reference array to contain
152 ; selected divisions;
153 ; ECXALL = 1/0 (optional)
154 ; 1==> user wants all divisions OR
155 ; facility is non-divisional
156 ; 0==> user wants to select some divisions
157 ; if ECXALL not defined, then assume 1
158 ; ECXSTART = start date of date range (optional)
159 ; ECXEND = end date of date range (optional)
160 ; ECXERR = passed by reference for error return (required)
161 ; output
162 ; ECXDIV = array of divisions selected from file #40.8;
163 ; ECXDIV(ien in file #40.8) = ien in file #4^name^station number^primary indicator^active indicator^dss id
164 ; error CODE
165 ; ECXERR = 1, if input problem occurs
166 ; 0, otherwise
167 ;
168 N OUT,DIC,X,Y,NM,ECXD,ECXIEN,ECXDIEN,ECXACT,ECXNAME,ECXNUM
169 S (OUT,ECXERR)=0
170 ;if start date or end date missing, then both default to today
171 I '$G(ECXSTART)!('$G(ECXEND)) S (ECXSTART,ECXEND)=DT
172 S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1
173 I ECXALL=1 D
174 .S NM="" F S NM=$O(^DG(40.8,"B",NM)) Q:NM="" S ECXIEN=$O(^(NM,"")) D
175 ..K Y S DIC="^DG(40.8,",DIC(0)="NZ",X=ECXIEN D ^DIC
176 ..Q:Y=-1
177 ..S ECXNAME=$P(Y(0),U,1),ECXNUM=$P(Y(0),U,2),ECXDIEN=$P(Y(0),U,7)
178 ..S ECXDIV(ECXIEN)=ECXDIEN_U_ECXNAME_U_ECXNUM
179 ..D ACTDIV^ECXDVSN(ECXIEN,ECXSTART,ECXEND,.ECXD,.ECXACT)
180 ..S ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_ECXD_U_ECXACT
181 ..I $D(^ECX(727.3,ECXIEN)) D
182 ...S ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_$P($G(^ECX(727.3,ECXIEN,0)),U,2)
183 I ECXALL=0 F Q:OUT!ECXERR D
184 .K Y S DIC="^DG(40.8,",DIC(0)="AEMQZ"
185 .D ^DIC I $G(DUOUT)!($G(DTOUT)) S OUT=1,ECXERR=1 Q
186 .I Y=-1,X="" S OUT=1 Q
187 .S ECXIEN=+Y,ECXNAME=$P(Y(0),U,1),ECXNUM=$P(Y(0),U,2),ECXDIEN=$P(Y(0),U,7)
188 .S ECXDIV(ECXIEN)=ECXDIEN_U_ECXNAME_U_ECXNUM
189 .D ACTDIV^ECXDVSN(ECXIEN,ECXSTART,ECXEND,.ECXD,.ECXACT)
190 .S ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_ECXD_U_ECXACT
191 .I $D(^ECX(727.3,ECXIEN)) D
192 ..S ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_$P($G(^ECX(727.3,ECXIEN,0)),U,2)
193 .I 'ECXACT W !!,?5,"Please note: Division "_ECXNUM_" was not active during",!,?5," selected date range.",!
194 I ECXERR=1 K ECXDIV
195 I '$D(ECXDIV) S ECXERR=1
196 Q
Note: See TracBrowser for help on using the repository browser.