source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECDSSA.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1ECDSSA ;BIR/RHK,JPW-Activate/Inactivate Local Procedure Routine ;29 Apr 96
2 ;;2.0; EVENT CAPTURE ;;8 May 96
3SETDEAC ; 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
22END ;kill variables
23 D ^ECKILL
24 Q
Note: See TracBrowser for help on using the repository browser.