Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECDEAL

ECDEAL.m

Go to the documentation of this file.
  1. 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
  1. S ECOUT=0
  1. 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
  1. 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,"
  1. I "YyNn"'[ECYN W !,"enter YES.",!!,"Press <RET> to continue " R X:DTIME G USER
  1. I "Yy"[ECYN D ^ECDEAL1 G END
  1. 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)
  1. U W !!,"Do you want to remove access to this DSS Unit for all users ? NO// " R ECYN:DTIME I '$T!(ECYN="^") G END
  1. 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
  1. I "Yy"[ECYN D D ALL W:ECOUT !!,"Processing cancelled" G END
  1. . W !!,"Access to "_ECDN_" will be removed from all users."
  1. 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)
  1. 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
  1. 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
  1. Q
  1. ALL ; remove all units from all users
  1. W !!,"Do you want to inactivate "_ECDN_" ? YES// " R ECYN:DTIME I '$T!(ECYN="^") S ECOUT=1 Q
  1. S:ECYN="" ECYN="Y" S ECYN=$E(ECYN) I "YyNn"'[ECYN D G ALL
  1. . W !!,"Enter <RET> if you want to inactivate this DSS Unit, or "
  1. . W "NO to leave it active.",!!
  1. . W "NOTE: If unit is inactivated it will be inaccessible during "
  1. . W "patient data",!,?6,"entry; i.e none of its associated EC screens "
  1. . W "(procedures) will be",!,?6,"available for patient data entry."
  1. S INACT=ECYN,ECSCN=0,ECINC=DT I "Yy"[ECYN D SCN I ECOUT Q
  1. I ECSCN W !!,"All Event Code Screens will be inactivated for "_ECDN
  1. I "Yy"[INACT K DIE,DR S DIE=724,DA=ECD,DR="5////1" D ^DIE K DIE,DR
  1. 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
  1. Q
  1. SCN ;prompt to inactive event code screens associated with unit
  1. W !!,"Do you want to inactivate all Event Code Screens associated with"
  1. W !,"this DSS Unit? YES// " R ECYN:DTIME I '$T!(ECYN="^") S ECOUT=1 Q
  1. S:ECYN="" ECYN="Y" S ECYN=$E(ECYN)
  1. I "YyNn"'[ECYN D G SCN
  1. . W !!,"Enter <RET> if you want to inactivate ALL Event Code Screens "
  1. . W "for this DSS",!,"Unit, or NO to leave them active."
  1. S ECSCN=$S("Yy"[ECYN:1,1:0)
  1. I "Yy"[INACT,'ECSCN D
  1. . W !!,"The "_ECDN_" DSS Unit has been inactivated. Event Code Screens"
  1. . W !,"associated with that unit are no longer accessible to users."
  1. . W !,"If you wish to inactivate individual Event Code Screens, use the"
  1. . W !,"Inactivate Event Code Screens menu option."
  1. Q
  1. DIK ; entry when queued
  1. 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
  1. K DA,DIK
  1. I ECSCN D INSCRN
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. Q
  1. INSCRN ; inactivate screen codes
  1. S EC=0
  1. 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
  1. .K DA,DIE,DR S DIE="^ECJ(",DA=+$O(^ECJ("AP",EC,ECD,ECC,ECA,0))
  1. .I ECINC,$P($G(^ECJ(DA,0)),U,2)'="" Q
  1. .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"
  1. .S DR="1///"_ECINC D ^DIE
  1. K EC,ECC,ECA,DA,DIE,DR
  1. Q
  1. END I 'ECOUT W !!,"Press <RET> to continue " R X:DTIME
  1. W @IOF D ^ECKILL K ECSCN,INACT,ECINC S:$D(ZTQUEUED) ZTREQ="@"
  1. Q