source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECDEAL.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1ECDEAL ;BIR/MAM,JPW-Deallocate DSS Units ;6 May 96
2 ;;2.0; EVENT CAPTURE ;**13,19,25**;8 May 96
3 S ECOUT=0
4USER 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
5 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,"
6 I "YyNn"'[ECYN W !,"enter YES.",!!,"Press <RET> to continue " R X:DTIME G USER
7 I "Yy"[ECYN D ^ECDEAL1 G END
8UNIT 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)
9U W !!,"Do you want to remove access to this DSS Unit for all users ? NO// " R ECYN:DTIME I '$T!(ECYN="^") G END
10 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
11 I "Yy"[ECYN D D ALL W:ECOUT !!,"Processing cancelled" G END
12 . W !!,"Access to "_ECDN_" will be removed from all users."
13 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)
14 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
15 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
16 Q
17ALL ; remove all units from all users
18 W !!,"Do you want to inactivate "_ECDN_" ? YES// " R ECYN:DTIME I '$T!(ECYN="^") S ECOUT=1 Q
19 S:ECYN="" ECYN="Y" S ECYN=$E(ECYN) I "YyNn"'[ECYN D G ALL
20 . W !!,"Enter <RET> if you want to inactivate this DSS Unit, or "
21 . W "NO to leave it active.",!!
22 . W "NOTE: If unit is inactivated it will be inaccessible during "
23 . W "patient data",!,?6,"entry; i.e none of its associated EC screens "
24 . W "(procedures) will be",!,?6,"available for patient data entry."
25 S INACT=ECYN,ECSCN=0,ECINC=DT I "Yy"[ECYN D SCN I ECOUT Q
26 I ECSCN W !!,"All Event Code Screens will be inactivated for "_ECDN
27 I "Yy"[INACT K DIE,DR S DIE=724,DA=ECD,DR="5////1" D ^DIE K DIE,DR
28 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
29 Q
30SCN ;prompt to inactive event code screens associated with unit
31 W !!,"Do you want to inactivate all Event Code Screens associated with"
32 W !,"this DSS Unit? YES// " R ECYN:DTIME I '$T!(ECYN="^") S ECOUT=1 Q
33 S:ECYN="" ECYN="Y" S ECYN=$E(ECYN)
34 I "YyNn"'[ECYN D G SCN
35 . W !!,"Enter <RET> if you want to inactivate ALL Event Code Screens "
36 . W "for this DSS",!,"Unit, or NO to leave them active."
37 S ECSCN=$S("Yy"[ECYN:1,1:0)
38 I "Yy"[INACT,'ECSCN D
39 . W !!,"The "_ECDN_" DSS Unit has been inactivated. Event Code Screens"
40 . W !,"associated with that unit are no longer accessible to users."
41 . W !,"If you wish to inactivate individual Event Code Screens, use the"
42 . W !,"Inactivate Event Code Screens menu option."
43 Q
44DIK ; entry when queued
45 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
46 K DA,DIK
47 I ECSCN D INSCRN
48 I $D(ZTQUEUED) S ZTREQ="@"
49 Q
50INSCRN ; inactivate screen codes
51 S EC=0
52 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
53 .K DA,DIE,DR S DIE="^ECJ(",DA=+$O(^ECJ("AP",EC,ECD,ECC,ECA,0))
54 .I ECINC,$P($G(^ECJ(DA,0)),U,2)'="" Q
55 .S DR="1///"_ECINC D ^DIE
56 K EC,ECC,ECA,DA,DIE,DR
57 Q
58END I 'ECOUT W !!,"Press <RET> to continue " R X:DTIME
59 W @IOF D ^ECKILL K ECSCN,INACT,ECINC S:$D(ZTQUEUED) ZTREQ="@"
60 Q
Note: See TracBrowser for help on using the repository browser.