| 1 | ECDSSA ;BIR/RHK,JPW-Activate/Inactivate Local Procedure Routine ;29 Apr 96
 | 
|---|
| 2 |  ;;2.0; EVENT CAPTURE ;;8 May 96
 | 
|---|
| 3 | SETDEAC ; Set inactivation date for local procedures
 | 
|---|
| 4 |  W @IOF,!,"Inactivate Local Procedures",!
 | 
|---|
| 5 |  K DA,DIC,DIE,DR S ECOUT=0
 | 
|---|
| 6 |  F  S DIC="^EC(725,",DIC(0)="AEQMZ",DIC("S")="I +Y>89999",DIC("A")="Select Local Procedure: " D ^DIC K DIC Q:Y<0  D  Q:ECOUT
 | 
|---|
| 7 |  .S ECRN=+Y,ECPN=$P(Y,"^",2),(ECJLP,ECOUT)=0
 | 
|---|
| 8 |  .I $P($G(^EC(725,ECRN,0)),"^",3)]"" D  Q:$D(DUOUT)!($D(DTOUT))  Q:ECJLP
 | 
|---|
| 9 |  ..W !!,ECPN," is currently inactive."
 | 
|---|
| 10 |  ..S DIR(0)="Y",DIR("A")="Do you wish to reactivate",DIR("B")="YES"
 | 
|---|
| 11 |  ..S DIR("?")="Enter YES to reactivate this local procedure or NO leave inactive."
 | 
|---|
| 12 |  ..D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S ECOUT=1 Q
 | 
|---|
| 13 |  ..I 'Y W !,ECPN," remains inactive.",!!
 | 
|---|
| 14 |  ..I Y>0 S DIE=725,DA=ECRN,DR="2///@" D ^DIE K DA,DIE,DR W !,ECPN," has been reactivated for use.",!! S ECJLP=1
 | 
|---|
| 15 |  .Q:$P($G(^EC(725,ECRN,0)),"^",3)]""
 | 
|---|
| 16 |  .S DIR(0)="Y",DIR("A")="Do you wish to inactivate",DIR("B")="YES"
 | 
|---|
| 17 |  .S DIR("?")="Enter YES to inactivate this local procedure or NO to leave active."
 | 
|---|
| 18 |  .D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S ECOUT=1 Q
 | 
|---|
| 19 |  .I 'Y W !,ECPN," remains active for use.",!!
 | 
|---|
| 20 |  .I Y>0 S DIE=725,DA=ECRN,DR="2///TODAY" D ^DIE K DA,DIE,DR W !,ECPN," has been inactivated.",!!
 | 
|---|
| 21 |  .K DA,DIC,DIE,DR,DTOUT,DUOUT,ECRN,ECPN
 | 
|---|
| 22 | END ;kill variables
 | 
|---|
| 23 |  D ^ECKILL
 | 
|---|
| 24 |  Q
 | 
|---|