- 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 Feb 18, 2025@23:18:57 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