- 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 Mar 13, 2025@21:03:59 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
