- ECL ;BIR/MAM-Get Event Capture Location ;17 May 89
- ;;2.0; EVENT CAPTURE ;**25**;8 May 96
- S ECOUT=0
- D GETLOC(.LOC)
- I '$D(LOC(1)) D R X:5 W @IOF Q
- . W !!,"You have no locations flagged for Event Capture.",!
- S:'$D(LOC(2)) ECLN=$P(LOC(1),"^"),ECL=$P(LOC(1),"^",2)
- I $D(LOC(2)) D LL I '$D(ECL) Q
- I '$G(NOTIOF) W @IOF
- Q
- GETLOC(LOC) ;Get all event capture locations
- N I,CNT
- S (X,CNT)=0
- F I=0:0 S X=$O(^DIC(4,"LOC",X)) Q:X="" D
- . S CNT=CNT+1,LOC(CNT)=X,Y=$O(^DIC(4,"LOC",X,0)),LOC(CNT)=LOC(CNT)_"^"_Y
- Q
- LL ; select location
- W:'$G(NOTIOF) @IOF W !,"Event Capture Locations: ",!
- S CNT=0 F I=0:0 S CNT=$O(LOC(CNT)) Q:'CNT W !,CNT_". "_$P(LOC(CNT),"^")
- ASK W !!,"Select Number: " R X:DTIME Q:'$T!("^"[X)!(X="")
- I '$D(LOC(X)) D G LL
- . W !!,"Enter the number corresponding to the location you want to "
- . W "select.",!!,"Press <RET> to continue"
- . R X:DTIME
- S ECL=$P(LOC(X),"^",2),ECLN=$P(LOC(X),"^")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECL 942 printed Feb 18, 2025@23:23:56 Page 2
- ECL ;BIR/MAM-Get Event Capture Location ;17 May 89
- +1 ;;2.0; EVENT CAPTURE ;**25**;8 May 96
- +2 SET ECOUT=0
- +3 DO GETLOC(.LOC)
- +4 IF '$DATA(LOC(1))
- Begin DoDot:1
- +5 WRITE !!,"You have no locations flagged for Event Capture.",!
- End DoDot:1
- READ X:5
- WRITE @IOF
- QUIT
- +6 if '$DATA(LOC(2))
- SET ECLN=$PIECE(LOC(1),"^")
- SET ECL=$PIECE(LOC(1),"^",2)
- +7 IF $DATA(LOC(2))
- DO LL
- IF '$DATA(ECL)
- QUIT
- +8 IF '$GET(NOTIOF)
- WRITE @IOF
- +9 QUIT
- GETLOC(LOC) ;Get all event capture locations
- +1 NEW I,CNT
- +2 SET (X,CNT)=0
- +3 FOR I=0:0
- SET X=$ORDER(^DIC(4,"LOC",X))
- if X=""
- QUIT
- Begin DoDot:1
- +4 SET CNT=CNT+1
- SET LOC(CNT)=X
- SET Y=$ORDER(^DIC(4,"LOC",X,0))
- SET LOC(CNT)=LOC(CNT)_"^"_Y
- End DoDot:1
- +5 QUIT
- LL ; select location
- +1 if '$GET(NOTIOF)
- WRITE @IOF
- WRITE !,"Event Capture Locations: ",!
- +2 SET CNT=0
- FOR I=0:0
- SET CNT=$ORDER(LOC(CNT))
- if 'CNT
- QUIT
- WRITE !,CNT_". "_$PIECE(LOC(CNT),"^")
- ASK WRITE !!,"Select Number: "
- READ X:DTIME
- if '$TEST!("^"[X)!(X="")
- QUIT
- +1 IF '$DATA(LOC(X))
- Begin DoDot:1
- +2 WRITE !!,"Enter the number corresponding to the location you want to "
- +3 WRITE "select.",!!,"Press <RET> to continue"
- +4 READ X:DTIME
- End DoDot:1
- GOTO LL
- +5 SET ECL=$PIECE(LOC(X),"^",2)
- SET ECLN=$PIECE(LOC(X),"^")
- +6 QUIT