source: FOIAVistA/trunk/r/DSS_EXTRACTS-ECX/ECXDVSN.m@ 686

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

initial load of FOIAVistA 6/30/08 version
File size: 9.5 KB
Line 
1ECXDVSN ;ALB/JAP - Division selection utility ; 8/13/07 1:11pm
2 ;;3.0;DSS EXTRACTS;**8,105**;Dec 22, 1997;Build 70
3ADM(ECXDIV,ECXALL,ECXSTART,ECXEND,ECXERR) ;division information for ADM extract audit report
4 ;selected inpatient divisions from medical center division file (#40.8)
5 ; input
6 ; ECXDIV = array of inpatient divisions selected (required)
7 ; passed by reference array containing
8 ; selected divisions;
9 ; ECXALL = 1/0 (optional)
10 ; 1==> user wants all inpatient divisions OR
11 ; facility is non-divisional
12 ; 0==> user wants to select some divisions
13 ; if ECXALL not defined, then assume 1
14 ; ECXSTART = start date of date range (optional)
15 ; ECXEND = end date of date range (optional)
16 ; ECXERR = passed by reference for error return (required)
17 ; output
18 ; ECXDIV = array of divisions selected from file #40.8;
19 ; if ECXALL=1, then array contains all divisions
20 ; if ECXALL=0, then array contains user-selected divisions
21 ; ECXDIV(ien in file #40.8) = ien in file #4^name^station number^primary indicator^active indicator^dss id
22 ; error CODE
23 ; ECXERR = 1, if input problem occurs
24 ; 0, otherwise
25 N OUT,DIC,X,Y,NM,ECXD,ECXIEN,ECXDIEN,ECXACT,ECXNAME,ECXNUM
26 S (OUT,ECXERR)=0
27 ;if start date or end date missing, then both default to today
28 I '$G(ECXSTART)!('$G(ECXEND)) S (ECXSTART,ECXEND)=DT
29 S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1
30 I ECXALL=1 D
31 .S NM="" F S NM=$O(^DG(40.8,"B",NM)) Q:NM="" S ECXIEN=$O(^(NM,"")) D
32 ..Q:+$P(^DG(40.8,ECXIEN,0),U,3)=1
33 ..K Y S DIC="^DG(40.8,",DIC(0)="NZ",X=ECXIEN D ^DIC
34 ..Q:Y=-1
35 ..S ECXNAME=$P(Y(0),U,1),ECXNUM=$P(Y(0),U,2),ECXDIEN=$P(Y(0),U,7)
36 ..S ECXDIV(ECXIEN)=ECXDIEN_U_ECXNAME_U_ECXNUM
37 ..D ACTDIV(ECXIEN,ECXSTART,ECXEND,.ECXD,.ECXACT)
38 ..S ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_ECXD_U_ECXACT
39 ..I $D(^ECX(727.3,ECXIEN)) D
40 ...S ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_$P($G(^ECX(727.3,ECXIEN,0)),U,2)
41 I ECXALL=0 F Q:OUT!ECXERR D
42 .K Y S DIC="^DG(40.8,",DIC(0)="AEMQZ",DIC("S")="I $P(^(0),U,3)'=1"
43 .D ^DIC I $G(DUOUT)!($G(DTOUT)) S OUT=1,ECXERR=1 Q
44 .I Y=-1,X="" S OUT=1 Q
45 .S ECXIEN=+Y,ECXNAME=$P(Y(0),U,1),ECXNUM=$P(Y(0),U,2),ECXDIEN=$P(Y(0),U,7)
46 .S ECXDIV(ECXIEN)=ECXDIEN_U_ECXNAME_U_ECXNUM
47 .D ACTDIV(ECXIEN,ECXSTART,ECXEND,.ECXD,.ECXACT)
48 .S ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_ECXD_U_ECXACT
49 .I $D(^ECX(727.3,ECXIEN)) D
50 ..S ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_$P($G(^ECX(727.3,ECXIEN,0)),U,2)
51 .I 'ECXACT W !!,?5,"Please note: Division "_ECXNUM_" was not active during",!,?5," selected date range.",!
52 I ECXERR=1 K ECXDIV
53 I '$D(ECXDIV) S ECXERR=1
54 Q
55ACTDIV(ECXIEN,ECXSTART,ECXEND,ECXD,ECXACT) ;determine if division active at anytime during date range
56 ;to be called by ADM^ECXDVSN
57 ; input
58 ; ECXIEN = ien in file #40.8; required
59 ; ECXSTART = start of date range; FM format; required
60 ; ECXEND = end of date range; FM format; required
61 ; output
62 ; ECXD = 1/0; passed by reference
63 ; 1 indicates primary division
64 ; ECXACT = 1/0; passed by reference
65 ; returns 0, if division not active during date range;
66 ; note: only start date and end date are checked; if division
67 ; inactive on both dates, then division assumed inactive
68 ; for entire date range
69 ;assume division active; set ecxact=1
70 S ECXACT=1
71 ;check if division active on start date or end date;
72 ;these dates are normally within the same month
73 F ECXDATE=ECXSTART,ECXEND D
74 .S DATE(ECXDATE)=$$SITE^VASITE(ECXDATE,ECXIEN)
75 .S ECXD=0
76 .I ECXIEN=$$PRIM^VASITE(ECXDATE) S ECXD=1
77 ;if not active on start date and not active on end date, reset ecxact=0
78 I DATE(ECXSTART)=-1,DATE(ECXEND)=-1 S ECXACT=0
79 Q
80MOV(ECXDIV,ECXALL,ECXSTART,ECXEND,ECXERR) ;division information for MOV extract audit report
81 ;selected divisions from medical center division file (#40.8)
82 ; input
83 ; (see ADM)
84 ; output
85 ; (see ADM)
86 D ADM^ECXDVSN(.ECXDIV,ECXALL,ECXSTART,ECXEND,.ECXERR)
87 Q
88PAS(ECXDIV,ECXALL,ECXERR) ;setup division/site information for PAS extract audit report
89 ; input
90 ; ECXDIV = passed by reference array variable
91 ; ECXALL = 1
92 ; output
93 ; ECXDIV = data for default division/site;
94 ; ECXDIV(1)=ien in file #4^name^station number
95 ; where the INSTITUTION file pointer is obtained from file #728
96 S ECXALL=1 D DEFAULT^ECXDVSN(.ECXDIV,ECXALL,.ECXERR)
97 Q
98TRT(ECXDIV,ECXALL,ECXERR) ;setup division/site information for TRT extract audit report
99 ; input
100 ; ECXDIV = passed by reference array variable
101 ; ECXALL = 1
102 ; output
103 ; ECXDIV = data for default division/site;
104 ; ECXDIV(1)=ien in file #4^name^station number
105 ; where the INSTITUTION file pointer is obtained from file #728
106 S ECXALL=1 D DEFAULT^ECXDVSN(.ECXDIV,ECXALL,.ECXERR)
107 Q
108DEFAULT(ECXDIV,ECXALL,ECXERR) ;default division/site information for audit report
109 ; input
110 ; ECXDIV = passed by reference array variable
111 ; ECXALL = 1
112 ; output
113 ; ECXDIV = data for default division/site;
114 ; ECXDIV(1)=ien in file #4^name^station number
115 ; where the INSTITUTION file pointer is obtained from file #728
116 N DIV,ECX
117 S ECXERR=0
118 S DIV=$P($G(^ECX(728,1,0)),U,1)
119 I DIV="" S ECXERR=1 Q
120 K ECX S DIC="^DIC(4,",DIQ(0)="I",DIQ="ECX",DA=DIV,DR=".01;99" D EN^DIQ1
121 I $D(ECX) S ECXDIV(1)=DIV_U_ECX(4,DIV,.01,"I")_U_ECX(4,DIV,99,"I")
122 I '$D(ECX) S ECXERR=1
123 I '$D(ECXDIV) S ECXERR=1
124 Q
125DEN(ECXDIV,ECXALL,ECXERR) ;setup division/site information for DEN extract audit report
126 ; input
127 ; ECXDIV = passed by reference array variable (required)
128 ; ECXALL = 0/1 (optional)
129 ; '0' indicates user to select dental division;
130 ; '1' indicates 'all' dental divisions or only one division
131 ; exists in file #225; default is '1'
132 ; output
133 ; ECXDIV = data for dental division/site;
134 ; ECXDIV(ien in file #225)=ien in file #4^name^station number
135 ; ECXERR = 0/1
136 ; if input problem, then '1' returned
137 N X,Y,DIC,DTOUT,DUOUT,DIRUT,OUT,ECXD,ECXIEN
138 S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1
139 S ECXERR=0,ECXD=""
140 ;if ecxall=1, then all dental divisions/sites
141 I ECXALL=1 D
142 .F S ECXD=$O(^DENT(225,"B",ECXD)) Q:ECXD="" S ECXIEN=$O(^(ECXD,"")) D
143 ..S $P(ECXDIV(ECXIEN),U,3)=ECXD S DIC="^DIC(4,",DIC(0)="MX",X=ECXD D ^DIC
144 ..S:+Y>0 ECXDIV(ECXIEN)=Y S:+Y=-1 ECXDIV(ECXIEN)=U
145 ..S ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_ECXD
146 ;if ecxall=0, user selects some/all dental divisions/sites
147 I ECXALL=0 S OUT=0 D
148 .F Q:OUT!ECXERR D
149 ..S DIC="^DENT(225,",DIC(0)="AEMQ" K X,Y D ^DIC
150 ..I $G(DUOUT)!($G(DTOUT)) S OUT=1,ECXERR=1 Q
151 ..I Y=-1,X="" S OUT=1 Q
152 ..S ECXIEN=+Y,ECXD=$P(Y,U,2) K X,Y
153 ..S DIC="^DIC(4,",DIC(0)="MX",X=ECXD D ^DIC
154 ..S:+Y>0 ECXDIV(ECXIEN)=Y S:+Y=-1 ECXDIV(ECXIEN)=U
155 ..S ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_ECXD
156 I ECXERR=1 K ECXDIV
157 I '$D(ECXDIV) S ECXERR=1
158 Q
159ECS(ECXDIV,ECXALL,ECXERR) ;setup division/location information for ECS extract audit report
160 ; input
161 ; ECXDIV = passed by reference array variable (required)
162 ; ECXALL = 0/1 (optional)
163 ; '0' indicates user to select EC location(s);
164 ; '1' indicates 'all' locations or only one location
165 ; exists in file #4 "LOC" index;
166 ; default is '1'
167 ; output
168 ; ECXDIV = data for EC location;
169 ; ECXDIV(ien in file #4)=ien in file #4^name^station number
170 ; where the INSTITUTION file pointer is obtained from
171 ; "LOC" index in file #4
172 ; ECXERR = 0/1
173 ; if input problem, then '1' returned
174 ;
175 N X,Y,I,DIC,DIR,DIRUT,DTOUT,DUOUT,NM,OUT,ECXD,ECXIEN,ECXLOC
176 S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1
177 S ECXERR=0,ECXD="",I=0
178 ;get all available ec locations in ecxloc array
179 F S ECXD=$O(^DIC(4,"LOC",ECXD)) Q:ECXD="" S I=I+1,ECXIEN=$O(^(ECXD,"")),ECXLOC(I)=ECXD_U_ECXIEN_U_$P($G(^DIC(4,ECXIEN,99)),U,1)
180 ;if ecxall=1, then all ec locations
181 I ECXALL=1 S I="" D Q
182 .F S I=$O(ECXLOC(I)) Q:I="" D
183 ..S ECXIEN=$P(ECXLOC(I),U,2)
184 ..S ECXDIV(ECXIEN)=ECXIEN_U_$P(ECXLOC(I),U,1)_U_$P(ECXLOC(I),U,3)
185 I ECXALL=0 S OUT=0,I=0 D
186 .W !!,"Event Capture Locations:",! S I=0,DIR(0)="SXO^"
187 .;spaces are embedded in dir(0) to prevent user from selecting by alpha characters in name
188 .F S I=$O(ECXLOC(I)) Q:I="" S NM=$P(ECXLOC(I),U,1) W !,?10,I_" ",NM S DIR(0)=DIR(0)_I_":"_"- "_NM_";"
189 .W !
190 .F Q:OUT!ECXERR D
191 ..S DIR("A")="Select Event Capture Location",DIR("S")="I +Y=Y"
192 ..D ^DIR
193 ..I $G(DTOUT)!($G(DUOUT)) S ECXERR=1 Q
194 ..I X="" D Q
195 ...I '$D(ECXDIV) W !!,"No Location selected...exiting.",! S OUT=1 Q
196 ...W !!,"You have selected the following Location(s):",!
197 ...S I=0 F S I=$O(ECXDIV(I)) Q:I="" W !,?10,$P(ECXDIV(I),U,2)_" ("_$P(ECXDIV(I),U,3)_")"
198 ...W ! K X,Y,DIR S DIR(0)="Y",DIR("A")="Is that ok",DIR("B")="YES" D ^DIR
199 ...I $D(DIRUT) S ECXERR=1
200 ...I Y=0 S ECXERR=1
201 ...S OUT=1
202 ..S ECXIEN=$P(ECXLOC(X),U,2)
203 ..S ECXDIV(ECXIEN)=ECXIEN_U_$P(ECXLOC(X),U,1)_U_$P(ECXLOC(X),U,3)
204 ;exit
205 I ECXERR=1 K ECXDIV
206 I '$D(ECXDIV) S ECXERR=1
207 Q
208NUT() ; Set Divisions into screen array (prompt is one/many/all)
209 ;Input : SCRNARR - Screen array full global reference
210 ;Output : 1 = OK 0 = User abort/timeout
211 ; @SCRNARR@("DIVISION") = User pick all divisions ?
212 ; 1 = Yes (all) 0 = No
213 ; @SCRNARR@("DIVISION",PtrDiv) = Division name
214 ;Note : @SCRNARR@("DIVISION") is initialized (KILLed) on input
215 ; : @SCRNARR@("DIVISION",PtrDiv) is only set when the user
216 ; picked individual divisions (i.e. didn't pick all)
217 ;
218 ;Declare variables
219 N VAUTD,Y,SCANARR
220 ;Get division selection
221 S DIC="^DIC(4,"
222 S VAUTSTR="PATIENT DIVISION"
223 S VAUTVB="SCANARR"
224 S VAUTNI=2
225 D FIRST^VAUTOMA
226 I Y<0 Q 1
227 M @SCRNARR@("DIVISION")=SCANARR
228 Q 0
Note: See TracBrowser for help on using the repository browser.