| 1 | ECUN1 ;BIR/MAM-Allocate DSS Units (cont'd) ;13 Nov 95
 | 
|---|
| 2 |  ;;2.0; EVENT CAPTURE ;**8,19**;8 May 96
 | 
|---|
| 3 |  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
 | 
|---|
| 4 |  W !!!,"Assigning DSS Units for Event Capture Users selected ...",!
 | 
|---|
| 5 |  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
 | 
|---|
| 6 |  K USER,UNIT
 | 
|---|
| 7 |  W !!,"Press <RET> to continue  " R X:DTIME
 | 
|---|
| 8 |  Q
 | 
|---|
| 9 | ALLOC ; stuff info in USER/NEW PERSON file
 | 
|---|
| 10 |  I '$D(^VA(200,+USER(CNT1),"EC",0)) S ^VA(200,+USER(CNT1),"EC",0)="^200.72PA^^"
 | 
|---|
| 11 |  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
 | 
|---|
| 12 |  Q
 | 
|---|
| 13 |  ;
 | 
|---|
| 14 |  ;
 | 
|---|
| 15 | ACTSCR(ECDSS) ;- Reactivate Event Code Screens on DSS Unit
 | 
|---|
| 16 |  ;
 | 
|---|
| 17 |  N ECLOC,ECCAT,ECPROC,ECSCRN
 | 
|---|
| 18 |  G ACTSCRQ:'$G(ECDSS)
 | 
|---|
| 19 |  S (ECLOC,ECSCRN)=0,(ECCAT,ECPROC)=""
 | 
|---|
| 20 |  ;
 | 
|---|
| 21 |  ;- Get EC Screen IEN
 | 
|---|
| 22 |  F  S ECLOC=$O(^ECJ("AP",ECLOC)) Q:'ECLOC  D
 | 
|---|
| 23 |  . F  S ECCAT=$O(^ECJ("AP",ECLOC,ECDSS,ECCAT)) Q:ECCAT=""  D
 | 
|---|
| 24 |  .. F  S ECPROC=$O(^ECJ("AP",ECLOC,ECDSS,ECCAT,ECPROC)) Q:ECPROC=""  D
 | 
|---|
| 25 |  ... S ECSCRN=+$O(^ECJ("AP",ECLOC,ECDSS,ECCAT,ECPROC,0))
 | 
|---|
| 26 |  ...;
 | 
|---|
| 27 |  ...;- If inactive date exists, delete it
 | 
|---|
| 28 |  ... I $P($G(^ECJ(ECSCRN,0)),"^",2)'="" D
 | 
|---|
| 29 |  .... L +^ECJ(ECSCRN):5 Q:'$T
 | 
|---|
| 30 |  .... S DIE="^ECJ("
 | 
|---|
| 31 |  .... S DA=ECSCRN
 | 
|---|
| 32 |  .... S DR="1////@"
 | 
|---|
| 33 |  .... D ^DIE
 | 
|---|
| 34 |  .... K DA,DIE,DR
 | 
|---|
| 35 |  .... L -^ECJ(ECSCRN)
 | 
|---|
| 36 | ACTSCRQ Q
 | 
|---|
| 37 |  ;
 | 
|---|
| 38 |  ;
 | 
|---|
| 39 | HELP ;
 | 
|---|
| 40 |  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
 | 
|---|
| 41 |  Q
 | 
|---|