ECDEAL ;BIR/MAM,JPW-Deallocate DSS Units ;1/22/16 14:33
;;2.0;EVENT CAPTURE;**13,19,25,131**;8 May 96;Build 13
S ECOUT=0
USER W @IOF,!!,"Do you want to remove access to all DSS Units for a specific user ? NO// " R ECYN:DTIME I '$T!(ECYN["^") G END
S ECYN=$E(ECYN) S:ECYN="" ECYN="N" I "YyNn"'[ECYN W !!,"If you are removing access to a DSS Unit for one or more users, enter",!,"<RET>. If you want to remove access to all units for an individual user,"
I "YyNn"'[ECYN W !,"enter YES.",!!,"Press <RET> to continue " R X:DTIME G USER
I "Yy"[ECYN D ^ECDEAL1 G END
UNIT Q:ECOUT W @IOF K DIC,DA S DIC(0)="QEAMZ",DIC=724,DIC("A")="Remove User Access for which DSS Unit ? " D ^DIC K DIC G:Y<0 END S ECD=+Y,ECDN=$P(Y,"^",2)
U W !!,"Do you want to remove access to this DSS Unit for all users ? NO// " R ECYN:DTIME I '$T!(ECYN="^") G END
S:ECYN="" ECYN="N" S ECYN=$E(ECYN) I "YyNn"'[ECYN W !!,"Enter <RET> if you are removing access to "_ECDN_" for an individual",!,"user or Y to remove access for ALL users." G U
I "Yy"[ECYN D D ALL W:ECOUT !!,"Processing cancelled" G END
. W !!,"Access to "_ECDN_" will be removed from all users."
W !! K DIC S DIC("S")="I $D(^VA(200,Y,""EC"",ECD))",DIC(0)="QEAMZ",DIC=200,DIC("A")="Inactivate "_ECDN_" from which User ? " D ^DIC K DIC G:Y<0 END S ECU=+Y,ECUN=$P(Y,"^",2)
K DIC,DA,DIK S DA=ECD,DA(1)=ECU,DIK="^VA(200,"_DA(1)_",""EC""," D ^DIK W !!,"Access to "_ECDN_" has been removed from "_ECUN_"." K DA,DIK G END
I ECU="" W !!,"Access for "_ECDN_" will be removed from all users.",!!,"All Event Code Screens will be inactivated for "_ECDN D ALL G UNIT
Q
ALL ; remove all units from all users
W !!,"Do you want to inactivate "_ECDN_" ? YES// " R ECYN:DTIME I '$T!(ECYN="^") S ECOUT=1 Q
S:ECYN="" ECYN="Y" S ECYN=$E(ECYN) I "YyNn"'[ECYN D G ALL
. W !!,"Enter <RET> if you want to inactivate this DSS Unit, or "
. W "NO to leave it active.",!!
. W "NOTE: If unit is inactivated it will be inaccessible during "
. W "patient data",!,?6,"entry; i.e none of its associated EC screens "
. W "(procedures) will be",!,?6,"available for patient data entry."
S INACT=ECYN,ECSCN=0,ECINC=DT I "Yy"[ECYN D SCN I ECOUT Q
I ECSCN W !!,"All Event Code Screens will be inactivated for "_ECDN
I "Yy"[INACT K DIE,DR S DIE=724,DA=ECD,DR="5////1" D ^DIE K DIE,DR
S ZTDESC="DEALLOCATE DSS UNIT",(ZTSAVE("ECD"),ZTSAVE("ECOUT"),ZTSAVE("ECDN"),ZTSAVE("ECSCN"),ZTSAVE("ECINC"))="",ZTRTN="DIK^ECDEAL",ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS K ZTSK Q
Q
SCN ;prompt to inactive event code screens associated with unit
W !!,"Do you want to inactivate all Event Code Screens associated with"
W !,"this DSS Unit? YES// " R ECYN:DTIME I '$T!(ECYN="^") S ECOUT=1 Q
S:ECYN="" ECYN="Y" S ECYN=$E(ECYN)
I "YyNn"'[ECYN D G SCN
. W !!,"Enter <RET> if you want to inactivate ALL Event Code Screens "
. W "for this DSS",!,"Unit, or NO to leave them active."
S ECSCN=$S("Yy"[ECYN:1,1:0)
I "Yy"[INACT,'ECSCN D
. W !!,"The "_ECDN_" DSS Unit has been inactivated. Event Code Screens"
. W !,"associated with that unit are no longer accessible to users."
. W !,"If you wish to inactivate individual Event Code Screens, use the"
. W !,"Inactivate Event Code Screens menu option."
Q
DIK ; entry when queued
S ECU=0 F I=0:0 S ECU=$O(^VA(200,ECU)) Q:'ECU I $D(^VA(200,ECU,"EC",ECD)) K DA,DIK S DA(1)=ECU,DA=ECD,DIK="^VA(200,"_DA(1)_",""EC""," D ^DIK
K DA,DIK
I ECSCN D INSCRN
I $D(ZTQUEUED) S ZTREQ="@"
Q
INSCRN ; inactivate screen codes
S EC=0
F EC=0:0 S EC=$O(^ECJ("AP",EC)) Q:'EC S ECC="" F S ECC=$O(^ECJ("AP",EC,ECD,ECC)) Q:ECC="" S ECA="" F S ECA=$O(^ECJ("AP",EC,ECD,ECC,ECA)) Q:ECA="" D
.K DA,DIE,DR S DIE="^ECJ(",DA=+$O(^ECJ("AP",EC,ECD,ECC,ECA,0))
.I ECINC,$P($G(^ECJ(DA,0)),U,2)'="" Q
.I ECINC="@",ECC,'$P($G(^ECD(ECD,0)),U,11) Q ;131 Don't reactivate an EC screen with a category if DSS unit is set to "no categories"
.S DR="1///"_ECINC D ^DIE
K EC,ECC,ECA,DA,DIE,DR
Q
END I 'ECOUT W !!,"Press <RET> to continue " R X:DTIME
W @IOF D ^ECKILL K ECSCN,INACT,ECINC S:$D(ZTQUEUED) ZTREQ="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECDEAL 4112 printed Oct 16, 2024@17:57:45 Page 2
ECDEAL ;BIR/MAM,JPW-Deallocate DSS Units ;1/22/16 14:33
+1 ;;2.0;EVENT CAPTURE;**13,19,25,131**;8 May 96;Build 13
+2 SET ECOUT=0
USER WRITE @IOF,!!,"Do you want to remove access to all DSS Units for a specific user ? NO// "
READ ECYN:DTIME
IF '$TEST!(ECYN["^")
GOTO END
+1 SET ECYN=$EXTRACT(ECYN)
if ECYN=""
SET ECYN="N"
IF "YyNn"'[ECYN
WRITE !!,"If you are removing access to a DSS Unit for one or more users, enter",!,"<RET>. If you want to remove access to all units for an individual user,"
+2 IF "YyNn"'[ECYN
WRITE !,"enter YES.",!!,"Press <RET> to continue "
READ X:DTIME
GOTO USER
+3 IF "Yy"[ECYN
DO ^ECDEAL1
GOTO END
UNIT if ECOUT
QUIT
WRITE @IOF
KILL DIC,DA
SET DIC(0)="QEAMZ"
SET DIC=724
SET DIC("A")="Remove User Access for which DSS Unit ? "
DO ^DIC
KILL DIC
if Y<0
GOTO END
SET ECD=+Y
SET ECDN=$PIECE(Y,"^",2)
U WRITE !!,"Do you want to remove access to this DSS Unit for all users ? NO// "
READ ECYN:DTIME
IF '$TEST!(ECYN="^")
GOTO END
+1 if ECYN=""
SET ECYN="N"
SET ECYN=$EXTRACT(ECYN)
IF "YyNn"'[ECYN
WRITE !!,"Enter <RET> if you are removing access to "_ECDN_" for an individual",!,"user or Y to remove access for ALL users."
GOTO U
+2 IF "Yy"[ECYN
Begin DoDot:1
+3 WRITE !!,"Access to "_ECDN_" will be removed from all users."
End DoDot:1
DO ALL
if ECOUT
WRITE !!,"Processing cancelled"
GOTO END
+4 WRITE !!
KILL DIC
SET DIC("S")="I $D(^VA(200,Y,""EC"",ECD))"
SET DIC(0)="QEAMZ"
SET DIC=200
SET DIC("A")="Inactivate "_ECDN_" from which User ? "
DO ^DIC
KILL DIC
if Y<0
GOTO END
SET ECU=+Y
SET ECUN=$PIECE(Y,"^",2)
+5 KILL DIC,DA,DIK
SET DA=ECD
SET DA(1)=ECU
SET DIK="^VA(200,"_DA(1)_",""EC"","
DO ^DIK
WRITE !!,"Access to "_ECDN_" has been removed from "_ECUN_"."
KILL DA,DIK
GOTO END
+6 IF ECU=""
WRITE !!,"Access for "_ECDN_" will be removed from all users.",!!,"All Event Code Screens will be inactivated for "_ECDN
DO ALL
GOTO UNIT
+7 QUIT
ALL ; remove all units from all users
+1 WRITE !!,"Do you want to inactivate "_ECDN_" ? YES// "
READ ECYN:DTIME
IF '$TEST!(ECYN="^")
SET ECOUT=1
QUIT
+2 if ECYN=""
SET ECYN="Y"
SET ECYN=$EXTRACT(ECYN)
IF "YyNn"'[ECYN
Begin DoDot:1
+3 WRITE !!,"Enter <RET> if you want to inactivate this DSS Unit, or "
+4 WRITE "NO to leave it active.",!!
+5 WRITE "NOTE: If unit is inactivated it will be inaccessible during "
+6 WRITE "patient data",!,?6,"entry; i.e none of its associated EC screens "
+7 WRITE "(procedures) will be",!,?6,"available for patient data entry."
End DoDot:1
GOTO ALL
+8 SET INACT=ECYN
SET ECSCN=0
SET ECINC=DT
IF "Yy"[ECYN
DO SCN
IF ECOUT
QUIT
+9 IF ECSCN
WRITE !!,"All Event Code Screens will be inactivated for "_ECDN
+10 IF "Yy"[INACT
KILL DIE,DR
SET DIE=724
SET DA=ECD
SET DR="5////1"
DO ^DIE
KILL DIE,DR
+11 SET ZTDESC="DEALLOCATE DSS UNIT"
SET (ZTSAVE("ECD"),ZTSAVE("ECOUT"),ZTSAVE("ECDN"),ZTSAVE("ECSCN"),ZTSAVE("ECINC"))=""
SET ZTRTN="DIK^ECDEAL"
SET ZTIO=""
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
QUIT
+12 QUIT
SCN ;prompt to inactive event code screens associated with unit
+1 WRITE !!,"Do you want to inactivate all Event Code Screens associated with"
+2 WRITE !,"this DSS Unit? YES// "
READ ECYN:DTIME
IF '$TEST!(ECYN="^")
SET ECOUT=1
QUIT
+3 if ECYN=""
SET ECYN="Y"
SET ECYN=$EXTRACT(ECYN)
+4 IF "YyNn"'[ECYN
Begin DoDot:1
+5 WRITE !!,"Enter <RET> if you want to inactivate ALL Event Code Screens "
+6 WRITE "for this DSS",!,"Unit, or NO to leave them active."
End DoDot:1
GOTO SCN
+7 SET ECSCN=$SELECT("Yy"[ECYN:1,1:0)
+8 IF "Yy"[INACT
IF 'ECSCN
Begin DoDot:1
+9 WRITE !!,"The "_ECDN_" DSS Unit has been inactivated. Event Code Screens"
+10 WRITE !,"associated with that unit are no longer accessible to users."
+11 WRITE !,"If you wish to inactivate individual Event Code Screens, use the"
+12 WRITE !,"Inactivate Event Code Screens menu option."
End DoDot:1
+13 QUIT
DIK ; entry when queued
+1 SET ECU=0
FOR I=0:0
SET ECU=$ORDER(^VA(200,ECU))
if 'ECU
QUIT
IF $DATA(^VA(200,ECU,"EC",ECD))
KILL DA,DIK
SET DA(1)=ECU
SET DA=ECD
SET DIK="^VA(200,"_DA(1)_",""EC"","
DO ^DIK
+2 KILL DA,DIK
+3 IF ECSCN
DO INSCRN
+4 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 QUIT
INSCRN ; inactivate screen codes
+1 SET EC=0
+2 FOR EC=0:0
SET EC=$ORDER(^ECJ("AP",EC))
if 'EC
QUIT
SET ECC=""
FOR
SET ECC=$ORDER(^ECJ("AP",EC,ECD,ECC))
if ECC=""
QUIT
SET ECA=""
FOR
SET ECA=$ORDER(^ECJ("AP",EC,ECD,ECC,ECA))
if ECA=""
QUIT
Begin DoDot:1
+3 KILL DA,DIE,DR
SET DIE="^ECJ("
SET DA=+$ORDER(^ECJ("AP",EC,ECD,ECC,ECA,0))
+4 IF ECINC
IF $PIECE($GET(^ECJ(DA,0)),U,2)'=""
QUIT
+5 ;131 Don't reactivate an EC screen with a category if DSS unit is set to "no categories"
IF ECINC="@"
IF ECC
IF '$PIECE($GET(^ECD(ECD,0)),U,11)
QUIT
+6 SET DR="1///"_ECINC
DO ^DIE
End DoDot:1
+7 KILL EC,ECC,ECA,DA,DIE,DR
+8 QUIT
END IF 'ECOUT
WRITE !!,"Press <RET> to continue "
READ X:DTIME
+1 WRITE @IOF
DO ^ECKILL
KILL ECSCN,INACT,ECINC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 QUIT
