ECXDVSN ;ALB/JAP - Division selection utility ; 8/13/07 1:11pm
;;3.0;DSS EXTRACTS;**8,105**;Dec 22, 1997;Build 70
ADM(ECXDIV,ECXALL,ECXSTART,ECXEND,ECXERR) ;division information for ADM extract audit report
;selected inpatient divisions from medical center division file (#40.8)
; input
; ECXDIV = array of inpatient divisions selected (required)
; passed by reference array containing
; selected divisions;
; ECXALL = 1/0 (optional)
; 1==> user wants all inpatient 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;
; if ECXALL=1, then array contains all divisions
; if ECXALL=0, then array contains user-selected divisions
; 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
..Q:+$P(^DG(40.8,ECXIEN,0),U,3)=1
..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(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",DIC("S")="I $P(^(0),U,3)'=1"
.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(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
ACTDIV(ECXIEN,ECXSTART,ECXEND,ECXD,ECXACT) ;determine if division active at anytime during date range
;to be called by ADM^ECXDVSN
; input
; ECXIEN = ien in file #40.8; required
; ECXSTART = start of date range; FM format; required
; ECXEND = end of date range; FM format; required
; output
; ECXD = 1/0; passed by reference
; 1 indicates primary division
; ECXACT = 1/0; passed by reference
; returns 0, if division not active during date range;
; note: only start date and end date are checked; if division
; inactive on both dates, then division assumed inactive
; for entire date range
;assume division active; set ecxact=1
S ECXACT=1
;check if division active on start date or end date;
;these dates are normally within the same month
F ECXDATE=ECXSTART,ECXEND D
.S DATE(ECXDATE)=$$SITE^VASITE(ECXDATE,ECXIEN)
.S ECXD=0
.I ECXIEN=$$PRIM^VASITE(ECXDATE) S ECXD=1
;if not active on start date and not active on end date, reset ecxact=0
I DATE(ECXSTART)=-1,DATE(ECXEND)=-1 S ECXACT=0
Q
MOV(ECXDIV,ECXALL,ECXSTART,ECXEND,ECXERR) ;division information for MOV extract audit report
;selected divisions from medical center division file (#40.8)
; input
; (see ADM)
; output
; (see ADM)
D ADM^ECXDVSN(.ECXDIV,ECXALL,ECXSTART,ECXEND,.ECXERR)
Q
PAS(ECXDIV,ECXALL,ECXERR) ;setup division/site information for PAS extract audit report
; input
; ECXDIV = passed by reference array variable
; ECXALL = 1
; output
; ECXDIV = data for default division/site;
; ECXDIV(1)=ien in file #4^name^station number
; where the INSTITUTION file pointer is obtained from file #728
S ECXALL=1 D DEFAULT^ECXDVSN(.ECXDIV,ECXALL,.ECXERR)
Q
TRT(ECXDIV,ECXALL,ECXERR) ;setup division/site information for TRT extract audit report
; input
; ECXDIV = passed by reference array variable
; ECXALL = 1
; output
; ECXDIV = data for default division/site;
; ECXDIV(1)=ien in file #4^name^station number
; where the INSTITUTION file pointer is obtained from file #728
S ECXALL=1 D DEFAULT^ECXDVSN(.ECXDIV,ECXALL,.ECXERR)
Q
DEFAULT(ECXDIV,ECXALL,ECXERR) ;default division/site information for audit report
; input
; ECXDIV = passed by reference array variable
; ECXALL = 1
; output
; ECXDIV = data for default division/site;
; ECXDIV(1)=ien in file #4^name^station number
; where the INSTITUTION file pointer is obtained from file #728
N DIV,ECX
S ECXERR=0
S DIV=$P($G(^ECX(728,1,0)),U,1)
I DIV="" S ECXERR=1 Q
K ECX S DIC="^DIC(4,",DIQ(0)="I",DIQ="ECX",DA=DIV,DR=".01;99" D EN^DIQ1
I $D(ECX) S ECXDIV(1)=DIV_U_ECX(4,DIV,.01,"I")_U_ECX(4,DIV,99,"I")
I '$D(ECX) S ECXERR=1
I '$D(ECXDIV) S ECXERR=1
Q
DEN(ECXDIV,ECXALL,ECXERR) ;setup division/site information for DEN extract audit report
; input
; ECXDIV = passed by reference array variable (required)
; ECXALL = 0/1 (optional)
; '0' indicates user to select dental division;
; '1' indicates 'all' dental divisions or only one division
; exists in file #225; default is '1'
; output
; ECXDIV = data for dental division/site;
; ECXDIV(ien in file #225)=ien in file #4^name^station number
; ECXERR = 0/1
; if input problem, then '1' returned
N X,Y,DIC,DTOUT,DUOUT,DIRUT,OUT,ECXD,ECXIEN
S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1
S ECXERR=0,ECXD=""
;if ecxall=1, then all dental divisions/sites
I ECXALL=1 D
.F S ECXD=$O(^DENT(225,"B",ECXD)) Q:ECXD="" S ECXIEN=$O(^(ECXD,"")) D
..S $P(ECXDIV(ECXIEN),U,3)=ECXD S DIC="^DIC(4,",DIC(0)="MX",X=ECXD D ^DIC
..S:+Y>0 ECXDIV(ECXIEN)=Y S:+Y=-1 ECXDIV(ECXIEN)=U
..S ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_ECXD
;if ecxall=0, user selects some/all dental divisions/sites
I ECXALL=0 S OUT=0 D
.F Q:OUT!ECXERR D
..S DIC="^DENT(225,",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=+Y,ECXD=$P(Y,U,2) K X,Y
..S DIC="^DIC(4,",DIC(0)="MX",X=ECXD D ^DIC
..S:+Y>0 ECXDIV(ECXIEN)=Y S:+Y=-1 ECXDIV(ECXIEN)=U
..S ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_ECXD
I ECXERR=1 K ECXDIV
I '$D(ECXDIV) S ECXERR=1
Q
ECS(ECXDIV,ECXALL,ECXERR) ;setup division/location information for ECS extract audit report
; input
; ECXDIV = passed by reference array variable (required)
; ECXALL = 0/1 (optional)
; '0' indicates user to select EC location(s);
; '1' indicates 'all' locations or only one location
; exists in file #4 "LOC" index;
; default is '1'
; output
; ECXDIV = data for EC location;
; ECXDIV(ien in file #4)=ien in file #4^name^station number
; where the INSTITUTION file pointer is obtained from
; "LOC" index in file #4
; ECXERR = 0/1
; if input problem, then '1' returned
;
N X,Y,I,DIC,DIR,DIRUT,DTOUT,DUOUT,NM,OUT,ECXD,ECXIEN,ECXLOC
S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1
S ECXERR=0,ECXD="",I=0
;get all available ec locations in ecxloc array
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)
;if ecxall=1, then all ec locations
I ECXALL=1 S I="" D Q
.F S I=$O(ECXLOC(I)) Q:I="" D
..S ECXIEN=$P(ECXLOC(I),U,2)
..S ECXDIV(ECXIEN)=ECXIEN_U_$P(ECXLOC(I),U,1)_U_$P(ECXLOC(I),U,3)
I ECXALL=0 S OUT=0,I=0 D
.W !!,"Event Capture Locations:",! S I=0,DIR(0)="SXO^"
.;spaces are embedded in dir(0) to prevent user from selecting by alpha characters in name
.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_";"
.W !
.F Q:OUT!ECXERR D
..S DIR("A")="Select Event Capture Location",DIR("S")="I +Y=Y"
..D ^DIR
..I $G(DTOUT)!($G(DUOUT)) S ECXERR=1 Q
..I X="" D Q
...I '$D(ECXDIV) W !!,"No Location selected...exiting.",! S OUT=1 Q
...W !!,"You have selected the following Location(s):",!
...S I=0 F S I=$O(ECXDIV(I)) Q:I="" W !,?10,$P(ECXDIV(I),U,2)_" ("_$P(ECXDIV(I),U,3)_")"
...W ! K X,Y,DIR S DIR(0)="Y",DIR("A")="Is that ok",DIR("B")="YES" D ^DIR
...I $D(DIRUT) S ECXERR=1
...I Y=0 S ECXERR=1
...S OUT=1
..S ECXIEN=$P(ECXLOC(X),U,2)
..S ECXDIV(ECXIEN)=ECXIEN_U_$P(ECXLOC(X),U,1)_U_$P(ECXLOC(X),U,3)
;exit
I ECXERR=1 K ECXDIV
I '$D(ECXDIV) S ECXERR=1
Q
NUT() ; Set Divisions into screen array (prompt is one/many/all)
;Input : SCRNARR - Screen array full global reference
;Output : 1 = OK 0 = User abort/timeout
; @SCRNARR@("DIVISION") = User pick all divisions ?
; 1 = Yes (all) 0 = No
; @SCRNARR@("DIVISION",PtrDiv) = Division name
;Note : @SCRNARR@("DIVISION") is initialized (KILLed) on input
; : @SCRNARR@("DIVISION",PtrDiv) is only set when the user
; picked individual divisions (i.e. didn't pick all)
;
;Declare variables
N VAUTD,Y,SCANARR
;Get division selection
S DIC="^DIC(4,"
S VAUTSTR="PATIENT DIVISION"
S VAUTVB="SCANARR"
S VAUTNI=2
D FIRST^VAUTOMA
I Y<0 Q 1
M @SCRNARR@("DIVISION")=SCANARR
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXDVSN 9996 printed Dec 13, 2024@01:52:31 Page 2
ECXDVSN ;ALB/JAP - Division selection utility ; 8/13/07 1:11pm
+1 ;;3.0;DSS EXTRACTS;**8,105**;Dec 22, 1997;Build 70
ADM(ECXDIV,ECXALL,ECXSTART,ECXEND,ECXERR) ;division information for ADM extract audit report
+1 ;selected inpatient divisions from medical center division file (#40.8)
+2 ; input
+3 ; ECXDIV = array of inpatient divisions selected (required)
+4 ; passed by reference array containing
+5 ; selected divisions;
+6 ; ECXALL = 1/0 (optional)
+7 ; 1==> user wants all inpatient divisions OR
+8 ; facility is non-divisional
+9 ; 0==> user wants to select some divisions
+10 ; if ECXALL not defined, then assume 1
+11 ; ECXSTART = start date of date range (optional)
+12 ; ECXEND = end date of date range (optional)
+13 ; ECXERR = passed by reference for error return (required)
+14 ; output
+15 ; ECXDIV = array of divisions selected from file #40.8;
+16 ; if ECXALL=1, then array contains all divisions
+17 ; if ECXALL=0, then array contains user-selected divisions
+18 ; ECXDIV(ien in file #40.8) = ien in file #4^name^station number^primary indicator^active indicator^dss id
+19 ; error CODE
+20 ; ECXERR = 1, if input problem occurs
+21 ; 0, otherwise
+22 NEW OUT,DIC,X,Y,NM,ECXD,ECXIEN,ECXDIEN,ECXACT,ECXNAME,ECXNUM
+23 SET (OUT,ECXERR)=0
+24 ;if start date or end date missing, then both default to today
+25 IF '$GET(ECXSTART)!('$GET(ECXEND))
SET (ECXSTART,ECXEND)=DT
+26 if '$DATA(ECXALL)
SET ECXALL=1
if ECXALL=""
SET ECXALL=1
+27 IF ECXALL=1
Begin DoDot:1
+28 SET NM=""
FOR
SET NM=$ORDER(^DG(40.8,"B",NM))
if NM=""
QUIT
SET ECXIEN=$ORDER(^(NM,""))
Begin DoDot:2
+29 if +$PIECE(^DG(40.8,ECXIEN,0),U,3)=1
QUIT
+30 KILL Y
SET DIC="^DG(40.8,"
SET DIC(0)="NZ"
SET X=ECXIEN
DO ^DIC
+31 if Y=-1
QUIT
+32 SET ECXNAME=$PIECE(Y(0),U,1)
SET ECXNUM=$PIECE(Y(0),U,2)
SET ECXDIEN=$PIECE(Y(0),U,7)
+33 SET ECXDIV(ECXIEN)=ECXDIEN_U_ECXNAME_U_ECXNUM
+34 DO ACTDIV(ECXIEN,ECXSTART,ECXEND,.ECXD,.ECXACT)
+35 SET ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_ECXD_U_ECXACT
+36 IF $DATA(^ECX(727.3,ECXIEN))
Begin DoDot:3
+37 SET ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_$PIECE($GET(^ECX(727.3,ECXIEN,0)),U,2)
End DoDot:3
End DoDot:2
End DoDot:1
+38 IF ECXALL=0
FOR
if OUT!ECXERR
QUIT
Begin DoDot:1
+39 KILL Y
SET DIC="^DG(40.8,"
SET DIC(0)="AEMQZ"
SET DIC("S")="I $P(^(0),U,3)'=1"
+40 DO ^DIC
IF $GET(DUOUT)!($GET(DTOUT))
SET OUT=1
SET ECXERR=1
QUIT
+41 IF Y=-1
IF X=""
SET OUT=1
QUIT
+42 SET ECXIEN=+Y
SET ECXNAME=$PIECE(Y(0),U,1)
SET ECXNUM=$PIECE(Y(0),U,2)
SET ECXDIEN=$PIECE(Y(0),U,7)
+43 SET ECXDIV(ECXIEN)=ECXDIEN_U_ECXNAME_U_ECXNUM
+44 DO ACTDIV(ECXIEN,ECXSTART,ECXEND,.ECXD,.ECXACT)
+45 SET ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_ECXD_U_ECXACT
+46 IF $DATA(^ECX(727.3,ECXIEN))
Begin DoDot:2
+47 SET ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_$PIECE($GET(^ECX(727.3,ECXIEN,0)),U,2)
End DoDot:2
+48 IF 'ECXACT
WRITE !!,?5,"Please note: Division "_ECXNUM_" was not active during",!,?5," selected date range.",!
End DoDot:1
+49 IF ECXERR=1
KILL ECXDIV
+50 IF '$DATA(ECXDIV)
SET ECXERR=1
+51 QUIT
ACTDIV(ECXIEN,ECXSTART,ECXEND,ECXD,ECXACT) ;determine if division active at anytime during date range
+1 ;to be called by ADM^ECXDVSN
+2 ; input
+3 ; ECXIEN = ien in file #40.8; required
+4 ; ECXSTART = start of date range; FM format; required
+5 ; ECXEND = end of date range; FM format; required
+6 ; output
+7 ; ECXD = 1/0; passed by reference
+8 ; 1 indicates primary division
+9 ; ECXACT = 1/0; passed by reference
+10 ; returns 0, if division not active during date range;
+11 ; note: only start date and end date are checked; if division
+12 ; inactive on both dates, then division assumed inactive
+13 ; for entire date range
+14 ;assume division active; set ecxact=1
+15 SET ECXACT=1
+16 ;check if division active on start date or end date;
+17 ;these dates are normally within the same month
+18 FOR ECXDATE=ECXSTART,ECXEND
Begin DoDot:1
+19 SET DATE(ECXDATE)=$$SITE^VASITE(ECXDATE,ECXIEN)
+20 SET ECXD=0
+21 IF ECXIEN=$$PRIM^VASITE(ECXDATE)
SET ECXD=1
End DoDot:1
+22 ;if not active on start date and not active on end date, reset ecxact=0
+23 IF DATE(ECXSTART)=-1
IF DATE(ECXEND)=-1
SET ECXACT=0
+24 QUIT
MOV(ECXDIV,ECXALL,ECXSTART,ECXEND,ECXERR) ;division information for MOV extract audit report
+1 ;selected divisions from medical center division file (#40.8)
+2 ; input
+3 ; (see ADM)
+4 ; output
+5 ; (see ADM)
+6 DO ADM^ECXDVSN(.ECXDIV,ECXALL,ECXSTART,ECXEND,.ECXERR)
+7 QUIT
PAS(ECXDIV,ECXALL,ECXERR) ;setup division/site information for PAS extract audit report
+1 ; input
+2 ; ECXDIV = passed by reference array variable
+3 ; ECXALL = 1
+4 ; output
+5 ; ECXDIV = data for default division/site;
+6 ; ECXDIV(1)=ien in file #4^name^station number
+7 ; where the INSTITUTION file pointer is obtained from file #728
+8 SET ECXALL=1
DO DEFAULT^ECXDVSN(.ECXDIV,ECXALL,.ECXERR)
+9 QUIT
TRT(ECXDIV,ECXALL,ECXERR) ;setup division/site information for TRT extract audit report
+1 ; input
+2 ; ECXDIV = passed by reference array variable
+3 ; ECXALL = 1
+4 ; output
+5 ; ECXDIV = data for default division/site;
+6 ; ECXDIV(1)=ien in file #4^name^station number
+7 ; where the INSTITUTION file pointer is obtained from file #728
+8 SET ECXALL=1
DO DEFAULT^ECXDVSN(.ECXDIV,ECXALL,.ECXERR)
+9 QUIT
DEFAULT(ECXDIV,ECXALL,ECXERR) ;default division/site information for audit report
+1 ; input
+2 ; ECXDIV = passed by reference array variable
+3 ; ECXALL = 1
+4 ; output
+5 ; ECXDIV = data for default division/site;
+6 ; ECXDIV(1)=ien in file #4^name^station number
+7 ; where the INSTITUTION file pointer is obtained from file #728
+8 NEW DIV,ECX
+9 SET ECXERR=0
+10 SET DIV=$PIECE($GET(^ECX(728,1,0)),U,1)
+11 IF DIV=""
SET ECXERR=1
QUIT
+12 KILL ECX
SET DIC="^DIC(4,"
SET DIQ(0)="I"
SET DIQ="ECX"
SET DA=DIV
SET DR=".01;99"
DO EN^DIQ1
+13 IF $DATA(ECX)
SET ECXDIV(1)=DIV_U_ECX(4,DIV,.01,"I")_U_ECX(4,DIV,99,"I")
+14 IF '$DATA(ECX)
SET ECXERR=1
+15 IF '$DATA(ECXDIV)
SET ECXERR=1
+16 QUIT
DEN(ECXDIV,ECXALL,ECXERR) ;setup division/site information for DEN extract audit report
+1 ; input
+2 ; ECXDIV = passed by reference array variable (required)
+3 ; ECXALL = 0/1 (optional)
+4 ; '0' indicates user to select dental division;
+5 ; '1' indicates 'all' dental divisions or only one division
+6 ; exists in file #225; default is '1'
+7 ; output
+8 ; ECXDIV = data for dental division/site;
+9 ; ECXDIV(ien in file #225)=ien in file #4^name^station number
+10 ; ECXERR = 0/1
+11 ; if input problem, then '1' returned
+12 NEW X,Y,DIC,DTOUT,DUOUT,DIRUT,OUT,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 dental divisions/sites
+16 IF ECXALL=1
Begin DoDot:1
+17 FOR
SET ECXD=$ORDER(^DENT(225,"B",ECXD))
if ECXD=""
QUIT
SET ECXIEN=$ORDER(^(ECXD,""))
Begin DoDot:2
+18 SET $PIECE(ECXDIV(ECXIEN),U,3)=ECXD
SET DIC="^DIC(4,"
SET DIC(0)="MX"
SET X=ECXD
DO ^DIC
+19 if +Y>0
SET ECXDIV(ECXIEN)=Y
if +Y=-1
SET ECXDIV(ECXIEN)=U
+20 SET ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_ECXD
End DoDot:2
End DoDot:1
+21 ;if ecxall=0, user selects some/all dental divisions/sites
+22 IF ECXALL=0
SET OUT=0
Begin DoDot:1
+23 FOR
if OUT!ECXERR
QUIT
Begin DoDot:2
+24 SET DIC="^DENT(225,"
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=+Y
SET ECXD=$PIECE(Y,U,2)
KILL X,Y
+28 SET DIC="^DIC(4,"
SET DIC(0)="MX"
SET X=ECXD
DO ^DIC
+29 if +Y>0
SET ECXDIV(ECXIEN)=Y
if +Y=-1
SET ECXDIV(ECXIEN)=U
+30 SET ECXDIV(ECXIEN)=ECXDIV(ECXIEN)_U_ECXD
End DoDot:2
End DoDot:1
+31 IF ECXERR=1
KILL ECXDIV
+32 IF '$DATA(ECXDIV)
SET ECXERR=1
+33 QUIT
ECS(ECXDIV,ECXALL,ECXERR) ;setup division/location information for ECS extract audit report
+1 ; input
+2 ; ECXDIV = passed by reference array variable (required)
+3 ; ECXALL = 0/1 (optional)
+4 ; '0' indicates user to select EC location(s);
+5 ; '1' indicates 'all' locations or only one location
+6 ; exists in file #4 "LOC" index;
+7 ; default is '1'
+8 ; output
+9 ; ECXDIV = data for EC location;
+10 ; ECXDIV(ien in file #4)=ien in file #4^name^station number
+11 ; where the INSTITUTION file pointer is obtained from
+12 ; "LOC" index in file #4
+13 ; ECXERR = 0/1
+14 ; if input problem, then '1' returned
+15 ;
+16 NEW X,Y,I,DIC,DIR,DIRUT,DTOUT,DUOUT,NM,OUT,ECXD,ECXIEN,ECXLOC
+17 if '$DATA(ECXALL)
SET ECXALL=1
if ECXALL=""
SET ECXALL=1
+18 SET ECXERR=0
SET ECXD=""
SET I=0
+19 ;get all available ec locations in ecxloc array
+20 FOR
SET ECXD=$ORDER(^DIC(4,"LOC",ECXD))
if ECXD=""
QUIT
SET I=I+1
SET ECXIEN=$ORDER(^(ECXD,""))
SET ECXLOC(I)=ECXD_U_ECXIEN_U_$PIECE($GET(^DIC(4,ECXIEN,99)),U,1)
+21 ;if ecxall=1, then all ec locations
+22 IF ECXALL=1
SET I=""
Begin DoDot:1
+23 FOR
SET I=$ORDER(ECXLOC(I))
if I=""
QUIT
Begin DoDot:2
+24 SET ECXIEN=$PIECE(ECXLOC(I),U,2)
+25 SET ECXDIV(ECXIEN)=ECXIEN_U_$PIECE(ECXLOC(I),U,1)_U_$PIECE(ECXLOC(I),U,3)
End DoDot:2
End DoDot:1
QUIT
+26 IF ECXALL=0
SET OUT=0
SET I=0
Begin DoDot:1
+27 WRITE !!,"Event Capture Locations:",!
SET I=0
SET DIR(0)="SXO^"
+28 ;spaces are embedded in dir(0) to prevent user from selecting by alpha characters in name
+29 FOR
SET I=$ORDER(ECXLOC(I))
if I=""
QUIT
SET NM=$PIECE(ECXLOC(I),U,1)
WRITE !,?10,I_" ",NM
SET DIR(0)=DIR(0)_I_":"_"- "_NM_";"
+30 WRITE !
+31 FOR
if OUT!ECXERR
QUIT
Begin DoDot:2
+32 SET DIR("A")="Select Event Capture Location"
SET DIR("S")="I +Y=Y"
+33 DO ^DIR
+34 IF $GET(DTOUT)!($GET(DUOUT))
SET ECXERR=1
QUIT
+35 IF X=""
Begin DoDot:3
+36 IF '$DATA(ECXDIV)
WRITE !!,"No Location selected...exiting.",!
SET OUT=1
QUIT
+37 WRITE !!,"You have selected the following Location(s):",!
+38 SET I=0
FOR
SET I=$ORDER(ECXDIV(I))
if I=""
QUIT
WRITE !,?10,$PIECE(ECXDIV(I),U,2)_" ("_$PIECE(ECXDIV(I),U,3)_")"
+39 WRITE !
KILL X,Y,DIR
SET DIR(0)="Y"
SET DIR("A")="Is that ok"
SET DIR("B")="YES"
DO ^DIR
+40 IF $DATA(DIRUT)
SET ECXERR=1
+41 IF Y=0
SET ECXERR=1
+42 SET OUT=1
End DoDot:3
QUIT
+43 SET ECXIEN=$PIECE(ECXLOC(X),U,2)
+44 SET ECXDIV(ECXIEN)=ECXIEN_U_$PIECE(ECXLOC(X),U,1)_U_$PIECE(ECXLOC(X),U,3)
End DoDot:2
End DoDot:1
+45 ;exit
+46 IF ECXERR=1
KILL ECXDIV
+47 IF '$DATA(ECXDIV)
SET ECXERR=1
+48 QUIT
NUT() ; Set Divisions into screen array (prompt is one/many/all)
+1 ;Input : SCRNARR - Screen array full global reference
+2 ;Output : 1 = OK 0 = User abort/timeout
+3 ; @SCRNARR@("DIVISION") = User pick all divisions ?
+4 ; 1 = Yes (all) 0 = No
+5 ; @SCRNARR@("DIVISION",PtrDiv) = Division name
+6 ;Note : @SCRNARR@("DIVISION") is initialized (KILLed) on input
+7 ; : @SCRNARR@("DIVISION",PtrDiv) is only set when the user
+8 ; picked individual divisions (i.e. didn't pick all)
+9 ;
+10 ;Declare variables
+11 NEW VAUTD,Y,SCANARR
+12 ;Get division selection
+13 SET DIC="^DIC(4,"
+14 SET VAUTSTR="PATIENT DIVISION"
+15 SET VAUTVB="SCANARR"
+16 SET VAUTNI=2
+17 DO FIRST^VAUTOMA
+18 IF Y<0
QUIT 1
+19 MERGE @SCRNARR@("DIVISION")=SCANARR
+20 QUIT 0
