Changeset 623 for WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXDVSN.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXDVSN.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXDVSN.m
r613 r623 1 ECXDVSN ;ALB/JAP - Division selection utility ; 8/13/07 1:11pm 2 ;;3.0;DSS EXTRACTS;**8,105**;Dec 22, 1997;Build 70 3 ADM(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 55 ACTDIV(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 80 MOV(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 88 PAS(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 98 TRT(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 108 DEFAULT(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 125 DEN(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 159 ECS(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 208 NUT() ; 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 1 ECXDVSN ;ALB/JAP - Division selection utility ;Sep 29, 1997 2 ;;3.0;DSS EXTRACTS;**8**;Dec 22, 1997 3 ; 4 ADM(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 ; 58 ACTDIV(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 ; 84 MOV(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 ; 94 PAS(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 ; 106 TRT(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 ; 118 DEFAULT(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 ; 137 DEN(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 ; 172 ECS(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 TracChangeset
for help on using the changeset viewer.
