- 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 Jan 18, 2025@02:53:44 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