ECSUN ;BIR/JLP,RHK-Category and Procedure Summary (Old File) ;30 Apr 96
;;2.0; EVENT CAPTURE ;;8 May 96
LOC K ECL S EC1=0 D ^ECL S:$D(LOC(2)) EC1=1 K LOC I '$D(ECL) S ECOUT=1 G END
S ECJLP=0 I $G(^ECC(722,+$O(^ECC(722,"B",ECL,0)),"BRO"))="" S ECJLP=1
S (ECOUT,ECALL)=0,ECPG=1
UNIT ;
W @IOF F Q=0:0 W !!,"Do you want to list all accessible DSS Units for "_ECLN S %=1 D YN^DICN Q:% W !!,"Enter <RET> to list all your accessible DSS Units for this location,",!," or NO to select a specific DSS Unit"
G:%<0 END I %=1 S ECALL=1 G DEV
W @IOF,! K DIC S DIC=724,DIC(0)="QEAMZ",DIC("A")="Select DSS Unit: " S:ECL DIC("S")="I $D(^ECK(""AP"",ECL,+Y))" D ^DIC K DIC G:Y<0 END S ECD=+Y,ECDN=$P(Y,"^",2)
S ECS=+$P(^ECD(ECD,0),"^",2),ECSN=$S($P($G(^DIC(49,ECS,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
SEL ;
I ECJLP G DEV
W @IOF F Q=0:0 W !!,"Do you want to list all categories for "_ECDN S %=1 D YN^DICN Q:% W !!,"Enter <RET> if you would like to list all categories for this DSS Unit,",!," or NO to select a specific category"
G:%<0 END I %=1 S ECC="ALL" G DEV
W @IOF,! K DIC S DIC=720,DIC(0)="QEAMZ",DIC("A")="Select Category for "_ECDN_" DSS Unit: " S:ECD DIC("S")="I $D(^ECK(""AP"",ECL,ECD,+Y))" D ^DIC K DIC G:Y<0 END S ECC=+Y,ECCN=$P(Y,"^",2)
DEV W !! K IOP,POP,IO("Q"),%ZIS,ZTSK S %ZIS="QM",%ZIS("A")="Select Device: " D ^%ZIS I POP S ECOUT=1 G END
I $D(IO("Q")) K IO("Q") S ZTDESC="CATEGORY AND PROCEDURE SUMMARY",ZTRTN="START^ECSUN",ZTIO=ION D SAVE,^%ZTLOAD,HOME^%ZIS K ZTSK G END
START ;
U IO
S %H=$H D YX^%DTC S ECDATE=Y
S ECOUT=0,ECPG=1 I ECALL D ^ECSUN1 G CLEAR
D ^ECSUN2
CLEAR I $E(IOST,1,2)'="C-" W @IOF G END
I ECPG W !!,"Press <RET> to continue " R X:DTIME I '$T!(X="^") S ECOUT=1 G END
G:ECALL END
ASK ;
W @IOF F Q=0:0 W !!,"Would you like to list another DSS Unit for this Location" S %=2 D YN^DICN Q:% W !!,"Enter YES to list another DSS Unit or <RET> to continue"
G:%<0 END I %=1 K ECD,ECDN,ECC,ECCN,ECP,ECPN,ECS,ECSN G UNIT
K ECD,ECDN,ECC,ECCN,ECP,ECPN,ECS,ECSN G:EC1 LOC
END ;
D ^ECKILL W @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
SAVE ;
S (ZTSAVE("ECA*"),ZTSAVE("ECJLP"),ZTSAVE("ECC*"),ZTSAVE("ECD*"),ZTSAVE("ECL*"),ZTSAVE("ECM*"),ZTSAVE("ECP*"),ZTSAVE("ECS*"))=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECSUN 2238 printed Dec 13, 2024@01:58:56 Page 2
ECSUN ;BIR/JLP,RHK-Category and Procedure Summary (Old File) ;30 Apr 96
+1 ;;2.0; EVENT CAPTURE ;;8 May 96
LOC KILL ECL
SET EC1=0
DO ^ECL
if $DATA(LOC(2))
SET EC1=1
KILL LOC
IF '$DATA(ECL)
SET ECOUT=1
GOTO END
+1 SET ECJLP=0
IF $GET(^ECC(722,+$ORDER(^ECC(722,"B",ECL,0)),"BRO"))=""
SET ECJLP=1
+2 SET (ECOUT,ECALL)=0
SET ECPG=1
UNIT ;
+1 WRITE @IOF
FOR Q=0:0
WRITE !!,"Do you want to list all accessible DSS Units for "_ECLN
SET %=1
DO YN^DICN
if %
QUIT
WRITE !!,"Enter <RET> to list all your accessible DSS Units for this location,",!," or NO to select a specific DSS Unit"
+2 if %<0
GOTO END
IF %=1
SET ECALL=1
GOTO DEV
+3 WRITE @IOF,!
KILL DIC
SET DIC=724
SET DIC(0)="QEAMZ"
SET DIC("A")="Select DSS Unit: "
if ECL
SET DIC("S")="I $D(^ECK(""AP"",ECL,+Y))"
DO ^DIC
KILL DIC
if Y<0
GOTO END
SET ECD=+Y
SET ECDN=$PIECE(Y,"^",2)
+4 SET ECS=+$PIECE(^ECD(ECD,0),"^",2)
SET ECSN=$SELECT($PIECE($GET(^DIC(49,ECS,0)),"^")]"":$PIECE(^(0),"^"),1:"UNKNOWN")
SEL ;
+1 IF ECJLP
GOTO DEV
+2 WRITE @IOF
FOR Q=0:0
WRITE !!,"Do you want to list all categories for "_ECDN
SET %=1
DO YN^DICN
if %
QUIT
WRITE !!,"Enter <RET> if you would like to list all categories for this DSS Unit,",!," or NO to select a specific category"
+3 if %<0
GOTO END
IF %=1
SET ECC="ALL"
GOTO DEV
+4 WRITE @IOF,!
KILL DIC
SET DIC=720
SET DIC(0)="QEAMZ"
SET DIC("A")="Select Category for "_ECDN_" DSS Unit: "
if ECD
SET DIC("S")="I $D(^ECK(""AP"",ECL,ECD,+Y))"
DO ^DIC
KILL DIC
if Y<0
GOTO END
SET ECC=+Y
SET ECCN=$PIECE(Y,"^",2)
DEV WRITE !!
KILL IOP,POP,IO("Q"),%ZIS,ZTSK
SET %ZIS="QM"
SET %ZIS("A")="Select Device: "
DO ^%ZIS
IF POP
SET ECOUT=1
GOTO END
+1 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTDESC="CATEGORY AND PROCEDURE SUMMARY"
SET ZTRTN="START^ECSUN"
SET ZTIO=ION
DO SAVE
DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
GOTO END
START ;
+1 USE IO
+2 SET %H=$HOROLOG
DO YX^%DTC
SET ECDATE=Y
+3 SET ECOUT=0
SET ECPG=1
IF ECALL
DO ^ECSUN1
GOTO CLEAR
+4 DO ^ECSUN2
CLEAR IF $EXTRACT(IOST,1,2)'="C-"
WRITE @IOF
GOTO END
+1 IF ECPG
WRITE !!,"Press <RET> to continue "
READ X:DTIME
IF '$TEST!(X="^")
SET ECOUT=1
GOTO END
+2 if ECALL
GOTO END
ASK ;
+1 WRITE @IOF
FOR Q=0:0
WRITE !!,"Would you like to list another DSS Unit for this Location"
SET %=2
DO YN^DICN
if %
QUIT
WRITE !!,"Enter YES to list another DSS Unit or <RET> to continue"
+2 if %<0
GOTO END
IF %=1
KILL ECD,ECDN,ECC,ECCN,ECP,ECPN,ECS,ECSN
GOTO UNIT
+3 KILL ECD,ECDN,ECC,ECCN,ECP,ECPN,ECS,ECSN
if EC1
GOTO LOC
END ;
+1 DO ^ECKILL
WRITE @IOF
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 QUIT
SAVE ;
+1 SET (ZTSAVE("ECA*"),ZTSAVE("ECJLP"),ZTSAVE("ECC*"),ZTSAVE("ECD*"),ZTSAVE("ECL*"),ZTSAVE("ECM*"),ZTSAVE("ECP*"),ZTSAVE("ECS*"))=""
+2 QUIT
