source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXDVSN.m@ 1800

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

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