| 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
|
|---|
