ECUNIT ;BIR/MAM,JPW-Allocate DSS Units ;1 May 96
;;2.0; EVENT CAPTURE ;;8 May 96
;
W @IOF,"Allocating DSS Units for Event Capture",!!
BEG K ECMORE S LIST="DSS Units",(CNT,ECOUT)=0 W !!,"Enter the names of the DSS Units to be assigned: ",!!
UNIT ; select DSS Unit
K DIC,DA,DUOUT S DIC=724,DIC(0)="QEAMZ",DIC("A")="Select DSS Unit: " D ^DIC K DIC G:$D(DUOUT) END I CNT=0,Y<0 G END
I CNT,Y<0,$D(ECMORE) Q
I CNT,Y<0 G CONT
S ECNOPE=0 D CHECK I ECNOPE G UNIT
S CNT=CNT+1,UNIT(CNT)=+Y_"^"_$P(Y,"^",2) G UNIT
CONT ;
S CNT=0 W @IOF,!,"Enter the names of the people who will have access to enter procedures",!,"for the DSS Units selected:",!!
USER ; select users
K DIC,DA,DUOUT S DIC=200,DIC(0)="QEAMZ",DIC("A")="Select Name: " D ^DIC K DIC G:$D(DUOUT) END I CNT=0,Y<0 G END
I CNT,Y<0,$D(ECMORE) Q
I CNT,Y<0 G ENTER
S CNT=CNT+1,USER(CNT)=+Y_"^"_$P(Y,"^",2) G USER
Q
ENTER ; display DSS Units & Users
W @IOF,!,"Allocating DSS Units for Event Capture",!,?3,LIST_": ",!
I LIST["DSS" S CNT=0 F I=0:0 S CNT=$O(UNIT(CNT)) Q:'CNT W:CNT#2 !,?3,CNT W:CNT#2=0 ?45,CNT W ". "_$P(UNIT(CNT),"^",2)
I LIST["Event" S CNT=0 F I=0:0 S CNT=$O(USER(CNT)) Q:'CNT W:CNT#2 !,?3,CNT W:CNT#2=0 ?45,CNT W ". "_$P(USER(CNT),"^",2)
Q:$D(ECREDO) W !!,"Do you want to modify this list ? NO// " R ECYN:DTIME I '$T!(ECYN="^") G END
S ECYN=$E(ECYN) S:ECYN="" ECYN="N" I "YyNn"'[ECYN D HELP^ECUN1 G ENTER
I LIST["DSS","Nn"[ECYN S LIST="Event Capture Users" G ENTER
I LIST["Event","Nn"[ECYN D ^ECUN1 G BEG
ASK W !!,"Add or Delete from the List ? ADD// " R X:DTIME I '$T!(X="^") G ENTER
S X=$E(X) S:X="" X="A" I "AaDd"'[X W !!,"Enter <RET> to add more "_LIST_", or ""D"" to delete a "_$S(LIST["DSS":"unit",1:"user"),!,"from the list." G ASK
I LIST["DSS","Aa"[X D COUNT S CNT=CNT1,ECMORE=1 W @IOF D UNIT S LIST="DSS Units" D VAL G:ECOUT END G ENTER
I LIST["Event","Aa"[X D CNT S CNT=CNT1,ECMORE=1 W @IOF D USER S LIST="Event Capture Users" D VAL G:ECOUT END G ENTER
DELUN ; delete units
W !!,"Select Number: " R X:DTIME I '$T!("^"[X) G ENTER
I LIST["DSS",'$D(UNIT(X)) W !!,"Enter the number corresponding to the DSS Unit that you want to remove." D DISP G DELUN
I LIST["Event",'$D(USER(X)) W !!,"Enter the number corresponding to the Event Capture User that you",!,"want to remove." D DISP G DELUN
I LIST["DSS" K UNIT(X) S (CNT,CNT1)=0 F I=0:0 S CNT=$O(UNIT(CNT)) Q:'CNT S CNT1=CNT1+1 I CNT'=CNT1 S UNIT(CNT1)=UNIT(CNT) K UNIT(CNT)
I LIST["Event" K USER(X) S (CNT,CNT1)=0 F I=0:0 S CNT=$O(USER(CNT)) Q:'CNT S CNT1=CNT1+1 I CNT'=CNT1 S USER(CNT1)=USER(CNT) K USER(CNT)
G ENTER
;
DISP ; display list
S ECREDO=1 W !!,"Do you need to see the list again ? NO// " R ECYN:DTIME I '$T!(X="^") S ECOUT=1 Q
S ECYN=$E(ECYN) S:ECYN="" ECYN="N" I "YyNn"'[ECYN W !!,"Enter YES if you would like see the list of "_LIST_"." G DISP
I "Nn"[ECYN K ECREDO Q
D ENTER K ECREDO
Q
END D ^ECKILL W @IOF
Q
COUNT ; re-number units
S (CNT,CNT1)=0 F I=0:0 S CNT=$O(UNIT(CNT)) Q:'CNT S CNT1=CNT1+1
Q
CNT ; re-number users
S (CNT,CNT1)=0 F I=0:0 S CNT=$O(USER(CNT)) Q:'CNT S CNT1=CNT1+1
Q
CHECK ; check for valid DSS Unit
I $P(^ECD(+Y,0),"^",6) S ECNOPE=1 W !!,"This DSS Unit is inactive.",!!,"Press <RET> to continue " R X:DTIME W @IOF
Q
VAL ;check valid lists
I LIST["DSS",'$O(UNIT(0)) S ECOUT=1 D MSG Q
I LIST["Event",'$O(USER(0)) S ECOUT=1 D MSG Q
Q
MSG W !!,"No action taken.",!!,"Press <RET> to continue " R X:DTIME
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECUNIT 3471 printed Nov 22, 2024@17:09:18 Page 2
ECUNIT ;BIR/MAM,JPW-Allocate DSS Units ;1 May 96
+1 ;;2.0; EVENT CAPTURE ;;8 May 96
+2 ;
+3 WRITE @IOF,"Allocating DSS Units for Event Capture",!!
BEG KILL ECMORE
SET LIST="DSS Units"
SET (CNT,ECOUT)=0
WRITE !!,"Enter the names of the DSS Units to be assigned: ",!!
UNIT ; select DSS Unit
+1 KILL DIC,DA,DUOUT
SET DIC=724
SET DIC(0)="QEAMZ"
SET DIC("A")="Select DSS Unit: "
DO ^DIC
KILL DIC
if $DATA(DUOUT)
GOTO END
IF CNT=0
IF Y<0
GOTO END
+2 IF CNT
IF Y<0
IF $DATA(ECMORE)
QUIT
+3 IF CNT
IF Y<0
GOTO CONT
+4 SET ECNOPE=0
DO CHECK
IF ECNOPE
GOTO UNIT
+5 SET CNT=CNT+1
SET UNIT(CNT)=+Y_"^"_$PIECE(Y,"^",2)
GOTO UNIT
CONT ;
+1 SET CNT=0
WRITE @IOF,!,"Enter the names of the people who will have access to enter procedures",!,"for the DSS Units selected:",!!
USER ; select users
+1 KILL DIC,DA,DUOUT
SET DIC=200
SET DIC(0)="QEAMZ"
SET DIC("A")="Select Name: "
DO ^DIC
KILL DIC
if $DATA(DUOUT)
GOTO END
IF CNT=0
IF Y<0
GOTO END
+2 IF CNT
IF Y<0
IF $DATA(ECMORE)
QUIT
+3 IF CNT
IF Y<0
GOTO ENTER
+4 SET CNT=CNT+1
SET USER(CNT)=+Y_"^"_$PIECE(Y,"^",2)
GOTO USER
+5 QUIT
ENTER ; display DSS Units & Users
+1 WRITE @IOF,!,"Allocating DSS Units for Event Capture",!,?3,LIST_": ",!
+2 IF LIST["DSS"
SET CNT=0
FOR I=0:0
SET CNT=$ORDER(UNIT(CNT))
if 'CNT
QUIT
if CNT#2
WRITE !,?3,CNT
if CNT#2=0
WRITE ?45,CNT
WRITE ". "_$PIECE(UNIT(CNT),"^",2)
+3 IF LIST["Event"
SET CNT=0
FOR I=0:0
SET CNT=$ORDER(USER(CNT))
if 'CNT
QUIT
if CNT#2
WRITE !,?3,CNT
if CNT#2=0
WRITE ?45,CNT
WRITE ". "_$PIECE(USER(CNT),"^",2)
+4 if $DATA(ECREDO)
QUIT
WRITE !!,"Do you want to modify this list ? NO// "
READ ECYN:DTIME
IF '$TEST!(ECYN="^")
GOTO END
+5 SET ECYN=$EXTRACT(ECYN)
if ECYN=""
SET ECYN="N"
IF "YyNn"'[ECYN
DO HELP^ECUN1
GOTO ENTER
+6 IF LIST["DSS"
IF "Nn"[ECYN
SET LIST="Event Capture Users"
GOTO ENTER
+7 IF LIST["Event"
IF "Nn"[ECYN
DO ^ECUN1
GOTO BEG
ASK WRITE !!,"Add or Delete from the List ? ADD// "
READ X:DTIME
IF '$TEST!(X="^")
GOTO ENTER
+1 SET X=$EXTRACT(X)
if X=""
SET X="A"
IF "AaDd"'[X
WRITE !!,"Enter <RET> to add more "_LIST_", or ""D"" to delete a "_$SELECT(LIST["DSS":"unit",1:"user"),!,"from the list."
GOTO ASK
+2 IF LIST["DSS"
IF "Aa"[X
DO COUNT
SET CNT=CNT1
SET ECMORE=1
WRITE @IOF
DO UNIT
SET LIST="DSS Units"
DO VAL
if ECOUT
GOTO END
GOTO ENTER
+3 IF LIST["Event"
IF "Aa"[X
DO CNT
SET CNT=CNT1
SET ECMORE=1
WRITE @IOF
DO USER
SET LIST="Event Capture Users"
DO VAL
if ECOUT
GOTO END
GOTO ENTER
DELUN ; delete units
+1 WRITE !!,"Select Number: "
READ X:DTIME
IF '$TEST!("^"[X)
GOTO ENTER
+2 IF LIST["DSS"
IF '$DATA(UNIT(X))
WRITE !!,"Enter the number corresponding to the DSS Unit that you want to remove."
DO DISP
GOTO DELUN
+3 IF LIST["Event"
IF '$DATA(USER(X))
WRITE !!,"Enter the number corresponding to the Event Capture User that you",!,"want to remove."
DO DISP
GOTO DELUN
+4 IF LIST["DSS"
KILL UNIT(X)
SET (CNT,CNT1)=0
FOR I=0:0
SET CNT=$ORDER(UNIT(CNT))
if 'CNT
QUIT
SET CNT1=CNT1+1
IF CNT'=CNT1
SET UNIT(CNT1)=UNIT(CNT)
KILL UNIT(CNT)
+5 IF LIST["Event"
KILL USER(X)
SET (CNT,CNT1)=0
FOR I=0:0
SET CNT=$ORDER(USER(CNT))
if 'CNT
QUIT
SET CNT1=CNT1+1
IF CNT'=CNT1
SET USER(CNT1)=USER(CNT)
KILL USER(CNT)
+6 GOTO ENTER
+7 ;
DISP ; display list
+1 SET ECREDO=1
WRITE !!,"Do you need to see the list again ? NO// "
READ ECYN:DTIME
IF '$TEST!(X="^")
SET ECOUT=1
QUIT
+2 SET ECYN=$EXTRACT(ECYN)
if ECYN=""
SET ECYN="N"
IF "YyNn"'[ECYN
WRITE !!,"Enter YES if you would like see the list of "_LIST_"."
GOTO DISP
+3 IF "Nn"[ECYN
KILL ECREDO
QUIT
+4 DO ENTER
KILL ECREDO
+5 QUIT
END DO ^ECKILL
WRITE @IOF
+1 QUIT
COUNT ; re-number units
+1 SET (CNT,CNT1)=0
FOR I=0:0
SET CNT=$ORDER(UNIT(CNT))
if 'CNT
QUIT
SET CNT1=CNT1+1
+2 QUIT
CNT ; re-number users
+1 SET (CNT,CNT1)=0
FOR I=0:0
SET CNT=$ORDER(USER(CNT))
if 'CNT
QUIT
SET CNT1=CNT1+1
+2 QUIT
CHECK ; check for valid DSS Unit
+1 IF $PIECE(^ECD(+Y,0),"^",6)
SET ECNOPE=1
WRITE !!,"This DSS Unit is inactive.",!!,"Press <RET> to continue "
READ X:DTIME
WRITE @IOF
+2 QUIT
VAL ;check valid lists
+1 IF LIST["DSS"
IF '$ORDER(UNIT(0))
SET ECOUT=1
DO MSG
QUIT
+2 IF LIST["Event"
IF '$ORDER(USER(0))
SET ECOUT=1
DO MSG
QUIT
+3 QUIT
MSG WRITE !!,"No action taken.",!!,"Press <RET> to continue "
READ X:DTIME
+1 QUIT