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 Nov 22, 2024@17:07:42 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
