ECDSSA.m

ECDSSA ;BIR/RHK,JPW-Activate/Inactivate Local Procedure Routine ;29 Apr 96

 ;;2.0; EVENT CAPTURE ;;8 May 96

SETDEAC ; Set inactivation date for local procedures

 W @IOF,!,"Inactivate Local Procedures",!

 K DA,DIC,DIE,DR S ECOUT=0

 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

 .S ECRN=+Y,ECPN=$P(Y,"^",2),(ECJLP,ECOUT)=0

 .I $P($G(^EC(725,ECRN,0)),"^",3)]"" D  Q:$D(DUOUT)!($D(DTOUT))  Q:ECJLP

 ..W !!,ECPN," is currently inactive."

 ..S DIR(0)="Y",DIR("A")="Do you wish to reactivate",DIR("B")="YES"

 ..S DIR("?")="Enter YES to reactivate this local procedure or NO leave inactive."

 ..D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S ECOUT=1 Q

 ..I 'Y W !,ECPN," remains inactive.",!!

 ..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

 .Q:$P($G(^EC(725,ECRN,0)),"^",3)]""

 .S DIR(0)="Y",DIR("A")="Do you wish to inactivate",DIR("B")="YES"

 .S DIR("?")="Enter YES to inactivate this local procedure or NO to leave active."

 .D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S ECOUT=1 Q

 .I 'Y W !,ECPN," remains active for use.",!!

 .I Y>0 S DIE=725,DA=ECRN,DR="2///TODAY" D ^DIE K DA,DIE,DR W !,ECPN," has been inactivated.",!!

 .K DA,DIC,DIE,DR,DTOUT,DUOUT,ECRN,ECPN

END ;kill variables

 D ^ECKILL

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECDSSA   1347     printed  Apr 09, 2024@21:03:35                                                                                                                                                                                                      Page 2

ECDSSA    ;BIR/RHK,JPW-Activate/Inactivate Local Procedure Routine ;29 Apr 96

 +1       ;;2.0; EVENT CAPTURE ;;8 May 96

SETDEAC   ; Set inactivation date for local procedures

 +1        WRITE @IOF,!,"Inactivate Local Procedures",!

 +2        KILL DA,DIC,DIE,DR

           SET ECOUT=0

 +3        FOR 

               SET DIC="^EC(725,"

               SET DIC(0)="AEQMZ"

               SET DIC("S")="I +Y>89999"

               SET DIC("A")="Select Local Procedure: "

               DO ^DIC

               KILL DIC

               if Y<0

                   QUIT 

               Begin DoDot:1

 +4                SET ECRN=+Y

                   SET ECPN=$PIECE(Y,"^",2)

                   SET (ECJLP,ECOUT)=0

 +5                IF $PIECE($GET(^EC(725,ECRN,0)),"^",3)]""

                       Begin DoDot:2

 +6                        WRITE !!,ECPN," is currently inactive."

 +7                        SET DIR(0)="Y"

                           SET DIR("A")="Do you wish to reactivate"

                           SET DIR("B")="YES"

 +8                        SET DIR("?")="Enter YES to reactivate this local procedure or NO leave inactive."

 +9                        DO ^DIR

                           KILL DIR

                           IF $DATA(DUOUT)!($DATA(DTOUT))

                               SET ECOUT=1

                               QUIT 

 +10                       IF 'Y

                               WRITE !,ECPN," remains inactive.",!!

 +11                       IF Y>0

                               SET DIE=725

                               SET DA=ECRN

                               SET DR="2///@"

                               DO ^DIE

                               KILL DA,DIE,DR

                               WRITE !,ECPN," has been reactivated for use.",!!

                               SET ECJLP=1

                       End DoDot:2

                       if $DATA(DUOUT)!($DATA(DTOUT))

                           QUIT 

                       if ECJLP

                           QUIT 

 +12               if $PIECE($GET(^EC(725,ECRN,0)),"^",3)]""

                       QUIT 

 +13               SET DIR(0)="Y"

                   SET DIR("A")="Do you wish to inactivate"

                   SET DIR("B")="YES"

 +14               SET DIR("?")="Enter YES to inactivate this local procedure or NO to leave active."

 +15               DO ^DIR

                   KILL DIR

                   IF $DATA(DUOUT)!($DATA(DTOUT))

                       SET ECOUT=1

                       QUIT 

 +16               IF 'Y

                       WRITE !,ECPN," remains active for use.",!!

 +17               IF Y>0

                       SET DIE=725

                       SET DA=ECRN

                       SET DR="2///TODAY"

                       DO ^DIE

                       KILL DA,DIE,DR

                       WRITE !,ECPN," has been inactivated.",!!

 +18               KILL DA,DIC,DIE,DR,DTOUT,DUOUT,ECRN,ECPN

               End DoDot:1

               if ECOUT

                   QUIT 

END       ;kill variables

 +1        DO ^ECKILL

 +2        QUIT