| [613] | 1 | ECDSS2 ;BIR/RHK,JPW-Local Category Routine ;1 May 96
 | 
|---|
 | 2 |  ;;2.0; EVENT CAPTURE ;**1**;8 May 96
 | 
|---|
 | 3 | EDITC ; 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
 | 
|---|
 | 10 | SETDEAC ; 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
 | 
|---|
 | 27 | END ;kill variables and exit
 | 
|---|
 | 28 |  D ^ECKILL
 | 
|---|
 | 29 |  Q
 | 
|---|