ECXDVSN2 ;ALB/JAP - Division selection utility (cont.) ; 5/11/04 3:29pm
;;3.0;DSS EXTRACTS;**14,24,68**;Dec 22, 1997
;
RAD(ECXDIV,ECXALL,ECXERR) ;setup division/site information for RAD extract audit report
; input
; ECXDIV = passed by reference array variable (required)
; ECXALL = 0/1 (optional)
; '0' indicates user to select radiology division;
; '1' indicates 'all' radiology divisions selected or only one division
; exists in file #79; default is '1'
; output
; ECXDIV = data for radiology division/site;
; ECXDIV(ien in file #79)=ien in file #4^name^station number
; ECXERR = 0/1
; if input problem, then '1' returned
N X,Y,DIC,DA,DUOUT,DTOUT,DR,DIQ,OUT,ECXARR,ECXD,ECXIEN
S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1
S ECXERR=0,ECXD=""
;if ecxall=1, then all radiology divisions/sites are selected
I ECXALL=1 D
.;ecxd=ecxien; both are iens in file #4
.F S ECXD=$O(^RA(79,"B",ECXD)) Q:ECXD="" S ECXIEN=$O(^(ECXD,"")) D
..K ECXARR S DA=ECXIEN,DIC="^DIC(4,",DR=".01;99",DIQ="ECXARR" D EN^DIQ1
..I $D(ECXARR) S ECXDIV(ECXIEN)=ECXIEN_U_ECXARR(4,ECXIEN,.01)_U_ECXARR(4,ECXIEN,99)
;if ecxall=0, user selects radiology divisions/sites
I ECXALL=0 S OUT=0 D
.F Q:OUT!ECXERR D
..S DIC="^RA(79,",DIC(0)="AEMQ" K X,Y D ^DIC
..I $G(DUOUT)!($G(DTOUT)) S OUT=1,ECXERR=1 Q
..I Y=-1,X="" S OUT=1 Q
..S (ECXIEN,DA)=+Y K ECXARR S DIC="^DIC(4,",DR=".01;99",DIQ="ECXARR" D EN^DIQ1
..I $D(ECXARR) S ECXDIV(ECXIEN)=ECXIEN_U_ECXARR(4,ECXIEN,.01)_U_ECXARR(4,ECXIEN,99)
I ECXERR=1 K ECXDIV
I '$D(ECXDIV) S ECXERR=1
Q
;
MTL(ECXDIV,ECXALL,ECXERR) ;setup division/site information for MTL extract audit report
; input
; ECXDIV = passed by reference array variable (required)
; ECXALL = 0/1 (optional)
; '0' not valid; mental health is non-divisional
; '1' indicates 'all' divisions selected or only one
; exists in file #602; default is '1'
; output
; ECXDIV = data for site;
; ECXDIV(ien in file #602)=name in file #602^ien in file #4^name in file #4^station number
; ECXERR = 0/1
; if error, then '1' returned; otherwise 0
N X,Y,DIC,DA,DR,DIQ,DATE,ECXARR,ECXIEN,SITE,DSITE,YSITE
S ECXALL=1
S ECXERR=0,ECXD=""
;ecxall=0 is not valid; mental health application is non-divisional
;ecxall=1; get mh site name from file #602
;because mh site is free text, use dss site pointer to file #4
I ECXALL=1 D
.S X=$O(^YSA(602,"B",ECXD))
.I X="" S ECXERR=1 Q
.S ECXIEN=$O(^(X,""))
.K ECXARR S DA=ECXIEN,DIC="^YSA(602,",DR=".01",DIQ="ECXARR" D EN^DIQ1
.I '$D(ECXARR) S ECXERR=1 Q
.S YSITE=ECXARR(602,ECXIEN,.01)
.S DSSITE=$P($G(^ECX(728,1,0)),U)
.I 'DSSITE S ECXERR=1 Q
.K ECXARR S DA=DSSITE,DIC="^DIC(4,",DR=".01;99",DIQ="ECXARR" D EN^DIQ1
.S DATA=DSSITE_U_ECXARR(4,DSSITE,.01)_U_ECXARR(4,DSSITE,99)
.;name in file#602^file#4 pointer^name in file #4^station number with suffix
.S ECXDIV(ECXIEN)=YSITE_U_DATA
I ECXERR=1 K ECXDIV
I '$D(ECXDIV) S ECXERR=1
Q
;
SUR(ECXDIV,ECXALL,ECXERR) ;setup division/site information for SUR extract audit report
; input
; ECXDIV = passed by reference array variable (required)
; ECXALL = 0/1 (optional)
; '0' indicates user to select surgery division;
; '1' indicates 'all' surgery divisions selected or only one division
; exists in file #133; default is '1'
; output
; ECXDIV = data for surgery division/site;
; ECXDIV(ien in file #133)=ien in file #4^name^station number
; ECXERR = 0/1
; if input problem, then '1' returned
N X,Y,DIC,DA,DUOUT,DTOUT,DR,DIQ,OUT,ECXARR,ECXD,ECXIEN
S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1
S ECXERR=0,ECXD=""
;if ecxall=1, then all surgery divisions/sites are selected
I ECXALL=1 D
.F S ECXD=$O(^SRO(133,"B",ECXD)) Q:ECXD="" S ECXIEN=$O(^(ECXD,"")) D
..K ECXARR S DA=ECXD,DIC="^DIC(4,",DR=".01;99",DIQ="ECXARR" D EN^DIQ1
..I $D(ECXARR) S ECXDIV(ECXD)=ECXIEN_U_ECXARR(4,ECXD,.01)_U_ECXARR(4,ECXD,99)
;if ecxall=0, user selects surgery divisions/sites
I ECXALL=0 S OUT=0 D
.F Q:OUT!ECXERR D
..S DIC="^SRO(133,",DIC(0)="AEMQ",DIC("W")="I $P(^(0),U,21)=1 W ""**INACTIVE**""" K X,Y D ^DIC
..I $G(DUOUT)!($G(DTOUT)) S OUT=1,ECXERR=1 Q
..I Y=-1,X="" S OUT=1 Q
..S ECXIEN=+Y,(ECXD,DA)=$P(Y,U,2) K ECXARR S DIC="^DIC(4,",DR=".01;99",DIQ="ECXARR" D EN^DIQ1
..I $D(ECXARR) S ECXDIV(ECXD)=ECXIEN_U_ECXARR(4,ECXD,.01)_U_ECXARR(4,ECXD,99)
I ECXERR=1 K ECXDIV
I '$D(ECXDIV) S ECXERR=1
Q
;
PRO(ECXDUZ,ECXPRIME,ECXDIV,ECXALL,ECXERR) ;setup division/site information for PRO extract reports
; input
; ECXDUX = ien in file#200 for user
; ECXPRIME = primary division ien in file #4 (required)
; all other variables passed by reference
; output
; ECXALL = 0 (one subdivision)
; 1 (all divisions related to primary division)
; ECXDIV = data array for prosthetics division/site;
; ECXDIV(n)=ien in file #4^name^station number
; ECXERR = 0/1
; if input problem, then '1' returned
N X,Y,DA,DR,DUOUT,DTOUT,DIRUT,DIC,DIQ,DIR,OUT,ECXARR
S ECXERR=0
I +ECXPRIME=0 S ECXERR=1
I '$D(^DIC(4,+ECXPRIME)) S ECXERR=1
D PDIV3^ECXPUTL(ECXDUZ,ECXPRIME,.ECXDIV)
I ECXDIV(1)=0 S ECXERR=1 Q
S ECXALL=1
S LAST=$O(ECXDIV(99),-1) I LAST>1 D
.W !!,"You may select ONE or ALL of the following:",!
.F DIV=1:1:LAST D
..W !,"("_DIV_")",?6,$P(ECXDIV(DIV),U,2),?14,$P(ECXDIV(DIV),U,3)
.S DIR(0)="SMBA^A:ALL;O:ONE",DIR("A")="Select O(ne) or A(ll): ",DIR("B")="ALL"
.W ! K X,Y D ^DIR K DIR
.I $D(DUOUT)!($D(DTOUT)) K ECXDIV S OUT=1 Q
.Q:Y="A"
.S OUT=0 F D Q:OUT
..S DIR(0)="NA^1:99:0",DIR("A")="Which one?: ",DIR("?")="^D HELP^ECXDVSN2"
..W ! K X,Y D ^DIR K DIR
..I $D(ECXDIV(+Y)) S DIV=+Y,OUT=1,ECXALL=0 Q
..I $D(DUOUT)!($D(DTOUT)) K ECXDIV S OUT=1 Q
.Q:'$D(ECXDIV)
.F X=1:1:LAST I X'=DIV K ECXDIV(X)
I '$D(ECXDIV) S ECXERR=1
Q
;
HELP ;help for dir in pro
W !,"A response is required from the following:",!
F DIV=1:1:LAST D
.W !,"("_DIV_")",?6,$P(ECXDIV(DIV),U,2),?14,$P(ECXDIV(DIV),U,3)
W !,"Or ""^"" to exit."
Q
;
ALL(ECXDIV,ECXALL,ECXSTART,ECXEND,ECXERR) ;general purpose division information
; input
; ECXDIV = array of divisions selected (required)
; passed by reference array to contain
; selected divisions;
; ECXALL = 1/0 (optional)
; 1==> user wants all divisions OR
; facility is non-divisional
; 0==> user wants to select some divisions
; if ECXALL not defined, then assume 1
; ECXSTART = start date of date range (optional)
; ECXEND = end date of date range (optional)
; ECXERR = passed by reference for error return (required)
; output
; ECXDIV = array of divisions selected from file #40.8;
; ECXDIV(ien in file #40.8) = ien in file #4^name^station number^primary indicator^active indicator^dss id
; error CODE
; ECXERR = 1, if input problem occurs
; 0, otherwise
;
N OUT,DIC,X,Y,NM,ECXD,ECXIEN,ECXDIEN,ECXACT,ECXNAME,ECXNUM
S (OUT,ECXERR)=0
;if start date or end date missing, then both default to today
I '$G(ECXSTART)!('$G(ECXEND)) S (ECXSTART,ECXEND)=DT
S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1
I ECXALL=1 D
.S NM="" F S NM=$O(^DG(40.8,"B",NM)) Q:NM="" S ECXIEN=$O(^(NM,"")) D
..K Y S DIC="^DG(40.8,",DIC(0)="NZ",X=ECXIEN D ^DIC
..Q:Y=-1
..S ECXNAME=$P(Y(0),U,1),ECXNUM=$P(Y(0),U,2),ECXDIEN=$P(Y(0),U,7)
..S ECXDIV(ECXIEN)=ECXDIEN_U_ECXNAME_U_ECXNUM
..D ACTDIV^ECXDVSN(ECXIEN,ECXSTART,ECXEND,.ECXD,.ECXACT)
..S ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_ECXD_U_ECXACT
..I $D(^ECX(727.3,ECXIEN)) D
...S ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_$P($G(^ECX(727.3,ECXIEN,0)),U,2)
I ECXALL=0 F Q:OUT!ECXERR D
.K Y S DIC="^DG(40.8,",DIC(0)="AEMQZ"
.D ^DIC I $G(DUOUT)!($G(DTOUT)) S OUT=1,ECXERR=1 Q
.I Y=-1,X="" S OUT=1 Q
.S ECXIEN=+Y,ECXNAME=$P(Y(0),U,1),ECXNUM=$P(Y(0),U,2),ECXDIEN=$P(Y(0),U,7)
.S ECXDIV(ECXIEN)=ECXDIEN_U_ECXNAME_U_ECXNUM
.D ACTDIV^ECXDVSN(ECXIEN,ECXSTART,ECXEND,.ECXD,.ECXACT)
.S ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_ECXD_U_ECXACT
.I $D(^ECX(727.3,ECXIEN)) D
..S ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_$P($G(^ECX(727.3,ECXIEN,0)),U,2)
.I 'ECXACT W !!,?5,"Please note: Division "_ECXNUM_" was not active during",!,?5," selected date range.",!
I ECXERR=1 K ECXDIV
I '$D(ECXDIV) S ECXERR=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXDVSN2 8563 printed Dec 13, 2024@01:52:33 Page 2
ECXDVSN2 ;ALB/JAP - Division selection utility (cont.) ; 5/11/04 3:29pm
+1 ;;3.0;DSS EXTRACTS;**14,24,68**;Dec 22, 1997
+2 ;
RAD(ECXDIV,ECXALL,ECXERR) ;setup division/site information for RAD extract audit report
+1 ; input
+2 ; ECXDIV = passed by reference array variable (required)
+3 ; ECXALL = 0/1 (optional)
+4 ; '0' indicates user to select radiology division;
+5 ; '1' indicates 'all' radiology divisions selected or only one division
+6 ; exists in file #79; default is '1'
+7 ; output
+8 ; ECXDIV = data for radiology division/site;
+9 ; ECXDIV(ien in file #79)=ien in file #4^name^station number
+10 ; ECXERR = 0/1
+11 ; if input problem, then '1' returned
+12 NEW X,Y,DIC,DA,DUOUT,DTOUT,DR,DIQ,OUT,ECXARR,ECXD,ECXIEN
+13 if '$DATA(ECXALL)
SET ECXALL=1
if ECXALL=""
SET ECXALL=1
+14 SET ECXERR=0
SET ECXD=""
+15 ;if ecxall=1, then all radiology divisions/sites are selected
+16 IF ECXALL=1
Begin DoDot:1
+17 ;ecxd=ecxien; both are iens in file #4
+18 FOR
SET ECXD=$ORDER(^RA(79,"B",ECXD))
if ECXD=""
QUIT
SET ECXIEN=$ORDER(^(ECXD,""))
Begin DoDot:2
+19 KILL ECXARR
SET DA=ECXIEN
SET DIC="^DIC(4,"
SET DR=".01;99"
SET DIQ="ECXARR"
DO EN^DIQ1
+20 IF $DATA(ECXARR)
SET ECXDIV(ECXIEN)=ECXIEN_U_ECXARR(4,ECXIEN,.01)_U_ECXARR(4,ECXIEN,99)
End DoDot:2
End DoDot:1
+21 ;if ecxall=0, user selects radiology divisions/sites
+22 IF ECXALL=0
SET OUT=0
Begin DoDot:1
+23 FOR
if OUT!ECXERR
QUIT
Begin DoDot:2
+24 SET DIC="^RA(79,"
SET DIC(0)="AEMQ"
KILL X,Y
DO ^DIC
+25 IF $GET(DUOUT)!($GET(DTOUT))
SET OUT=1
SET ECXERR=1
QUIT
+26 IF Y=-1
IF X=""
SET OUT=1
QUIT
+27 SET (ECXIEN,DA)=+Y
KILL ECXARR
SET DIC="^DIC(4,"
SET DR=".01;99"
SET DIQ="ECXARR"
DO EN^DIQ1
+28 IF $DATA(ECXARR)
SET ECXDIV(ECXIEN)=ECXIEN_U_ECXARR(4,ECXIEN,.01)_U_ECXARR(4,ECXIEN,99)
End DoDot:2
End DoDot:1
+29 IF ECXERR=1
KILL ECXDIV
+30 IF '$DATA(ECXDIV)
SET ECXERR=1
+31 QUIT
+32 ;
MTL(ECXDIV,ECXALL,ECXERR) ;setup division/site information for MTL extract audit report
+1 ; input
+2 ; ECXDIV = passed by reference array variable (required)
+3 ; ECXALL = 0/1 (optional)
+4 ; '0' not valid; mental health is non-divisional
+5 ; '1' indicates 'all' divisions selected or only one
+6 ; exists in file #602; default is '1'
+7 ; output
+8 ; ECXDIV = data for site;
+9 ; ECXDIV(ien in file #602)=name in file #602^ien in file #4^name in file #4^station number
+10 ; ECXERR = 0/1
+11 ; if error, then '1' returned; otherwise 0
+12 NEW X,Y,DIC,DA,DR,DIQ,DATE,ECXARR,ECXIEN,SITE,DSITE,YSITE
+13 SET ECXALL=1
+14 SET ECXERR=0
SET ECXD=""
+15 ;ecxall=0 is not valid; mental health application is non-divisional
+16 ;ecxall=1; get mh site name from file #602
+17 ;because mh site is free text, use dss site pointer to file #4
+18 IF ECXALL=1
Begin DoDot:1
+19 SET X=$ORDER(^YSA(602,"B",ECXD))
+20 IF X=""
SET ECXERR=1
QUIT
+21 SET ECXIEN=$ORDER(^(X,""))
+22 KILL ECXARR
SET DA=ECXIEN
SET DIC="^YSA(602,"
SET DR=".01"
SET DIQ="ECXARR"
DO EN^DIQ1
+23 IF '$DATA(ECXARR)
SET ECXERR=1
QUIT
+24 SET YSITE=ECXARR(602,ECXIEN,.01)
+25 SET DSSITE=$PIECE($GET(^ECX(728,1,0)),U)
+26 IF 'DSSITE
SET ECXERR=1
QUIT
+27 KILL ECXARR
SET DA=DSSITE
SET DIC="^DIC(4,"
SET DR=".01;99"
SET DIQ="ECXARR"
DO EN^DIQ1
+28 SET DATA=DSSITE_U_ECXARR(4,DSSITE,.01)_U_ECXARR(4,DSSITE,99)
+29 ;name in file#602^file#4 pointer^name in file #4^station number with suffix
+30 SET ECXDIV(ECXIEN)=YSITE_U_DATA
End DoDot:1
+31 IF ECXERR=1
KILL ECXDIV
+32 IF '$DATA(ECXDIV)
SET ECXERR=1
+33 QUIT
+34 ;
SUR(ECXDIV,ECXALL,ECXERR) ;setup division/site information for SUR extract audit report
+1 ; input
+2 ; ECXDIV = passed by reference array variable (required)
+3 ; ECXALL = 0/1 (optional)
+4 ; '0' indicates user to select surgery division;
+5 ; '1' indicates 'all' surgery divisions selected or only one division
+6 ; exists in file #133; default is '1'
+7 ; output
+8 ; ECXDIV = data for surgery division/site;
+9 ; ECXDIV(ien in file #133)=ien in file #4^name^station number
+10 ; ECXERR = 0/1
+11 ; if input problem, then '1' returned
+12 NEW X,Y,DIC,DA,DUOUT,DTOUT,DR,DIQ,OUT,ECXARR,ECXD,ECXIEN
+13 if '$DATA(ECXALL)
SET ECXALL=1
if ECXALL=""
SET ECXALL=1
+14 SET ECXERR=0
SET ECXD=""
+15 ;if ecxall=1, then all surgery divisions/sites are selected
+16 IF ECXALL=1
Begin DoDot:1
+17 FOR
SET ECXD=$ORDER(^SRO(133,"B",ECXD))
if ECXD=""
QUIT
SET ECXIEN=$ORDER(^(ECXD,""))
Begin DoDot:2
+18 KILL ECXARR
SET DA=ECXD
SET DIC="^DIC(4,"
SET DR=".01;99"
SET DIQ="ECXARR"
DO EN^DIQ1
+19 IF $DATA(ECXARR)
SET ECXDIV(ECXD)=ECXIEN_U_ECXARR(4,ECXD,.01)_U_ECXARR(4,ECXD,99)
End DoDot:2
End DoDot:1
+20 ;if ecxall=0, user selects surgery divisions/sites
+21 IF ECXALL=0
SET OUT=0
Begin DoDot:1
+22 FOR
if OUT!ECXERR
QUIT
Begin DoDot:2
+23 SET DIC="^SRO(133,"
SET DIC(0)="AEMQ"
SET DIC("W")="I $P(^(0),U,21)=1 W ""**INACTIVE**"""
KILL X,Y
DO ^DIC
+24 IF $GET(DUOUT)!($GET(DTOUT))
SET OUT=1
SET ECXERR=1
QUIT
+25 IF Y=-1
IF X=""
SET OUT=1
QUIT
+26 SET ECXIEN=+Y
SET (ECXD,DA)=$PIECE(Y,U,2)
KILL ECXARR
SET DIC="^DIC(4,"
SET DR=".01;99"
SET DIQ="ECXARR"
DO EN^DIQ1
+27 IF $DATA(ECXARR)
SET ECXDIV(ECXD)=ECXIEN_U_ECXARR(4,ECXD,.01)_U_ECXARR(4,ECXD,99)
End DoDot:2
End DoDot:1
+28 IF ECXERR=1
KILL ECXDIV
+29 IF '$DATA(ECXDIV)
SET ECXERR=1
+30 QUIT
+31 ;
PRO(ECXDUZ,ECXPRIME,ECXDIV,ECXALL,ECXERR) ;setup division/site information for PRO extract reports
+1 ; input
+2 ; ECXDUX = ien in file#200 for user
+3 ; ECXPRIME = primary division ien in file #4 (required)
+4 ; all other variables passed by reference
+5 ; output
+6 ; ECXALL = 0 (one subdivision)
+7 ; 1 (all divisions related to primary division)
+8 ; ECXDIV = data array for prosthetics division/site;
+9 ; ECXDIV(n)=ien in file #4^name^station number
+10 ; ECXERR = 0/1
+11 ; if input problem, then '1' returned
+12 NEW X,Y,DA,DR,DUOUT,DTOUT,DIRUT,DIC,DIQ,DIR,OUT,ECXARR
+13 SET ECXERR=0
+14 IF +ECXPRIME=0
SET ECXERR=1
+15 IF '$DATA(^DIC(4,+ECXPRIME))
SET ECXERR=1
+16 DO PDIV3^ECXPUTL(ECXDUZ,ECXPRIME,.ECXDIV)
+17 IF ECXDIV(1)=0
SET ECXERR=1
QUIT
+18 SET ECXALL=1
+19 SET LAST=$ORDER(ECXDIV(99),-1)
IF LAST>1
Begin DoDot:1
+20 WRITE !!,"You may select ONE or ALL of the following:",!
+21 FOR DIV=1:1:LAST
Begin DoDot:2
+22 WRITE !,"("_DIV_")",?6,$PIECE(ECXDIV(DIV),U,2),?14,$PIECE(ECXDIV(DIV),U,3)
End DoDot:2
+23 SET DIR(0)="SMBA^A:ALL;O:ONE"
SET DIR("A")="Select O(ne) or A(ll): "
SET DIR("B")="ALL"
+24 WRITE !
KILL X,Y
DO ^DIR
KILL DIR
+25 IF $DATA(DUOUT)!($DATA(DTOUT))
KILL ECXDIV
SET OUT=1
QUIT
+26 if Y="A"
QUIT
+27 SET OUT=0
FOR
Begin DoDot:2
+28 SET DIR(0)="NA^1:99:0"
SET DIR("A")="Which one?: "
SET DIR("?")="^D HELP^ECXDVSN2"
+29 WRITE !
KILL X,Y
DO ^DIR
KILL DIR
+30 IF $DATA(ECXDIV(+Y))
SET DIV=+Y
SET OUT=1
SET ECXALL=0
QUIT
+31 IF $DATA(DUOUT)!($DATA(DTOUT))
KILL ECXDIV
SET OUT=1
QUIT
End DoDot:2
if OUT
QUIT
+32 if '$DATA(ECXDIV)
QUIT
+33 FOR X=1:1:LAST
IF X'=DIV
KILL ECXDIV(X)
End DoDot:1
+34 IF '$DATA(ECXDIV)
SET ECXERR=1
+35 QUIT
+36 ;
HELP ;help for dir in pro
+1 WRITE !,"A response is required from the following:",!
+2 FOR DIV=1:1:LAST
Begin DoDot:1
+3 WRITE !,"("_DIV_")",?6,$PIECE(ECXDIV(DIV),U,2),?14,$PIECE(ECXDIV(DIV),U,3)
End DoDot:1
+4 WRITE !,"Or ""^"" to exit."
+5 QUIT
+6 ;
ALL(ECXDIV,ECXALL,ECXSTART,ECXEND,ECXERR) ;general purpose division information
+1 ; input
+2 ; ECXDIV = array of divisions selected (required)
+3 ; passed by reference array to contain
+4 ; selected divisions;
+5 ; ECXALL = 1/0 (optional)
+6 ; 1==> user wants all divisions OR
+7 ; facility is non-divisional
+8 ; 0==> user wants to select some divisions
+9 ; if ECXALL not defined, then assume 1
+10 ; ECXSTART = start date of date range (optional)
+11 ; ECXEND = end date of date range (optional)
+12 ; ECXERR = passed by reference for error return (required)
+13 ; output
+14 ; ECXDIV = array of divisions selected from file #40.8;
+15 ; ECXDIV(ien in file #40.8) = ien in file #4^name^station number^primary indicator^active indicator^dss id
+16 ; error CODE
+17 ; ECXERR = 1, if input problem occurs
+18 ; 0, otherwise
+19 ;
+20 NEW OUT,DIC,X,Y,NM,ECXD,ECXIEN,ECXDIEN,ECXACT,ECXNAME,ECXNUM
+21 SET (OUT,ECXERR)=0
+22 ;if start date or end date missing, then both default to today
+23 IF '$GET(ECXSTART)!('$GET(ECXEND))
SET (ECXSTART,ECXEND)=DT
+24 if '$DATA(ECXALL)
SET ECXALL=1
if ECXALL=""
SET ECXALL=1
+25 IF ECXALL=1
Begin DoDot:1
+26 SET NM=""
FOR
SET NM=$ORDER(^DG(40.8,"B",NM))
if NM=""
QUIT
SET ECXIEN=$ORDER(^(NM,""))
Begin DoDot:2
+27 KILL Y
SET DIC="^DG(40.8,"
SET DIC(0)="NZ"
SET X=ECXIEN
DO ^DIC
+28 if Y=-1
QUIT
+29 SET ECXNAME=$PIECE(Y(0),U,1)
SET ECXNUM=$PIECE(Y(0),U,2)
SET ECXDIEN=$PIECE(Y(0),U,7)
+30 SET ECXDIV(ECXIEN)=ECXDIEN_U_ECXNAME_U_ECXNUM
+31 DO ACTDIV^ECXDVSN(ECXIEN,ECXSTART,ECXEND,.ECXD,.ECXACT)
+32 SET ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_ECXD_U_ECXACT
+33 IF $DATA(^ECX(727.3,ECXIEN))
Begin DoDot:3
+34 SET ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_$PIECE($GET(^ECX(727.3,ECXIEN,0)),U,2)
End DoDot:3
End DoDot:2
End DoDot:1
+35 IF ECXALL=0
FOR
if OUT!ECXERR
QUIT
Begin DoDot:1
+36 KILL Y
SET DIC="^DG(40.8,"
SET DIC(0)="AEMQZ"
+37 DO ^DIC
IF $GET(DUOUT)!($GET(DTOUT))
SET OUT=1
SET ECXERR=1
QUIT
+38 IF Y=-1
IF X=""
SET OUT=1
QUIT
+39 SET ECXIEN=+Y
SET ECXNAME=$PIECE(Y(0),U,1)
SET ECXNUM=$PIECE(Y(0),U,2)
SET ECXDIEN=$PIECE(Y(0),U,7)
+40 SET ECXDIV(ECXIEN)=ECXDIEN_U_ECXNAME_U_ECXNUM
+41 DO ACTDIV^ECXDVSN(ECXIEN,ECXSTART,ECXEND,.ECXD,.ECXACT)
+42 SET ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_ECXD_U_ECXACT
+43 IF $DATA(^ECX(727.3,ECXIEN))
Begin DoDot:2
+44 SET ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_$PIECE($GET(^ECX(727.3,ECXIEN,0)),U,2)
End DoDot:2
+45 IF 'ECXACT
WRITE !!,?5,"Please note: Division "_ECXNUM_" was not active during",!,?5," selected date range.",!
End DoDot:1
+46 IF ECXERR=1
KILL ECXDIV
+47 IF '$DATA(ECXDIV)
SET ECXERR=1
+48 QUIT
