source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECUN1.m@ 1150

Last change on this file since 1150 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1ECUN1 ;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
9ALLOC ; 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 ;
15ACTSCR(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)
36ACTSCRQ Q
37 ;
38 ;
39HELP ;
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
Note: See TracBrowser for help on using the repository browser.