[613] | 1 | ECXDVSN2 ;ALB/JAP - Division selection utility (cont.) ; 5/11/04 3:29pm
|
---|
| 2 | ;;3.0;DSS EXTRACTS;**14,24,68**;Dec 22, 1997
|
---|
| 3 | ;
|
---|
| 4 | RAD(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 | ;
|
---|
| 37 | MTL(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 | ;
|
---|
| 72 | SUR(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 | ;
|
---|
| 104 | PRO(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 | ;
|
---|
| 141 | HELP ;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 | ;
|
---|
| 148 | ALL(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
|
---|