- 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 Dec 13, 2024@01:57:01 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