source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECDSS2.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: 1.5 KB
Line 
1ECDSS2 ;BIR/RHK,JPW-Local Category Routine ;1 May 96
2 ;;2.0; EVENT CAPTURE ;**1**;8 May 96
3EDITC ; Create/Edit local categories
4 W @IOF,!,"Enter/Edit Local Categories",!
5 K DA,DIC,DIE,DLAYGO,DR
6 F W ! S DIC=726,DIC(0)="AEQLMZ",DIC("A")="Select Category: ",DLAYGO=726 D ^DIC K DIC,DLAYGO Q:Y<0 D
7 .S DA=+Y I $P(Y,"^",3) S $P(^EC(726,DA,0),"^",2)=$G(DT)
8 .S DIE=726,DR=".01T" D ^DIE K DA,DIE,DR
9 G END
10SETDEAC ; Set inactivation date for local categories
11 W @IOF,!,"Inactivate Categories",!
12 K DA,DIC,DIE,DLAYGO,DR S ECOUT=0
13 F S DIC="^EC(726,",DIC(0)="AEQMZ",DIC("A")="Select Category: " D ^DIC K DIC Q:Y<0 D Q:ECOUT
14 .S ECC=+Y,ECCN=$P(Y,"^",2),(ECJLP,ECOUT)=0
15 .I $P($G(^EC(726,ECC,0)),"^",3)]"" D Q:$D(DUOUT)!($D(DTOUT)) Q:ECJLP
16 ..W !!,ECCN," is currently inactive."
17 ..S DIR(0)="Y",DIR("A")="Do you wish to reactivate",DIR("B")="YES"
18 ..S DIR("?")="Enter YES to reactivate this category or NO to leave inactive."
19 ..D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S ECOUT=1 Q
20 ..I Y>0 S DIE=726,DA=ECC,DR="2///@" D ^DIE K DA,DIE,DR W !,ECCN," has been reactivated for use.",!! S ECJLP=1 Q
21 ..I 'Y W !,ECCN," remains inactive.",!! S ECJLP=1 Q
22 .S DIR(0)="Y",DIR("A")="Do you wish to inactivate",DIR("B")="YES"
23 .S DIR("?")="Enter YES to inactivate this category or NO to leave active."
24 .D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S ECOUT=1 Q
25 .I Y>0 S DIE=726,DA=ECC,DR="2///TODAY" D ^DIE K DA,DIE,DR W !,ECCN," has been inactivated.",!!
26 .K DA,DIC,DIE,DR,DTOUT,DUOUT,ECC,ECCN
27END ;kill variables and exit
28 D ^ECKILL
29 Q
Note: See TracBrowser for help on using the repository browser.