ECUN1 ;BIR/MAM-Allocate DSS Units (cont'd) ;13 Nov 95
;;2.0; EVENT CAPTURE ;**8,19**;8 May 96
I '$D(UNIT(1))!('$D(USER(1))) W !!,"You must select both DSS Units and Event Capture Users. No action taken.",!!,"Press <RET> to continue " R X:DTIME Q
W !!!,"Assigning DSS Units for Event Capture Users selected ...",!
S (CNT,CNT1)=0 F I=0:0 S CNT=$O(UNIT(CNT)) Q:'CNT F I=0:0 S CNT1=$O(USER(CNT1)) Q:'CNT1 D ALLOC
K USER,UNIT
W !!,"Press <RET> to continue " R X:DTIME
Q
ALLOC ; stuff info in USER/NEW PERSON file
I '$D(^VA(200,+USER(CNT1),"EC",0)) S ^VA(200,+USER(CNT1),"EC",0)="^200.72PA^^"
K DA,DIC,DD,DO I '$D(^VA(200,+USER(CNT1),"EC","B",+UNIT(CNT))) S DINUM=+UNIT(CNT),DA(1)=+USER(CNT1),DIC(0)="L",DIC="^VA(200,"_DA(1)_",""EC"",",X=+UNIT(CNT) D FILE^DICN K DIC
Q
;
;
ACTSCR(ECDSS) ;- Reactivate Event Code Screens on DSS Unit
;
N ECLOC,ECCAT,ECPROC,ECSCRN
G ACTSCRQ:'$G(ECDSS)
S (ECLOC,ECSCRN)=0,(ECCAT,ECPROC)=""
;
;- Get EC Screen IEN
F S ECLOC=$O(^ECJ("AP",ECLOC)) Q:'ECLOC D
. F S ECCAT=$O(^ECJ("AP",ECLOC,ECDSS,ECCAT)) Q:ECCAT="" D
.. F S ECPROC=$O(^ECJ("AP",ECLOC,ECDSS,ECCAT,ECPROC)) Q:ECPROC="" D
... S ECSCRN=+$O(^ECJ("AP",ECLOC,ECDSS,ECCAT,ECPROC,0))
...;
...;- If inactive date exists, delete it
... I $P($G(^ECJ(ECSCRN,0)),"^",2)'="" D
.... L +^ECJ(ECSCRN):5 Q:'$T
.... S DIE="^ECJ("
.... S DA=ECSCRN
.... S DR="1////@"
.... D ^DIE
.... K DA,DIE,DR
.... L -^ECJ(ECSCRN)
ACTSCRQ Q
;
;
HELP ;
W !!,"Enter <RET> if you wish to continue with this option, or YES to make ",!,"additions or deletions to the list. Enter ^ to quit the option.",!!,"Press <RET> to continue " R X:DTIME Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECUN1 1682 printed Nov 22, 2024@17:09:17 Page 2
ECUN1 ;BIR/MAM-Allocate DSS Units (cont'd) ;13 Nov 95
+1 ;;2.0; EVENT CAPTURE ;**8,19**;8 May 96
+2 IF '$DATA(UNIT(1))!('$DATA(USER(1)))
WRITE !!,"You must select both DSS Units and Event Capture Users. No action taken.",!!,"Press <RET> to continue "
READ X:DTIME
QUIT
+3 WRITE !!!,"Assigning DSS Units for Event Capture Users selected ...",!
+4 SET (CNT,CNT1)=0
FOR I=0:0
SET CNT=$ORDER(UNIT(CNT))
if 'CNT
QUIT
FOR I=0:0
SET CNT1=$ORDER(USER(CNT1))
if 'CNT1
QUIT
DO ALLOC
+5 KILL USER,UNIT
+6 WRITE !!,"Press <RET> to continue "
READ X:DTIME
+7 QUIT
ALLOC ; stuff info in USER/NEW PERSON file
+1 IF '$DATA(^VA(200,+USER(CNT1),"EC",0))
SET ^VA(200,+USER(CNT1),"EC",0)="^200.72PA^^"
+2 KILL DA,DIC,DD,DO
IF '$DATA(^VA(200,+USER(CNT1),"EC","B",+UNIT(CNT)))
SET DINUM=+UNIT(CNT)
SET DA(1)=+USER(CNT1)
SET DIC(0)="L"
SET DIC="^VA(200,"_DA(1)_",""EC"","
SET X=+UNIT(CNT)
DO FILE^DICN
KILL DIC
+3 QUIT
+4 ;
+5 ;
ACTSCR(ECDSS) ;- Reactivate Event Code Screens on DSS Unit
+1 ;
+2 NEW ECLOC,ECCAT,ECPROC,ECSCRN
+3 if '$GET(ECDSS)
GOTO ACTSCRQ
+4 SET (ECLOC,ECSCRN)=0
SET (ECCAT,ECPROC)=""
+5 ;
+6 ;- Get EC Screen IEN
+7 FOR
SET ECLOC=$ORDER(^ECJ("AP",ECLOC))
if 'ECLOC
QUIT
Begin DoDot:1
+8 FOR
SET ECCAT=$ORDER(^ECJ("AP",ECLOC,ECDSS,ECCAT))
if ECCAT=""
QUIT
Begin DoDot:2
+9 FOR
SET ECPROC=$ORDER(^ECJ("AP",ECLOC,ECDSS,ECCAT,ECPROC))
if ECPROC=""
QUIT
Begin DoDot:3
+10 SET ECSCRN=+$ORDER(^ECJ("AP",ECLOC,ECDSS,ECCAT,ECPROC,0))
+11 ;
+12 ;- If inactive date exists, delete it
+13 IF $PIECE($GET(^ECJ(ECSCRN,0)),"^",2)'=""
Begin DoDot:4
+14 LOCK +^ECJ(ECSCRN):5
if '$TEST
QUIT
+15 SET DIE="^ECJ("
+16 SET DA=ECSCRN
+17 SET DR="1////@"
+18 DO ^DIE
+19 KILL DA,DIE,DR
+20 LOCK -^ECJ(ECSCRN)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
ACTSCRQ QUIT
+1 ;
+2 ;
HELP ;
+1 WRITE !!,"Enter <RET> if you wish to continue with this option, or YES to make ",!,"additions or deletions to the list. Enter ^ to quit the option.",!!,"Press <RET> to continue "
READ X:DTIME
QUIT
+2 QUIT
